diff options
Diffstat (limited to 'devel/misc/unknown/src/TRACE.ELA')
| -rw-r--r-- | devel/misc/unknown/src/TRACE.ELA | 552 |
1 files changed, 552 insertions, 0 deletions
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
|