From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- devel/debug/1/source-disk | 1 + devel/debug/1/src/RUN dez <-> hex | 49 ++ devel/debug/1/src/all tracer | 10 + devel/debug/1/src/convert | 154 ++++++ devel/debug/1/src/disa | 454 +++++++++++++++++ devel/debug/1/src/extended instr | 25 + devel/debug/1/src/gen.bulletin | 536 +++++++++++++++++++ devel/debug/1/src/gen.procheads | 89 ++++ devel/debug/1/src/gen.trace | 23 + devel/debug/1/src/info | 371 ++++++++++++++ devel/debug/1/src/trace | 1020 +++++++++++++++++++++++++++++++++++++ devel/debug/1/src/trace.dok | 387 ++++++++++++++ 12 files changed, 3119 insertions(+) create mode 100644 devel/debug/1/source-disk create mode 100644 devel/debug/1/src/RUN dez <-> hex create mode 100644 devel/debug/1/src/all tracer create mode 100644 devel/debug/1/src/convert create mode 100644 devel/debug/1/src/disa create mode 100644 devel/debug/1/src/extended instr create mode 100644 devel/debug/1/src/gen.bulletin create mode 100644 devel/debug/1/src/gen.procheads create mode 100644 devel/debug/1/src/gen.trace create mode 100644 devel/debug/1/src/info create mode 100644 devel/debug/1/src/trace create mode 100644 devel/debug/1/src/trace.dok (limited to 'devel/debug/1') diff --git a/devel/debug/1/source-disk b/devel/debug/1/source-disk new file mode 100644 index 0000000..e42b22b --- /dev/null +++ b/devel/debug/1/source-disk @@ -0,0 +1 @@ +debug/debug-1_1987-04-24.img diff --git a/devel/debug/1/src/RUN dez <-> hex b/devel/debug/1/src/RUN dez <-> hex new file mode 100644 index 0000000..041fcf1 --- /dev/null +++ b/devel/debug/1/src/RUN dez <-> hex @@ -0,0 +1,49 @@ +LET hexziffern = "123456789ABCDEF"; +ROW 4 INT CONST faktoren :: ROW 4 INT : (1, 16, 256, 4096); + +INT PROC dez (TEXT CONST hex): + INT VAR stellen := LENGTH hex; + IF stellen > 4 + OR stellen > 3 AND (hex SUB 1) > "7" + THEN errorstop ("Zahl zu groß") + FI; + INT VAR i :: 0, stelle, ziffpos; + TEXT VAR ziffer; + FOR stelle FROM 1 UPTO stellen REP + ziffer := hex SUB (stellen - stelle + 1); + ziffpos := pos (hexziffern, ziffer); + IF ziffpos <> 0 + THEN i INCR ziffpos * faktoren [stelle] + ELIF ziffer <> "0" + THEN errorstop ("Hexadezimalzahl fehlerhaft") + FI + PER; + i +END PROC dez; +{194 + 76 ; kann nicht durch `replace' zu Beginn verkleinert werden } +TEXT PROC hex (TEXT CONST t dez): + IF t dez = "" THEN LEAVE hex WITH "" FI; + INT VAR stelle, hex ziffer, dez := int (t dez); + TEXT VAR hexzahl := ""; + FOR stelle FROM 4 DOWNTO 1 REP + hexziffer := dez DIV faktoren [stelle]; + IF hexziffer <> 0 + THEN hexzahl CAT (hexziffern SUB hexziffer); + dez DECR hexziffer * faktoren [stelle] + ELSE hexzahl CAT "0" + FI + PER; + hexzahl +END PROC hex; + +putline (""1""4"Dezimalzahlen schlicht, Hexadezimalzahlen mit schließendem ""h"" eingeben"); +line; +TEXT VAR z; +REP put ("Zahl:"); + get (z); + IF (z SUB LENGTH z) = "h" + THEN put (dez (subtext (z, 1, LENGTH z - 1))) + ELSE put (hex (z)) + FI +UNTIL z = "" PER + diff --git a/devel/debug/1/src/all tracer b/devel/debug/1/src/all tracer new file mode 100644 index 0000000..1e84b59 --- /dev/null +++ b/devel/debug/1/src/all tracer @@ -0,0 +1,10 @@ +gen.trace +extended instr +convert +info +disa +trace +gen.procheads +gen.bulletin +trace.dok + diff --git a/devel/debug/1/src/convert b/devel/debug/1/src/convert new file mode 100644 index 0000000..426a5e5 --- /dev/null +++ b/devel/debug/1/src/convert @@ -0,0 +1,154 @@ +PACKET convert DEFINES dec, hex, dsget2b, exhilo, (* Stand: 87-01-13 *) + addc, subc, addl, subl, incl, (* Autor: G. Szalay *) + txt, CT, gethex, integ: + +LET dectab = "0123456789", hextab="0123456789abcdef", mask16=15; +INT VAR number, digit, i; +TEXT VAR buffer, char; +INT CONST min 1 := dec ("ffff"), + min 2 := dec ("fffe"), + minint := dec ("8000"), + maxint := dec ("7fff"), + maxint min 1 := dec ("7ffe"); + +INT PROC integ (TEXT CONST text): (*only digits allowed*) + number := 0; + FOR i FROM 1 UPTO LENGTH text REP + digit := pos (dectab, text SUB i); + IF digit > 0 + THEN number := number * 10 + digit - 1 + FI + UNTIL digit = 0 PER; + number +END PROC integ; + +TEXT PROC hex (INT CONST n): + buffer := ""; number := n; + FOR i FROM 1 UPTO 4 REP + rotate (number,4); + digit := number AND mask16; + buffer CAT (hextab SUB (digit + 1)) + PER; + buffer +END PROC hex; + +INT PROC dec (TEXT CONST t): + IF LENGTH t > 4 THEN leave with message FI; + number := 0; + FOR i FROM 1 UPTO LENGTH t + REP char := t SUB i; + digit := pos (hextab, char) - 1; + IF digit<0 THEN leave with message FI; + rotate (number, 4); + number INCR digit + PER; + number. + + leave with message: + error stop ("wrong param for dec"); + LEAVE dec WITH 0. + +END PROC dec; + +INT PROC exhilo (INT CONST val): + INT VAR ex := val; rotate (ex, 8); + ex +END PROC exhilo; + +INT PROC dsget2b (INT CONST drid, off hi, off lo): + INT VAR val := dsgetw (drid, off hi, off lo); + IF drid <> 1 THEN rotate (val, 8) FI; + val +END PROC dsget2b; + +PROC addc (INT CONST a, b, INT VAR sum, BOOL VAR carry): + INT VAR s; + disable stop; + s := a + b; + IF a >= 0 AND b >= 0 THEN carry := FALSE + ELIF a < 0 AND b < 0 THEN carry := TRUE + ELSE carry := s >= 0 + FI; + sum := s; + clear error +END PROC addc; + +PROC subc (INT CONST a, b, INT VAR diff, BOOL VAR carry): + INT VAR d; + disable stop; + d := a - b; + IF a >= 0 AND b < 0 THEN carry := TRUE + ELIF a < 0 AND b >= 0 THEN carry := FALSE + ELSE carry := d < 0 + FI; + diff := d; + clear error +END PROC subc; + +PROC incl (INT VAR ah, al, INT CONST ainc): + BOOL VAR ov; + IF ainc = 1 + THEN IF al = min1 THEN al := 0; ah INCR 1 + ELIF al = maxint THEN al := minint + ELSE al INCR 1 + FI + ELIF ainc = 2 + THEN IF al = min2 THEN al := 0; ah INCR 1 + ELIF al = maxint min1 THEN al := minint + ELSE al INCR 2 + FI + ELSE addc (al, ainc, al, ov); + IF ov THEN addc (ah, 1, ah, ov) FI + FI +END PROC incl; + +PROC addl (INT CONST ah, al, bh, bl, INT VAR sumh, suml, BOOL VAR carry): + BOOL VAR low carry, high carry; + addc (al, bl, suml, low carry); + addc (ah, bh, sumh, high carry); + IF low carry THEN addc (sumh, 1, sumh, low carry) FI; + carry := low carry OR high carry +END PROC addl; + +PROC subl (INT CONST ah, al, bh, bl, INT VAR diffh, diffl, BOOL VAR carry): + BOOL VAR low carry, high carry; + subc (al, bl, diffl, low carry); + subc (ah, bh, diffh, high carry); + IF low carry THEN subc (diffh, 1, diffh, low carry) FI; + carry := low carry OR high carry +END PROC subl; + +TEXT PROC txt (INT CONST num): + IF num = minint THEN "-32768" + ELIF num < 0 THEN "-" CT txt (-num) + ELIF num <= 9 THEN code (num + 48) + ELSE txt (num DIV 10) CT code (num MOD 10 + 48) + FI +END PROC txt; + +TEXT OP CT (TEXT CONST left, right): + buffer := left; buffer CAT right; buffer +END OP CT; + +PROC gethex (TEXT VAR hexline): + buffer := ""; + REP inchar (char); + SELECT pos (""13""12"0123456789abcdef", char) OF + CASE 0: out(""7"") + CASE 1: hexline := buffer; out (""13""10""); LEAVE gethex + CASE 2: delete last char + OTHERWISE buffer CAT char; out (char) + ENDSELECT + PER. + +delete last char: + IF buffer = "" + THEN out (""7"") + ELSE buffer := subtext (buffer, 1, LENGTH buffer - 1); + out (""8" "8"") + FI. + +ENDPROC gethex; + +END PACKET convert; + diff --git a/devel/debug/1/src/disa b/devel/debug/1/src/disa new file mode 100644 index 0000000..8819e21 --- /dev/null +++ b/devel/debug/1/src/disa @@ -0,0 +1,454 @@ +PACKET dis DEFINES disasm, disa, proc head, (* Autor: G.Szalay *) + set proc heads: (* Stand: 87-04-23 *) + +LET INSTR = STRUCT (TEXT mnem, INT length, class), + clear to eop = ""4"", stdds = 0, no of lines = 4, beep = ""7""; +INT VAR first word, opcode, cur x, cur y; +INT CONST right 2 := -2; + +ROW 31 INSTR CONST primary list :: ROW 31 INSTR: + ( INSTR: ("LN - ",1,10), + INSTR: ("LN1 - ",1,10), + INSTR: ("MOV i- ",2,0), + INSTR: ("INC1 I ",1,0), + INSTR: ("DEC1 I ",1,0), + INSTR: ("INC Ii ",2,0), + INSTR: ("DEC Ii ",2,0), + INSTR: ("ADD iiI ",3,0), + INSTR: ("SUB iiI ",3,0), + INSTR: ("CLEAR I ",1,0), + INSTR: ("TEST i ",1,1), + INSTR: ("EQU ii ",2,1), + INSTR: ("LSEQ ii ",2,1), + INSTR: ("FMOV r- ",2,0), + INSTR: ("FADD rrR ",3,0), + INSTR: ("FSUB rrR ",3,0), + INSTR: ("FMUL rrR ",3,0), + INSTR: ("FDIV rrR ",3,0), + INSTR: ("FLSEQ rr ",2,1), + INSTR: ("TMOV t- ",2,0), + INSTR: ("TEQU tt ",2,1), + INSTR: ("ULSEQ ii ",2,1), + INSTR: ("DSACC dE ",2,0), + INSTR: ("REF a- ",2,0), + INSTR: ("SUBS vviaE",5,0), + INSTR: ("SEL avE ",3,0), + INSTR: ("PPV -i ",2,9), + INSTR: ("PP a ",1,9), + INSTR: ("B - ",1,2), + INSTR: ("B1 - ",1,2), + INSTR: ("CALL - ",1,4) ); + +ROW 6 INSTR CONST special list :: ROW 6 INSTR: + ( INSTR: ("EQUIM vi ",2,1), + INSTR: ("MOVX vh- ",3,0), + INSTR: ("GETW ihI ",3,0), + INSTR: ("MOVI vI ",2,0), + INSTR: ("PUTW vhi ",3,0), + INSTR: ("PENTER v ",1,8) ); + +ROW 157 INSTR CONST secondary list :: ROW 157 INSTR: + ( INSTR: ("RTN ",1,7), + INSTR: ("RTNT ",1,7), + INSTR: ("RTNF ",1,7), + INSTR: ("RESTART ",1,0), + INSTR: ("STOP ",1,11), + (* INSTR: ("*057F* ",0,0), *) + INSTR: ("LBAS H ",2,0), + INSTR: ("KE ",1,12), + (* INSTR: ("*077F* ",0,0), *) + INSTR: ("DSGETW dhhH ",5,0), + INSTR: ("BCRD iI ",3,0), + INSTR: ("CRD II ",3,0), + INSTR: ("ECWR Iii ",4,0), + INSTR: ("CWR IIi ",4,0), + INSTR: ("CTT iE ",3,0), + INSTR: ("GETC tII ",4,1), + INSTR: ("FNONBL ItI ",4,1), + INSTR: ("DREM256 Ii ",3,0), + INSTR: ("AMUL256 Ii ",3,0), + (* INSTR: ("*117F* ",0,0), *) + INSTR: ("DSPUTW dhhh ",5,0), + INSTR: ("ISDIG i ",2,1), + INSTR: ("ISLD i ",2,1), + INSTR: ("ISLC i ",2,1), + INSTR: ("ISUC i ",2,1), + INSTR: ("GADDR -iI ",4,0), + INSTR: ("GCADDR iiI ",4,1), + INSTR: ("ISSHA a ",2,1), + INSTR: ("SYSG ",1,0), + INSTR: ("GETTAB ",1,0), + INSTR: ("PUTTAB ",1,0), + INSTR: ("ERTAB ",1,0), + INSTR: ("EXEC - ",2,5), + INSTR: ("PPROC - ",2,9), + INSTR: ("PCALL - ",2,6), + INSTR: ("BRCOMP iv ",3,3), + INSTR: ("MOVXX vh- ",4,0), + INSTR: ("ALIAS vdD ",4,0), + INSTR: ("MOVII vI ",3,0), + INSTR: ("FEQU rr ",3,1), + INSTR: ("TLSEQ tt ",3,1), + INSTR: ("FNEG rR ",3,0), + INSTR: ("NEG iI ",3,0), + INSTR: ("IMULT iiI ",4,0), + INSTR: ("MUL iiI ",4,0), + INSTR: ("DIV iiI ",4,0), + INSTR: ("MOD iiI ",4,0), + INSTR: ("ITSUB tiI ",4,0), + INSTR: ("ITRPL Tii ",4,0), + INSTR: ("DECOD tI ",3,0), + INSTR: ("ENCOD iT ",3,0), + INSTR: ("SUBT1 tiT ",4,0), + INSTR: ("SUBTFT tiiT ",5,0), + INSTR: ("SUBTF tiT ",4,0), + INSTR: ("REPLAC Tit ",4,0), + INSTR: ("CAT Tt ",3,0), + INSTR: ("TLEN tI ",3,0), + INSTR: ("POS ttI ",4,0), + INSTR: ("POSF ttiI ",5,0), + INSTR: ("POSFT ttiiI",6,0), + INSTR: ("STRAN -iitiiI",8,0), + INSTR: ("POSIF tiiiI",6,0), + INSTR: ("*3B7F* ",0,0), + INSTR: ("OUT t ",2,0), + INSTR: ("COUT i ",2,0), + INSTR: ("OUTF ti ",3,0), + INSTR: ("OUTFT tii ",4,0), + INSTR: ("INCHAR T ",2,0), + INSTR: ("INCETY T ",2,0), + INSTR: ("PAUSE i ",2,0), + INSTR: ("GCPOS II ",3,0), + INSTR: ("CATINP TT ",3,0), + INSTR: ("NILDS D ",2,0), + INSTR: ("DSCOPY Dd ",3,0), + INSTR: ("DSFORG d ",2,0), + INSTR: ("DSWTYP di ",3,0), + INSTR: ("DSRTYP dI ",3,0), + INSTR: ("DSHPSIZ dI ",3,0), + INSTR: ("ESTOP ",1,11), + INSTR: ("DSTOP ",1,11), + INSTR: ("SETERR i ",2,0), + INSTR: ("ISERR ",1,1), + INSTR: ("CLRERR ",1,13), + INSTR: ("RPCB iI ",3,0), + INSTR: ("INFOPW ttI ",4,0), + INSTR: ("TWCPU pr ",3,0), + INSTR: ("ROTATE Hi ",3,0), + INSTR: ("IOCNTL iiiI ",5,0), + INSTR: ("BLKOUT diiiI",6,0), + INSTR: ("BLKIN diiiI",6,0), + INSTR: ("BLKNXT diI ",4,0), + INSTR: ("DSSTOR dpI ",4,0), + INSTR: ("STORAGE II ",3,0), + INSTR: ("SYSOP i ",2,0), + INSTR: ("ARITS ",1,0), + INSTR: ("ARITU ",1,0), + INSTR: ("HPSIZE I ",2,0), + INSTR: ("GARB ",1,0), + INSTR: ("TCREATE ppia ",5,0), + INSTR: ("FSLD iRI ",4,0), + INSTR: ("GEXP rI ",3,0), + INSTR: ("SEXP iR ",3,0), + INSTR: ("FLOOR rR ",3,0), + INSTR: ("RTSUB tiR ",4,0), + INSTR: ("RTRPL Tir ",4,0), + INSTR: ("CLOCK iR ",3,0), + INSTR: ("SETNOW r ",2,0), + INSTR: ("TRPCB piI ",4,0), + INSTR: ("TWPCB pii ",4,0), + INSTR: ("TCPU pR ",3,0), + INSTR: ("TSTAT pI ",3,0), + INSTR: ("ACT p ",2,0), + INSTR: ("DEACT p ",2,0), + INSTR: ("THALT p ",2,0), + INSTR: ("TBEGIN pa ",3,0), + INSTR: ("TEND p ",2,0), + INSTR: ("SEND pidI ",5,0), + INSTR: ("WAIT DIP ",4,0), + INSTR: ("SWCALL piDI ",5,0), + INSTR: ("CDBINT hI ",3,0), + INSTR: ("CDBTXT hT ",3,0), + INSTR: ("PNACT P ",2,0), + INSTR: ("PW hhi ",4,0), + INSTR: ("GW hhI ",4,0), + INSTR: ("BITXOR hhH ",4,0), + INSTR: ("SNDWT piDI ",5,0), + INSTR: ("TEXIST p ",2,1), + INSTR: ("BITAND hhH ",4,0), + INSTR: ("BITOR hhH ",4,0), + INSTR: ("SESSION I ",2,0), + INSTR: ("SNDFROM ppiDI",6,0), + INSTR: ("DEFCOLL i ",2,0), + INSTR: ("IDENT iI ",3,0), + INSTR: ("*827F* ",0,0), + INSTR: ("*837F* ",0,0), + INSTR: ("*847F* ",0,0), + INSTR: ("*857F* ",0,0), + INSTR: ("*867F* ",0,0), + INSTR: ("*877F* ",0,0), + INSTR: ("*887F* ",0,0), + INSTR: ("*897F* ",0,0), + INSTR: ("*8a7F* ",0,0), + INSTR: ("*8b7F* ",0,0), + INSTR: ("*8c7F* ",0,0), + INSTR: ("*8d7F* ",0,0), + INSTR: ("*8e7F* ",0,0), + INSTR: ("*8f7F* ",0,0), + INSTR: ("*907F* ",0,0), + INSTR: ("*917F* ",0,0), + INSTR: ("*927F* ",0,0), + INSTR: ("*937F* ",0,0), + INSTR: ("*947F* ",0,0), + INSTR: ("*957F* ",0,0), + INSTR: ("*967F* ",0,0), + INSTR: ("*977F* ",0,0), + INSTR: ("*987F* ",0,0), + INSTR: ("*997F* ",0,0), + INSTR: ("DSGETW dhhH ",5,0), + INSTR: ("DSPUTW dhhh ",5,0), + INSTR: ("LBAS H ",2,0) ); + + +PROC disa (INT CONST icount h, icount l, + TEXT VAR mnemonic, oplist, + INT VAR instr length, instr class) : + fetch first instr word; + fetch opcode; + IF primary THEN process primary + ELIF secondary THEN process secondary + ELIF longprim THEN process longprim + ELSE process special + FI; + oplist := subtext (mnemonic, 9); + mnemonic := subtext (mnemonic, 1, 8). + +fetch first instr word: + first word := dsgetw (stdds, icount h, icount l). + +fetch opcode: + opcode := first word; + rotate (opcode,8); + opcode := opcode AND 255. + +primary: (opcode AND 124) <> 124. + +secondary: opcode = 127. + +longprim: opcode = 255. + +process primary: + opcode := opcode AND 124; + rotate (opcode, right 2); + mnemonic := primary list (opcode+1) . mnem; + instr length := primary list (opcode+1) . length; + instr class := primary list (opcode+1) . class. + +process secondary: + opcode := first word AND 255; + IF opcode <= 156 + THEN mnemonic := secondary list (opcode+1) . mnem; + instr length := secondary list (opcode+1) . length; + instr class := secondary list (opcode+1) . class + ELSE mnemonic := "wrongopc"; + instr length := 0; instr class := -1 + FI. + +process longprim: + opcode := first word AND 255; + IF (opcode AND 124) = opcode + THEN rotate (opcode, -2); + mnemonic := primary list (opcode+1) . mnem; + instr length := primary list (opcode+1) . length + 1; + instr class := primary list (opcode+1) . class + ELSE mnemonic := "wrongopc"; + instr length := 0; instr class := -1 + FI. + +process special: + IF opcode < 128 + THEN opcode := (opcode AND 3) + 1 + ELSE opcode := (opcode AND 3) + 4 + FI; + mnemonic := special list (opcode) .mnem; + instr length := special list (opcode) .length; + instr class := special list (opcode) . class. + +END PROC disa; + +(*********************************************************************) + +LET max modno = 3071; +INT VAR word1, modno; +TEXT VAR buf, mod decr; +BOOL VAR proc heads file exists := FALSE; +INITFLAG VAR initflag := FALSE; +BOUND ROW max modno TEXT VAR proc heads; + +PROC set proc heads (TEXT CONST proc heads filename): + proc heads file exists := FALSE; + IF proc heads filename <> "" AND exists (proc heads filename) + THEN proc heads := old (proc heads filename); + put (proc heads (max modno)); (*to test type*) + proc heads file exists := TRUE + FI +END PROC set proc heads; + +TEXT PROC proc head (INT CONST module no): + IF NOT initialized (initflag) + THEN provide proc heads file + FI; + INT VAR modno := module no; + IF modno >= 10000 THEN modno DECR 10000 FI; + IF proc heads file exists AND modno <= max modno + THEN IF modno = 0 + THEN "(* mod no 0 *)" + ELSE buf := proc heads (modno); + IF subtext (buf, 1, 2) = "+>" + THEN mod decr := subtext (buf, 3); + buf := "(* " CT mod decr CT " +> " + CT proc head (modno - integ (mod decr)) CT " *)" + FI; + buf + FI + ELSE "" + FI. + +provide proc heads file: + IF NOT exists ("procheads") + THEN disable stop; + command dialogue (FALSE); + fetch ("procheads"); + IF is error + THEN putline ("(*** proc heads file missing ***)"); + out (beep); clear error + ELSE set proc heads ("procheads") + FI; + command dialogue (TRUE) + FI +ENDPROC proc head; + +(***********************************************************************) + +INT VAR ic h:=2, ic l:=0, ilen, iclass, i, cmd, maxlines:=12, lines; +INT CONST mask 8000 := dec ("8000"), + mask 7fff := dec ("7fff"), + mask 0400 := dec ("0400"), + bf mask1 := dec ("0040"), + opcode mask0 := dec ("83ff"); +BOOL VAR step mode := TRUE, quit; +TEXT VAR iname, ioplist, char, input; + +PROC disasm : + out (""13""); + disasm (ic h, ic l) + +ENDPROC disasm; + +PROC disasm (INT CONST startaddr hi, startaddr lo): + ic h := startaddr hi; + ic l := startaddr lo; + lines := 0; + quit := FALSE; + REP + IF NOT (ic h = 3 OR ic h = 2) + THEN out ("*** icount out of code area ***"); line; out (beep); + step mode := TRUE + ELSE disa (ic h, ic l, iname, ioplist, ilen, iclass); + put icount mnemonic and instr words; + put proc head for call; + line; lines INCR 1; + IF iclass = 1 THEN put cond branch instr FI; + FI; + process command if necessary + UNTIL quit PER. + +put icount mnemonic and instr words: + put icount; + out (iname); + out (" "); + IF ilen > 0 + THEN IF iclass = 4 THEN word1 := dsgetw (stdds, ic h, ic l) FI; + FOR i FROM 1 UPTO ilen REP + out (hex (dsget2b (stdds, ic h, ic l))); out (" "); + incl (ic h, ic l, 1) + PER + ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (""7""); + incl (ic h, ic l, 1); + step mode := TRUE + FI. + +put cond branch instr: + put icount; + word1 := dsget2b (stdds, ic h, ic l); + IF (word1 AND bf mask1) <> 0 + THEN out ("BF ") + ELSE out ("BT ") + FI; + putline (hex (word1)); + lines INCR 1; + incl (ic h, ic l, 1). + +put icount: + out (txt (ic h)); + out (hex (ic l)); + out (": "). + +put proc head for call: + IF iclass = 4 + THEN eval module no; + out (" "); + out (proc head (mod no)) + FI. + +eval module no: + mod no := word1 AND opcode mask0; + IF (mod no AND mask 8000) <> 0 + THEN mod no := mod no AND mask 7fff OR mask 0400 + FI. + +process command if necessary: + IF step mode OR incharety <> "" OR lines >= maxlines + THEN process command; + lines := 0 + FI. + +process command : + REP putline (""15"DISASM: step, more, address, lines, info, or quit"14""); + inchar (char); + cmd := pos ("smaliq",char); + IF cmd > 0 + THEN SELECT cmd OF + CASE 1: step mode := TRUE; point to previous line + CASE 2: step mode := FALSE; point to previous line + CASE 3: set new ic + CASE 4: set new linecount + CASE 5: info (stdds, ic h, ic l, no of lines) + CASE 6: quit := TRUE + ENDSELECT + FI + UNTIL char <> "i" PER. + +point to previous line: + get cursor (cur x, cur y); cursor (1, cur y - 1); out (clear to eop). + +set new line count: + out ("lines="); gethex (buf); maxlines := dec (buf). + +set new ic : + REP + put ("type new ic (20000...3ffff)"); + gethex (input); + input := "0000" CT input; + ic l := dec (subtext (input, LENGTH input-3)); + ic h := dec (subtext (input, LENGTH input-7, LENGTH input-4)); + IF ic h = 2 OR ic h = 3 THEN LEAVE set new ic FI; + out (beep); putline ("*** icount out of code area ***") + PER. + +ENDPROC disasm; + +(* disasm *) (*for test only*). + +END PACKET dis; + diff --git a/devel/debug/1/src/extended instr b/devel/debug/1/src/extended instr new file mode 100644 index 0000000..93b3b9e --- /dev/null +++ b/devel/debug/1/src/extended instr @@ -0,0 +1,25 @@ +(**************************************************************) +(* Extended EUMEL0-instructions for TRACE G.Szalay *) +(************************************************* 87-04-03 ***) + +PACKET extended instr DEFINES dsgetw, dsputw, local base, + signed arith, unsigned arith: + +INT PROC dsgetw (INT CONST drid, adr hi, adr lo): + EXTERNAL 154 +ENDPROC dsgetw; + +PROC dsputw (INT CONST drid, adr hi, adr lo, word): + EXTERNAL 155 +ENDPROC dsputw; + +INT PROC local base: + EXTERNAL 156 +ENDPROC local base; + +PROC signed arith: EXTERNAL 91 ENDPROC signed arith; + +PROC unsigned arith: EXTERNAL 92 ENDPROC unsigned arith; + +ENDPACKET extended instr; + diff --git a/devel/debug/1/src/gen.bulletin b/devel/debug/1/src/gen.bulletin new file mode 100644 index 0000000..8c5b15b --- /dev/null +++ b/devel/debug/1/src/gen.bulletin @@ -0,0 +1,536 @@ +PACKET eumel coder part 1 m DEFINES bulletin m : (* Author: U.Bartling *) + (* modif'd by G.Szalay*) + (* 87-03-31 *) + +(**************************************************************************) +(* *) +(* This program generates a file "bulletin" containing procedure heads *) +(* and the module numbers, to be used by the debugging packet 'trace'. *) +(* *) +(**************************************************************************) + + + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR hash table pointer, nt link, permanent pointer, param link, + index, mode, word, packet link; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 04.08.1986 *) +(* 1.8.0 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , + before first pt entry = 22784 , + first permanent entry = 22785 , + end of permanent table = 32767 , + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , +(* permanent param proc end marker = 0 , *) + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + + void = 0 , + int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 , + row = 10 , + struct = 11 , + + const = 1 , + var = 2 , +(* proc = 3 , *) +(* denoter = 5 , *) + bold = 2 ; + + +INT CONST permanent packet := -2 , + permanent end := -3 ; + + + + + (***** Hash/Namenstabelle *****) +. +next hash entry : + hash table pointer INCR wordlength . + +end of hash table reached : + hash table pointer > end of hash table . + +yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + next pt param ; + mode := cdb int (param link) + UNTIL mode = permanent type field PER ; + param link INCR wordlength +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR wordlength ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 01.08.1986 *) +(* *) +(**************************************************************************) + + + +INT VAR line number, begin of packet, + last packet entry, indentation; + +TEXT VAR type and mode, pattern, buffer; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DS" + CASE row : type and mode CAT "ROW " + CASE struct : type and mode CAT "STRUCT" + OTHERWISE : complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + + +BOOL PROC not end of chain : + permanent pointer <> 0 +ENDPROC not end of chain ; + +PROC put specifications (TEXT CONST proc name) : + put obj name (proc name) ; + to first param ; + IF NOT end of params THEN put param list FI ; + put result ; + write bulletin line (text(cdb int(param link+wordlength),5)) ; + writeline . + +to first param : + param link := permanent pointer + word length ; + set end marker if end of list . + +put result : + INT VAR type; + get type and mode (type) ; + IF type <> void THEN type and mode := " --> " ; + name of type (type) ; + write bulletin line (type and mode) + FI +ENDPROC put specifications ; + +PROC put param list : + write bulletin line (" (") ; + REP + INT VAR type, param mode; + get type and mode (type) ; + param mode := mode ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params THEN write bulletin line (")") ; + LEAVE put param list + FI ; + write bulletin line (", ") ; + PER . + +put type and mode : + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + write bulletin line (type and mode) . + +name of mode : + IF param mode = const THEN " C" + ELIF param mode = var THEN " V" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params THEN put param list FI. + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params +ENDPROC put param list ; + +PROC to packet (TEXT CONST packet name) : + to object ( packet name) ; + IF found THEN find start of packet objects FI . + +find start of packet objects : + last packet entry := 0 ; + packet link := before first pt entry ; + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word < 0 THEN IF word = permanent packet THEN packet found + ELIF word = permanent end THEN return + FI + FI + ENDREP . + +packet found : + IF cdb int (packet link + wordlength) = nt link + THEN last packet entry := packet link FI . + +return : + IF last packet entry <> 0 THEN found := TRUE ; + packet link := last packet entry + ELSE found := FALSE + FI ; + LEAVE to packet +ENDPROC to packet ; + +PROC next packet : + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word = permanent packet THEN true return + ELIF end of permanents THEN false return + FI ; + ENDREP . + +true return : + found := TRUE ; + LEAVE next packet . + +false return : + found := FALSE ; + LEAVE next packet . + +end of permanents : + word = permanent end OR packet link > end of permanent table +ENDPROC next packet ; + +PROC prep bulletin : + IF exists ("bulletin") + THEN IF yes("overwrite old file ""bulletin""") + THEN command dialogue (FALSE); + forget ("bulletin"); + command dialogue (TRUE); + bulletin file := sequential file (output, new ("bulletin")) + ELSE bulletin file := sequential file (output, old ("bulletin")) + FI + ELSE bulletin file := sequential file (output, new ("bulletin")) + FI; + putline ("GENERATING ""bulletin"" ..."); + line number := 0 ; + buffer := "" +ENDPROC prep bulletin ; + +PROC write bulletin line (TEXT CONST line) : + (* IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; *) + buffer CAT line +ENDPROC write bulletin line ; + +PROC writeline : + write (bulletin file, buffer) ; + line (bulletin file) ; + line number INCR 1 ; + cout (line number) ; + buffer := "" +ENDPROC writeline ; + +PROC writeline (INT CONST times) : + IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ; + writeline + ELSE index := times + FI ; + line (bulletin file, index) ; + line number INCR index; + indentation := 0 ; + cout (line number) +ENDPROC writeline ; + +PROC bulletin m (TEXT CONST packet name) : + prep bulletin ; + scan (packet name) ; + next symbol (pattern) ; + to packet (pattern) ; + IF found THEN list packet + ELSE error stop (packet name + " ist kein Paketname") + FI . + +ENDPROC bulletin m; + +PROC list packet : + begin of packet := packet link + word length ; + find end of packet ; + run through nametab and list all packet objects . + +find end of packet : + last packet entry := begin of packet ; + REP + last packet entry INCR wordlength ; + word := cdb int (last packet entry) ; + UNTIL end of packet entries PER . + +end of packet entries : + word = permanent packet OR word = permanent end . + +run through nametab and list all packet objects : + hashtable pointer := begin of hashtable ; + REP + nt link := hashtable pointer ; + list objects of current packet in this chain ; + next hash entry + UNTIL end of hashtable reached ENDREP . + +list objects of current packet in this chain : + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + put objects of this name + PER . + +put objects of this name : + IF there is at least one object of this name in the current packet + THEN into bulletin FI . + +there is at least one object of this name in the current packet : + REP + IF permanent pointer >= begin of packet AND + permanent pointer < last packet entry + THEN LEAVE there is at least one object of this name + in the current packet WITH TRUE FI ; + next procedure + UNTIL permanent pointer = 0 PER ; + FALSE . + +into bulletin : + object name := cdb text (nt link + two word length) ; + object names into bulletin (BOOL PROC within packet) +ENDPROC list packet ; + +BOOL PROC within packet : + permanent pointer >= begin of packet AND + permanent pointer < last packet entry +ENDPROC within packet ; + +PROC object names into bulletin (BOOL PROC link ok) : + scan (object name) ; + next symbol (object name, mode) ; + IF NOT type definition THEN put object definitions FI . + +type definition : + mode = bold AND no params . + +no params : + cdb int (permanent pointer + word length) >= permanent type . + +put object definitions : + WHILE link ok REP + put specifications (object name) ; + next procedure + ENDREP +ENDPROC object names into bulletin ; + +PROC bulletin m: + prep bulletin ; + packet link := first permanent entry ; + REP + list packet ; + next packet + UNTIL NOT found PER +ENDPROC bulletin m; + +PROC put obj name (TEXT CONST name) : + buffer := name. +ENDPROC put obj name ; + +bulletin m; + +ENDPACKET eumel coder part 1 m; + diff --git a/devel/debug/1/src/gen.procheads b/devel/debug/1/src/gen.procheads new file mode 100644 index 0000000..e2ab0ea --- /dev/null +++ b/devel/debug/1/src/gen.procheads @@ -0,0 +1,89 @@ +(**********************************************************************) +(* *) +(* This program generates/updates a dataspace "procheads" from the *) +(* file "bulletin", including the module numbers. "procheads" will *) +(* be used by 'trace" and 'disasm" to show the name and the formal *) +(* param list of a called procedure. *) +(* *) +(* GMD-Z2.P/G.Szalay/86-04-06 *) +(* *) +(**********************************************************************) + +LET digits = "1234567890", outname = "procheads", + maxno of procs = 3071, first compiled module no = 256; +FILE VAR infile := sequential file (input, old ("bulletin")); +TEXT VAR buf, linebuf, entry, answer; +INT VAR i, j, module no, posit, max module no := 0; +BOUND ROW maxno of procs TEXT VAR proc heads; + +putline ("generating """ + outname + """ ..."); +BOOL VAR oldfile := exists (outname); +IF oldfile +THEN ask for action to be taken; + IF answer = "r" + THEN forget (outname); oldfile := FALSE; + proc heads := new (outname) + ELSE proc heads := old (outname) + FI +ELSE proc heads := new (outname) +FI; + +IF NOT oldfile THEN init heads FI; +getline (infile, linebuf); +FOR i FROM 1 UPTO 1000 REP + process line; + cout (i); + getline (infile, linebuf) +UNTIL eof (infile) PER; +process missing heads. + +ask for action to be taken: + out ("replace or append to old file """+outname+""" (r/a) ? "); + REP inchar (answer); + IF answer <> "r" AND answer <> "a" THEN out(""7"") FI + UNTIL answer = "r" OR answer = "a" PER; + putline (answer). + +init heads: + proc heads (1) := "+>1"; + FOR i FROM 2 UPTO maxno of procs REP proc heads (i) := "" PER. + +process line: + fetch module no and entry; + IF module no >= first compiled module no + THEN IF module no < 10000 + THEN proc heads (module no) := entry + ELSE proc heads (module no - 10000) := entry + FI + FI. + +fetch module no and entry: + posit := LENGTH linebuf - 1; + WHILE pos (digits, linebuf SUB posit) <> 0 + REP posit DECR 1 PER; + module no := int (subtext (linebuf, posit+1)); + IF module no < 10000 AND module no > max module no + THEN max module no := module no + FI; + WHILE (linebuf SUB posit) = " " REP posit DECR 1 PER; + entry := subtext (linebuf, 1, posit). + +process missing heads: + putline ("max module no=" + text(max module no)); + FOR i FROM 1 UPTO max module no REP + cout(i); + IF proc heads (i) = "" THEN put in offset to last head FI + PER. + +put in offset to last head: + FOR j FROM i-1 DOWNTO 1 REP + IF proc heads (j) <> "" + THEN IF subtext (proc heads (j), 1, 2) = "+>" + THEN proc heads (i) := "+>" + text (i - j + + int (subtext (proc heads (j), 3))) + ELSE proc heads (i) := "+>" + text (i - j) + FI; + LEAVE put in offset to last head + FI + PER. + diff --git a/devel/debug/1/src/gen.trace b/devel/debug/1/src/gen.trace new file mode 100644 index 0000000..4dc8c53 --- /dev/null +++ b/devel/debug/1/src/gen.trace @@ -0,0 +1,23 @@ +checkoff; +putline("inserting ""extended instr"" ..."); +insert("extended instr"); +putline("inserting ""convert"" ..."); +insert("convert"); +putline("inserting ""info"" ..."); +insert("info"); +putline("inserting ""disa"" ..."); +insert("disa"); +putline("inserting ""trace"" ..."); +insert("trace"); +putline("inserting ""gen.bulletin"" ..."); +insert("gen.bulletin"); +putline("compiling ""gen.procheads"" ..."); +run("gen.procheads"); +do("set procheads(""procheads"")"); +forget("bulletin",quiet); +putline("task """+name(myself)+""" is now global manager"); +putline("press any key ..."); +pause; global manager + + + diff --git a/devel/debug/1/src/info b/devel/debug/1/src/info new file mode 100644 index 0000000..31099c6 --- /dev/null +++ b/devel/debug/1/src/info @@ -0,0 +1,371 @@ +PACKET info DEFINES info: + +(**********************************************************************) +(** **) +(** M i n i - I N F O Autor: G. Szalay Stand: 87-04-03 **) +(** **) +(**********************************************************************) + +LET charset = "1234567890ß'qwertzuiopü+asdfghjklöä#YXCVBNM;:_ ", + hextab = "0123456789abcdef", stdds = 0, + cr = ""13"", cr rubout = ""13""12"", + up down left right = ""3""10""8""2""; +TEXT VAR buf, linebuf, bytes, hexbytes, char, + search param := ""255"", search buffer, + first byte, hex search param := "ff", search mode := "h"; +INT VAR drid := stdds, adr hi := 2, adr lo := 0, lines := 4, + begin hi := adr hi, begin lo := adr lo, first word, + saddr hi, saddr lo, + no of found bytes, cur xx, cur x, cur y, ymin, ymax, + xmin := 9, xmidlo := xmin + 21, + xmidhi := xmidlo + 5, xmax := xmidhi + 21, + word, byte, i, l; +INT CONST mask 00ff := dec ("00ff"), + mask ff00 := dec ("ff00"), + offs mask := dec ("0007"), + addr mask := dec ("fff8"); +BOOL VAR found, low byte flag := TRUE, interrupted, + area 2 nonchangeable := id (1) <> 4 (*i.e. other than 68000*); + +PROC wait for (TEXT CONST chars): + inchar (char); + WHILE pos (chars, char) = 0 + REP out (""7""); inchar (char) PER +END PROC wait for; + +PROC info: + info (drid, begin hi, begin lo, lines) +END PROC info; + +PROC info (INT CONST start drid, start addr hi, start addr lo, start len): + drid := start drid; + begin hi := start addr hi; + begin lo := start addr lo; + lines := start len; + line; line; show dump; + command loop. + +command loop: + REP + zeige kommandoliste; + kommando lesen und ausfuehren + PER. + +zeige kommandoliste: + putline (""15"INFO: more, address, dsid, lines, find, or quit"14""). + +kommando lesen und ausfuehren: + inchar (char); + SELECT pos ("damlfq"3"", char) OF + CASE 1: drid command + CASE 2: addr command + CASE 3: more command + CASE 4: len command + CASE 5: find command + CASE 6: quit command + CASE 7: up command + OTHERWISE more command + END SELECT. + +quit command: LEAVE command loop. + +drid command: + out ("dsid="); gethex (buf); drid := dec (buf); + IF drid > 0 AND drid < 4 OR drid > 255 + THEN beep; drid := stdds + ELIF drid = 4 + THEN drid := stdds + FI; + found := FALSE; + show dump. + +len command: + out ("lines="); gethex (buf); lines := dec (buf); show dump. + +addr command: + out ("address="); + gethex (buf); + IF LENGTH buf < 5 + THEN begin hi := 0; begin lo := dec (buf) + ELSE begin hi := dec (subtext (buf, 1, LENGTH buf - 4)); + begin lo := dec (subtext (buf, LENGTH buf - 3)) + FI; + low byte flag := TRUE; found := FALSE; + show dump. + +more command: + begin hi := adr hi; begin lo := adr lo; + low byte flag := TRUE; found := FALSE; + line; show dump. + +show dump: + interrupted := FALSE; + get cursor (cur x, cur y); + cursor (1, cur y - 2); + out ("---------------------------- dsid="); + IF drid = stdds THEN out ("04") ELSE outsubtext (hex (drid), 3) FI; + putline (" --------------------"); + adr hi := begin hi; + adr lo := begin lo AND addr mask; + FOR l FROM 1 UPTO lines REP + buf := " "; linebuf := " "; bytes := ""; + out (txt (adr hi)); out (hex (adr lo) CT ": "); + IF adr hi = 8 + THEN out ("_________e_n_d___o_f___d_a_t_a_s_p_a_c_e_________"); + line; beep; LEAVE show dump + FI; + FOR i FROM 1 UPTO 8 REP + word := dsgetw (drid, adr hi, adr lo); + replace (buf, 1, word); rotate (word, 8); hexbytes := hex (word); + IF adr lo <> begin lo + THEN outsubtext (hexbytes, 1, 2); out (" "); + outsubtext (hexbytes, 3) ; out (" ") + ELIF low byte flag + THEN out (""8"-"); outsubtext (hexbytes, 1, 2); out ("-"); + outsubtext (hexbytes, 3); out (" ") + ELSE outsubtext (hexbytes, 1, 2); out ("-"); + outsubtext (hexbytes, 3); out ("-") + FI; + IF i = 4 THEN out (" ") FI; + bytes CAT buf; + incl (adr hi, adr lo, 1) + PER; + FOR i FROM 1 UPTO 16 REP + IF pos (charset, bytes SUB i) = 0 THEN replace (bytes, i, ".") FI + PER; + out (" "); outsubtext (bytes, 1, 8); + out (" "); outsubtext (bytes, 9); line; + IF incharety <> "" THEN interrupted := TRUE; LEAVE show dump FI + PER. + +up command: + IF change not allowed THEN beep; reposit cursor; LEAVE up command FI; + get cursor (cur x, cur y); + ymax := cur y - 2; ymin := ymax - lines + 1; + cur x := xmin + (begin lo AND offs mask) * 6; + IF cur x > xmidlo THEN cur x INCR 2 FI; + IF NOT low byte flag THEN cur x INCR 3 FI; + cur y := ymin; + cursor (cur x, cur y); + REP inchar (char); + IF pos (up down left right, char) > 0 THEN move cursor + ELIF pos (hextab, char) > 0 THEN read byte and move cursor + ELIF char <> cr THEN beep + FI + UNTIL char = cr PER; + cursor (1, ymax + 2); line; show dump. + +change not allowed: + interrupted OR area 2 nonchangeable AND area 2 of stdds in window. + +area 2 of stdds in window: + drid = stdds AND + (begin hi = 2 OR + begin hi = 1 AND begin lo < 0 AND lines * 8 + begin lo > 0). + +read byte and move cursor: + out (char); byte := pos (hextab, char) - 1; + wait for (hextab); + out (char); byte := pos (hextab, char) - 1 + 16 * byte; + out (""8""8""); + eval cursor address and modify word; + char := ""2""; move cursor. + +eval cursor address and modify word: + adr hi := begin hi; adr lo := begin lo AND addr mask; + incl (adr hi, adr lo, ((cur y - ymin)*8 + (cur x - xmin) DIV 6)); + word := dsgetw (drid, adr hi, adr lo); + IF high byte read + THEN rotate (byte, 8); word := (word AND mask 00ff) OR byte + ELSE word := (word AND mask ff00) OR byte + FI; + dsputw (drid, adr hi, adr lo, word). + +high byte read: + cur xx := cur x; IF cur xx > xmidlo THEN cur xx DECR 2 FI; + cur xx MOD 6 < 3. + +move cursor: + SELECT pos (up down left right, char) OF + CASE 1: IF cur y = ymin THEN beep ELSE cur y DECR 1 FI + CASE 2: IF cur y = ymax THEN beep ELSE cur y INCR 1 FI + CASE 3: IF cur x = xmin THEN IF cur y = ymin THEN beep + ELSE cur y DECR 1; cur x := xmax + FI + ELIF cur x = xmidhi THEN cur x DECR 5 + ELSE cur x DECR 3 FI + CASE 4: IF cur x = xmax THEN IF cur y = ymax THEN beep + ELSE cur y INCR 1; cur x := xmin + FI + ELIF cur x = xmidlo THEN cur x INCR 5 + ELSE cur x INCR 3 FI + ENDSELECT; + cursor (cur x, cur y). + +beep: out (""7""). + +reposit cursor: out (""3""). + +find command: + out ("find: hex, char, or last param? (h/H/c/C/)"); + wait for ("hHcC"13""); + saddr hi := begin hi; saddr lo := begin lo; + IF char = "c" OR char = "C" + THEN out (char); get char string; low byte flag := NOT low byte flag + ELIF char = "h" OR char = "H" + THEN out (char); get hex string; low byte flag := NOT low byte flag + ELSE out (search mode); + IF pos ("cC", search mode) > 0 + THEN out (search param) + ELSE out (hex search param) + FI; + IF NOT found THEN low byte flag := NOT low byte flag + ELIF NOT low byte flag OR pos ("CH", search mode) > 0 + THEN incl (saddr hi, saddr lo, 1) + FI + FI; + out (cr); (*acknowledge CR*) + search string; + line; show dump. + +get char string: + search mode := char; + search param := ""; + REP inchar (char); + SELECT pos (cr rubout, char) OF + CASE 1: IF search param = "" THEN beep ELSE LEAVE get char string FI + CASE 2: delete last char + OTHERWISE search param CAT char; out (char) + ENDSELECT + PER. + +delete last char: + IF search param = "" + THEN beep + ELSE search param := subtext (search param, 1, LENGTH search param - 1); + out (""8" "8"") + FI. + +get hex string: + search mode := char; + search param := ""; + REP wait for (hextab CT cr rubout); + SELECT pos (cr rubout, char) OF + CASE 1: IF NOT regular hex string THEN beep; char :="" FI + CASE 2: delete last char + OTHERWISE search param CAT char; out (char) + ENDSELECT + UNTIL char = cr PER; + hex search param := search param; + search param := ""; + FOR i FROM 1 UPTO LENGTH hex search param DIV 2 REP + char := hex search param SUB i; + word := pos (hextab, hex search param SUB (2*i-1)) - 1; + word := word * 16 + pos (hextab, hex search param SUB (2*i)) - 1; + search param CAT code (word) + PER. + +regular hex string: + LENGTH search param > 0 AND (LENGTH search param AND 1) = 0. + +search string: + first byte := search param SUB 1; buf := " "; + IF LENGTH search param > 1 THEN first word := search param ISUB 1 FI; + REP IF pos ("ch", search mode) > 0 + THEN search first byte or word + ELSE search first word + FI; + search rest if any; + IF found THEN begin hi := saddr hi; begin lo := saddr lo; + LEAVE search string + FI; + IF NOT low byte flag THEN incl (saddr hi, saddr lo, 1) FI + PER. + +search first byte or word: + REP + IF saddr hi = 8 THEN LEAVE search first byte or word FI; + word := dsgetw (drid, saddr hi, saddr lo); + replace (buf, 1, word); + IF NOT low byte flag AND (buf SUB 1) = first byte + THEN IF LENGTH search param = 1 + THEN low byte flag := TRUE; no of found bytes := 1; + LEAVE search first byte or word + ELIF (buf SUB 2) = (search param SUB 2) + THEN low byte flag := TRUE; no of found bytes := 2; + LEAVE search first byte or word + ELSE look in high byte + FI + ELSE look in high byte + FI; + low byte flag := FALSE; + incr search address and provide for interaction + PER. + +search first word: + REP + IF saddr hi = 8 THEN LEAVE search first word FI; + word := dsgetw (drid, saddr hi, saddr lo); + IF LENGTH search param = 1 + THEN replace (buf, 1, word); + IF (buf SUB 1) = first byte + THEN low byte flag := TRUE; no of found bytes := 1; + LEAVE search first word + FI + ELSE IF word = first word + THEN low byte flag := TRUE; no of found bytes := 2; + LEAVE search first word + FI + FI; + incr search address and provide for interaction + PER. + +look in high byte: + IF (buf SUB 2) = first byte + THEN low byte flag := FALSE; no of found bytes := 1; + LEAVE search first byte or word + FI. + +incr search address and provide for interaction: + incl (saddr hi, saddr lo, 1); + IF incharety <> "" + THEN cursor (64, 24); out ("--- interrupted"); line; line; + begin hi := saddr hi; begin lo := saddr lo; + LEAVE search string + FI. + +search rest if any: + found := TRUE; + IF LENGTH search param = no of found bytes OR saddr hi = 8 + THEN LEAVE search rest if any + FI; + IF low byte flag + THEN search buffer := subtext (search param, 3) + ELSE search buffer := subtext (search param, 2) + FI; + adr hi := saddr hi; adr lo := saddr lo; + FOR i FROM 1 UPTO (LENGTH search param - no of found bytes) DIV 2 REP + incl (adr hi, adr lo, 1); + word := dsgetw (drid, adr hi, adr lo); + IF (search buffer ISUB i) = word + THEN no of found bytes INCR 2 + ELSE found := FALSE + FI + UNTIL NOT found PER; + IF found AND LENGTH search param > no of found bytes + THEN search last byte + FI. + +search last byte: + incl (adr hi, adr lo, 1); + word := dsgetw (drid, adr hi, adr lo); + replace (buf, 1, word); + found := (buf SUB 1) = (search param SUB length (search param)). + +END PROC info; + +(* info *) (****) + +END PACKET info; + diff --git a/devel/debug/1/src/trace b/devel/debug/1/src/trace new file mode 100644 index 0000000..773b5f2 --- /dev/null +++ b/devel/debug/1/src/trace @@ -0,0 +1,1020 @@ +PACKET trace DEFINES trace: + +(**************************************************************) +(* Autor: G. Szalay *) +(* E U M E L 0 - T R A C E *) +(* Stand: 87-04-23 *) +(**************************************************************) + +LET packet area = 0, stack area = 1, text opd maxlen = 14, + stdds = 0, info lines = 4, crlf = ""13""10"", + beep = ""7"", carriage return = ""13"", cursor up = ""3"", + std charset = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ123456 + 7890<>.,:;-_+*!""�$%&/()=?'äÄöÖüÜ#^", + blanks = " ", + startindent = 10, indentincr = 2; +BOOL VAR trap set := FALSE, trapped, initial call := TRUE, quit, + single step := FALSE, protocol := FALSE, cond br follows, + prot just started := FALSE, prot stopped := TRUE, + users error := FALSE, users stpdis, prot operands := TRUE, + nontraceable found, errorstop processing := FALSE, + std procs traceable := id (1) = 4 (* processor = 68000 *), + longcall to trace flag; +INT VAR aret hi := 0, aret lo := 0, ic hi, ic lo, ic h, ic l, i, + atrap hi, atrap lo, nail1 hi, nail1 lo, nail2 hi, nail2 lo, + no of nails := 1, saved instr, saved instr w2, + saved1, saved1 w2, saved2, saved2 w2, + call to trace, call2 to trace, length of call to trace, + cmd, ilen, iclass, ilen1, iclass1, indentpos, + code addr modif, pbase, lbase, users lbase, + users errcode, users errline, old flags, flags, + module no, word, word1, word2, case, xpos, ypos, + cond br hi, cond br lo, maxlines:=12, lines, + opad hiword, opad hi, opad lo, opdds, br param, brcomp index, + ic off, opd ptr, int opd, text opd len, text opd tr len, + heap link, root word 2, no of results:=0, + no of nontraceables := 0, no of long nontraceables := 0, + pproc modno, pproc call, pproc ic lo := 0; +ROW 3 INT VAR res ds, res opadh, res opadl; +INT CONST lo byte mask := dec ("00ff"), + hi byte mask := dec ("ff00"), + branch param mask := dec ("87ff"), + opcode mask0 := dec ("83ff"), + opcode mask1 := dec ("7c00"), + bf mask1 := dec ("0040"), + ln br mask1 := dec ("7800"), + stpdis mask0 := dec ("ffbf"), + stpdis mask1 := dec ("0040"), + aritu mask1 := dec ("0010"), + error mask1 := dec ("0080"), + flags mask1 := dec ("00fc"), + mask 8000 := dec ("8000"), + mask 7fff := dec ("7fff"), + mask 7ffe := dec ("7ffe"), + mask 7f00 := dec ("7f00"), + mask 0400 := dec ("0400"), + mask fbff := dec ("fbff"), + mask 0007 := dec ("0007"), + mask fff8 := dec ("fff8"), + m l t start := dec ("0200"), + ln opcode := dec ("0000"), + br opcode := dec ("7000"), + rtn opcode := dec ("7f00"), + call opcode := dec ("7800"), + longcall opcode := dec ("ff78"), + pproc opcode := dec ("7f1e"), + estop opcode := dec ("7f4b"), + dstop opcode := dec ("7f4c"); +TEXT VAR buf, char, command, iname, iname1, ioplist, ioplist1, opd type, + opd buf, text opd, res types, users errmsg; + + +(********* following OPs and PROCs may be used by TRACE only ***********) + +PROC put (TEXT CONST a): + out (a); out (" ") +ENDPROC put; + +PROC putline (TEXT CONST a): + out (a); out (crlf) +ENDPROC putline; + + +(***********************************************************************) + +PROC eval br addr (INT CONST br para hi, br para lo, + INT VAR br addr hi, br addr lo): + br param := dsgetw (stdds, br para hi, br para lo) + AND branch param mask; + br addr hi := br para hi; + br addr lo := (br para lo AND hi byte mask) + OR (br param AND lo byte mask); + IF NOT br within page + THEN rotate (br param, 8); + br param := br param AND lo byte mask; + rotate (br param, 1); + IF br param > 255 + THEN br param INCR 1; + br param := br param AND 255 + FI; + rotate (br param, 8); + br addr lo INCR br param; + word := br addr lo AND hi byte mask; rotate (word, 8); + IF word >= code addr modif + THEN br addr lo DECR dec("1000") + FI + FI. + + br within page: + br param = (br param AND lo byte mask). + +ENDPROC eval br addr; + + +PROC eval opd addr (INT CONST ic offset): + word := dsgetw (stdds, ic hi, ic lo PLUS ic offset); + IF ic offset = 0 + THEN word := word AND opcode mask0 + FI; + IF global + THEN eval global addr + ELIF local + THEN eval local addr + ELSE eval ref addr + FI. + + global: (word AND mask 8000) = 0. + + local: (word AND 1) = 0. + + eval global addr: + opdds := stdds; + opad hi := packet area; + opad hiword := opad hi; + opad lo := pbase PLUS word; + perhaps put opad. + + eval local addr: + opdds := stdds; + opad hi := stack area; + opad hiword := opad hi; + word := word AND mask 7ffe; rotate (word, -1); + opad lo := users lbase PLUS word; + perhaps put opad. + + eval ref addr: + eval local addr; + opad hiword := dsgetw (stdds, stack area, opad lo PLUS 1); + opad lo := dsgetw (stdds, stack area, opad lo); + opdds := opad hiword AND hi byte mask; rotate (opdds, 8); + opad hi := opad hiword AND lo byte mask; + perhaps put opad. + +perhaps put opad: + (* put("opad=" CT hex(opad hiword) CT hex(opad lo)) *) . (*for tests*) + +ENDPROC eval opd addr; + + +PROC out int opd: + out (txt (int opd)); + IF int opd < 0 OR int opd > 9 + THEN out ("("); out (hex (int opd)); out (")") + FI +ENDPROC out int opd; + + +PROC fetch text opd: + root word 2 := dsgetw (opdds, opad hi, opad lo PLUS 1); + opd buf := subtext (blanks, 1, text opd maxlen + 2); + IF text on heap + THEN eval text from heap + ELSE eval text from root + FI; + convert nonstd chars; + text opd := """"; + text opd CAT subtext (opd buf, 1, text opd tr len); + text opd CAT """"; + IF text opd len > text opd tr len + THEN text opd CAT "(..."; + text opd CAT txt (text opd len); + text opd CAT "B)" + FI. + +text on heap: + (root word 2 AND lo byte mask) = 255. + +eval text from root: + text opd len := root word 2 AND lo byte mask; + text opd tr len := min (text opd len, text opd maxlen); + FOR i FROM 1 UPTO text opd tr len DIV 2 + 1 REP + replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) + PER; + opd buf := subtext (opd buf, 2, text opd tr len + 1). + +eval text from heap: + rotate (root word 2, 8); + text opd len := root word 2 AND lo byte mask + OR (dsget2b (opdds, opad hi, opad lo PLUS 2) AND hi byte mask); + text opd tr len := min (text opd len, text opd maxlen); + heap link := dsgetw (opdds, opad hi, opad lo); + rotate (heap link, 15); + opad hi := heap link AND mask 0007; + opad lo := heap link AND mask fff8; + IF opdds = stdds THEN opad lo INCR 2 FI; + FOR i FROM 1 UPTO text opd tr len DIV 2 REP + replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) + PER; + opd buf := subtext (opd buf, 1, text opd tr len). + +convert nonstd chars: + i := 1; + WHILE i <= LENGTH opd buf REP + char := opd buf SUB i; + IF pos (std charset, char) = 0 + THEN buf := txt (code (char)); + opd buf := subtext (opd buf, 1, i-1) CT + """" CT buf CT """" CT + subtext (opd buf, i+1); + i INCR 2 + length (buf); + ELIF char = """" + THEN opd buf := subtext (opd buf, 1, i-1) CT """""" CT + subtext (opd buf, i+1); + i INCR 2 + ELSE i INCR 1 + FI + PER; + text opd tr len := LENGTH opd buf. + +END PROC fetch text opd; + + +INT OP PLUS (INT CONST a, b): + unsigned arith; + a + b +ENDOP PLUS; + +PROC trace: + ROW 40 INT VAR dummy space for 20 pps; + get return address; + IF initial call + THEN save call to trace + ELSE process regular call + FI. + +get return address: + lbase:=local base; + users lbase := dsgetw (stdds, stack area, lbase); + aret lo := dsgetw (stdds, stack area, lbase+1); + word := dsgetw (stdds, stack area, lbase+2); + aret hi := word AND 3; + flags := word AND flags mask1; + ic hi := aret hi; ic lo := aret lo. + +save call to trace: + call to trace := dsgetw (stdds, aret hi, aret lo - 1); + IF (call to trace AND opcode mask1) = call opcode + THEN length of call to trace := 1; + longcall to trace flag := FALSE + ELSE call2 to trace := call to trace; + call to trace := dsgetw (stdds, aret hi, aret lo - 2); + length of call to trace := 2; + longcall to trace flag := TRUE; + putline ("WARNING: call to trace needs 2 words!!!") + FI; + initial call := FALSE. + +process regular call: + IF protocol + THEN pull old nails + ELSE indentpos := startindent; cond br follows := FALSE + FI; + get users error state and set modes for trace; + IF NOT errorstop processing + THEN normal processing of instructions + ELSE errorstop processing := FALSE + FI; + handle possible trace errors; + IF NOT protocol THEN restore users error state FI. + +normal processing of instructions: + trapped := trap set AND atrap lo = ic lo - length of call to trace + AND atrap hi = ic hi; + IF protocol THEN postprocess protocol FI; + IF trapped THEN handle trap FI; + IF protocol OR trapped + THEN ic lo DECR length of call to trace; + update icount on stack + FI; + IF trapped OR NOT protocol OR single step OR incharety <> "" + OR lines >= maxlines + THEN quit := FALSE; protocol := FALSE; single step := FALSE; lines := 0; + REP ask for next action; + execute command + UNTIL quit PER + FI; + IF protocol THEN protocol instruction and set nails FI. + +get users error state and set modes for trace: + signed arith; + IF NOT protocol + THEN users error := (flags AND error mask1) <> 0; + users stpdis := (flags AND stpdis mask1) <> 0; + IF users error + THEN save users error state; clear error; + line; putline ("trace called with user error " CT + txt (users errcode) CT ": " CT users errmsg) + ELSE disable stop + FI + ELIF is error + THEN IF first occurrence + THEN users error := TRUE; + save users error state; + line; + putline ("trace detected user error " CT + txt (users errcode) CT ": " CT users errmsg); + IF users stpdis + THEN out ("(stop disabled)") + ELSE errorstop processing := TRUE; stop op; + IF protocol THEN set nail1 FI + FI + ELSE line; + putline ("trace detected user error " CT + txt (error code) CT ": " CT error message); + out ("(ignored because of previous error(s)) "); + FI; + clear error + ELSE IF (flags AND stpdis mask1) = 0 + THEN set stpdis flag on stack; disable stop + FI + FI. + +first occurrence: NOT users error. + +save users error state: + users errmsg := error message; + users errline := error line; + users errcode := error code. + +handle possible trace errors: + IF is error + THEN line; + putline ("TRACE error " CT txt (error code) + CT " at line " CT txt (error line) + CT ": " CT error message); + clear error + FI. + +restore users error state: + IF users error + THEN error stop (users errcode, users errmsg); + users error := FALSE + FI; + restore users stpdis flag on stack. + +handle trap: + put trap message; + restore instruction; + trap set := FALSE. + +put trap message: + putline ("trap at address " CT txt (atrap hi) CT hex (atrap lo)). + +restore instruction: + dsputw (stdds, atrap hi, atrap lo, saved instr); + IF longcall to trace flag + THEN dsputw (stdds, atrap hi, atrap lo PLUS 1, saved instr w2) + FI. + +postprocess protocol: + IF prot operands THEN protocol result operands FI; + line; lines INCR 1; + IF cond br follows THEN protocol cond br op; cond br follows := FALSE FI. + +protocol cond br op: + outsubtext (blanks, 1, indentpos); + out (txt (cond br hi)); out (hex (cond br lo)); out (": "); + word := dsget2b (stdds, cond br hi, cond br lo); + IF (word AND bf mask1) <> 0 + THEN out ("BF ") + ELSE out ("BT ") + FI; + putline (hex (word)); lines INCR 1. + +pull old nails: + dsputw (stdds, nail1 hi, nail1 lo, saved1); + IF longcall to trace flag + THEN dsputw (stdds, nail1 hi, nail1 lo PLUS 1, saved1 w2) + FI; + IF no of nails = 2 + THEN dsputw (stdds, nail2 hi, nail2 lo, saved2); + IF longcall to trace flag + THEN dsputw (stdds, nail2 hi, nail2 lo PLUS 1, saved2 w2) + FI; + no of nails := 1 + FI. + +update icount on stack: + dsputw (stdds, 1, lbase + 1, ic lo). + +ask for next action: + putline (""15"" CT + "TRACE: step, more, trap, regs, lines, info, disasm, or quit"14""); + inchar (command). + +execute command: + cmd := pos ("tidqmsrl", command); + SELECT cmd OF + CASE 1: set address trap; prot stopped := TRUE + CASE 2: info (stdds, ic hi, ic lo, info lines); prot stopped := TRUE + CASE 3: disasm (ic hi, ic lo); prot stopped := TRUE + CASE 4: quit := TRUE; prot stopped := TRUE + CASE 5: initialize protocol; single step := FALSE; + quit := TRUE + CASE 6: initialize protocol; single step := TRUE; + quit := TRUE + CASE 7: show registers; prot stopped := TRUE + CASE 8: set new line count; prot stopped := TRUE + OTHERWISE out(beep CT carriage return CT cursor up) + ENDSELECT. + +set new line count: + out ("lines="); gethex (buf); maxlines := dec (buf). + +set address trap: + IF trap set + THEN putline ("current trap address: " CT txt (atrap hi) CT hex (atrap lo)); + out ("type to confirm, or ") + ELSE out ("type ") + FI; + out ("new trap addr ("); + IF std procs traceable THEN out ("2") ELSE out ("3") FI; + out ("0000...3ffff), or 0 for no trap:"); + gethex (buf); + IF buf <> "" + THEN IF trap set THEN restore instruction; trap set := FALSE FI; + buf:="0000" CT buf; + atrap hi := dec (subtext (buf, LENGTH buf-7, LENGTH buf-4)); + atrap lo := dec (subtext (buf, LENGTH buf-3)); + IF atrap hi=3 OR atrap hi=2 AND std procs traceable + THEN saved instr := dsgetw (stdds, atrap hi, atrap lo); + dsputw (stdds, atrap hi, atrap lo, call to trace); + IF longcall to trace flag + THEN saved instr w2 := dsgetw (stdds, atrap hi, atrap lo PLUS 1); + dsputw (stdds, atrap hi, atrap lo PLUS 1, call2 to trace); + FI; + trap set := TRUE + ELIF NOT (atrap hi=0 AND atrap lo=0) + THEN out (beep); putline ("address not in above range") + FI + ELSE IF NOT trap set THEN out (beep); putline ("no trap specified") FI + FI. + +initialize protocol: + pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, lbase + 3) + AND lo byte mask; + set stpdis flag on stack; + prot just started := TRUE; + protocol := TRUE. + +set stpdis flag on stack: + word := dsgetw (stdds, stack area, lbase + 2); + dsputw (stdds, stack area, lbase + 2, word OR stpdis mask1). + +restore users stpdis flag on stack: + word := dsgetw (stdds, stack area, lbase + 2) AND stpdis mask0; + IF users stpdis THEN word := word OR stpdis mask1 FI; + dsputw (stdds, stack area, lbase + 2, word). + +protocol instruction and set nails: + protocol instr; + SELECT iclass OF + CASE 0: standard ops + CASE 1: cond branch ops + CASE 2: branch ops + CASE 3: comp branch op + CASE 4: call op + CASE 5: exec op + CASE 6: pcall op + CASE 7: return ops + CASE 8: penter op + CASE 9: pp ops + CASE 10: line ops + CASE 11: stop ops + CASE 12: ke op + CASE 13: clrerr op + OTHERWISE: wrong ops + ENDSELECT; + IF protocol THEN set nail1 FI. + +protocol instr: + word1 := dsgetw (stdds, ic hi, ic lo); + disa (ic hi, ic lo, iname, ioplist, ilen, iclass); + protocol this instr. + +protocol this instr: + possibly delete command line; + outsubtext (blanks, 1, indentpos); + ic h := ic hi; ic l := ic lo; + out (txt (ic h)); out (hex (ic l)); out (": "); + out (iname); out (" "); + IF ilen > 0 + THEN FOR i FROM 1 UPTO ilen + REP out (hex (dsget2b (stdds, ic h, ic l))); out (" "); + ic l INCR 1 PER + ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (" ") + FI; + IF prot operands THEN protocol operands FI. + +possibly delete command line: + IF prot just started + THEN prot just started := FALSE; + IF prot stopped + THEN prot stopped := FALSE + ELSE delete command line + FI + FI. + +delete command line: + get cursor (xpos, ypos); cursor (1, ypos-1); out(""4""). + +protocol operands: + out (" "); + IF (word1 AND mask 7f00) = mask 7f00 + THEN ic off := 1 + ELSE ic off := 0 + FI; + res types := ""; + no of results := 0; + FOR opd ptr FROM 1 UPTO LENGTH ioplist REP + opd type := ioplist SUB opd ptr; + IF opd type <> " " + THEN case := pos ("irtdpahIRTDPEH", opd type); + IF case > 0 + THEN eval opd addr (ic off); + SELECT case OF + CASE 1: prot int rd opd + CASE 2: prot real rd opd + CASE 3: prot text rd opd + CASE 4: prot dataspace rd opd + CASE 5: prot task rd opd + CASE 6: prot virt addr + CASE 7: prot hex rd opd + OTHERWISE save res type + ENDSELECT + FI; + ic off INCR 1 + FI + UNTIL opd type = " " PER. + +save res type: + res types CAT opd type; + no of results INCR 1; + res ds (no of results) := opdds; + res opadh (no of results) := opad hi; + res opadl (no of results) := opad lo. + +protocol result operands: + FOR opd ptr FROM 1 UPTO no of results REP prot this result PER. + +prot this result: + opdds := res ds (opd ptr); + opad hi := res opadh (opd ptr); + opad lo := res opadl (opd ptr); + opd type := res types SUB opd ptr; + SELECT pos ("IRTDPEH", opd type) OF + CASE 1: prot int result + CASE 2: prot real result + CASE 3: prot text result + CASE 4: prot dataspace result + CASE 5: prot task result + CASE 6: prot eva result + CASE 7: prot hex result + OTHERWISE out (opd type CT "(???) ") + ENDSELECT. + +prot int rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out int opd; out (" "). + +prot int result: + int opd := dsgetw (opdds, opad hi, opad lo); + out int opd; out ("> "). + +prot hex rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out (hex (int opd)); out (" "). + +prot hex result: + int opd := dsgetw (opdds, opad hi, opad lo); + out (hex (int opd)); out ("> "). + +prot real rd opd: + out (">"); + out (hex (dsget2b (opdds, opad hi, opad lo))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); out (" "). + +prot real result: + out (hex (dsget2b (opdds, opad hi, opad lo))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); + out ("> "). + +prot text rd opd: + fetch text opd; + out (">"); out (text opd); out (" "). + +prot text result: + fetch text opd; + out (text opd); out ("> "). + +prot dataspace rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out (hex (int opd)); out (" "). + +prot dataspace result: + int opd := dsgetw (opdds, opad hi, opad lo); + out (hex (int opd)); out ("> "). + +prot task rd opd: + out (">"); out (hex (dsgetw (opdds, opad hi, opad lo))); + out ("/"); out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out (" "). + +prot task result: + out (hex (dsgetw (opdds, opad hi, opad lo))); out ("/"); + out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out ("> "). + +prot virt addr: + out (">"); out (hex (opad hiword)); out (hex (opad lo)); out (" "). + +prot eva result: + out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsgetw (opdds, opad hi, opad lo))); + out (">"). + +standard ops: + nail1 hi := ic hi; nail1 lo := ic lo PLUS ilen. + +set nail1: + saved1 := dsgetw (stdds, nail1 hi, nail1 lo); + dsputw (stdds, nail1 hi, nail1 lo, call to trace); + IF longcall to trace flag + THEN saved1 w2 := dsgetw (stdds, nail1 hi, nail1 lo PLUS 1); + dsputw (stdds, nail1 hi, nail1 lo PLUS 1, call2 to trace) + FI. + +set nail2: + saved2 := dsgetw (stdds, nail2 hi, nail2 lo); + dsputw (stdds, nail2 hi, nail2 lo, call to trace); + IF longcall to trace flag + THEN saved2 w2 := dsgetw (stdds, nail2 hi, nail2 lo PLUS 1); + dsputw (stdds, nail2 hi, nail2 lo PLUS 1, call2 to trace) + FI. + +cond branch ops: + cond br follows := TRUE; + cond br hi := ic hi; cond br lo := ic lo PLUS ilen; + nail1 hi := cond br hi; nail1 lo := cond br lo PLUS 1; + eval br addr (cond br hi, cond br lo, nail2 hi, nail2 lo); + no of nails := 2; set nail2. + +branch ops: + eval br addr (ic hi, ic lo, nail1 hi, nail1 lo). + +comp branch op: + eval opd addr (1); + brcomp index := dsgetw (stdds, opad hi, opad lo); + IF brcomp index < 0 OR brcomp index >= dsgetw (stdds, ic hi, ic lo PLUS 2) + THEN brcomp index := -1 + FI; + nail1 hi := ic hi; + nail1 lo := ic lo PLUS ilen PLUS brcomp index PLUS 1. + +call op: + eval module no; + call or exec. + +call or exec: + IF module no < 1280 AND NOT std procs traceable + THEN possibly append proc head; + out (" (*n.t.*)"); + nontraceable found := TRUE + ELSE check for nontraceable + FI; + IF NOT nontraceable found + THEN restore users stpdis flag on stack; + get proc address via module link table; + possibly append proc head; + indentpos INCR indentincr; + nail1 hi := ic hi; nail1 lo := ic lo PLUS 1 (*nail behind head*) + ELIF call to trace found + THEN skip instruction + ELIF possibly call to bool proc + THEN cond branch ops + ELSE standard ops + FI. + +eval module no: + IF word1 = longcall opcode + THEN module no := dsgetw (stdds, ic hi, ic lo PLUS 1) + ELSE module no := word1 AND opcode mask0; + IF (module no AND mask 8000) <> 0 + THEN module no := module no AND mask 7fff OR mask 0400 + FI + FI. + +check for nontraceable: + nontraceable found := FALSE; + IF word1 = longcall opcode + THEN word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); + FOR j FROM 1 UPTO no of long nontraceables REP + IF word 2 = call2 to nontraceables (j) + THEN out (names of long nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + ELSE FOR j FROM 1 UPTO no of nontraceables REP + IF word1 = calls to nontraceables (j) + THEN out (names of short nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + FI. + +get proc address via module link table: + IF module no < 1280 THEN ic hi := 2 ELSE ic hi := 3 FI; + ic lo := dsgetw (stdds, packet area, m l t start + module no). + +possibly append proc head: + out (proc head (module no)). + +skip instruction: + ic lo INCR ilen; update icount on stack; + nail1 hi := ic hi; nail1 lo := ic lo. + +possibly call to bool proc: + word := dsgetw (stdds, ic hi, ic lo PLUS ilen) AND ln br mask1; + word = ln opcode OR word = br opcode. + +exec op: + eval opd addr (1); + module no := dsgetw (stdds, opad hi, opad lo); + call or exec. + +pcall op: + eval opd addr (1); + IF opad lo = 2 AND NOT std procs traceable + THEN out (" (*n.t.*)"); + nontraceable found := TRUE + ELSE check for nontraceable pproc + FI; + IF NOT nontraceable found + THEN restore users stpdis flag on stack; + possibly append proc head for pproc; + indentpos INCR indentincr; + nail1 hi := opad hi; nail1 lo := opad lo PLUS 1 (*nail behind head*) +(*ELIF word1 = call to trace + THEN skip instruction *) + ELIF possibly call to bool proc + THEN cond branch ops + ELSE standard ops + FI. + +check for nontraceable pproc: + nontraceable found := FALSE; + IF opad lo = pproc ic lo + THEN FOR j FROM 1 UPTO no of nontraceables REP + IF pproc call = calls to nontraceables (j) + THEN out (names of nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + ELSE nontraceable found := TRUE (*to be on the secure side*) + FI. + +possibly append proc head for pproc: + IF opad lo = pproc ic lo + THEN out (proc head (pproc modno)) + FI. + +return ops: + fetch eumel0 regs of caller from users stack; + out ("--> "); + put users flags; + IF (old flags AND aritu mask1) <> 0 + THEN put ("ARITU") + ELSE put ("ARITS") + FI; + IF nontraceable caller + THEN line; putline ("trace ended by returning to nontraceable caller"); + protocol := FALSE; prot stopped := TRUE + ELIF users error AND NOT users stpdis + THEN stop op + ELSE set nail for return ops + FI. + +set nail for return ops: + IF word1 = rtn opcode + THEN nail1 hi := ic hi; nail1 lo := ic lo + ELSE nail1 hi := ic hi; nail1 lo := ic lo PLUS 1; + eval br addr (ic hi, ic lo, nail2 hi, nail2 lo); + no of nails := 2; set nail2 + FI. + +penter op: + pbase := word1 AND lo byte mask; rotate (pbase, 8); + standard ops. + +line ops: + standard ops. + +stop ops: + IF word1 = estop opcode + THEN users stpdis := FALSE; + IF users error THEN stop op ELSE standard ops FI + ELIF word1 = dstop opcode + THEN users stpdis := TRUE; standard ops + ELSE stop op + FI. + +clrerr op: + users error := FALSE; standard ops. + +ke op: + skip instruction; + line; putline ("INFO: ke"); + info (stdds, ic hi, ic lo, info lines); + single step := TRUE. + +pp ops: + save modno and ic lo if pproc; + look at next instr; + WHILE iclass1 = 9 REP + ic lo INCR ilen; iname := iname1; ioplist := ioplist1; + ilen := ilen1; iclass := iclass1; + line; lines INCR 1; + protocol this instr; + save modno and ic lo if pproc; (*only the first one will be saved!!!*) + look at next instr + PER; + standard ops. + +save modno and ic lo if pproc: + IF word1 = pproc opcode + THEN pproc modno := dsgetw (stdds, ic hi, ic lo PLUS 1); + IF pproc modno < 256 + THEN putline ("*** this looks like a compiler error ***"); + protocol := FALSE; prot stopped := TRUE; users error := TRUE; + users errcode := 0; users errmsg := ("maybe a compiler error"); + LEAVE normal processing of instructions + ELIF (pproc modno AND mask 0400) <> 0 + THEN word := (pproc modno AND mask fbff) OR mask 8000 + ELSE word := pproc modno + FI; + pproc call := word OR opcode mask1; + pproc ic lo := dsgetw (stdds, packet area, m l t start + pproc modno) + FI. + +look at next instr: + word1 := dsgetw (stdds, ic hi, ic lo PLUS ilen); + disa (ic hi, ic lo PLUS ilen, iname1, ioplist1, ilen1, iclass1). + +wrong ops: + putline ("**** das kann ich (noch) nicht!!! ***"); + info (stdds, ic hi, ic lo, info lines); + protocol := FALSE. + +show registers: + pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, lbase + 3) + AND lo byte mask; + putline ("----------------- EUMEL0-registers: ------------------"); + put ("icount=" CT txt (ic hi) CT hex (ic lo) CT + " lbase=1" CT hex (users lbase) CT " pbase=" CT hex (pbase)); + put users flags; + IF (flags AND aritu mask1) <> 0 + THEN putline ("ARITU") + ELSE putline ("ARITS") + FI. + +put users flags: + IF users stpdis + THEN put ("STPDIS") + ELSE put ("STOPEN") + FI; + IF users error + THEN put ("ERROR") + ELSE put ("NOERR") + FI. + +ENDPROC trace; + + +PROC stop op: + line; + suppress result protocolling; + REP outsubtext (blanks, 1, indentpos); + fetch eumel0 regs of caller from users stack; + out ("stop/error induced return to addr "); + out (txt (ic hi)); out (hex (ic lo)); + IF users stpdis + THEN putline (" (STPDIS)") + ELSE putline (" (STOPEN)") + FI; + lines INCR 1; + IF nontraceable caller + THEN putline ("trace ended by returning to nontraceable caller"); + protocol := FALSE; prot stopped := TRUE + ELIF users stpdis + THEN copy stack of disabled caller to tracers stack + ELSE users lbase := dsgetw (stdds, stack area, users lbase) + FI + UNTIL users stpdis OR NOT protocol PER; + nail1 hi := ic hi; nail1 lo := ic lo. + +suppress result protocolling: + no of results := 0. + +copy stack of disabled caller to tracers stack: + FOR i FROM 1 UPTO 4 REP + word := dsgetw (stdds, stack area, users lbase + i - 1); + dsputw (stdds, stack area, lbase + i - 1, word) + PER. + +ENDPROC stop op; + + +i n i t i a l i z e t r a c e. + +nontraceable caller: + ic hi = 2 AND NOT std procs traceable + OR (old flags AND aritu mask1) <> 0 AND (flags AND aritu mask1) = 0. + +fetch eumel0 regs of caller from users stack: + indentpos DECR indentincr; + ic lo := dsgetw (stdds, stack area, users lbase + 1); + word := dsgetw (stdds, stack area, users lbase + 2); + ic hi := word AND 3; + old flags := word AND flags mask1; + users stpdis := (old flags AND stpdis mask1) <> 0; + pbase := word AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, users lbase + 3) + AND lo byte mask. + +initialize trace: + LET maxno of nontraceables = 20; + INT VAR int, j; + TEXT VAR text; + ROW maxno of nontraceables TEXT VAR names of nontraceables; + ROW maxno of nontraceables TEXT VAR names of short nontraceables; + ROW maxno of nontraceables TEXT VAR names of long nontraceables; + ROW maxno of nontraceables INT VAR calls to nontraceables; + ROW maxno of nontraceables INT VAR call2 to nontraceables; + + putline("initializing ""trace"" ..."); + names of nontraceables (1) := "disa (I,I,T,T,I,I) (*n.t.*)"; + names of nontraceables (2) := "disasm (I,I) (*n.t.*)"; + names of nontraceables (3) := "info (I,I,I,I) (*n.t.*)"; + names of nontraceables (4) := "dec (T) (*n.t.*)"; + names of nontraceables (5) := "hex (I) (*n.t.*)"; + names of nontraceables (6) := "dsget2b (I,I,I) (*n.t.*)"; + names of nontraceables (7) := "trace (*ignored*)"; + trace; (* initialize 'call to trace', 'ic hi' and 'ic lo' *) + IF FALSE THEN + disa (int, int, text, text, int, int); + disasm (int, int); + info (int, int, int, int); + int := dec (text); + text := hex (int); + int := dsget2b (int, int, int); + trace (****** must be the last one !!! *****) + FI; + FOR j FROM 1 UPTO maxno of nontraceables REP + REP ic lo INCR 1; + word1 := dsgetw (stdds, ic hi, ic lo) + UNTIL call opcode found PER; + IF word1 <> longcall opcode + THEN no of nontraceables INCR 1; + calls to nontraceables (no of nontraceables) := word1; + names of short nontraceables (no of nontraceables) := + names of nontraceables (j) + ELSE no of long nontraceables INCR 1; + word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); ic lo INCR 1; + call2 to nontraceables (no of long nontraceables) := word2; + names of long nontraceables (no of long nontraceables) := + names of nontraceables (j) + FI + UNTIL call to trace found + OR no of nontraceables = maxno of nontraceables + OR no of long nontraceables = maxno of nontraceables PER; + putline ("""trace"" initialized:"); + putline (" " CT txt (no of nontraceables) + CT " nontraceable shortcalls"); + putline (" " CT txt (no of long nontraceables) + CT " nontraceable longcalls"); + IF no of nontraceables = maxno of nontraceables + OR no of long nontraceables = maxno of nontraceables + THEN errorstop ("too many nontraceables") + ELSE test trace + FI. + +call opcode found: + (word1 AND opcode mask1) = call opcode OR word1 = longcall opcode. + +call to trace found: + IF word1 = call to trace + THEN IF longcall to trace flag + THEN word2 = call2 to trace + ELSE TRUE + FI + ELSE FALSE + FI. + +test trace:. + +END PACKET trace; + diff --git a/devel/debug/1/src/trace.dok b/devel/debug/1/src/trace.dok new file mode 100644 index 0000000..7de46f8 --- /dev/null +++ b/devel/debug/1/src/trace.dok @@ -0,0 +1,387 @@ +#type ("trium8")##limit (13.0)# +#start(3.0,1.5)# +#pagelength(18.5)# +#block# +#type("trium36.b")# +#free(3.5)# +#center#EUMEL +#center#DEBUG +#type("trium18.b")# +#free(1.4)# +#center#Version 1 +#center#87-04-24 + +#center#G. Szalay +#page(1)# +#type ("trium8")##limit (13.0)# +#head# +#center#- % - + + +#end# +#type ("trium14.b")# +#center#E U M E L - D E B U G + +#type ("trium12.b")# +#center#Task-local Debugging Tools for EUMEL: +#center##type("trium12.bc")#info, disasm, #type("trium12.b")#and #type("trium12.bc")#trace + + +#b("1. Features")# + +#it("info:")# display and modification of a dataspace on the users terminal in the conventional dump + format; search for a bytestring; + +#it("disasm:")# disassembly of EUMEL-0-code out of the standard dataspace using symbolic opcodes + and procedure heads; + +#it("trace:")# tracing of user programs, protocolling of executed instructions and their actual operands, + trap at a given code address, single-step-mode, multiple-step-mode (interruptable at + any time) + +The procedures have no effect outside the task. Especially no other task will be halted by using the +single-step mode. + + +#b("2. Installation")# + +The debugging tools need a suitable system kernel ("Urlader"). They can be used with kernels for +processors Z80, 8086 and 80286 with versions 190 \#14, 181 \#347 \#1347, 180 \#347 \#1347 and higher, +and with 68000-kernel version \#3600 and higher. + +The archive diskette "trace" contains all necessary files. The commands +#inb# + archive ("trace"); + fetchall (archive); + run ("gen.trace") +#ine# +insert all source files and generate a dataspace "procheads" containing procedure heads of all +inserted procedures (including the standard ones). Then the current task becomes a local mana­ +ger. Now a son task may be created, in which the debugging tools are available. + +The first time when (in a son task) #it("disasm")# or #it("trace")# protocols a CALL-instruction the dataspace +'procheads' will be fetched from the father task for subsequent usage. If for any reason (e.g. after +inserting new packets, see below) the user will change or re-install 'procheads' he has to inform +the debugging procedures by issuing the command +#inb# set procheads ("procheads") #ine# + +Access to the dataspace "procheads" may be suppressed by +#inb# set procheads ("") #ine# + +Procedures inserted at a later time by the user should be added to the dataspace "procheads" (in the +current task!) by typing the commands +#inb# + bulletin m (""); + run ("gen.procheads") +#ine# + + + +#b("3. Description of the debugging procedures")# + +#b1("3.1 PROC info ")# + +The standard output is a hexadecimal dump of a dataspace in the following format: + +#outb# +---------------------------- dsid=xx -------------------- +xxxxx: -xx-xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx yyyyyyy......... +xxxxx: xx xx xx ... ..... +xxxxx: xx xx ... ... +xxxxx: xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx .........yyyyyyy +#re("INFO: more, address, dsid, lines, find, or quit")# +#oute# + + +The first line displays the dataspace identifier (4 <= dsid <= ff, dsid=4 identifies the standard +dataspace). +The dump lines begin with the hexadecimal word (!) address of the first word on this line. The order +of bytes is the same as on EUMEL-'Hintergrund': low byte, high byte. Following the hexadecimal +display of 16 bytes they will be shown as ascii-characters, too. Non-ascii characters will be +displayed as '.'. + +The last line shows (as with #it("disasm")# and #it("trace")#, too) possible commands which will be recognized by +their first letter. If a parameter is needed, it has to be typed as a hexadecimal number followed by a +. The key may be used to delete the last input character(s). +Possible commands and their effect: + +m (more): continues displaying at the next higher address + +a (address): specifies a new address + +d (dsid): specifies a new dataspace identifier + +l (lines): specifies a new line count (=window height); this value may be larger than the + number of lines of the terminal screen. + +f (find): (tries to) find a hexadecimal or character bytestring. The prompting message +#outb# + find: hex, char, or last param? (h/H/c/C/) +#oute# + may be answered in several ways. Examples: + + #inb#h41#ine# looks for a byte 41h, beginning at the actual position, marked by -xx-. + + #inb#Hcafe#ine# searches the bytestring 0cafeh, beginning at the actual word address. + Only strings at word addresses will be concerned for a comparison. + + #inb#challo#ine# searches the character string "hallo", beginning at the actual position. + + #inb#Ca#ine# searches the letter "a", which has to be located at a word address. + #inb#H41 #ine#has the same effect. + + #inb##ine# searches the last bytestring explicitly specified in a search command, + beginning #bo("behind")# the marked position. The last parameter will be shown + during the search. + + The search can be interrupted at any time by pressing a key. It may then be conti­ + nued by a new 'find' command and . + +q (quit): leaves #it("info")# . + +Instead of a command the dataspace can be modified within the displayed area by the key- +sequence + positions the cursor to the first displayed byte; + ... moves the cursor within the hexadecimal display; + <2 hexadecimal digits>... overwrite the byte under the cursor; + leaves the window. + +Note: in the standard dataspace changes within the address range 20000...2ffff are only allowed in + conjunction with a 68000-kernel (see also 3.3, note a.). + + + +#b1("3.2 PROC disasm ")# + +EUMEL-0-code in the address range 20000...3ffff of the standard dataspace will be disassem­ +bled. The code will be listed one instruction per line, using symbolic opcodes and (in case of a CALL +instruction) procedure heads as found in the dataspace "procheads". + +The following example shows the disassembled code of the standard procedure + +REAL OP MOD (REAL CONST left, right): + REAL VAR result := left - floor (left/right) * right; + IF result < 0.0 + THEN result + abs (right) + ELSE result + FI +ENDOP MOD; + +#outb# +23edd: LN 2000 +23ede: PENTER 15fe +23edf: FDIV 09c4 0d80 2880 +23ee2: FLOOR 637f 2880 2880 +23ee5: FMUL 28c0 0d80 2880 +23ee8: FSUB 09bc 2880 1880 +23eeb: FLSEQ 6049 1880 +23eed: BT f700 +23eee: PP 0dec +23eef: PP 28ec +23ef0: CALL 5d79 abs (REAL C) --> REAL +23ef1: FADD 18b8 2880 2880 +23ef4: REF 28dc 2080 +23ef6: B f970 +23ef7: REF 18dc 2080 +23ef9: FMOV 21b4 1180 +23efb: RTN 007f +#re("DISASM: step, more, address, lines, info, or quit")# +#oute# + +Possible commands: + +s (step): shows the next instruction on the terminal. The command line will be rewritten. + +m (more): shows the next instructions. The output will stop after 'lines' (standard=12) lines. It + can be interrupted at any time by pressing any key. The output list terminates, when + an invalid opcode has been detected or when the instruction count exceeds 3ffff. + +a (address): specifies a new code address. Disassembly continues at this address. + +l (lines): specifies a new line count; this value may be larger than the number of lines of the + terminal screen. + +i (info): calls #it("info")#. The first line of dump contains the first word of the next instruction not yet + disassembled. This word will be marked. (After leaving #it("info")# disassembly would + continue with this instruction.) + +q (quit): leaves #it("disasm")#. + + +#b1("3.3 PROC trace ")# + +#it("trace")# allowes controlled execution of subsequent EUMEL-0-code. The effect of the trace-mode +can be demonstrated by showing the protocol produced by + + #inb#trace; putline ("hallo") + + #ine##outb##re("TRACE: step, more, trap, regs, lines, info, disasm, or quit")# +#oute##inb# + p + +#ine##outb# + 34afb: PP 006d >00009000 + 34afc: CALL f37a putline (TEXT C) + 28d63: PENTER 38fe + 28d64: TEST c828 >0 + 28d65: BF 6b70 + 28d66: OUT 3c7f 0980 >"hallo" hallo + 28d68: OUT 3c7f 6c01 >""13""10"" + + 28d6a: B 6e70 + 28d6e: RTN 007f --> STOPEN NOERR ARITS + 34afd: RTN 007f --> STOPEN NOERR ARITS + 20944: RTN 007f --> STPDIS NOERR ARITU + trace ended by returning to nontraceable caller +#oute# + +Comments on this output: +- the indentation of the protocol lines shows the call depth. +- in order to get 1 line per instruction as often as possible, some abbreviations are used in the + procedure heads: 'C' for 'CONST', 'V' for 'VAR', 'DS' for 'DATASPACE'. +- the first occurrence of the string 'hallo' is part of the protocol. The second one is a result of the + execution of the (first) OUT-instruction. The blank line is produced by the second OUT-instruc­ + tion! +- the flags given with a RTN-instruction reflect the flag settings #bo("after")# execution of the RTN: + STOPEN = stop enabled STPDIS = stop disabled + NOERR = no error ERROR = error occurred + ARITS = signed arith mode ARITU = unsigned arith mode + + +Possible commands: + +s (step): executes and protocols one instruction (=single-step-mode). For reasons of the + implementation, consecutive PP-instructions will be executed as one single step. The + same holds for instructions followed by a conditional branch (e.g. EQU+BT). + + The protocol contains also actual operand values. Example: +#inb# + + trace;INT VAR a:= 2 + 11 +#ine##outb# + + 34afb: ADD 001d 0101 5400 >2 >11(000b) 13(000d)> +#oute# + + '>' in front of a value indicates input-operand; + '>' behind a value indicates output-operand. (For the instructions MOV, FMOV and + TMOV only 1 (output-)operand will be shown.) + INT-objects are shown decimal and (in parentheses) hexadecimal (4 digits). The + numbers 0 to 9 will be shown only decimal. + REAL-objects will be shown in the internal representation (e.g. 11.5 as + 0115000000000082) + TEXT-objects will be shown as text denoters. Non-ascii characters will be converted + (see example). For long texts only the first 14 characters will be shown, followed by + the (correct) number of characters. + All other objects (TASKs, DATASPACEs and effective virtual addresses) will be shown + hexadecimal (4 or 8 digits). + +m (more): executes and protocols up to 'line count' (standard=12) instructions. Execution can be + interrupted at any time by any key, and resumed by commands 's' or 'm'. + +t (trap): sets a trap on a code address. As soon as the instruction count reaches the specified + value, the message +#outb# + trap at address ..... +#oute# + will be displayed and the execution stopped. (The instruction at the trap address is the + next one to be executed!) At the same time the trap is deleted. + +r (regs): shows the relevant EUMEL-0-registers 'icount' (address of the instruction to be + executed next), 'pbase' (=packet base, base address for packet data), 'lbase' (=local + base, base address for local data on stack) as well as flag registers + (STOPEN/STPDIS, NOERR/ERROR, ARITS/ARITU). + +l (lines): specifies a new line count; this value may be larger than the number of lines of the + terminal screen. + +i (info): calls #it("info")#, s. 3.1. The instruction word pointed to by the instruction count is the actual + position, marked on the first line. + +d (disasm): calls #it("disasm")#, s. 3.2. Disassembly begins at the next instruction not yet executed. + +q (quit): leaves the trace-mode. However, a trap (see above) may still be in effect! Tracing + will be #bo("implicitly")# finished as soon as a RTN-instruction returns to a procedure + running in the 'unsigned arithmetic'-mode. (Regularly this is the ELAN-Compiler.) + + +#bo("Important Notes ")# + +Erroneous use of #it("info")# and #it("trace")# may destruct your task. Therefore read carefully and observe follow­ +ing notes: + +a. In order to gain control at proper points of the code area, #it("trace")# temporarily modifies the user code + by inserting instructions (CALLs to itself) into it. On EUMEL-hardware based on Z80, 8086, or + 80286, #it("trace")# does not allow modification of address range 20000...2ffff for reasons of storage + management strategy. Therefore calls to procedures occupying this address range will be marked + in the protocol by "(*n.t.*)" (for 'nontraceable') and executed normally, i.e. not protocolled. + + WARNING: execution of a nontraceable procedure cannot be interrupted by and 'halt'. So + be careful! + +b. Traps may only be set on the first word of an instruction. In a sequence of consecutive PP- + instructions only the first one may be trapped. In the same manner, a conditional branch (BT / BF) + following another instruction (e.g. EQU) may not be trapped. + +c. On inserting #it("trace")# it may get a module number > 2047. In that case the CALL to #it("trace")# occupies + 2 words. The user will be informed of this fact at the time just after inserting #it("trace")#: + #outb# + WARNING: call to trace needs 2 words! + #oute# + In this situation special care has to be taken to set a trap, e.g.: + +#outb# + LSEQ xxxx xxxx + BT xxxx (*branch on true to address a*) + ... + ... + a-1: B xxxx + a: ... +#oute# + + In this example the branch instruction at address 'a-1' may not be trapped because the following + instruction (at 'a') would be destroyed by a 2-word-CALL to #it("trace")#. A jump to 'a' would have an + undefined effect. So be careful! First inspect the code environment by using #it("disasm")# and then set + a trap at a suitable address! + +d. In the current version of #it("trace")# a trap will be implicitly deleted as soon as it has become active. If + the user wants (e.g. in a loop) to trap a given address again and again, he has to choose a + second suitable address, too, and alternately set a trap at these addresses. (A trap may be + #bo("explicitly")# deleted by specifying 0 as trap address.) + +e. One may be tempted to trace the ELAN-compiler by writing + #inb# + trace; do ("..........") + #ine# + which seems to work indeed for dozens of lines but at some point it begins to deliver wrong + results even with such trivial instructions as an integer ADD. This trouble arises from a storage + assignment policy during compilation of the ELAN compiler: temporary storage (e.g. for calculating + the value of an expression) will be assigned above the stack top of a procedure if it does not call + any other one. An #bo("implicit")# CALL to #it("trace")# causes a further stack frame to be established thus + possibly overwriting some temporary values of a compiler procedure. (Of course, the compiler + cannot know anything about CALLs inserted by #it("trace")# into the code area!) + +f. Errors (e.g. overflow) in user programs will be detected by #it("trace")# at the point of their occurrence + and reported in the protocol. However, #it("trace")# has no influence on the error handling, i.e. it does + not turn off the error flag by itself, nor causes it an error stop on the users level. (#it("trace")# may be + seen as an extension of the virtual EUMEL-0-machine offering some additional features but still + fully controlled by the users program.) + +g. Each time when the user has control within #it("trace")#, the users code area contains no other patches + than a possible CALL at the trap address if specified. + +h. The procedures #it("trace, disasm, info")#, and some others used by them are nontraceable. The body of + these procedures will not be protocolled. CALLs to them will be marked as nontraceable. Explicit + CALLs to #it("trace")# (i.e. in addition to the first call to switch on the trace mode) will be ignored. + +i. In trace-mode the EUMEL-0-instruction KE has the same effect as an explicit call to #it("info")#. + +j. Protocolling the execution produces output in addition to output programmed by the user. This + may lead to unexpected results when the user program specifies cursor positioning. The cursor + will always be moved to the position (10,13) instead of the position specified by the user. This is + due to the fact that cursor positioning takes place in two steps. One OUT instruction sends the + escape character for 'cursor positioning' (=""6""), and a second one sends two bytes containing + the coordinate values. The protocol line containing the first OUT will be followed by a lf-cr- + sequence (""10""13"") before the next protocol line can be written. + + -- cgit v1.2.3