← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/vnc4/gutsy

« back to all changes in this revision

Viewing changes to unix/xc/extras/FreeType/pascal/lib/ttdebug.pas

  • Committer: Bazaar Package Importer
  • Author(s): Ola Lundqvist
  • Date: 2006-05-15 20:35:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060515203517-l4lre1ku942mn26k
Tags: 4.1.1+X4.3.0-10
* Correction of critical security issue. Thanks to Martin Kogler
  <e9925248@student.tuwien.ac.at> that informed me about the issue,
  and provided the patch.
  This flaw was originally found by Steve Wiseman of intelliadmin.com.
* Applied patch from Javier Kohen <jkohen@users.sourceforge.net> that
  inform the user that only 8 first characters of the password will
  actually be used when typing more than 8 characters, closes:
  #355619.

Show diffs side-by-side

added added

removed removed

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