From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- devel/misc/unknown/src/TRACE.ELA | 552 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 552 insertions(+) create mode 100644 devel/misc/unknown/src/TRACE.ELA (limited to 'devel/misc/unknown/src/TRACE.ELA') diff --git a/devel/misc/unknown/src/TRACE.ELA b/devel/misc/unknown/src/TRACE.ELA new file mode 100644 index 0000000..63c1455 --- /dev/null +++ b/devel/misc/unknown/src/TRACE.ELA @@ -0,0 +1,552 @@ +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 -- cgit v1.2.3