1 (*******************************************************************
2 *
3 * TTDebug.Pas 1.2
4 *
5 * This unit is only used by the debugger.
6 *
7 * Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg
8 *
9 * This file is part of the FreeType project, and may only be used
10 * modified and distributed under the terms of the FreeType project
11 * license, LICENSE.TXT. By continuing to use, modify or distribute
12 * this file you indicate that you have read the license and
13 * understand and accept it fully.
14 *
15 ******************************************************************)
16
17 unit TTDebug;
18
19 interface
20
21 {$mode Delphi}
22
23 uses SysUtils, TTTypes, TTObjs;
24
25 type
26
27 ByteHexStr = string[2]; (* hex representation of a byte *)
28 ShortHexStr = string[4]; (* " " " short *)
29 LongHexStr = string[8]; (* " " " long *)
30 DebugStr = string[128]; (* disassembled line output *)
31
32 { TBreakPoint }
33
34 { A simple record to hold breakpoint information }
35 { it may be completed later with pass count, etc.. }
36 { They must be in a sorted linked list }
37
38 PBreakPoint = ^TBreakPoint;
39 TBreakPoint = record
40 Next : PBreakPoint;
41 Range : Int;
42 Address : Int;
43 end;
44
45 { TRangeRec }
46
47 { a record to store line number information and breakpoints list }
48
49 PRangeRec = ^TRangeRec;
50 TRangeRec = record
51 Code : PByte;
52 Size : Int;
53 index : Int;
54 NLines : Int;
55 Disassembled : PUShort;
56 Breaks : PBreakPoint;
57 end;
58
59
60 { Generate_Range : Generate Line Number information specific to }
61 { a given range }
62
63 procedure Generate_Range( CR : PCodeRange;
64 index : Int;
65 var RR : TRangeRec );
66
67 { Throw_Range : Discard Line Number Information }
68
69 procedure Throw_Range( var RR : TRangeRec );
70
71 { Toggle_Break : Toggle a breakpoint }
72
73 procedure Toggle_Break( var Head : PBreakPoint; Range, Adr : Int );
74
75 { Set_Break : Set a breakpoint on a given address }
76
77 procedure Set_Break ( var Head : PBreakPoint; Range, Adr : Int );
78
79 { Clear_Break : Clear one specific breakpoint }
80
81 procedure Clear_Break( var Head : PBreakPoint; Bp : PBreakPoint );
82
83 { Clear_All_Breaks : Clear breakpoint list }
84
85 procedure Clear_All_Breaks( var Head : PBreakPoint );
86
87 { Find_Breakpoint : find one breakpoint at a given address }
88
Find_BreakPointnull89 function Find_BreakPoint( Head : PBreakPoint; Range, IP : Int ) : PBreakPoint;
90
91 { Cur_U_Line : returns the current disassembled line at Code(IP) }
92
Cur_U_Linenull93 function Cur_U_Line( Code : PByte; IP : Int ) : DebugStr;
94
95 { Get_Length : returns the length of the current opcode at Code(IP) }
96
Get_Lengthnull97 function Get_Length( Code : PByte; IP : Int ) : Int;
98
Get_Dis_Linenull99 function Get_Dis_Line( var cr : TRangeRec; addr : Int ) : Int;
100
101
102 { Hex_N : returns an hexadecimal string }
103
Hex8null104 function Hex8 ( B : Byte ) : ByteHexStr;
Hex16null105 function Hex16( W : word ) : ShortHexStr;
Hex32null106 function Hex32( L : Long ) : LongHexStr;
107
108
109 implementation
110
111 {type
112 TStorageLong = record (* do-it-all union record type *)
113 case Byte of
114 0 : ( L : LongInt );
115 1 : ( S1, S2 : Integer );
116 2 : ( W1, W2 : Word );
117 3 : ( B1, B2,
118 B3, B4 : Byte );
119 4 : ( P : Pointer );
120 end;
121 }
122 const
123 OpStr : array[ 0..255 ] of String[10]
124 = (
125 'SVTCA y', (* Set vectors to coordinate axis y *)
126 'SVTCA x', (* Set vectors to coordinate axis x *)
127 'SPvTCA y', (* Set Proj. vec. to coord. axis y *)
128 'SPvTCA x', (* Set Proj. vec. to coord. axis x *)
129 'SFvTCA y', (* Set Free. vec. to coord. axis y *)
130 'SFvTCA x', (* Set Free. vec. to coord. axis x *)
131 'SPvTL //', (* Set Proj. vec. parallel to segment *)
132 'SPvTL +', (* Set Proj. vec. normal to segment *)
133 'SFvTL //', (* Set Free. vec. parallel to segment *)
134 'SFvTL +', (* Set Free. vec. normal to segment *)
135 'SPvFS', (* Set Proj. vec. from stack *)
136 'SFvFS', (* Set Free. vec. from stack *)
137 'GPV', (* Get projection vector *)
138 'GFV', (* Get freedom vector *)
139 'SFvTPv', (* Set free. vec. to proj. vec. *)
140 'ISECT', (* compute intersection *)
141
142 'SRP0', (* Set reference point 0 *)
143 'SRP1', (* Set reference point 1 *)
144 'SRP2', (* Set reference point 2 *)
145 'SZP0', (* Set Zone Pointer 0 *)
146 'SZP1', (* Set Zone Pointer 1 *)
147 'SZP2', (* Set Zone Pointer 2 *)
148 'SZPS', (* Set all zone pointers *)
149 'SLOOP', (* Set loop counter *)
150 'RTG', (* Round to Grid *)
151 'RTHG', (* Round to Half-Grid *)
152 'SMD', (* Set Minimum Distance *)
153 'ELSE', (* Else *)
154 'JMPR', (* Jump Relative *)
155 'SCvTCi', (* Set CVT *)
156 'SSwCi', (* *)
157 'SSW', (* *)
158
159 'DUP',
160 'POP',
161 'CLEAR',
162 'SWAP',
163 'DEPTH',
164 'CINDEX',
165 'MINDEX',
166 'AlignPTS',
167 'INS_$28',
168 'UTP',
169 'LOOPCALL',
170 'CALL',
171 'FDEF',
172 'ENDF',
173 'MDAP[-]',
174 'MDAP[r]',
175
176 'IUP[y]',
177 'IUP[x]',
178 'SHP[0]',
179 'SHP[1]',
180 'SHC[0]',
181 'SHC[1]',
182 'SHZ[0]',
183 'SHZ[1]',
184 'SHPIX',
185 'IP',
186 'MSIRP[0]',
187 'MSIRP[1]',
188 'AlignRP',
189 'RTDG',
190 'MIAP[-]',
191 'MIAP[r]',
192
193 'NPushB',
194 'NPushW',
195 'WS',
196 'RS',
197 'WCvtP',
198 'RCvt',
199 'GC[0]',
200 'GC[1]',
201 'SCFS',
202 'MD[0]',
203 'MD[1]',
204 'MPPEM',
205 'MPS',
206 'FlipON',
207 'FlipOFF',
208 'DEBUG',
209
210 'LT',
211 'LTEQ',
212 'GT',
213 'GTEQ',
214 'EQ',
215 'NEQ',
216 'ODD',
217 'EVEN',
218 'IF',
219 'EIF',
220 'AND',
221 'OR',
222 'NOT',
223 'DeltaP1',
224 'SDB',
225 'SDS',
226
227 'ADD',
228 'SUB',
229 'DIV',
230 'MUL',
231 'ABS',
232 'NEG',
233 'FLOOR',
234 'CEILING',
235 'ROUND[G]',
236 'ROUND[B]',
237 'ROUND[W]',
238 'ROUND[?]',
239 'NROUND[G]',
240 'NROUND[B]',
241 'NROUND[W]',
242 'NROUND[?]',
243
244 'WCvtF',
245 'DeltaP2',
246 'DeltaP3',
247 'DeltaC1',
248 'DeltaC2',
249 'DeltaC3',
250 'SROUND',
251 'S45Round',
252 'JROT',
253 'JROF',
254 'ROFF',
255 'INS_$7B',
256 'RUTG',
257 'RDTG',
258 'SANGW',
259 'AA',
260
261 'FlipPT',
262 'FlipRgON',
263 'FlipRgOFF',
264 'INS_$83',
265 'INS_$84',
266 'ScanCTRL',
267 'SDPVTL[0]',
268 'SDPVTL[1]',
269 'GetINFO',
270 'IDEF',
271 'ROLL',
272 'MAX',
273 'MIN',
274 'ScanTYPE',
275 'IntCTRL',
276 'INS_$8F',
277
278 'INS_$90',
279 'INS_$91',
280 'INS_$92',
281 'INS_$93',
282 'INS_$94',
283 'INS_$95',
284 'INS_$96',
285 'INS_$97',
286 'INS_$98',
287 'INS_$99',
288 'INS_$9A',
289 'INS_$9B',
290 'INS_$9C',
291 'INS_$9D',
292 'INS_$9E',
293 'INS_$9F',
294
295 'INS_$A0',
296 'INS_$A1',
297 'INS_$A2',
298 'INS_$A3',
299 'INS_$A4',
300 'INS_$A5',
301 'INS_$A6',
302 'INS_$A7',
303 'INS_$A8',
304 'INS_$A9',
305 'INS_$AA',
306 'INS_$AB',
307 'INS_$AC',
308 'INS_$AD',
309 'INS_$AE',
310 'INS_$AF',
311
312 'PushB[0]',
313 'PushB[1]',
314 'PushB[2]',
315 'PushB[3]',
316 'PushB[4]',
317 'PushB[5]',
318 'PushB[6]',
319 'PushB[7]',
320 'PushW[0]',
321 'PushW[1]',
322 'PushW[2]',
323 'PushW[3]',
324 'PushW[4]',
325 'PushW[5]',
326 'PushW[6]',
327 'PushW[7]',
328
329 'MDRP[G]',
330 'MDRP[B]',
331 'MDRP[W]',
332 'MDRP[?]',
333 'MDRP[rG]',
334 'MDRP[rB]',
335 'MDRP[rW]',
336 'MDRP[r?]',
337 'MDRP[mG]',
338 'MDRP[mB]',
339 'MDRP[mW]',
340 'MDRP[m?]',
341 'MDRP[mrG]',
342 'MDRP[mrB]',
343 'MDRP[mrW]',
344 'MDRP[mr?]',
345 'MDRP[pG]',
346 'MDRP[pB]',
347
348 'MDRP[pW]',
349 'MDRP[p?]',
350 'MDRP[prG]',
351 'MDRP[prB]',
352 'MDRP[prW]',
353 'MDRP[pr?]',
354 'MDRP[pmG]',
355 'MDRP[pmB]',
356 'MDRP[pmW]',
357 'MDRP[pm?]',
358 'MDRP[pmrG]',
359 'MDRP[pmrB]',
360 'MDRP[pmrW]',
361 'MDRP[pmr?]',
362
363 'MIRP[G]',
364 'MIRP[B]',
365 'MIRP[W]',
366 'MIRP[?]',
367 'MIRP[rG]',
368 'MIRP[rB]',
369 'MIRP[rW]',
370 'MIRP[r?]',
371 'MIRP[mG]',
372 'MIRP[mB]',
373 'MIRP[mW]',
374 'MIRP[m?]',
375 'MIRP[mrG]',
376 'MIRP[mrB]',
377 'MIRP[mrW]',
378 'MIRP[mr?]',
379 'MIRP[pG]',
380 'MIRP[pB]',
381
382 'MIRP[pW]',
383 'MIRP[p?]',
384 'MIRP[prG]',
385 'MIRP[prB]',
386 'MIRP[prW]',
387 'MIRP[pr?]',
388 'MIRP[pmG]',
389 'MIRP[pmB]',
390 'MIRP[pmW]',
391 'MIRP[pm?]',
392 'MIRP[pmrG]',
393 'MIRP[pmrB]',
394 'MIRP[pmrW]',
395 'MIRP[pmr?]'
396 );
397
398 const
399 HexStr : string[16] = '0123456789abcdef';
400
401 (*******************************************************************
402 *
403 * Function : Hex8
404 *
405 * Description : Returns the string hexadecimal representation
406 * of a Byte.
407 *
408 * Input : B byte
409 *
410 * Output : two-chars string
411 *
412 *****************************************************************)
413
Hex8null414 function Hex8( B : Byte ) : ByteHexStr;
415 var
416 S : ByteHexStr;
417 begin
418 S[0] :=#2;
419 S[1] := HexStr[ 1+( B shr 4 ) ];
420 S[2] := HexStr[ 1+( B and 15 )];
421 Hex8 := S;
422 end;
423
424 (*******************************************************************
425 *
426 * Function : Hex16
427 *
428 * Description : Returns the string hexadecimal representation
429 * of a Short.
430 *
431 * Input : W word
432 *
433 * Output : four-chars string
434 *
435 *****************************************************************)
436
Hex16null437 function Hex16( W : word ) : ShortHexStr;
438 begin
439 Hex16 := Hex8( Hi(w) )+Hex8( Lo(w) );
440 end;
441
442 (*******************************************************************
443 *
444 * Function : Hex32
445 *
446 * Description : Returns the string hexadecimal representation
447 * of a Long.
448 *
449 * Input : L Long
450 *
451 * Output : eight-chars string
452 *
453 *****************************************************************)
454
Hex32null455 function Hex32( L : Long ) : LongHexStr;
456 begin
457 Result := SysUtils.IntToHex(L, 8);
458 // Hex32 := Hex16( TStorageLong(L).W2 )+Hex16( TStorageLong(L).W1 );
459 end;
460
461 (*******************************************************************
462 *
463 * Function : Cur_U_Line
464 *
465 * Description : Returns a string of the current unassembled
466 * line at Code^[IP].
467 *
468 * Input : Code base code range
469 * IP current instruction pointer
470 *
471 * Output : line string
472 *
473 *****************************************************************)
474
Cur_U_Linenull475 function Cur_U_Line( Code : PByte; IP : Int ) : DebugStr;
476 var
477 Op : Byte;
478 N, I : Int;
479 S : DebugStr;
480 begin
481
482 Op := Code^[IP];
483 S := Hex16(IP)+': '+Hex8(Op)+' '+OpStr[Op];
484
485 case Op of
486
487 $40 : begin
488 n := Code^[IP+1];
489 S := S+'('+Hex8(n)+')';
490 for i := 1 to n do
491 S := S+' $'+Hex8( Code^[Ip+i+1] );
492 end;
493
494 $41 : begin
495 n := Code^[IP+1];
496 S := S+'('+Hex8(n)+')';
497 for i := 1 to n do
498 S := S+' $'+Hex8( Code^[Ip+i*2+1] )+Hex8( Code^[Ip+i*2+2] );
499 end;
500
501 $B0..$B7 : begin
502 n := Op-$B0;
503 for i := 0 to N do
504 S := S+' $'+Hex8( Code^[Ip+i+1] );
505 end;
506
507 $B8..$BF : begin
508 n := Op-$B8;
509 for i := 0 to N do
510 S := S+' $'+Hex8( Code^[IP+i*2+1] )+Hex8( Code^[Ip+i*2+2] );
511 end;
512
513 end;
514
515 Cur_U_Line := S;
516 end;
517
518 (*******************************************************************
519 *
520 * Function : Get_Length
521 *
522 * Description : Returns the length in bytes of the instruction at
523 * current instruction pointer.
524 *
525 * Input : Code base code range
526 * IP current instruction pointer
527 *
528 * Output : Length in bytes
529 *
530 *****************************************************************)
531
Get_Lengthnull532 function Get_Length( Code : PByte; IP : Int ) : Int;
533 var
534 Op : Byte;
535 N : Int;
536 begin
537
538 Op := Code^[IP];
539
540 case Op of
541
542 $40 : N := 2 + Code^[IP+1];
543 $41 : N := 2 + Code^[IP+1]*2;
544
545 $B0..$B7 : N := 2 + ( Op-$B0 );
546 $B8..$BF : N := 3 + ( Op-$B8 )*2
547
548 else
549 N := 1;
550 end;
551
552 Get_Length := N;
553
554 end;
555
556 (*******************************************************************
557 *
558 * Function : Generate_Range
559 *
560 * Description : Create a list of unassembled lines for a
561 * given code range
562 *
563 * Input :
564 *
565 * Output :
566 *
567 *****************************************************************)
568
569 procedure Generate_Range( CR : PCodeRange;
570 index : Int;
571 var RR : TRangeRec );
572 var
573 Adr, Line, N : Int;
574 begin
575
576 N := CR^.Size;
577
578 RR.Code := PByte( CR^.Base );
579 RR.Size := N;
580
581 Line := 0;
582
583 if N > 0 then
584 begin
585 Adr := 0;
586 GetMem( RR.Disassembled, sizeof(Short) * N );
587
588 while Adr < N do
589 begin
590 RR.Disassembled^[Line] := Adr;
591 inc( Line );
592 inc( Adr, Get_Length( RR.Code, Adr ));
593 end;
594 end;
595
596 RR.NLines := Line;
597 RR.Index := index;
598 RR.Breaks := nil;
599 end;
600
601 (*******************************************************************
602 *
603 * Function : Get_Dis_Line
604 *
605 * Description : Returns the line index of address 'addr'
606 * in the coderange 'cr'
607 *
608 *****************************************************************)
609
Get_Dis_Linenull610 function Get_Dis_Line( var cr : TRangeRec; addr : Int ) : Int;
611 var
612 l, r, m : Int;
613 begin
614 if (cr.NLines = 0) or
615 (addr > cr.Disassembled^[cr.Nlines-1] ) then
616 begin
617 Get_Dis_Line := -1;
618 exit;
619 end;
620
621 l := 0;
622 r := cr.NLines-1;
623
624 while ( r-l > 1 ) do
625 begin
626 if cr.Disassembled^[l] = addr then
627 begin
628 Get_Dis_Line := l;
629 exit;
630 end;
631
632 if cr.Disassembled^[r] = addr then
633 begin
634 Get_Dis_Line := r;
635 exit;
636 end;
637
638 m := (l+r) shr 1;
639 if cr.Disassembled^[m] = addr then
640 begin
641 Get_Dis_Line := m;
642 exit;
643 end
644 else
645 if cr.Disassembled^[m] < addr then
646 l := m
647 else
648 r := m;
649 end;
650
651 if cr.Disassembled^[r] = addr then
652 begin
653 Get_Dis_Line := r;
654 exit;
655 end;
656
657 Get_Dis_Line := l;
658
659 end;
660
661 (*******************************************************************
662 *
663 * Function : Throw_Range
664 *
665 * Description : Destroys a list of unassembled lines for a
666 * given code range
667 *
668 * Input :
669 *
670 * Output :
671 *
672 *****************************************************************)
673
674 procedure Throw_Range( var RR : TRangeRec );
675 var
676 B, Bnext : PBreakPoint;
677 begin
678
679 if RR.Size > 0 then
680 FreeMem( RR.Disassembled, RR.Size * sizeof(Short) );
681
682 RR.Disassembled := nil;
683 RR.Size := 0;
684 RR.Code := nil;
685 RR.NLines := 0;
686
687 B := RR.Breaks;
688 RR.Breaks := nil;
689
690 while B<>nil do
691 begin
692 Bnext := B^.Next;
693 Dispose( B );
694 B := Bnext;
695 end;
696 end;
697
698 (*******************************************************************
699 *
700 * Function : Set_Break
701 *
702 * Description : Sets a Breakpoint ON
703 *
704 * Input :
705 *
706 * Output :
707 *
708 *****************************************************************)
709
710 procedure Set_Break( var Head : PBreakPoint;
711 Range : Int;
712 Adr : Int );
713 var
714 BP,
715 Old,
716 Cur : PBreakPoint;
717 begin
718 Old := nil;
719 Cur := Head;
720
721 while (Cur <> nil) and (Cur^.Address < Adr) do
722 begin
723 Old := Cur;
724 Cur := Cur^.Next;
725 end;
726
727 { No duplicates }
728 if Cur <> nil then
729 if (Cur^.Address = Adr) and (Cur^.Range = Range) then exit;
730
731 New( BP );
732 BP^.Address := Adr;
733 BP^.Range := Range;
734 BP^.Next := Cur;
735
736 if Old = nil then
737 Head := BP
738 else
739 Old^.Next := BP;
740 end;
741
742 (*******************************************************************
743 *
744 * Function : Clear_Break
745 *
746 * Description : Clears a breakpoint OFF
747 *
748 * Input :
749 *
750 * Output :
751 *
752 *****************************************************************)
753
754 procedure Clear_Break( var Head : PBreakPoint; Bp : PBreakPoint );
755 var
756 Old,
757 Cur : PBreakPoint;
758 begin
759 Old := nil;
760 Cur := Head;
761
762 while (Cur <> nil) and (Cur <> Bp) do
763 begin
764 Old := Cur;
765 Cur := Cur^.Next;
766 end;
767
768 if Cur = nil then exit;
769
770 if Old = nil then
771 Head := Cur^.Next
772 else
773 Old^.Next := Cur^.Next;
774 end;
775
776
777
778 procedure Toggle_Break( var Head : PBreakPoint; Range, Adr : Int );
779 var
780 Bp : PBreakPoint;
781 begin
782 Bp := Find_BreakPoint( Head, Range, Adr );
783 if Bp <> nil then Clear_Break( Head, Bp )
784 else Set_Break( Head, Range, Adr );
785 end;
786
787 (*******************************************************************
788 *
789 * Function : Clear_All_Breaks
790 *
791 * Description : Clears all breakpoints
792 *
793 * Input :
794 *
795 * Output :
796 *
797 *****************************************************************)
798
799 procedure Clear_All_Breaks( var Head : PBreakPoint );
800 var
801 Old,
802 Cur : PBreakPoint;
803 begin
804 Cur := Head;
805 Head := Nil;
806
807 while Cur <> nil do
808 begin
809 Old := Cur;
810 Cur := Cur^.Next;
811 Dispose( Old );
812 end;
813 end;
814
815 (*******************************************************************
816 *
817 * Function : Find_BreakPoint
818 *
819 * Description : Find a breakpoint at address IP
820 *
821 * Input : Head break points sorted linked list
822 * IP address of expected breakpoint
823 *
824 * Output : pointer to breakpoint if found
825 * nil otherwise.
826 *
827 *****************************************************************)
828
Find_BreakPointnull829 function Find_BreakPoint( Head : PBreakPoint; Range, IP : Int ) : PBreakPoint;
830 var
831 Cur : PBreakPoint;
832 Res : PBreakPoint;
833 begin
834 Cur := Head;
835 Res := nil;
836
837 while Cur <> nil do
838 begin
839 if (Cur^.Address = IP ) and
840 (Cur^.Range = Range) then Res := Cur;
841
842 if (Cur^.Address >= IP) then Cur := nil
843 else Cur := Cur^.Next;
844 end;
845
846 Find_BreakPoint := Res;
847 end;
848
849 end.
850