; ~ c/;/ ;/ $MACRO STRING ** str%ng <#@*(1"Z)> $ENDM ; - - - - - - - - - - - - - - $MACRO STRINGS ** str%ng <#@*(1"Z)> .byte 0,0 .even $ENDM ; - - - - - - - - - - - - - - $MACRO STR%NG .asciz ~#@1~ $ENDM ; - - - - - - - - - - - - - - $MACRO OUT STR push r0 mov #@1,r0 call outstr pop r0 $ENDM ; - - - - - - - - - - - - - - $MACRO OUTF push r0 let r0 = sprintf[#$buf2$,#@1,<#@*(2"Z)>] mov #$buf2$,r0 call outstr pop r0 $ENDM ; - - - - - - - - - - - - - - $MACRO LEN string ?? 2 mov #@{1},r0 #@2=. tstb (r0)+ bne #@2 sub #@{1},r0 dec r0 $ENDM ; - - - - - - - - - - - - - - / program debug optimize with r2 ; - - - - - - - - - - - - - - ; .globl traps,mdebug,converse,getstr,init1,fleave,eq,locate ; .globl keys,keys2,keys2,ptrs,$buf2$,.new,.cr,.lf,sreg,drec,frec ; .globl fcur,ftrace,ltrace,step,startl,saveregs,restregs ; .globl err,outstr,qio,newline,cr,lf ; .globl arg1,arg2,arg3,arg4,arg5,dcur,flags ; .globl bline,bfunc,nbrk,bproc,noroom,cvar,cval,ccur,ctrace,laddr ; - - - - - - - - - - - - - - .psect debug ;all code and local data here .mcall svtk$s,qiow$s,exit$s struct drecord ;debug record, /da switch causes this member entry ;entry point of procedure member called[4] ;32 bit int counts times called member instrs[4] ; counts instr executed member nparms ;number of parameters in function member ptext ;pointer to text of symbol table member ptype ; types of symbols member pval ; values of symbols member fname[8.] ;function name asciz (padded to 8) member ctim[16.] ;compile time asciz member nsyms ;number of symbols in symbol table end-struct drecord struct frecord member fdp ;pointer to debug record member fr5 ;r5 from routine instance member fline ;current line number in routine end-struct frecord ; - - - - - - - - - - - - - - ssttbl: .word odtrap,mptrap,benter,iotrap,ritrap,emtrap,atrap,0 sstsiz=<.-ssttbl>/2 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - keys: string p l lb ls t b bd bl f fa ft ftv c ;text strings for parse strings ct m mb debug us keys2: strings f l ;trace f and t flags: strings off on ;general off/on 0/1 treason: string Odd-addr/ill-inst Mem-Prot x Iot Resv-Inst ;trap reason strings Emt-inst Trap-ins x ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ptrs: .blkw 1. ;pointers to piece of string arg1: .word ;argument 1 arg2: .word ;------------| ; " 2 arg3: .word ; Buffers | ; ... arg4: .word ; for text | arg5: .word ; input and | arg6: .word ; output | .blkw 5 ;------------| ;for safety $buf2$: .blkb 100. ;format buffer getl: .byte tc.tbf,0 ;get typeahead count, used for interupt .new: .byte 15,12,0 ;these are just format strings .cr: .byte 15,0 ;for output .lf: .byte 12,0 .even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - laddr: .word 0 ;last addr tcause: .word 0 ;trap reason code dmode: .word 0 ;0=user mode 1=debug mode (what to do on traps) oldsp: .word 0 ;saved sp on debug entry cvar: .word 0 ;save address of check variable cval: .word 0 ;save value of check variable ccur: .word 0 ;current fcur record pointer for variable to check ctrace: .word 0 ;0=check breakpoint, 1=check trace (don't break) sreg: .blkw 8. ;save registers drec: .blkw 3 ;debug record listhead frec: .blkw 3 ;function entry listhead (in stack configuration) fcur: .word 0 ;current function entry pointer (top of stack) dcur: .word 0 ;current function debug record ftrace: .word 0 ;1=trace all function entrys and exits ltrace: .word 0 ;1=trace all lines step: .word 1 ;1=yes, single step ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - nbrk=8. bline: .blkw nbrk ;breakpoint line numbers bfunc: .blkw nbrk ; func pointers (to drecord) bproc: .blkw nbrk ; procede counts ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; The symbol table lives in $$db1. We output a record which has as its ; ; first word a pointer to the next word after all that we output in ; ; psect $$db1. Thus at runtime we have a forward linked list with a ; ; null at the end (because of $$db2 below). The first order of ; ; business is to make a doubly linked list of our standard type so we ; ; can manipulate it using our normal routines. Init1 does this. ; ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; .psect $$db0 ;so we can find start of $$db1 psect startl: .word 0 .psect $$db2 ;so we can terminate $$db1 properly .word 0,0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - .psect debug go: ;start here, r0=real start mov r0,sreg ;so save a few regs and mov r1,sreg+2 ;do initialization mov %2,sreg+4 ;note %2, its so we can allow ;mp to use it for optimization svtk$s #ssttbl,#sstsiz ;but we need it here and r2 is call init1 ;not defined so if we use it ;by mistake it gets caught. mov sreg+2,r1 mov sreg+4,%2 mov sreg,r0 jmp (r0) ;startup real task ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - odtrap: mov #0,tcause ;-----------------------| br traps0 ; These are the trap | mptrap: mov #1,tcause ; vectors. They each | add #6,sp ; set the reason for | br traps0 ; the trap (for common | iotrap: mov #3,tcause ; code below) and some | br traps0 ; must remove trap | ritrap: mov #4,tcause ; dependent parameters | br traps0 ; off the stack first. | emtrap: mov #5,tcause ;-----------------------| add #2,sp br traps0 atrap: mov #6,tcause add #2,sp br traps0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - traps0: if sp lo 0300 ;bad stack? mov sp,r1 step := 1 mov #1000,sp ;make a little room for us printf "Fatal stack underflow sp=%6o" r1 mdebug[0,0,0] exit$s fi if dmode ne 0 ;Is it internal or user trap? call itrap ;here on internal else call saveregs ;save all regs mov (sp),r0 ;get pc mov 2(sp),r1 ;and psw traps[tcause,r0,r1] ;so trap routine can output em call restregs ;restore regs rti ;back to user fi ;---------------------------------------------------------------------| ; This is the breakpoint trap processor. Each line of code after the | ; first function statement in a file is preceded with .word 3,lineno | ; which translated is a bpt and a data word which tells us the line | ; number. The entry and exit to a function is `trapped' by having a | ; different name for the register save and restore ($$dsav, $$dret). | ; Thus we get control either on a bpt instruction or at function | ; entry and exit time. Benter thus saves state and calls mdebug | ; which determines if a breakpoint is satisfied (either location or | ; variable state change) and also if just a trace is desired. If we | ; should stop, then Converse is called to interact via listings etc. | ; with the user until he proceeds or single steps. | ;---------------------------------------------------------------------| benter: ;breakpoint trap entry call saveregs mov sp,oldsp ;save in the event of disaster bent2: mov (sp),r0 ;get pc mov 2(sp),r1 ;get psw mov @(sp),%2 ;get the line number which follows mdebug[r0,r1,%2] ;the bpt instruction and enter debugger call restregs ;restore these add #2,(sp) ;return after the line number rti ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - saveregs: mov r0,sreg mov r1,sreg+2 mov %2,sreg+4 mov r3,sreg+6 mov r4,sreg+8. mov r5,sreg+10. rts pc restregs: mov sreg,r0 mov sreg+2,r1 mov sreg+4,%2 mov sreg+6,r3 mov sreg+8.,r4 mov sreg+10.,r5 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - $$dsav:: ;debug register save routine mov r5,(sp) ;on entry to a function push r4 push r3 push %2 mov sp,r5 push r1 push r5 push r0 call fenter ;do all enter work here pop r0 ;which is to push a record on the pop r5 ;f stack and trace (possibly) entry pop r1 add #2,r0 ;this line gets us past the data word jsr pc,(r0) ;now call the function ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - $$dret:: ;this is the return code for a debug push r5 ;enabled routine push r1 push r0 call fleave ;pop function record off stack pop r0 ;and possibly trace this pop r1 pop r5 mov r5,sp pop %2 pop r3 pop r4 pop r5 rts pc ; --------------------------------------------------------------------| ; This here routine is to recover from a trap during an internal | ; operation (usually the user tried to list protected memory or | ; forced an odd address trap. We simply restore state (sp on entry | ; to debug mode) and go back to just after we saved the registers of | ; the user program. | ; --------------------------------------------------------------------| function itrap is local clr cvar ;clear this printf "%s trap in debug mode" strn[#treason,tcause] step := 1 mov oldsp,sp jmp bent2 ;re-enter debuger auto p ;just handle traps with a trace back ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function traps[code,reg7,psw] is local printf "*** %s Trap pc=%o psw=%o" strn[#treason,code] reg7 psw for printf " In %s at line %d" <#fdp[p] + #fname> #fline[p] break if interupt[0] ne 0 rof step := 1 ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function mdebug[reg7,psw,line] is local ;main debugger routine if ccur = fcur or ccur = 0 ;must be from same func or a global if cvar ne 0 ;check var break if cval ne @cvar ;yes, did it change printf "Var changed from %d. to %d." cval @cvar cval := @cvar ;update for next change if ctrace = 0 ;do we stop step := 1 ;yes, fake it as a single step else step := -1 fi fi fi fi r4 := findb[dcur,line] ;search breakpoints if ltrace ne 0 or step ne 0 or r4 ge 0 ;print line #? call ptrace if step = -1 ;not really a step clr step fi fi #fline[fcur] := line ;update current line r3 := dcur + #instrs ;Increment the counters inc 2(r3) ;of how many instructions adc (r3) ;executed in routine if step ne 0 or r4 ge 0 ;should we stop clr step ;and talk to converse[reg7,psw,line] ;user fi ret ptrace: printf "%s Line %d." line ;yep rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto str[40.],ans,nf function converse[reg7,psw,line] is local ;talk to user dmode := 1 do forever ;forever (or until proceed) r4 := getstr[&str,40] ;get an input string bic #177400,r4 ;play safe with qio status if r4 ne 1 ;any error (like eof) exit$s ;means exit fi if strlen[&str] = 0 ;just cr means step step := 1 ;set single step jmp cout ;and go back to program else ifb str = #'! r4 := &str + 1 system[r4] else clr arg1 clr arg2 clr arg3 clr arg4 clr arg5 nf := lfield[&str,#ptrs] ;break up into fragments ans := locate[&str,#keys] ;ans is which command he gave select case ans of ;just do 1 of n things case 0 ;p is proceed jmp cout case 1 or ;these three are list case 2 or ;commands case 3 ;handle all in listv listv[nf,&str,#ptrs,] break case 4 ;t is trace if nf = 1 ;t is just print stuff printf "Line trace %s, Func trace %s" strn[#flags,ltrace] strn[#flags,ftrace] elseif nf = 3 ;else get on/off and func/line r4 := locate[arg1,#keys2] ;get parm 1 r3 := locate[arg2,#flags] ;get parm 2 if r3 lt 0 or r4 lt 0 call err ;bad parms break else if r4 = 0 ;wants to fiddle with func if r3 ne 0 ;trace ftrace := 1 ;on else ftrace := 0 ;off fi else ;otherwise line trace if r3 ne 0 ltrace := 1 ;on else ltrace := 0 ;off fi fi fi else call err fi break case 5 or ;breakpoints case 6 or case 7 breaks[nf,&str,#ptrs,] break case 8 or ;facts about current case 9 or ;facts about all case 10 or ;facts on trace back case 11 ;verbose traceback facts[nf,&str,#ptrs,] break case 12 or case 13 check[nf,] ;check var break default ;unknown command if others[nf,ans] = 0 call err fi esac fi fi od cout: clr dmode ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - err: printf "Huh??" rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - noroom: printf "No room for breakpoint" rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function check[nf,ans] is local ;check breakpoint or trace if nf = 1 ;single arg means remove it clr cvar clr cval clr ccur elseif nf = 2 or nf = 3 ;2 args means set it cvar := addr[arg1] cval := @cvar if nf = 3 ;three args means global check clr ccur else ccur := fcur fi else ;more means bull call err ret fi if ans = 1 ;is it trace or breakpoint ctrace := 1 ;its a trace else ctrace := 0 ;its just a breakpoint fi ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p function facts[nf,str,ptr,dis] is local ;print facts about program state select case dis of ;switch on DISpatch case 0 ;facts about current (f) dfact1[dcur,0] dfact2[dcur,"--"] break case 1 ;facts about all (fa) for break if interupt[0] ne 0 dfact1[p,0] dfact2[p,"--"] rof break case 2 or ;facts about traceback (fa) case 3 ; verbosely (fav) for break if interupt[0] ne 0 printf "In %s at line %d" <#fdp[p] + #fname> #fline[p] if dis = 3 dfact1[#fdp[p],"--"] dfact2[#fdp[p],"--"] fi rof esac ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p function dfact1[pt,sup] is local ;facts about name, #parms etc r4 := pt r3 := "%-6s @%o %d parms comp:%s" if sup = 0 p := r4 + #fname else p := sup fi printf r3 p #entry[r4] #nparms[r4] ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p function dfact2[pt,sup] is local ;statistics facts r4 := pt r3 := "%-6s calls: %ld instrs: %ld" if sup = 0 p := r4 + #fname else p := sup fi printf r3 p #called[r4] #called+2[r4] #instrs[r4] #instrs+2[r4] ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function findb[name,line] is local ;find a breakpoint fast version ; if .bline[i] = line and .bfunc[i] = name ; ret i ; fi mov #bline,r0 mov #bfunc,r1 mov #nbrk,r3 mov line(r5),r4 10$: cmp r4,(r0)+ bne 20$ cmp name(r5),(r1)+ bne 15$ ; printf "fnd=%d ln=%d nm=%o ret=%d" r3 line name <#nbrk - r3> ret #nbrk - r3 15$: sob r3,10$ ret -1 20$: add #2,r1 sob r3,10$ ret -1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto stat[4] function getstr[s,len] is local ;get a string from lun 5 call newline out "." mov s,r0 mov len,r1 r4 := &stat qiow$s #io.rvb,#5,#5,,r4,, r3 := .stat[1] ;length .s[r3,b] = 0 ;null terminate it ret stat ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p function init1 is local ;init routine mov #startl+2,r4 ilist[#drec] ilist[#frec] mov drec,p do forever ;this piece of code mov p,2(r4) ;just threads the back mov (r4),r3 ;pointers of the break if r3 = 0 ;doubly linked list add #4,(r4) ;of debug records mov r4,p add 4,p mov (r4),r4 sub #4,r4 od mov p,drec+4 mov #startl+6,drec+2 mov p,r4 mov drec,-4(r4) ;fix last reverse link if @drec+2 = 0 mov drec,drec+2 fi ; call newline ; for ; outf "Function %s (%o) has %d parms"

#entry[p] #nparms[p] ; call newline ; ; rof ; ; ldump[drec] ; printf "saved regs=%o %o %o" sreg sreg+2 sreg+4 ret ;---------------------------------------------------------------------- ; The enter function routine allocates a frecord from dynamic ; storage and enters it into a stack oriented list. This is used for ; the runtime traceback and the top of the stack contains the frame ; pointer for determining the values of variables in routines. ; Eventually the verbose mode of the ft command (ftv) will output ; all variable values for all routines in the dynamic chain. For now ; it only is used to store the current line number. ;---------------------------------------------------------------------- auto p function fenter[pdrec,reg5] is local if sp lo 0200 iot ;we really are out of stack here fi mov pdrec,r4 mov (r4),p add #4,p fcur := new[#frecord] ;get new frecord, store in fcur dcur := p ;debug current pointer r3 := dcur + #called ;increment count of entrys into inc 2(r3) ;this function. adc (r3) insert[prev[frec],fcur] ;insert onto list (a stack) if ftrace ne 0 ;and optionally trace printf "Enter `%s' r5=%o pc=%o"

reg5 #entry[p] fi mov fcur,r4 ;fill up the function record fdp(r4) := p ;with a pointer to debug record fr5(r4) := reg5 ;and the r5 frame pointer fline(r4) := 0 ;clear line number ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function fleave[rval] is local if ftrace ne 0 printf "Leave `%s' returns=%06o %d." rval rval fi release[delete[fcur]] ;delete from stack and then back to system if ccur ne 0 ;if not a global variable check if ccur = fcur ;then if leaving the routine we were to check clr ccur ;a variable on, we eliminate the check clr cval ;since it was on the stack clr cvar ;we do this primarilly so we can check fi ;on register changes as well as variables fi ;and register values are in out save area fcur := prev[frec] ;new top of stack dcur := #fdp[fcur] ;likewise ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function eqstr[a,b] is local ;just equate strings caselessly r4 := strlen[a] ;which are asciz r3 := strlen[b] if r3 ne r4 ret 0 else ret eq[a,b,r4] fi ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto i FUNCTION eq[a,b,n] is local ;equate strings given length char.a=r3 ;also caselessly char.b=r4 LOOP for i = #1 TO n call work NEXT i RET #1 work: LET char.a = .a[,b] LET char.b = .b[,b] IF char.b HIS #'a AND char.b LOS #'z BIC #40,char.b FI IF char.a HIS #'a AND char.a LOS #'z BIC #40,char.a FI IF char.a NE char.b RET 0 FI rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto n function locate[str,strs] is local ;locate a string in a list r3 := strs ;of strings: text/0/...text/0/0/ n := 0 do forever if strlen[r3] = 0 ret -1 fi if eqstr[str,r3] = 1 ret n fi inc n r3 := r3 + strlen[r3] + 1 od ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p,s,*nval,from,too,ad,stp,ad1 function listv[nf,str,ptr,ans] is local ;list processor if nf = 1 p := #fdp[fcur] printf "---Function `%s'"

loop for r4 = 0 to <#nsyms[p] - 1> break if interupt[0] ne 0 s := strn[#ptext[p],r4] r3 := addr[s] r0 := aval[r3] printf " %06o %6d. = %s" r0 r0 s next r4 else if nf = 2 from := 0 too := 0 elseif nf = 3 from := theval[arg2] too := from else from := theval[arg2] too := theval[arg3] fi stp := 2 if ans = 1 stp := 1 fi ad := addr[arg1] r4 := from * stp ad := ad + r4 loop for r4 = from to too break if interupt[0] ne 0 call getvl if ans = 2 ad1 := ad if nf gt 2 ad1 := @ad(r5) fi printf "%s(%3d)=(%s)" arg1 r4 ad1 else printf "%s(%3d) @%06o = %6d. %06o %c%c" arg1 r4 ad r0 r0 r1 r3 fi ad := ad + stp next r4 fi ret getvl: if stp = 1 r0 := #0[ad,b] bic #177400,r0 mov r0,r1 bic #177600,r1 if r1 lo 040 or r1 = 0177 mov #40,r1 fi mov #40,r3 else r0 := #0[ad] mov r0,r1 bic #177600,r1 if r1 lo 040 or r1 = 0177 mov #40,r1 fi mov r0,r3 swab r3 bic #177600,r3 if r3 lo 040 or r3 = 0177 mov #40,r3 fi fi rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto i function strn[str,n] is local ;get address of n'th string r4 := str loop for i = 1 to n r3 := strlen[r4] if r3 = 0 ret 0 fi r4 := r4 + r3 + 1 next i ret r4 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function addr[sym] laddr := addr1[sym] ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto l,*p,*n,*t,stype function addr1[sym] is local ;get addr of symbol (accepts a number) r3 := sym movb (r3),r3 ifb r3 his #'0 and r3 los #'9 and r3 ne 0 ifb r3 = #'0 r4 := 8 else r4 := 10 fi ret val[sym,r4] elseif eqstr[".",sym] = 1 ret laddr elseifb r3 = #'@ ret #0[addr[]] else p := #fdp[fcur] ;get pointer to debug record ;of current function r3 := locate[sym,#ptext[p]] ;get index of string sym if r3 lt 0 ret 0 ;no address since no symbol else n := #pval[p] ;n is pointer to values of symbols t := #ptype[p] ;t is pointer to types of symbols stype := .t[r3] ;get type of this symbol if stype = 1 or stype = 2 ;auto or parm variable r4 := #fr5[fcur] + .n[r3] elseif stype = 3 ;extern r4 := .n[r3] elseif stype ge 10 and stype le 15 ;register r4 := stype - 10 * 2 + #sreg else ;else bad r4 := 0 fi ret r4 fi fi ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function aval[ad] is local ;return value given address r3 := ad ;cannot odd address trap bit 1,r3 if on movb (r3),r0 else mov (r3),r0 fi ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto p function lfunc[str] is local ;locate a function debug record p := drec do forever p := next[p] if p = drec ret -1 fi if eqstr[str,

] ne 0 ret p fi od ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;; auto i ;slow version ;;function findb[name,line] is local ;find a breakpoint ;; loop for i = 0 to #nbrk-1 ;; if .bline[i] = line and .bfunc[i] = name ;; ret i ;; fi ;; next i ;; ret -1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto i function insb[name,line] is local ;install a breakpoint loop for i = 0 to #nbrk-1 if .bline[i] = 0 .bline[i] := line .bfunc[i] := name .bproc[i] := 1 ret i fi next i ret -1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function delb[num] is local ;delete a breakpont if num ge 0 and num lt #nbrk .bline[num] := 0 fi ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function breaks[nf,str,ptr,dis] is local ;its a bx command, do what is wanted select case dis of case 0 ;b r4 := val[arg1,10] if nf gt 2 r3 := lfunc[arg2] if r3 = -1 call err ret else if insb[r3,r4] lt 0 call noroom fi fi elseif nf = 2 if insb[dcur,r4] lt 0 call noroom fi else jmp bl2 fi break case 1 ;bd if nf = 2 delb[val[arg1,10]] else loop for r4 = 0 to #nbrk-1 delb[r4] next r4 fi break case 2 ;bl bl2: loop for r4 := 0 to #nbrk-1 if .bline[r4] ne 0 r3 := .bfunc[r4] printf "Brk %d: %6s ln %d proc=%d" r4 .bline[r4] .bproc[r4] fi next r4 esac ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function others[nf,ans] is local select case ans of case 14 modify[nf,2] break case 15 modify[nf,1] break case 16 printf "debug data=%o fcur=%o dcur=%o" #tcause #fcur #dcur laddr := #tcause case 17 ;user dump udump[,avalue[arg1],avalue[arg2],avalue[arg3]] break default ret 0 esac ret 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto loc,off,value function modify[nf,size] is local call getps if size = 1 #0[,b] := value else #0[] := value fi ret getps: if nf = 3 off := 0 loc := addr[arg1] value := theval[arg2] elseif nf = 4 off := theval[arg2] value := theval[arg3] loc := addr[arg1] else call err ret fi rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function avalue[s] is local if s ne 0 ret theval[s] else ret 0 fi ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function theval[s] is local ifb @s(r5) his #'0 and @s(r5) los #'9 push laddr r4 := addr[s] pop laddr ret r4 elseifb @s(r5) = #'- ret theval[] * -1 else push laddr r4 := #0[addr[s]] pop laddr ret r4 fi ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - function interupt[x] is local qiow$s #sf.gmc,#5,#5,,,,<#getl,#2> movb getl+1,r4 if r4 ne 0 clrb getl+1 qiow$s #sf.smc,#5,#5,,,,<#getl,#2> fi ret r4 outstr: ;r0 = address of asciz string push r0 push r1 mov r0,r1 len r1 qio: ;qiow$s #io.wvb,#5,#5,,,, THIS IS TOO DAMN SLOW CLR -(SP) CLR -(SP) CLR -(SP) clr -(sp) MOV r0,-(SP) MOV r1,-(SP) CLR -(SP) CLR -(SP) CLR -(SP) MOVB #5,(SP) MOV #5,-(SP) MOV #io.wvb,-(SP) MOV (PC)+,-(SP) .BYTE 3,12. EMT ^O<377> pop r1 pop r0 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - newline: push r0 mov #.new,r0 call outstr pop r0 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - cr: push r0 mov #.cr,r0 call outstr pop r0 rts pc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - lf: push r0 mov #.lf,r0 call outstr pop r0 rts pc .end go