PACKET tracer DEFINES breakpoint handler , (* M. Staubermann *) handlers module nr , (* 20.04.86 *) list breakpoints , set breakpoint , reset breakpoint , source file , trace , reset breakpoints : LET local base field = 25 , packet data segment = 0 , local data segment = 1 , begin of module nr link table = 512 , previous local base offset = 0 , return address offset = 1 , return segment offset = 2 , c8k offset = 3 , opcode mask = 31744 , bt opcode = 0 , btlong opcode = 1024 , bf opcode = 28672 , bflong opcode = 29696 , br opcode = 28672 , brlong opcode = 29696 , ln opcode = 0 , ln long opcode = 1024 , call opcode = 30720 , pcall opcode = 32543 ; LET nr of breakpoints = 2 , BREAKPOINT = STRUCT (BOOL set, INT segment, address, saved word) ; ROW nr of breakpoints BREAKPOINT VAR breakpoints ; BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, 3, -5, 0) ; FOR i FROM 1 UPTO nr of breakpoints REP breakpoints (i) := init breakpoint PER ; BOOL VAR auto trace := FALSE , zweizeilig ; INT VAR next instruction address , next instruction segment , next instruction , return segment, return address, breakpoint address , breakpoint segment , breakpoint nr , lbas , this local base , branch address , c8k , packet base , op word, saved word , i, x, y , actual line number := -1 , handler module := 395 ; (* PROC stop *) TEXT VAR key := "" , previous key := "" , statement line := "" , source line := "" , source file name := "" ; FILE VAR source ; PROC trace (BOOL CONST b) : auto trace := b ENDPROC trace ; PROC source file (TEXT CONST file name) : IF exists (file name) THEN source := sequentialfile (modify, file name) FI ; IF actual line number >= 0 CAND actual line number <= lines (source) THEN toline (source, actual line number) ; readrecord (source, source line) ELSE source line := "" FI ENDPROC source file ; TEXT PROC source file : source file name ENDPROC source file ; PROC breakpoint handler : determine return address ; determine breakpoint nr ; reset breakpoints ; getcursor (x, y) ; REP ueberschrift schreiben ; IF auto trace THEN IF incharety = "" THEN key := "s" ELSE auto trace := FALSE FI FI ; IF NOT auto trace THEN REP inchar (key) UNTIL pos (""13"acdefgst", key) > 0 PER ; IF key = "a" THEN auto trace := TRUE ; key := "s" ELIF key = "f" THEN out (""13""5"Sourcefile:") ; getline (source file name) ; out (""3"") ; source file (source file name) ELIF key = ""13"" THEN key := "s" FI FI ; previous key := key UNTIL pos ("gst", key) > 0 PER ; cursor (1, 7) ; out (""5"") ; IF key <> "t" THEN execute saved instruction FI ; IF key = "t" THEN resetbreakpoints ; term ELIF key = "s" THEN singlestep FI ; cursor (x, y) . ueberschrift schreiben : feld loeschen ; put (""1"Breakpoint") ; put (breakpoint nr) ; put ("lbas:") ; put (hex16 (lbas)) ; put ("pbas:") ; put (hex8 (packet base)) ; put ("c8k:") ; put (hex8 (c8k)) ; IF valid source THEN out ("""") ; out (source file name) ; put ("""") FI ; line ; IF valid source AND source line <> "" THEN put (text (actual line number, 5)) ; put ("|") ; outsubtext (source line, 1, 71) ; line ; IF LENGTH source line < 72 THEN put (text (actual line number +1, 5)) ; put ("|") ; toline (source, actual line number +1) ; out (subtext (source, 1, 71)) ; toline (source, actual line number) ; line ELSE put ("______|") ; outsubtext (source line, 72, 143) ; line FI ELSE line (2) FI ; out (text (return segment AND 3)) ; put (hex16 (return address)) ; put ("|") ; seg (breakpoint segment) ; addr (breakpoint address) ; zweizeilig := TRUE ; disassemble one statement ; IF auto trace THEN pause (5) FI ; next instruction segment := breakpoint segment ; next instruction address := addr ADD 1 ; next instruction := getword (next instruction segment, next instruction address) ; line ; put ("a)uto, s)tep, g)o, t)erm, d)stop, e)stop, c)lrerr, f)ile:") . feld loeschen : out (""1"") ; 7 TIMESOUT ""5""10"" ; 79 TIMESOUT "-" . valid source : exists (source file name) . disassemble one statement : statement line := hex16 (get word (breakpoint segment, addr)) ; statement line CAT " " ; code word line (statement line) ; (* local base (lbas + offset) ; *) statement line := opcode ; local base (-1) ; put (code word line) ; (* i := max (0, 26 - length (code word line)) ; i TIMESOUT " " ; *) i:=0; i := 71 - LENGTH codeword line - i ; outsubtext (statement line, 1, i) ; line ; IF zweizeilig THEN put (" |") ; outsubtext (statement line, i + 1, i + 72) ; line FI ; codeword line ("") . singlestep : IF is return opcode THEN set breakpoint behind previous call ELIF bool result THEN set first breakpoint behind branch instruction ; set second breakpoint at branch address ; bool result (FALSE) ; ELIF is bool return opcode THEN set first breakpoint behind branch instruction at return address ; set second breakpoint at branch address of branch instruction at return address ; ELIF is branch instruction THEN set breakpoint at branch address ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND yes (""3"Subroutine Trace") THEN out (""3""13""5"") ; calculate subroutine segment and address ; set breakpoint behind next instruction ELSE set breakpoint behind next instruction FI . is call opcode : (saved word AND opcode mask) = call opcode OR (* saved word = pcall opcode OR //einbauen, wenn local zugriffe ok sind// *) saved word = -136 . (* LONGA CALL *) is line number : (saved word AND opcode mask) = ln opcode OR (saved word AND opcode mask) = lnlong opcode . is branch instruction : (saved word AND opcode mask) = br opcode OR (saved word AND opcode mask) = brlong opcode . is return opcode : saved word = 32512 . is bool return opcode : saved word = 32513 OR saved word = 32514 . read source line : actual line number := ((saved word AND 768) * 2) OR (saved word AND 255); IF saved word < 0 THEN actual line number INCR 256 FI ; IF (saved word AND opcode mask) = lnlong opcode THEN actual line number INCR 2048 FI ; actual line number DECR 1 ; IF valid source THEN IF lineno (source) = actual line number CAND source line <> "" THEN (* nichts*) ELIF actual line number >= 0 AND actual line number <= lines(source) THEN toline (source, actual line number) ; readrecord (source, source line) ELSE source line := "" FI ELSE source line := "" FI . set first breakpoint behind branch instruction : op word := next instruction AND opcode mask ; IF op word = bf opcode OR op word = bflong opcode OR op word = bt opcode OR op word = btlong opcode THEN seg (next instruction segment) ; addr (next instruction address) ; out (""3"") ; out (text (next instruction segment)) ; put (hex16 (next instruction address)) ; put ("|") ; zweizeilig := FALSE ; bool result (TRUE) ; disassemble one statement ; (* Branch instruction *) IF NOT auto trace THEN pause (30) ELSE pause (5) FI ; next free breakpoint ; set breakpoint (i, next instruction segment, next instruction address ADD 1) ; ELSE putline (""3""7"Interner Fehler: Nach BOOL-Result folgt kein Branch"); LEAVE singlestep FI . set second breakpoint at branch address : calculate branch address ; next free breakpoint ; set breakpoint (i, next instruction segment, branch address) . set breakpoint at branch address : next instruction := saved word ; next instruction address := breakpoint address ; calculate branch address ; set breakpoint (breakpoint nr, next instruction segment, branch address) . set first breakpoint behind branch instruction at return address : next instruction address := getword (local data segment, lbas + return address offset) ; next instruction segment := getword (local data segment, lbas + return segment offset) AND 3 ; next instruction := getword (next instruction segment, next instruction address) ; IF next instruction segment = 3 THEN set first breakpoint behind branch instruction ELSE putline ("Trace beendet.") FI . set second breakpoint at branch address of branch instruction at return address : set second breakpoint at branch address . determine return address : pause (0) ; (* Local Base fixieren *) this local base := getword (local data segment, pcb (local base field)) ; pause (0) ; lbas := getword (local data segment, this local base + previous local base offset) ; c8k := getword (local data segment, this local base + c8k offset) AND 255 ; return segment := getword (local data segment, this local base + return segment offset) ; return address := getword (local data segment, this local base + return address offset) ; packet base := HIGH return segment ; arith 16 ; return address DECR 1 ; arith 15 . segment 3 module : IF saved word = -136 (* LONGA CALL *) THEN op word := getword (breakpoint segment, breakpoint address ADD 1) ELSE op word := saved word AND 1023 ; IF saved word < 0 THEN op word INCR 1024 FI ; FI ; op word >= 1280 . calculate subroutine segment and address : next instruction segment := 3 ; (* Laeuft nur in Segment 3 ! *) next instruction address := getword (packet data segment, begin of module nr link table + op word) ADD 1. determine breakpoint nr : FOR i FROM 1 UPTO nr of breakpoints REP IF breakpoints (i).set CAND breakpoints (i).segment = (return segment AND 3) CAND breakpoints (i).address = return address THEN breakpoint nr := i ; breakpoint address := breakpoints (i).address ; breakpoint segment := breakpoints (i).segment ; saved word := breakpoints (i).saved word ; LEAVE determine breakpoint nr FI PER ; put ("Returnaddresse:") ; out (text (return segment AND 3)) ; putline (hex16 (return address)) ; list breakpoints ; reset breakpoints ; enablestop ; errorstop ("Falsche Returnaddresse") . calculate branch address : IF lowbyte replacement possible THEN branch address := (next instruction address AND -256) OR (next instruction AND 255) ; LEAVE calculate branch address FI ; branch address := next instruction AND 768 ; IF branch long THEN branch address INCR 2048 FI ; branch address INCR branch address ; IF next instruction < 0 THEN branch address INCR 256 FI ; arith 16 ; branch address INCR (next instruction address AND -256) ; IF HIGH branch address >= c8k THEN branch address DECR 4096 FI ; arith 15 ; branch address := (branch address AND -256) OR (next instruction AND 255) . lowbyte replacement possible : (next instruction AND -32000) = 0 . branch long : bit (next instruction, 10) . execute saved instruction : perhaps change error flags ; putword (local data segment, this local base + return address offset, return address) ; putword (local data segment, this local base + return segment offset, return segment) . perhaps change error flags : IF bit (return segment, 7) AND previous key = "c" THEN reset bit (return segment, 7) FI ; IF bit (return segment, 6) AND previous key = "e" THEN reset bit (return segment, 6) ELIF NOT bit (return segment, 6) AND previous key = "d" THEN set bit (return segment, 6) FI . set breakpoint behind next instruction : IF is linenumber THEN read source line FI ; set breakpoint (breakpoint nr, next instruction segment, next instruction address) . set breakpoint behind previous call : return segment := getword (local data segment, lbas + return segment offset) AND 3 ; return address := getword (local data segment, lbas + return address offset) ; IF return segment = 3 THEN set breakpoint (breakpoint nr, return segment, return address) ELSE putline ("Trace beendet.") FI . next free breakpoint : FOR i FROM 1 UPTO nr of breakpoints REP IF NOT breakpoints (i).set THEN LEAVE next free breakpoint FI PER ; putline (""3""7"Alle " + text(nr of breakpoints) + " Breakpoints sind belegt") ; LEAVE singlestep . ENDPROC breakpoint handler ; INT OP HIGH (INT CONST word) : TEXT VAR t := " " ; replace (t, 1, word) ; code (t SUB 2) ENDOP HIGH ; PROC reset breakpoints : FOR i FROM 1 UPTO nr of breakpoints REP IF breakpoints (i).set THEN reset breakpoint (i) ELSE breakpoints (i) := init breakpoint FI PER ENDPROC reset breakpoints ; PROC reset breakpoint (INT CONST nr) : IF nr < 1 OR nr > nr of breakpoints THEN errorstop ("Unzulaessige Breakpoint Nummer") ELIF NOT breakpoints (nr).set THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt") ELSE putword (breakpoints (nr).segment, breakpoints (nr).address, breakpoints (nr).saved word) ; breakpoints (nr) := init breakpoint FI ENDPROC reset breakpoint ; PROC set breakpoint (INT CONST nr, segment, address) : INT VAR new word ; IF nr < 1 OR nr > nr of breakpoints THEN errorstop ("Unzulaessige Breakpoint Nummer") ELIF breakpoints (nr).set THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt") ELIF segment < 2 OR segment > 3 THEN errorstop ("Segment " + text (segment) + " ist kein Codesegment") ELSE breakpoints (nr).segment := segment ; breakpoints (nr).address := address ; breakpoints (nr).saved word := get word (segment, address) ; new word := call opcode + (handler module AND 1023) ; IF handler module >= 1024 THEN setbit (new word, 15) FI ; putword (segment, address, new word) ; IF getword (segment, address) <> new word THEN errorstop ("Addresse Schreibgeschuetzt") ELSE breakpoints (nr).set := TRUE FI FI ENDPROC set breakpoint ; PROC handlers module nr (INT CONST module nr) : handler module := module nr ENDPROC handlers module nr ; INT PROC handlers module nr : handler module ENDPROC handlers module nr ; PROC set breakpoint : handlers module nr (module number ("breakpointhandler", 1)) ; auto trace := FALSE ; source file name := "" ; actual line number := -1 ; page ; TEXT VAR object ; INT VAR object nr ; put ("Object Name:") ; getline (object) ; changeall (object, " ", "") ; putline ("Objekt von Anfang an abzaehlen") ; pause (5) ; help (object) ; put ("Objekt Nr:") ; get (object nr) ; INT VAR code address := code start (object, object nr) ADD 1 ; naechsten freien breakpoint setzen ; put ("Breakpoint") ; put (i) ; putline ("wurde gesetzt.") . naechsten freien breakpoint setzen : FOR i FROM 1 UPTO nr of breakpoints REP IF NOT breakpoints (i).set THEN set breakpoint (i, code segment, code address) ; LEAVE naechsten freien breakpoint setzen FI PER ; errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt"). ENDPROC set breakpoint ; PROC list breakpoints : line ; putline (" No Set Address Word") ; FOR i FROM 1 UPTO nr of breakpoints REP put (text (i, 3)) ; IF breakpoints (i).set THEN put (" Y ") ELSE put (" N ") FI ; out (text (breakpoints (i).segment)) ; put (hex16 (breakpoints (i).address)) ; put(" ") ; put (hex16 (breakpoints (i).saved word)) ; line PER ENDPROC list breakpoints ; ENDPACKET tracer