.enabl lc .title Call Tracer for Fortran (V2.5) ; ; This code is based heavily (copied in part) from an article ; in the RSTS Small Buffer circa late 1977. Original author ; unknown, but many thanks to whomever you are. ; ; Author: James A Krupp ; Voter Hall Computer Center ; Middlebury College ; Middlebury, Vermont 05753 ; ; ; Usage: ; ; This module contains modified versions of the OTS modules ; $SUBR and $ISNLSN. Statement tracing requires that modules ; are compiled using threaded code; The subroutine entry trace/ ; dump feature may be used for inline or threaded. Presumably, ; all modules will be threaded (since inline code is a poor ; choice until a program is fully debugged). However, modules ; may be mixed threaded/inline. Also, calls to Macro subroutines ; will handled OK. ; ; CALL TRACE - trace subroutine entry ; CALL UNTRAC - disable subroutine entry tracing ; CALL TRALSN - trace labeled statements ; CALL UNTLSN - disable tracing labled statements ; CALL TRAISN - trace all statements ; CALL UNTISN - disable all tracing of statement execution ; ; If subroutine tracing is on (TRACE called), it is possible ; to dump memory at every entry by using ; ; CALL TRADMP(LOWAD,HIGHAD) ; ; Here LOWAD and HIGHAD are addresses (i.e. variables) and the ; contents of the specified adress range is dumped. E.g., if ; LOWAD is the first variable in a common block and HIGHAD the ; last, then the entire common block is dumped each time a ; subroutine is entered. ; (Dump will be rounded to 8-word boundaries) ; ; CALL UNTDMP - disable dumping on subroutine entry ; CALL DUMP(LOWAD,HIGHAD) - dump specified memory range at point of call ; CALL DUMP(LOWAD,,INCREMENT) - dump LOWAD to LOWAD+INCREMENT ; ; CALL CRASH('TITLE') - force a program crash... ; .globl $aots,$otis,trace,untrac,dump .globl $trace,$isntr,$lsntr,traisn,untisn .globl tralsn,untlsn,tradmp,untdmp,crash,exit ; ; Following Macros defined in SYSMAC.SML ; .macro .print addr .if nb .if dif ,R0 mov addr,r0 .endc .endc emt ^O351 .endm .macro .ttyout char .if nb .if dif ,r0 movb char,r0 .endc .endc emt ^O341 bcs .-2. .endm ; ; following are defined in FRT.MAC (v2.5 kit) ; loname = 122. hiname = 124. enmlnk = 14. thread = 116. ; trace: mov (pc)+,r0 untrac: clr r0 mov r0,tflag rts pc traisn: mov #$trace,@#$isntr ;replace jmp with jsr tralsn: mov #$trace,@#$lsntr ;same for lsn tracing rts pc untisn: mov #134,@#$isntr ;replace the jmp @(r4)+ untlsn: mov #134,@#$lsntr ;same for lsn rts pc tradmp: cmp (r5)+,#2 ;2 args? bne 1$ ;ignore if not mov (r5)+,lowad mov (r5)+,highad 1$: rts pc untdmp: clr lowad ;disable dumping clr highad rts pc ; ; following is called from $otis or $$otis if location tflag ; is non-zero ; dumpit: .print #crlf ; ; borrow some code from the OTS error handler ; mov loname(r3),-(sp) ;save the program name mov hiname(r3),r0 mov #isnmsg,r4 ;put name in isn output mov 16(sp),r3 ;point to caller's name beq 2$ ;top level so use program name mov (r3)+,(sp) ;replace progname with caller's mov (r3),r0 2$: jsr pc,putnam ;output 3 rad50 chars mov (sp)+,r0 jsr pc,putnam ;and the second part .print #msg1 mov 12(sp),r0 ;caller's line number jsr pc,decout .print #msg2 mov 10(sp),r0 ;now put our name mov #isnmsg,r4 ;put name in isn output jsr pc,putnam mov 6(sp),r0 ;both parts. jsr pc,putnam .print #crlf ; ; now see if a dump was requested... ; cmp lowad,highad beq doneit ;nothing to do if same (=0) mov #dumlst,r5 ;sets up fortran type call jsr pc,dump ;CALL DUMP(lowad,highad) ; doneit: rts pc ;back to $OTIS to thread off... ; crash: .print #cramsg ;forced crash tst (r5)+ beq 1$ ;no title... mov (r5),r0 ;the title blt 1$ ;-1 for no arg .print 1$: .print #crlf trap 300 ;crashes us (but why?) jsr pc,exit ;can't really get here ; ; the dump routine - called from above or directly ; dump: mov (r5)+,r0 cmp r0,#2 ;must have two args blt doneit mov (r5)+,r1 ;low address mov (r5)+,-(sp) ;high address cmp r0,#3 ;could have 3 args though bne 1$ mov r1,(sp) ;change highad to lowad+incremennt add @(r5)+,(sp) 1$: cmp r1,(sp) ;is the order reasonable? blos 2$ ;yes mov (sp),r5 mov r1,(sp) mov r5,r1 2$: bic #7,r1 ;round down the lowad bis #7,(sp) ;up the highad ; ; dump time... ; 3$: .print #crlf ;newline cmp (sp),r1 ;more to dump blos 9$ ;nope mov r1,r3 ;get the address jsr pc,octout ;and print it mov (pc)+,r0 ;then a / .ascii '/ ' .ttyout mov #1,r4 ;set all zero flag mov #8.,r2 ;start a line 4$: mov (pc)+,r0 .ascii / / .ttyout ;print leading space mov (r1)+,r3 ;next address beq 5$ clr r4 ;clear zero-line flag 5$: jsr pc,octout sob r2,4$ tst r4 ;a zero line? beq 3$ ;no so do next one ; ; skip zero lines 6$: mov r1,r3 ;scan the next line mov #8.,r2 ;all 8 words 7$: tst (r3)+ ;is this one zero bne 8$ ;nope, so exit loop sob r2,7$ inc r4 ;this line zero, so count it mov r3,r1 ;start next line cmp (sp),r1 ;if there is one bhi 6$ ; ; non-zero line or end of range ; 8$: dec r4 ;how many? ble 3$ ;on one .print #dots br 3$ ;and continue 9$: tst (sp)+ ;clean the stack rts pc ; ; now some utility routines ; .enabl lsb decout: mov r0,-(sp) ;print r0 in decimal clr r0 1$: inc r0 sub #10.,(sp) bge 1$ add #60+10.,(sp) dec r0 beq 2$ jsr pc,decout 2$: .ttyout (sp)+ 3$: rts pc div: mov r0,r3 clr r0 4$: cmp r2,r3 bhi 3$ sub r2,r3 inc r0 br 4$ octout: mov #30,r0 sec 5$: rol r3 rolb r0 .ttyout mov #206,r0 6$: asl r3 beq 3$ rolb r0 bcs 6$ br 5$ putnam: mov #50,r2 ;print r0 in .rad50 jsr pc,div mov r3,-(sp) jsr pc,div mov r3,-(sp) mov #3,r3 7$: movb convtb(r0),r0 movb r0,(r4)+ .ttyout dec r3 beq 3$ mov (sp)+,r0 br 7$ .dsabl lsb ; data stuff... ; .psect $datat rw,d,gbl,rel,ovr tflag: .word 0 ;trace if<>0 eximsg: .ascii / Exiting from /<200> isnmsg: .ascii /.MAIN. ISN / isn: .asciz /#####/ .even dumlst: .word 2 ;for our call to dump lowad: .word 0 highad: .word 0 savr4: .blkw 5 ;used by ret$ threaded code. convtb: .ascii / ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789/ crlf: .ascii <15><12><200> msg1: .ascii '('<200> msg2: .ascii ') --> '<200> cramsg: .ascii <15><12>'Forced Crash!'<200> dots: .ascii <15><12>' . . .'<200> .even ; ; The following is a modification of FOR OTS module $SUBR for V2.5 ; ; Author: James A Krupp ; Voter Hall Computer Center ; Middlebury College ; Middlebury, Vermont 05753 ; ; ; Usage: ; This is the first code executed on entry to a ; subroutine. It pushes the calling line number and ; subroutine name (in RAD50) onto the stack, as well as ; link to previous name/line#. See FOR users guide page 1-30 ; for details. ; ; If code is inline, stack is "faked" so that return from ; subroutine routes through this module to undo stuff on ; the stack. ; ; Top elements on stack when this routine "threads off" ; to code is: ; ; SP -----> our name word 2 ; our name word 1 ; caller's ISN ; ptr to caller's name block ; callers thread/inline flag (inline=0; thread<>0) ; ; Modifications here include check for matching # of arguments, ; check against stack overflow into RSTS/E low core system area ; (absolute 460 = start of RSTS core common), and insertion ; of debug features for subroutine entry tracing. ; ; Following definitions are contained in FRT.MAC (on V2.5 tape) ; noargs = 16. ;Wrong number of arguments .macro error errnum trap errnum+^O200 .endm base = 460+20 ;core common + epsilon to avoid flakey errors .psect ots$i rw,i,lcl,rel,con .globl $otis,$$otis,$aots $otis: mov (pc)+,r1 ;threaded flag $$otis: clr r1 ;inline=0 tst (sp)+ ;pop phoney return address mov (r4)+,r0 ;threaded pointer (set even for inline) mov $aots,r3 ;beginning of Fortran Scratch area movb thread(r3),-(sp) ;save caller's inline/thread flag mov enmlnk(r3),-(sp) ;pointer to caller's name block on stack mov @r3,-(sp) ;save caller's ISN mov (r0)+,-(sp) ;1st word of rad50 name mov (r0)+,-(sp) ;2nd clr @r3 ;beginning at ISN 0 mov sp,enmlnk(r3) ;this is pointer to current name block ; ; following does check on # of args and growth of stack ; code differs from FOR OTS original... ; mov (r5)+,r2 ;# of arguments of caller cmp r2,(r0)+ ;caller's # must equal our number beq 1$ error noargs ;err 16 - wrong number of arguments 1$: cmp sp,#base bhi 2$ halt ;should be good for a Trap to 10 2$: tst r2 ;after all this, are there any args? beq 4$ mov @r0,r0 ;have some, this is where they go 3$: mov (r5)+,(r0)+ ;make copy of addresses (in $DATA) sob r2,3$ ; ; following sees if subroutine tracing is on ; 4$: tst @#tflag beq go ;no tracing enabled mov r1,-(sp) ;save trhead/inline indicator mov r4,-(sp) ;dumpit uses everything jsr pc,dumpit mov (sp)+,r4 ;find our place agian mov (sp)+,r1 ;restore thread/inline mov $aots,r3 ;and our favorite pointer ; ; back to standard OTS code... ; go: movb r1,thread(r3) ;our inline/thread flag beq 5$ ;skip ahead if inline jmp @(r4)+ ;thread off... 5$: jsr pc,@r4 ;put our return address on stack ; ; when inline routine does rts PC, back he comes to us... retcom: mov r4,savr4 ;save r4 first... mov #savr4+2,r4 ;must save r0-r3 in case mov r0,(r4)+ ;we are returning from function mov r1,(r4)+ mov r2,(r4)+ mov r3,(r4)+ mov $aots,r4 ;Fortran work area cmp sp,enmlnk(r4) ;stack messed up if not the same beq 10$ error 56. ;convenient error code (unused FPP code) 10$: cmp (sp)+,(sp)+ ;pop off old name mov (sp)+,@r4 ;restore caller's ISN mov (sp)+,enmlnk(r4) ;restore name block link movb (sp)+,thread(r4) ;and thread/inline flag tst @#tflag beq 20$ ;not tracing... .print #eximsg ;say we're leaving jsr pc,tprint ;;subroutine/line# mov enmlnk(r4),r1 bne 15$ mov r4,r1 add #loname,r1 15$: mov #isnmsg,r4 mov 2(r1),r0 jsr pc,putnam mov @r1,r0 jsr pc,putnam .ttyout msg1 mov @$aots,r0 jsr pc,decout .ttyout msg2 .print #crlf 20$: mov #savr4+12,r4 ;restore everybody mov -(r4),r3 mov -(r4),r2 mov -(r4),r1 mov -(r4),r0 mov -(r4),r4 ;restore r4 in case... rts pc ;now the "real" return ; ; following code is from $RETS module - threaded code returns. ; it is modified to use the above inline code. ; .globl stp$,ret$l,ret$f,ret$i,ret$ ; ret$l: movb @(r4)+,r0 br ret$ ret$f: mov @r4,r3 ;address of arg mov 2(r3),r1 ;low part in r1 ret$i: mov @(r4)+,r0 ;high part/integer in r0 ret$: mov $aots,r3 tst enmlnk(r3) ;is this the main program... beq 1$ ;yes br retcom ;branch to common return 1$: jsr pc,stp$ ;was jump - this allows overlays halt ;we never return from stp$ ; ; ; ; This code is based upon the Fortran#IV OTS module $ISNLSN ; ; Usage: ; If no /S switch is given, then $ISN or $LSN is the first ; executed code of each fortran statement. $ISN increments ; the current line number; $LSN loads the line number. $LSN ; is used following all conditional branches and at all labeled ; statements; $ISN elsewhere. The first location in $AOTS ; contains the line number. ; ; Under normal execution, $AOTS is incremented/loaded and ; then a JMP @(R4)+ is executed. When debugging, loading ; a JSR PC (004737 = $TRACE) into locations $ISNTR or ; $LSNTR will cause statement line# tracing to occur. ; ; This module and its companion OTIS are based upon a macro ; program appearing in the RSTS Small Buffer in 1977 (author ; unknown). It has been modified for use with V2.1/V2.5 Fortran. ; .globl isn$,lsn$,$isntr,$lsntr $trace == 4737 ;global JSR PC to help debuggers isn$: inc @$aots ;bump isn $isntr: jmp @(r4)+ ;thread off... .word tprint ;unless trace on - jmp becomes jsr pc jmp @(r4)+ lsn$: mov (r4)+,@$aots ;load new ISN from next location in code $lsntr: jmp @(r4)+ ;thread off... .word tprint ;same as above jmp @(r4)+ tprint: mov @$aots,r0 ;current isn mov #isn+5,r2 ;output field width 1$: mov r0,r1 ;prepare for divide beq 2$ ;space fill the rest clr r0 ;better be >0 div #10.,r0 add #60,r1 ;now its ascii movb r1,-(r2) ;to output field br 1$ ;and continue 2$: movb #40,-(r2) ;blank fill the rest cmp #isn,r2 blo 2$ .print #isnmsg ;output linenumber rts pc .end