Trailing-Edge
-
PDP-10 Archives
-
AP-5471B-BM
-
sources/algddt.mac
There are 8 other files named algddt.mac in the archive. Click here to see a list.
;
;
;
;
;
;
; COPYRIGHT (C) 1975,1976,1977,1978
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
; THIS SOFTWARE IS FURNISHED UNDER ALICENSE FOR USE ONLY ON A
; SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
; OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER
; COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
; TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
; AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD N OT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;
SUBTTL ASSEMBLY SWITCHES AND GLOBALS
SEARCH ALGPRM,ALGSYS ; SEARCH PARAMETER FILES
SALL
%TITLE(ALGDDT,ALGOL OBJECT TIME SYSTEM DEBUGGING ROUTINES)
INTERNAL .JBOPS
IF2, <
IFN FTDDT, <PRINTX Debugging system loaded.>
IFE FTDDT, <PRINTX Debugging system not loaded.>>
EXTERNAL .JBUUO,.JBREL,.JBHRL,.JBSA,.JBSYM,.JBAPR,.JBCNI,.JBTPC,.JBOPC
EXTERNAL .JBINT,.JBDDT
EXTERNAL CRLF%,IPRNT%,DPRNT%,PRFPR%,STSPR%,CNCTR%,DDCON%,DDFIN%,DDBEG%
EXTERNAL SPACE%,%ALGDR,RSTRT%,FLABL%
INTERNAL %ALGDD,BREAK%,DDERM%,DDTER%,DDTIN%,DDTOU%,DUMP%
ENTRY %ALGDD
MLON
SUBTTL DELOCATE PUSH AND RELOCATE POP MACROS
DEFINE DPUSH(A)
< SUBI A,(DB)
PUSH SP,A
>
DEFINE RPOP(A)
< POP SP,A
ADDI A,(DB)
>
; RE-DEFINE DOUBLE-LENGTH LOAD/STORE FOR OTS KA/KI INDEPENDENCE
DEFINE LRLOAD(A,B),<
MOVE A,B
MOVE 1+A,1+B
>
DEFINE LRSTOR(A,B),<
MOVEM A,B
MOVEM 1+A,1+B
>
OPDEF X [POPJ SP,0] ; Make return to ALGDDT from regular
OPDEF Y [JRSTF @.JBOPC]; DDT easier (just type X$X)
SUBTTL Debugging system - Definitions.
DDNEST==^D26 ; depth of nesting of autolists.
; Flags - in AC13 = FL.
; Left half are temporary, for life of 1 DDT command.
; Right half are more permanent.
; Bits 28-35 are width of TTY line.
; Bits 18-20 are action code for errors in autolists.
DDTTYW==377 ; MASK.
DDTTYL==400 ; 1= Lower Case available.
DDTTYH==1000 ; 1= Half Duplex TTY.
DDTTYT==2000 ; 1= TTY has Hardware Tabs.
DDALIP==4000 ; 1 = Inputting an auto-list.
DDALST==10000 ; 1 = Processing an auto-list.
DDINDF==20000 ; 1 = Processing an indirect file.
; Left half.
DDSUBS==400000 ; 1= subscript typed.
DDBYTS==200000 ; 1= Byte Subscript typed.
DD%FLG==100000 ; 1= % typed on front of identifier (e.g. %DB).
DDSLIC==40000 ; 1= Array Slice requested (ARRY[*,2]).
DDMTYP==10000 ; 1= Doing a multi-variable typeout.
DDTMP1==4000 ; Temp.
DDTMP2==2000 ; Temp.
DDMTY2==1000 ; Used in multi-variable typeout.
DDMPSC==400 ; Scalars option to DUMP command.
DDGTMP==200 ; Temp for DDGTCH.
; Accumulators.
FL==A13 ; Flags.
; A4 is current or last char read from TTY:, during cmd scanner etc.
; A6 is lexeme of current object (SYM).
; A12 is autolist input pointer, when inputting a/l.
; Characters.
.CONT==37 ; Continuation - control-backarrow.
.QUERY=="?" ; Give full error message.
.BYTES==200 ; Pseudo-character for .[ (byte-subscript)
.DEL==177 ; Delete.
.CTRLU==25 ; Line delete (Control-U).
.CTRLR==22 ; Re-type input line.
.CR==15
.FF==14
.VT==13
.LF==12
.HT==11 ; Must not change !!
.SPACE==" " ; Nor must this (code at DDGT3 depends).
.ESC==33 ; Altmode.
.SCOL==";"
.COMMA==","
.LBRA=="["
.RBRA=="]"
.LPAR=="("
.RPAR==")"
.COLON==":"
.AST=="*"
.ASIGN=="_" ; Returned in A4 for ":=" also.
.ZERO=="0"
.SEVEN=="7"
.EIGHT=="8"
.NINE=="9"
.PRCNT=="%"
.DOLLR=="$"
.HASH=="#"
.SQUOTE=="'"
.DQUOTE==""""
.EQU=="="
.PLUS=="+"
.MINUS=="-"
.SLASH=="/"
.BSLSH=="\"
.COMNT=="!" ; Introduces a comment.
.A=="A"
.F=="F"
.S=="S"
.T=="T"
.Z=="Z"
.LCA=="a" ; Lower-case.
.LCZ=="z" ; Lower-case.
.DOT=="."
.AT=="@"
; Bits in AC returned from GETLCH UUO (get TTY characteristics)
GL.LCM==20
GL.HDP==10000
GL.TAB==10
GL.LCP==4
; Define Decrement Byte Pointer macro.
; DBP Scratch-AC,Pointer,Size
DEFINE DBP (SCR,PTR,SIZE<7>,%A) <
LDB SCR,[
POINT 6,PTR,5] ;; GET P-FIELD
ADDI SCR,SIZE
CAIE SCR,^D36 ;; NEED PREVIOUS WORD ?
JRST %A ;; NO
SOS PTR ;; YES - GET IT
MOVEI SCR,<^D36-<^D36/SIZE*SIZE>> ;; CALCULATE NEW P
%A: DPB SCR,[
POINT 6,PTR,5] ;; SET P
>
; Bits in l.h. of word 1 (BP.FLG) of breakpoint control block.
BP.PSH==400000 ; 1 = displaced instruction is a PUSHJ SP,
BP.OCT==200000 ; 1 = octal address, not line number
BP.SIL==100000 ; 1 = silent b/p (/silent)
BP.PRO==40000 ; 1 = procedure name, not line number
BP.LAB==20000 ; 1 = label name, not line number
BP.PRI==10000 ; 1 = private autolist.
BP.ACT==7000 ; mask for action-code (action on a/l error)
BP.NXT==400 ; 'NEXT' command.
BP.STN==377 ; mask for statement # (left half)
; Words in breakpoint control block.
BP.PTR==0 ; xwd addr of module's LINK s.t.entry,
; addr of BLKIDX entry.
BP.FLG==1 ; left-half = flags, and statement #
BP.LIN==1 ; right half = line #, or ptr to SYM
; item if label or proc, or octal address.
BP.CNT==2 ; proceed-count
BP.LIM==3 ; Breakpoint activation upper limit
BP.ALP==4 ; xwd address of entry in b/p table,
; pointer to autolist, if private, or
; pointer to a/l list slot if public.
BP.LNK==5 ; Link to companion breakpoint, if 'NEXT'
BP.INS==6 ; displaced instruction (maybe first of sequence)
DD.LPW==^D132 ; width of line-printer line.
DD.BTW==DD.LPW-^D16 ; width of batch log line.
SUBTTL Common routines - DDT,KA10,KI10,ONTRACE,OFFTRACE action routines.
DDTDDT: SKIPN A3,.JBDDT ; IF REGULAR DDT IS LOADED
JRST DDNODD ; NOT
SETZM .JBINT ; make sure no ^C intercept.
OUTSTR [ASCIZ/
Entering regular DDT. Type X$X to return to ALGOL debugger.
/]
JRST (A3)
DDNODD: OUTSTR [ASCIZ/
Regular DDT is not loaded.
/]
POPJ SP,
; Processor type-change switches (simulation)
; NOT documented!
DDONTR: TLO DB,STMTST
POPJ SP,
DDOFTR: TLZ DB,STMTST
POPJ SP,
SUBTTL Common routines - Byte I/O and break routines (DDTOU%,DDBRKB)
DDTOU%: ; Enter with address of message in A1 in ASCIZ.
; Clobbers A1.
DDTOUT: PUSH SP,A10
PUSH SP,A11
PUSH SP,A12
PUSH SP,FL
HRLI A1,440700 ; MAKE A BYTE-POINTER.
DDTOU1: ILDB A13,A1
JUMPE A13,DDPOP4 ; RESTORE AC'S AND EXIT.
PUSHJ SP,OUBYTE
JFCL
JRST DDTOU1
DDBRKB: ; Breakoutput.
PUSH SP,A10
PUSH SP,A11
PUSH SP,A12
PUSH SP,FL
PUSHJ SP,BRKBYT
JFCL
DDPOP4: POP SP,FL
DDPOP3: POP SP,A12
POP SP,A11
POP SP,A10
POPJ SP,
SUBTTL Common routines - UNIQUE keyword scanner.
; UNIQUE is a general-purpose unique keyword scanner.
; On entry:
; A1 = AOBJN pointer to SIXBIT table of keyowrds.
; A2 = pointer to ASCIZ string to lookup.
; Exits:
; Call+1 (no skip) not found.
; Call+2 ( 1 skip) not unique - A1 points to first entry.
; - A0 is sixbit of typed string.
; Call+3 (2 skips) found. A1 points to entry.
; A0,(A1),A2,A3 clobbered.
; Only looks up first 6 characters - table has 1-word entries.
UNIQUE: HRLI A2,440700 ; MAKE BYTE-POINTER.
MOVEI A0,0
UNIQU2: ILDB A3,A2 ; GET CHARACTER.
JUMPE A3,UNIQU1 ; END.
LSH A0,6
ADDI A0,-40(A3) ; FORM 6-BIT IN A0
TLNN A0,770000 ; 6 CHARS ?
JRST UNIQU2 ; NO
SETO A3, ; MAKE MASK
JRST UNIQU3
UNIQU1: SETO A3, ; NOT LEFT-JUSTIFIED - MAKE IT SO.
LSH A3,6 ; AND MAKE A MASK.
LSH A0,6
TLNN A0,770000 ; LEFT-JUSTIFIED NOW ?
JRST UNIQU1+1 ; NO.
UNIQU3: PUSH SP,[0]
MOVE A2,(A1) ; GET TABLE ENTRY.
AND A2,A3 ; MASK OFF UNTYPED CHARACTERS.
CAMN A2,A0 ; FOUND ?
JRST UNIQU4 ; YES.
UNIQU6: AOBJN A1,UNIQU3+1 ; NO - NEXT ENTRY.
POP SP,A1 ; DONE - RESCUE POINTER.
POPJ SP, ; RETURN. LINK ALREADY ADJUSTED.
UNIQU4: ; Found a match. Is it unique ?
SKIPE 0(SP) ; FIRST MATCH ?
JRST UNIQU5 ; NO - ERROR.
MOVEM A1,0(SP) ; YES - SAVE POINTER.
AOS -1(SP) ; ADJUST
AOS -1(SP) ; LINK
JRST UNIQU6 ; AND CONTINUE.
UNIQU5: POP SP,A1 ; RETRIEVE POINTER TO FIRST MATCH.
SOS 0(SP) ; DECREMENT LINK
POPJ SP,
SUBTTL Skeleton ALGDDT (FTDDT=0)
IFE FTDDT,<
DDHELP: OUTSTR [ASCIZ/
Commands are:
Continue
Finish
Help
Start
Trace
Profile
Statistics
Ontrace
Offtrace
/]
POPJ SP,
DDSTART: CAIE DL,(DB)
JRST [OUTSTR [ASCIZ/
?Program has already been STARTed.
/]
EXIT]
MOVE AX,%ACCS+AX(DB)
JRST DDBEG%
PR.HST::MOVEI A7,@DDTDL(DB) ; Get topmost DL
CAIE A7,(DL) ; Is DL set to topmost level ?
OUTSTR [ASCIZ/during parameter evaluation /]; No - type message
OUTSTR [ASCIZ/in /] ;
HSTPR1: SKIPN A1,CONDL(A7) ; Main program ?
JRST HSTPR5 ; Yes
SKIPN A3,PMBPTR(A7) ; No - Traced ?
JRST HSTPR3 ; No - say so
OUTSTR [ASCIZ/procedure /] ; say procedure
MOVEI A1,2(A3) ; Get start of text
TLO A1,(POINT 6) ; Convert to SIXBIT byte pointer
HSTPR2: ILDB A3,A1 ; Get next character
JUMPE A3,HSTPR4 ; Done if this is a null
ADDI A3,"A"-'A' ; Otherwise convert to ASCII
OUTCHR A3 ; And type it
JRST HSTPR2 ; And loop
HSTPR3: OUTSTR [ASCIZ/an untraced procedure/]; Say procedure not traced
HSTPR4: MOVEI A4,@PRGLNK(A7) ; Get return address
OUTSTR [ASCIZ/)
Called from /] ; Tell user where we came from
HRRZ A1,CONDL(A7) ; Get 'context' DL
ADDI A1,(DB) ; and relocate it
CAIE A1,@LINKDL(A7) ; Is this the same ?
OUTSTR [ASCIZ/a parameter of /]; No - tell user
MOVEI A7,@LINKDL(A7) ; Follow procedure chain down
JRST HSTPR1 ; And carry on typeout
HSTPR5: OUTSTR [ASCIZ/main program/] ; Final message
POPJ SP, ; Return
%ALGDD: MOVEI A6,0
MOVE A2,[
POINT 7,A6]
OUTSTR [BYTE(7)15,12,76,0,0] ; the wonders of MACRO - right angle bracket !
INLOOP: INCHWL A4 ; GET CHARACTER.
CAIE A4,.SPACE ; IGNORE SPACES
CAIN A4,.HT ; AND TABS
JRST INLOOP
CAIN A4,.CR ; AND CARRIAGE-RETURNS.
JRST INLOOP
CAILE A4,.Z ; LOWER-CASE ?
SUBI A4,.LCA-.A ; MAKE UPPER.
CAIGE A4,.SPACE ; ANY OTHER CONTROL CHAR
JRST ALGDD2 ; IS TERMINATOR.
TRNN A6,377 ; ROOM FOR MORE CHARS ?
IDPB A4,A2 ; YES - PUT IN.
JRST INLOOP
EDIT(065); Dont loop if a null command is typed
ALGDD2: JUMPE A6,%ALGDD ; [E065] IGNORE BLANK LINES
MOVEI A2,A6
MOVEI A7,0 ; ASCIZ !
MOVE A1,[
XWD -DDCMLN,DDCOMT]
PUSHJ SP,UNIQUE ; LOOK UP COMMAND.
JRST SYNERR ; UNKNOWN
JRST SYNERR ; NOT UNIQUE.
; FOUND - A1 POINTS TO ENTRY.
MOVE A1,DDISPT-DDCOMT(A1) ; GET DISPATCH ADDRESS.
PUSHJ SP,(A1) ; AND GO THERE.
JRST %ALGDD ; NEXT COMMAND.
SYNERR: OUTSTR [ASCIZ/
?Command error. H for help.
/]
JRST %ALGDD
DDTIN%:DDERM%:BREAK%:DDTER%:
OUTSTR[ASCIZ/
?Debugging UUO executed, but debugging system is not loaded.
/]
EXIT ; ABORT
DDT.CC::DUMP%: POPJ SP, ; IGNORE.
GO.NXT::AOJA AX,CNC.AX## ; GOLAB/FORLAB - RETURN TO PROGRAM
> ; END OF IFE FTDDT.
SUBTTL Debugging system - main entry-point and command loop.
IFN FTDDT,<
%ALGDD: HRRI A0,DDCCML ;[E1000]
PUSHJ SP,DDSETI ;[E1000] SET CMD LVL ^C INTERCEPT
TLO DB,INDDT ; REMEMBER WE ARE DDT.
;
; Ac's have already been saved by fault-monitor.
;
MOVE A0,SP
SUBI A0,(DB) ; DELOCATE STACK-POINTER
MOVEM A0,%ACCS+SP(DB) ; AND SAVE (FOR RESET LATER)
SKIPN %DDTST(DB) ; SYMBOL TABLE BEEN READ ?
PUSHJ SP,DDINIT ; NO - DO SO.
SKIPL %DDTST(DB) ; READ SUCCESSFULLY ?
JRST ALGDD1 ; NO.
SKIPE A2,%DDTBE(DB) ; ANY CONTEXT YET ?
JRST ALGDD1 ; YES
MOVEI A4,@%SYS0(DB) ; NO - SET UP AS %BEGIN:.
MOVE A4,(A4)
HRRZM A4,%DDTPC(DB) ;
;
; Note that l.h. %DDTPC should be set up to the delocated DL.
; But initial DL = DB, so delocated DL = 0, so no action needed !
;
PUSHJ SP,FNDADR
DDTERR ^D18 ; DISASTER - CAN'T RESOLVE ADDRESS.
ALGDD1: MOVNI A2,1 ; SET O/P DEVICE = TTY.
EXCH A2,%CHAN(DB)
MOVEM A2,%DDTTY(DB)
PUSHJ SP,DDTTYC ; GET TTY CHARACTERISTICS TO %DDTFL
; MAIN COMMAND LOOP.
DDTLUP: HRRZI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PUSHJ SP,DDSTI1 ; [E1000] ^C INTERCEPT
SETOM %DDERD(DB) ; [E1000] CLEAR ANY DETECTED ERROR
HRRZ FL,%DDTFL(DB)
TRNN FL,DDALST ; EXECUTING AUTOLIST ?
JRST ALGDD2 ; NO.
MOVE A1,@%DDTIP(DB) ; YES - GET POINTER TO IT
DDTLU1: TLNE A1,770000-440000 ; POSITIONED CORRECTLY ?
MOVEI A1,1(A1) ; NO - ADVANCE TO NEXT WORD
HRLI A1,(POINT 7,0) ; SET UP BYTE POINTER
MOVEM A1,@%DDTIP(DB) ; AND REWRITE IN MEMORY
SKIPE (A1) ; END OF AUTOLIST ?
JRST ALGDD4 ; NO - READ COMMAND FROM A/L
SOS %DDTIP(DB) ; END OF A/L - GO TO NEXT
SKIPE A1,@%DDTIP(DB) ; (IF THERE IS ONE)
JRST DDTLU1 ; THERE IS - USE IT.
HRROI FL,DDALST ; OUTERMOST - CLEAR FLAG, AND
ANDCAB FL,%DDTFL(DB) ; FALL THROUGH TO READ FROM TTY
ALGDD2: PUSHJ SP,DDGTLN ; OUTPUT PROMPT, READ LINE FROM TTY
ALGDD4: PUSHJ SP,DDIGCH ; GET FIRST CHARACTER.
CAIN A4,.AT
JRST DDIND ; INDIRECT FILE.
PUSHJ SP,SCAN4 ; GET FIRST FIELD.
; Identifier is left in buffer %DDTIB(DB).
; Whole field is in buffer %DDTFB(DB).
; Pointer to end of ident in above buffer is in A10.
; Delimiter is in A4 (spaces have been skipped).
CAIE A4,.EQU ; IS DELIMITER
CAIN A4,.ASIGN ; AN OPERATOR ?
JRST ALGDD3 ; YES.
; No - Identifier should be a command keyword.
TLNE FL,DD%FLG!DDSUBS!DDBYTS ; SILLY SYNTAX ?
DDTERR 2 ; YES - COMPLAIN.
MOVE A1,[
XWD -DDCMLN,DDCOMT] ; GET PARAM FOR UNIQUE COMMAND SCANNER.
MOVEI A2,%DDTIB(DB) ; ADDRESS OF COMMAND TO LOOKUP.
SKIPN (A2) ; BLANK LINE ?
JRST DDTLUP ; YES.
PUSHJ SP,UNIQUE ; USES A0,A2,A3
DDTERR 3 ; UNKNOWN.
JRST [ ; NOT UNIQUE
MOVE A2,DDISPT-DDCOMT(A1)
TLNN A0,7700 ; ONLY ONE CHAR TYPED ?
TLNN A2,ONECHR ; AND ONE-CHAR PREFERENCE SW ?
DDTERR 4 ; NO - ERROR.
JRST .+1] ; YES - USE IT.
; Found - A1 is left pointing to its entry.
MOVE A1,DDISPT-DDCOMT(A1) ; GET DISPATCH TABLE ENTRY.
TRNE FL,DDALIP ; IN AUTOLIST INPUT ?
JRST DDALI0 ; YES - DON'T DISPATCH.
PUSHJ SP,(A1) ; DISPATCH.
JRST DDTLUP ; DO NEXT COMMAND.
ALGDD3: ; A4 = ELEMENT</ = _ :=>
MOVEI A1,0 ; REMEMBER NOT KEYWORD CMD.
TRNE FL,DDALIP ; IN AUTOLIST INPUT ?
JRST DDALI0 ; YES.
PUSHJ SP,SEARCH ; FIND IDENTIFIER IN SYMBOL-TABLE.
DDTERR ^D23 ; CANT FIND IT.
CAIN A4,.EQU ; TYPEOUT ?
PUSHJ SP,DDTYP. ; YES
CAIN A4,.ASIGN ; SET ?
PUSHJ SP,DDSET ; YES - DO IT.
JRST DDTLUP ; NEXT COMMAND.
DDIND: ; Indirect command file.
TRZE FL,DDINDF ; NESTED ?
DDTERR ^D66 ; YES - ILLEGAL.
TRNE FL,DDALST ; PROCESSING AUTOLIST ?
DDTERR ^D82 ; NOT ALLOWED.
PUSHJ SP,DDIGCH
MOVSI A0,'DSK' ; DEFAULT DEVICE.
MOVSI A6,'CMD' ; SET DEFAULT EXTN.
PUSHJ SP,DDIPFL ; READ FILE-NAME & OPEN IT.
HRLM A1,%CHAN(DB) ; SELECT IT.
TRO FL,DDINDF ; REMEMBER
HRRM FL,%DDTFL(DB) ; PERMANENTLY.
JRST DDTLUP ; START PROCESSING IT.
; ROUTINE TO FIND OUT ABOUT TTY: AND SET BITS IN FL & %DDTFL(DB)
DDTTYC: MOVNI A2,1 ;
CTLJOB A2, ; BATCH ?
JFCL ;
JUMPGE A2,DDTTy3 ; yes - not interested in TTY;
PJOB A2,
TRMNO. A2, ; ASK MONITOR.
JRST DDTTY2 ; WON'T TELL.
MOVEI A1,1012
MOVE FL,[
XWD 2,A1] ; GET WIDTH FUNCTION.
TRMOP. FL,
DDTTY2: MOVEI FL,^D72 ; ASSUME 72. IF MONITOR WON'T TELL.
MOVNI A1,1 ; US
GETLCH A1 ; GET LINE CHARACTERISTICS.
TLNE A1,GL.LCM ; LOWER-CASE ?
TRO FL,DDTTYL ; REMEMBER.
TLNE A1,GL.HDP ; HALF-DUPLEX ?
TRO FL,DDTTYH
TLNE A1,GL.TAB ; HARDWARE TABS ?
TRO FL,DDTTYT
HRRZM FL,%DDTFL(DB)
POPJ SP,
DDTTY3: MOVEI FL,DD.BTW!DDTTYT!DDTTYL ; BATCH - USE LONG LINE ETC.
HRRZM FL,%DDTFL(DB) ;
POPJ SP,
SUBTTL Debugging system - read autolist routine.
DDALI0: ; A1 (may be) dispatch table entry - B0 = 1 if illegal in A/L
; A4 is next i/p char (might be =, or first char of 2nd field.
; As much syntax (command exists, valid arrangement of .[ etc)
; as possible is checked, but not semantics (identifier exists,
; is of correct type, etc.) because that is context-dependent.
; The list is stored in ASCII in a chain of blocks taken from
; the HEAP. Each block holds ALSIZE data words, and the last
; word is a pointer to the next block (0 if this is the end).
; R.H. of A12 is pointer to start of this block, L.H. of A12
; is address of next free word in it.
; The end of the list is marked by a zero word. (Put there by
; the 'END' command, the only way of ending an autolist.)
ALSIZE=20
JUMPL A1,DDER5 ; COMMAND ILLEGAL IN A/L
TLZ A1,-1
CAIN A1,DDEND ; END COMMAND ?
JRST DDEND ; YES - WE'D BETTER DISPATCH!
HLRZ A7,A12 ; NEXT FREE WORD.
MOVEI A7,-1(A7) ; STEP BYTE POINTER BACK
HRLI A7,(POINT 7,0,34) ; SO THAT DDALI7 WORKS
EDIT(106); Remember buffers can move if stack shifts.
DDALI1: MOVE A6,[POINT 7,%DDTFB(DB)] ; [E106] POINT TO SCAN'S OUTPUT BUFFER
DDALI2: ILDB A2,A6 ; GET CHAR FROM SCAN BUFFER.
JUMPE A2,DDALI3 ; NULL - END.
PUSHJ SP,DDALI7 ; NO - DEPOSIT.
JRST DDALI2 ; NEXT.
DDALI3: CAIE A1,DDTYPE ; TYPE CMD ?
JRST DDALI4 ; NO.
CAIN A4,.SCOL ; FINISHED ?
JRST DDALI5 ; YES.
CAIN A4,.COMMA ; COMMA BETWEEN FIELDS ?
SKIPA A2,A4 ; YES - GET IT.
MOVEI A2,.SPACE ; NO - GET SPACE.
PUSHJ SP,DDALI7 ; PUT IN.
CAIN A4,.COMMA ; IF IT WAS COMMA,
PUSHJ SP,DDIGCH ; GET NEXT.
PUSHJ SP,SCAN4 ; GET IDENTIFIER.
JRST DDALI1 ; & PUT IN.
DDALI4: MOVEI A2,.SPACE ; PUT IN
PUSHJ SP,DDALI7 ; SEPARATOR SPACE.
DDALI5: ; SCAN part done. Get rest from TTY: buffer.
MOVEI A2,(A4) ; GET SCAN'S TERMINATOR.
PUSHJ SP,DDALI7 ; PUT IN.
CAIE A4,.EQU ; FOO =, OR
CAIN A4,.SCOL ; END OF COMMAND ?
JRST DDALI6 ; YES.
PUSHJ SP,DDGTCH ; NOT - GET A CHAR.
JRST DDALI5 ; & PUT IN.
DDALI6: ; End. Update contents of A12.
HRLI A12,1(A7) ; GET "NEXT FREE WORD".
JRST DDTLUP ; TO MAIN LOOP.
DDALI7: ; Deposit a character from A2 (which it clobbers).
TLNE A7,760000 ; IF SPACE LEFT IN WORD
JRST DDALOK ; JUST INSERT CHAR
MOVEI A3,ALSIZE-1(A12) ; ELSE GET LAST DATA WORD
CAILE A3,(A7) ; OVERFLOWING TO LINK WORD ?
JRST DDALI9 ; NO - JUST CLEAR WORD FIRST
SKIPE A7,ALSIZE(A12) ; YES. GOT ANOTHER CHUNK ?
JRST DDALI8 ; YES (REDEFINING A/L)
PUSH SP,A2 ; NO. SAVE CHAR
PUSH SP,A1 ; AND DISPATCH
MOVEI A0,ALSIZE+1 ; GET SIZE OF CHUNK
PUSHJ SP,GETOWN ; ASK FOR IT
SETZM ALSIZE(A1) ; AND CLEAR LINK
MOVEI A7,(A1) ; GET ADDRESS INTO A7
POP SP,A1 ; AND RESTORE ORIGINAL
POP SP,A2 ; DISPATCH AND CHAR
MOVEM A7,ALSIZE(A12) ; LINK IN NEW CHUNK
DDALI8: HRLS A12,A7 ; POINT A12 TO THIS CHUNK
MOVEI A7,-1(A7) ; AND MAKE A7 INTO
HRLI A7,(POINT 7,0,34) ; A BYTE POINTER
DDALI9: SETZM 1(A7) ; CLEAR NEXT WORD
DDALOK: IDPB A2,A7 ; STORE CHAR IN LIST
POPJ SP, ; AND RETURN
> ; End IFN FTDDT
SUBTTL Debugging system - command tables.
NOTAL==400000 ; NOT ALLOWED IN AUTOLIST. (MUST BE BIT 0).
ONECHR==200000 ; ONE-CHAR PREFERENCE - SWITCH WITH THIS
; SET IS USED IN PREFERENCE TO OTHERS
; WITH SAME FIRST CHAR, IF ONLY 1 CHAR IS TYPED.
; ***SWITCH WITH THIS SET MUST BE BEFORE OTHERS
; WITH SAME FIRST CHAR. ***
IFN FTDDT,<
DEFINE COMAND,<
;V NAME,DISPATCH-ADDRESS,FLAG,FLAG
V TYPE,DDTYPE,ONECHR
V CONTIN,CONTIN,ONECHR
V BREAK,PAUSE,ONECHR
V PAUSE,PAUSE,ONECHR
V END,DDEND,ONECHR
V LIST,LIST,ONECHR
V DEFINE,DEFINE,ONECHR,NOTAL
V KILL,KILL,ONECHR
V FINISH,DDFINISH,ONECHR,NOTAL
V HELP,DDHELP,ONECHR
V WHERE,DDWHERE,ONECHR
V GOTO,DDGOTO,ONECHR
V START,DDSTART,ONECHR
V UNWIND,UNWIND,ONECHR
V AUTO,DDAUTO,ONECHR
V NEXT,DDNEXT,ONECHR
V REDIRECT,REDIRECT
V RETRY,RETRY
V SOURCE,DDSORS
V DDT,DDTDDT
V DIMENSIONS,DDDIMS
V EXPERT,EXPERT,NOTAL
V EXTEND,EXTEND,NOTAL
V NOVICE,NOVICE,NOTAL
V DUMP,DDUMP
V TRACE,TRLPRT
V PROFILE,PRFPR%
V STATISTICS,STSPR%
V OBJECT,OBJECT
V ONTRACE,DDONTR
V OFFTRACE,DDOFTR
V BACK,DDBACK
>
> ; END OF IFN FTDDT
IFE FTDDT,<
DEFINE COMAND,<
V CONTIN,DDCON%
V FINISH,DDFIN%
V HELP,DDHELP
V START,DDSTART
V DDT,DDTDDT
V TRACE,TRLPRT
V PROFILE,PRFPR%
V STATISTICS,STSPR%
V ONTRACE,DDONTR
V OFFTRACE,DDOFTR
>
> ; END OF IFE FTDDT.
DEFINE V(A,B,C,D),<
<SIXBIT/A/>>
DDCOMT: COMAND ; GENERATE NAME TABLE.
DDCMLN==.-DDCOMT ; NUMBER OF COMMANDS.
DEFINE V(A,B,C,D),<
IFB<D>,<
IFB<C>,<
EXP B>
IFNB<C>,<
XWD C,B>>
IFNB<D>,<
XWD C!D,B>>
DDISPT: COMAND ; GENERATE DISPATCH TABLE.
PURGE V,NOTAL,COMAND
IFN FTDDT,<
SUBTTL Debugging system - command routines - CONTINUE, FINISH
CONTIN: SETZB A5,%SYS17(DB) ; MAKE ALL ERRORS CONTINUABLE (AT HIS PERIL!)
CAIL A4,.ZERO ; IS NEXT CHARACTER NUMERIC ?
CAILE A4,.NINE ; (PROCEED COUNT SPECIFIED)
JRST CONTN1 ; NO - CARRY ON
PUSHJ SP,DDGTV1 ; YES - GET VALUE
CONTN1: HLRZ A6,%DDTAL(DB) ; GET B/P CONTROL BLOCK ADDRESS
SKIPE A6 ; ARE WE IN A BREAKPOINT ?
MOVEM A5,BP.CNT(A6) ; YES - RESET PROCEED COUNT
JSP A0,CONRES ; RESTORE STACK ETC.
JRST DDCON%
DDFINI: SETZM .JBINT ; CLEAR ^C INTERCEPT.
HRRZS %DDTER(DB) ; ZAP REDIRECT CHAN # (INIT5 WILL RELEASE)
TLZ DB,INDDT ; JUST IN CASE.
JRST DDFIN%
; Common subroutine to restore stack, i/o channels etc.
; Called by JSP A0 - don't want to disturb the stack.
CONRES: TRZN FL,DDINDF ; IN INDIRECT FILE ?
JRST CONTN2 ; NO.
HRRM FL,%DDTFL(DB) ; CLEAR FLAG.
HLRE A1,%CHAN(DB) ; RELEASE
SKIPL A1
PUSHJ SP,RELESE ; CHANNEL.
JFCL
CONTN2: MOVE A6,%DDTTY(DB) ; RESET I/O
MOVEM A6,%CHAN(DB) ; CHANNELS.
TLZ DB,INDDT
SETZM %DDTBE(DB) ; ZAP CONTEXT
MOVE FL,%DDTFL(DB)
HLRZ A6,%DDTAL(DB)
JUMPN A6,BREAKX ; IN A B/P - CONTIN IS DIFFERENT.
HRRZ A1,%ACCS+SP(DB) ; DELOCATED SP
ADDI A1,(DB) ; RELOCATE IT.
MOVEI A2,(SP)
SUBI A2,(A1) ; GET AMOUNT TO RETARD SP BY
HRLI A2,(A2)
SUB SP,A2 ; RESET SP.
JRST @A0 ; GO ENTER/CONTINUE PROGRAM.
SUBTTL HSTPRT - Print history (WHERE command, or runtime error)
DDWHERE: ; TYPE CURRENT HISTORY.
PUSHJ SP,CRLF%
CAIN DL,(DB) ; [E127] LEVEL 0.0 ?
JRST HSPR10 ; [E127] YES - SPECIAL CASE
TLZ DB,TMPFL3 ; NO - MAKE SURE NOT IN SILENT MODE.
PUSH SP,%DDTUW(DB) ; SAVE "UNWOUND" POINTER
PUSH SP,%DDUWB(DB) ; [E127] AND UNWOUND BLOCK LVLS
PUSHJ SP,HSTPRT ; TYPE HISTORY.
POP SP,A5 ; [E127] RECOVER BLOCK LVLS
HLRZ A5,A5 ; [E127] AND SET A5 TO REQUD BLK LVL
POP SP,A7 ; [E127] RECOVER UNWIND COUNT
TLZE A7,-1 ; [E127] WERE WE UNWOUND ?
SOJA A7,DDUW0 ; [E127] YES - UNWIND US AGAIN !
POPJ SP,
PR.HST::HRRZM A4,%DDTPC(DB) ; Save address for later.
PUSH SP,%CHAN(DB) ; Entry from ALGOTS. Save channel
SETOM %CHAN(DB) ; Force channel -1 (TTCALL I/O)
AOSE %DDERD(DB) ; [E1000] Set error detected flag
JRST DD2ERR ; [E1000] Second error - die gracefully
SKIPN %DDTST(DB) ; Have we tried to read symbol table ?
PUSHJ SP,DDINIT ; Not yet - do it now
PUSHJ SP,HSTPRT ; Do the actual work
POP SP,%CHAN(DB) ; Then restore channel selection
POPJ SP, ; And return
HSTPRT: HRRZ A1,%DDTER(DB) ; Is this an 'expert' user ?
JUMPN A1,HSTPR0 ; (R.H. of %DDTER non-zero)
TLZ DB,TMPFL3 ; No - give him the typeout
HSTPR0: HRRZS A4,%DDTPC(DB) ; Get address we stopped at.
SETZM %DDTBE(DB) ; Clear context
SETOM %DDTUW(DB) ; and dynamic (UNWOUND) P.L.
CAIN DL,(DB) ; [E1001] Level 0.0?
JRST HSTPR9 ; [E1001] Yes - special case
SKIPGE %DDTST(DB) ; Unless symbol table unavailable,
PUSHJ SP,FNDADR ; Try to find out where error occurred
SETZB A4,%DDTBE(DB) ; No S.T., or can't resolve address.
TLNE DB,TMPFL3 ; Expert ?
JRST HSTPR2 ; Yes - no messages
JUMPE A4,HSTPR1 ; A4 zero if could not resolve address
PUSH SP,A5 ; Save module name
MOVEI A1,[ASCIZ/On /] ; Print first part of message
PUSHJ SP,DDTOUT ; ..
PUSHJ SP,STNPRT ; Print line #[, statement #] from A4
POP SP,A4 ; Then get module name to A4
PUSHJ SP,MODPRT ; And print that also
PUSHJ SP,CRLF% ; followed by <CR><LF>
HSTPR1: CAIN DL,@%DDTDL(DB) ; Is DL set to topmost level ?
JRST HSTPR2 ; Yes - all is well
MOVEI A1,[ASCIZ/during parameter evaluation /]; No - get message address
PUSHJ SP,DDTOUT ; And include message in typeout
HSTPR2: PUSH SP,[-1] ; Initialize context markers
SUBI DL,(DB) ; Delocate DL
SKIPE %DDTBE(DB) ; [E127] If FNDADR established context
HRLM DL,%DDTPC(DB) ; [E127] Save correct DL
TLO DL,DB ; Set DB into index field
PUSH SP,DL ; And save it on the stack
MOVEI DL,@%DDTDL(DB) ; Set DL to topmost level
SETZM %UWCON(DB) ; [E127] Initialize unwind limit
MOVEI A4,@LINKPC(DL) ; [E127] Get best-guess PC
PUSHJ SP,UWTEST ; [E127] And test for context
TLNE DB,TMPFL3 ; Is typeout suprressed ?
JRST HSTPR3 ; Yes - no message
MOVEI A1,[ASCIZ/in /] ; No - get prefix address
PUSHJ SP,DDTOUT ; And print it
HSTPR3: PUSHJ SP,PRPROC ; Now print procedure name
AOS A3,%DDTUW(DB) ; Count one more level
CAIN DL,@0(SP) ; And if this is correct DL
HRRM A3,-1(SP) ; Save current depth
SKIPN %DDTBE(DB) ; Has FNDADR established context ?
JRST HSTPR4 ; Not yet
HLRZ A0,%DDTPC(DB) ; Yes - first time ?
JUMPN A0,HSTPR4 ; No
MOVEI A0,(DL) ; Yes - set delocated value of
SUBI A0,(DB) ; DL into L.H. of %DDTPC
HRLM A0,%DDTPC(DB) ; (needed by DDGTDL)
HRLM A3,-1(SP) ; and remember current depth
HSTPR4: SKIPN CONDL(DL) ; Is this main program ?
JRST HSTPR7 ; Yes - finished
MOVEI A4,@PRGLNK(DL) ; No - get return address
SKIPGE %DDTST(DB) ; And unless debugger is turned off,
PUSHJ SP,FNDADR ; Convert to line number
SETZ A4, ; Can't resolve address !
TLNE DB,TMPFL3 ; Expert ?
JRST HSTPR6 ; Yes - no messages
PUSH SP,A4 ; No - save statement #
MOVEI A1,[ASCIZ/(level/] ; Output dynamic procedure
PUSHJ SP,DDTOUT ; level, which can be
SETCM A0,%DDTUW(DB) ; calculated as the difference
ADD A0,%DDTPL(DB) ; between the current value of
PUSHJ SP,IPRNT% ; %DDTUW+1 and the maximum (%DDTPL)
MOVSI A4,'. ' ; [E127] Then type a dot
PUSHJ SP,DDOSIX ; [E127] . . .
HRRZ A0,PLBLKL(DL) ; [E127] Followed by the
PUSHJ SP,DPRNT% ; [E127] current block level
MOVEI A1,[ASCIZ/)
Called from /] ; Tell user where we came from
PUSHJ SP,DDTOUT ; ..
POP SP,A4 ; Restore line number, if any
JUMPE A4,HSTPR5 ; Did we resolve address ?
PUSHJ SP,STNPRT ; Yes - tell user
MOVEI A1,[ASCIZ/ in /] ; and put in next bit of
PUSHJ SP,DDTOUT ; message
HSTPR5: HRRZ A1,CONDL(DL) ; Get 'context' DL
ADDI A1,(DB) ; and relocate it
CAIN A1,@LINKDL(DL) ; Is this the same ?
JRST HSTPR6 ; Yes - easy
MOVEI A1,[ASCIZ/a parameter of /]; No - tell user
PUSHJ SP,DDTOUT ; stopped during parameter evaluation
HSTPR6: MOVEI A4,@PRGLNK(DL) ; [E127] Get return link again
PUSHJ SP,UWTEST ; [E127] And test for context
MOVEI DL,@LINKDL(DL) ; Follow procedure chain down
JRST HSTPR3 ; And carry on typeout
HSTPR7: MOVE A1,%DDTUW(DB) ; [E127] Get full UNWOUND count
ADDM A1,%UWTOP(DB) ; [E127] and adjust maximum.
TLNE DB,TMPFL3 ; [E127] EXPERT ?
JRST HSTPR8 ; [E127] Yes - no message
MOVEI A1,[ASCIZ/, level 0./] ; [E127] No - tell user
PUSHJ SP,DDTOUT ; [E127] what block level
HRRZ A0,PLBLKL(DL) ; [E127] we are at in
PUSHJ SP,DPRNT% ; [E127] the main program.
HSTPR8: PUSHJ SP,DDBRKB ; Force any output to terminal
POP SP,DL ; Restore DL
TLZ DL,DB ; Clear DB from index field
ADDI DL,(DB) ; And relocate R.H.
POP SP,A1 ; Get context counters
SKIPGE A1 ; [E127] Original context set ?
HRL A1,A1 ; [E127] Yes - get correct level
AOS %DDTUW(DB) ; [E127] Correct unwound count
JUMPE A1,CPOPJ ; [E127] Return if context correct
HLRZ A5,A1 ; Get correction to %DDTUW
MOVNI A5,(A5) ; From the left half of A1
ADD A5,%DDTUW(DB) ; (Where FNDADR first found context)
HRROM A5,%DDTUW(DB) ; [E127] and mark as "UNWOUND"
TLNE DB,TMPFL3 ; [E127] Typeout suppressed ?
POPJ SP, ; [E127] Yes - just return
MOVEI A1,[ASCIZ/
Context established at level/] ; [E127] No - tell the user
PUSHJ SP,DDTOUT ; What level the error was detected
MOVEI A0,-1(A5) ; [E127] (or at least what context is)
PUSHJ SP,IPRNT% ; [E127] . .
MOVSI A4,'. ' ; [E127] And assume block level
PUSHJ SP,DDOSIX ; [E127] is set to the maximum
HLRZ A1,%DDTPC(DB) ; [E127] Get context DL
ADDI A1,(DB) ; [E127] (relocated)
HRRZ A0,PLBLKL(A1) ; [E127] Get relevant block level
PJRST DPRNT% ; [E127] Exit via print routine
HSTPR9: SETZM %UWCON(DB) ; [E1001] Clear context for UNWIND
MOVEI A4,%SYS0(DB) ; [E1001] Set P.C. to %BEGIN
MOVE A4,(A4) ; [E1001]
HRRZM A4,%DDTPC(DB) ; [E1001]
PUSHJ SP,FNDADR ; [E1001] Establish context
JFCL ; [E1001] No symbol info for main pgm ...
; [E1001] ... ignore for now
TLNE DB,TMPFL3 ; [E1001] Typeout suppressed ?
POPJ SP, ; [E1001] Yes - return
; **** JRST HSPR10 ; [E1001] No - tell user where we are
HSPR10: MOVEI A1,[ASCIZ/At level 0.0/] ; [E1001]
PUSHJ SP,DDTOUT ; [E127] Print basic message
HRRZ A1,%DDTER(DB) ; [E127] Expert ?
JUMPN A1,HSPR11 ; [E1001] If not ..
MOVEI A1,[ASCIZ/ (program not yet started or execution complete)/]
; [E127] more message
PUSHJ SP,DDTOUT ; [E127]
HSPR11: PUSHJ SP,DDBRKB ; [E1001] Force output to terminal
POPJ SP, ; [E127] and return
STNPRT: PUSH SP,A4 ; Save line number
MOVEI A1,[ASCIZ/line/] ; Print line identification
PUSHJ SP,DDTOUT ; ..
HRRZ A0,(SP) ; Get line number into A0
PUSHJ SP,IPRNT% ; and go print it
POP SP,A4 ; Restore line number
TLNN A4,777777 ; Any statement number ?
POPJ SP, ; No - return
MOVEI A1,[ASCIZ/, statement/] ; Yes - say so
PUSHJ SP,DDTOUT ; ..
HLRZ A0,A4 ; Then get number
PJRST IPRNT% ; Print it, and return
PRPROC: TLNE DB,TMPFL3 ; Expert ?
POPJ SP, ; Yes - no typeout
SKIPN A1,CONDL(DL) ; Main program ?
JRST PRMAIN ; Yes
SKIPN A3,PMBPTR(DL) ; No - Traced ?
JRST PRUNTR ; No - say so
MOVEI A1,[ASCIZ/procedure /] ; say procedure
PUSHJ SP,DDTOUT ; ..
MOVEI A1,2(A3) ; Get start of text
TLO A1,(POINT 6) ; Convert to SIXBIT byte pointer
PUSH SP,FL ; Save FL (=A13)
PRPRO1: ILDB A13,A1 ; Get next character
ADDI A13,"A"-'A' ; Otherwise convert to ASCII
PUSHJ SP,DDOUCH ; Print single character
CAIE A13," " ; Terminating space ?
JRST PRPRO1 ; No - loop
POP SP,FL ; Yes - Restore FL
POPJ SP, ; and return
UWTEST: SKIPE %UWCON(DB) ; [E127] Already found maximum ?
POPJ SP, ; [E127] Yes - return
PUSH SP,%DDTBE(DB) ; [E127] No - save S.T. pointer
PUSH SP,A4 ; [E127] and PC value
SKIPG %DDTST(DB) ; [E1000] Unless no S.T.,
PUSHJ SP,FNDADR ; [E127] Convert to line number
SETZB A4,(SP) ; [E127] Failed !
POP SP,%UWCON(DB) ; [E127] Set unwind limit
POP SP,%DDTBE(DB) ; [E127] Restore S.T. pointer
JUMPE A4,UWTST1 ; [E127] Return if failed
MOVEI A4,(DL) ; [E127] Otherwise get DL
SUBI A4,(DB) ; [E127] value which corresponds
HRLM A4,%UWCON(DB) ; [E127] to this context
MOVN A4,%DDTUW(DB) ; [E127] Get current UNWIND depth
MOVEM A4,%UWTOP(DB) ; [E127] Save as maximum possible
UWTST1: POPJ SP, ; [E127] and return
PRMAIN: TROA A1,[ASCIZ/main program/]; Say this is main program
PRUNTR: MOVEI A1,[ASCIZ/an untraced procedure /]; Say procedure not traced
PJRST DDTOUT ; Exit via type routine
SUBTTL Debugging system - command routines - START,GOTO,RETRY
DDSTART: ; start program execution.
HRRZ A0,.JBSA
CAIN A0,RSTRT% ; SECOND START ?
DDTERR ^D86 ; YES - NO GO
JSP A0,CONRES ; RESTORE STACK ETC.
MOVE AX,%ACCS+AX(DB) ; [E021] RESTORE THE ONLY AC WHICH CONTAINS ANYTHING !
EDIT(021) ; AX is clobbered by the debugger - make REE work.
JRST DDBEG% ; GO ENTER PROGRAM.
DDGOTO: ;GOTO label:, or GOTO switch[#] (or GOTO line-no,statement-no)
; Note that we certainly do not allow GOTO L: IN FOO; since this is,
; by definition, illegal: a label in another external procedure has to
; be out of scope.
HLRZ A2,%DDTUW(DB) ; GET ORIGINAL CONTEXT
SKIPE A2 ; ARE WE AT TOP LEVEL
DDTERR ^D93 ; NO - WARN USER
CAIL A4,.A ; NEXT CHARACTER ALPHA ?
CAILE A4,.Z ; (IDENTIFIER, OR "GO TO")
JRST DDGOT7 ; NO
PUSHJ SP,SCAN3 ; YES - READ NEXT WORD
CAIE A4,.COLON ; LABEL IDENTIFIER ?
CAIN A4,.LBRA ; OR SWITCH ?
JRST DDGOT1 ; YES - ALL IS WELL
HLRZ A2,%DDTIB(DB) ; NO - READ FIRST TWO CHARS (+4 BITS)
CAIE A2,(ASCII "TO") ; IS IT CORRECT ?
DDTERR ^D42 ; NO
CAIL A4,.A ; IS THIS FOLLOWED BY AN IDENTIFIER ?
CAILE A4,.Z ; (LABEL OR SWITCH NAME)
JRST DDGOT7 ; NO - COULD BE LINE[,STATEMENT]
PUSHJ SP,SCAN3 ; YES - READ NAME INTO BUFFER
CAIE A4,.COLON ; TERMINATED BY COLON
CAIN A4,.LBRA ; OR OPENING BRACKET ?
JRST DDGOT1 ; YES - O.K.
DDTERR ^D42 ; NO - SYNTAX ERROR
DDGOT1: ;We get here if we have read an identifier, terminated by ":" or "["
PUSHJ SP,SEARCH ; LOOK IDENTIFIER UP IN TABLE
DDTERR ^D23 ; CANT FIND IT
TLNE A6,$TYPE ; MAKE SURE IT IS OF TYPE LABEL
TLNE A6,$TYPE-$L ; (SWITCH = LABEL PROC)
DDTERR ^D62 ; ERROR IF IT ISN'T.
CAIE A4,.COLON ; LABEL OR SWITCH WANTED ?
TLC A6,300000 ; SWITCH :- <KIND> MUST BE $PRO
TLNE A6,300000 ; LABEL :- <KIND> MUST BE $VAR
DDTERR ^D62 ; <KIND> IS INCORRECT
CAIE A4,.LBRA ; IS THIS A SWITCH ?
JRST DDGOT2 ; NO - MUST BE A LABEL !
PUSH SP,A11 ; YES - SAVE A11 (DL OF SWITCH)
PUSHJ SP,DDGTVL ; READ VALUE TO A5
POP SP,A11 ; RESTORE A11
CAIE A4,.RBRA ; CORRECT TERMINATOR ?
DDTERR ^D38 ; NO
MOVEI A2,(A5) ; YES - GET INDEX INTO A2
DDGOT2: TLNE A6,400 ; IS THIS A FORMAL LABEL
TLNN A6,300 ; (BY NAME OR VALUE) ?
JRST DDGOT3 ; NO - IT ISN'T
DPUSH DL ; YES - SAVE OUR DL
PUSH SP,FLABL% ; AND BUILD UP A FAKE FORMAL
MOVEI AX,(SP) ; (F[0],F[1] & F[2]) ON
PUSH SP,AX ; THE STACK, POINTED TO BY AX
MOVE DL,A11 ; ASSUME DL OF THE FORMAL
HRL A11,CONDL(DL) ; SET A11 TO F[2] FOR A LABEL
SUBI A11,(DB) ; (CONDL,,DELOCATED F[0] ADDRESS)
ADDI A11,(A6) ; ..
PUSH SP,A11 ; AND STACK IT.
XCT (AX) ; CALL OTS ROUTINE TO EVALUATE FORMAL
SUB SP,[3,,3] ; TIDY UP THE STACK
JRST DDGOT5 ; GO JOIN COMMON CODE
DDGOT3: ;Here for a non-formal label or switch.
CAIE A4,.COLON ; WHICH IS IT ?
JRST DDGOT4 ; SWITCH - NEED TO EVALUATE IT
HLRZ A2,%DDTPT(DB) ; LABEL - GET ADDR OF MOD ENTRY
HRRZ A2,1(A2) ; GET MODULE RELOCATION
ADDI A2,(A6) ; ADD IN RELATIVE ADDRESS
JRST DDGOT6 ; AND DISPATCH
DDGOT4: DPUSH DL ; SWITCH - SAVE CURRENT DL
MOVE DL,A11 ; ASSUME CONTEXT DL
HLRZ AX,%DDTPT(DB) ; GET ADDRESS OF MOD ENTRY
HRRZ AX,1(AX) ; GET MODULE RELOCATION
ADDI AX,(A6) ; ADD IN RELATIVE ADDRESS
PUSHJ SP,(AX) ; EVALUATE THE SWITCH
DDGOT5: RPOP DL ; AND RESTORE CORRECT DL
MOVE FL,%DDTFL(DB) ; RESET FLAGS (THUNKS DESTROY EVERYTHING)
SKIPN A2 ; WAS TARGET A SWITCH OUT OF RANGE ?
DDTERR ^D63 ; YES - INFORM THE USER
DDGOT6: MOVEM A2,%ACCS+A2(DB) ; SET VALUE IN CASE FORLAB NEEDS IT
JRST DDGO11 ; AND LET CONTINUE CODE DO THE JUMP
DDGOT7: CAIN A4,.DOT ; GO TO . ?
JRST RETRY ; YES - THIS IS A 'RETRY' IN DISGUISE
PUSH SP,[0] ; INITIALIZE LINE NUMBER
CAIL A4,.ZERO ; IS NEXT CHARACTER A
CAILE A4,.NINE ; DECIMAL DIGIT ?
DDTERR ^D22 ; NO - SYNTAX ERROR
PUSHJ SP,DDGTV1 ; YES - GET VALUE
HRRM A5,(SP) ; AND REMEMBER IT
CAIE A4,.COMMA ; STMT NUMBER TO COME ?
JRST DDGOT8 ; NO - CARRY ON
PUSHJ SP,DDIGCH ; YES - READ NEXT NON-BLANK
CAIL A4,.ZERO ; IS THE NEXT CHARACTER
CAILE A4,.NINE ; A DECIMAL DIGIT ?
DDTERR ^D22 ; NO - SYNTAX ERROR
PUSHJ SP,DDGTV1 ; YES - READ VALUE
HRLM A5,(SP) ; AND REMEMBER THIS ALSO
DDGOT8: POP SP,A0 ; RESTORE STMT #,,LINE #
CAIE A4,.SCOL ; IF NOT AT END OF LINE
DDTERR ^D22 ; THEN SYNTAX ERROR
SETZ A1, ; OTHERWISE CLEAR MODULE NAME
PUSHJ SP,FNDLIN ; AND CONVERT ADDRESS
SKIPA A1,%DDTBE(DB) ; INITIALIZE SCOPE CHECK
DDGOT9: HLRZ A1,(A1) ; GET BLKIDX ADDRESS
CAIE A3,(A1) ; GOT TO DESIRED BLOCK YET ?
JUMPN A1,DDGOT9 ; NO - TRY NEXT ONE OUT
SKIPN A1 ; DID WE FIND BLOCK ?
DDTERR ^D95 ; NO - SCOPE ERROR
HRRZ A3,(A3) ; GET OFFSET OF BLK ITEM
ADD A3,%DDTST(DB) ; AND CONVERT TO ACTUAL ADDRESS
SKIPE A1,%DDTGO(DB) ; HAVE WE GOT A GOTO BLOCK ?
JRST DDGO10 ; YES - ALL IS WELL
MOVEM A2,%DDTGO(DB) ; NO - SAVE TARGET PC
HRLM A3,%DDTGO(DB) ; AND BLK ITEM ADDRESS
MOVEI A0,3 ; SET SIZE OF BLOCK
PUSHJ SP,GETOWN ; AND ASK FOR IT
MOVSI A2,[
JSP AX,GOLAB ; INITIALIZE THE BLOCK TO
Z 0(DL) ; A CALL TO GETOWN, AND
JRST 0 ] ; A JUMP TO NOWHERE
HRRI A2,(A1) ; BY MEANS OF A BLT
BLT A2,2(A1) ; ..
HLRZ A3,%DDTGO(DB) ; THEN RESTORE A3
HRRZ A2,%DDTGO(DB) ; AND A2
HRRZM A1,%DDTGO(DB) ; AND REMEMBER ADDRESS OF BLOCK
DDGO10: HRRM A2,2(A1) ; STORE TARGET ADDRESS IN GOTO
MOVE A2,A1 ; GET NEW TARGET ADDRESS INTO A2
HRRZ A1,2(A3) ; GET PL OF BLK ITEM
SUBI A1,1 ; CORRECT IT..
HRRM A1,1(A2) ; STORE IT IN R.H.
HRRZ A1,1(A3) ; THEN GET BL
SUBI A1,1 ; CORRECT IT..
DPB A1,[POINT 12,1(A2),12] ; STORE IN BITS 1-12
EDIT(113); Trap GO TO [JSP AX,PARAM] (Normally GO TO 1)
HRRZ A1,2(A2) ; [E113] Get transfer address
MOVE A3,(A1) ; [E113] Get transfer instruction
CAME A3,[JSP AX,PARAM] ; [E113] Procedure entry point ?
JRST DDGO11 ; [E113] No - carry on
HRRZ A1,3(A1) ; [E113] Yes -get number of parameters
ADDI A1,3 ; [E113] Allow for overhead words
ADDM A1,2(A2) ; [E113] Correct transfer address
DDGO11: HRRM A2,.JBOPC ; SET UP ADDRESS FOR CONTINUE
HRRZS %DDTAL(DB) ; CLEAR CURRENT BREAKPOINT
HRRZ A2,BLKPTR(DL) ; RESET (DELOCATED) STACK
MOVEM A2,%ACCS+SP(DB) ; IN CASE OF ERRORS
JRST CONTIN ; AND LET CONTIN DO THE WORK
RETRY: ; "RETRY" COMMAND, OR "GO TO ."
SKIPL %DDTST(DB) ; HAVE WE GOT THE SYMBOL TABLE ?
DDTERR 1 ; NO - CANT FIND STATEMENT START
HRRZ A4,%DDTPC(DB) ; GET OBJECT PROGRAM ADDRESS
PUSHJ SP,FNDADR ; RESOLVE LINE NUMBER, ETC.
DDTERR ^D87 ; NOT IN ALGOL CODE
HLRZ A1,%DDTPT(DB) ; GET LINK G.S.T. ADDRESS
SKIPN A2,1(A1) ; AND HENCE MODULE RELOCATION
DDTERR ^D17 ; NO LINK G.S.T. !
HRRZ A1,%DDTPT(DB) ; GET ADDRESS OF 'STN' ENTRY
ADD A2,1(A1) ; ADD IN OFFSET WITHIN MODULE
JRST DDGO11 ; AND CONTINUE FROM THERE
SUBTTL Debugging system - teletype input.
; DDGTLN gets a line from the TTY in 1 character input mode.
; Breaks on <CR><LF> etc., <altmode> := ;
; also outputs prompt. Uses A1,A2,A10,A11.
; Result is in buffer %DDTCB(DB) (up to 132 chars long).
DDGTLN: TLZA FL,DDTMP1
DDGTLX: TLO FL,DDTMP1 ; SPECIAL "NO-PROMPT" ENTRY.
MOVSI A1,%DDTCB(DB) ; I/P BUFFER ADDRESS
HRRI A1,%DDTCB+1(DB)
SETZM -1(A1) ; ZERO-FILL
BLT A1,%DDTCB+^D26(DB)
EDIT(106); Remember buffers can move if stack shifts.
MOVE A10,[POINT 7,%DDTCB(DB)]; [E106] GET POINTER TO BUFFER
TRNE FL,DDINDF ; IN INDIRECT FILE ?
JRST DDGTIN ; YES - GET A LINE FROM THERE.
HRRI A2,DDCCML ; [E1000] SET CMD LVL
HRRM A2,%CONC(DB) ; [E1000] ^C INTERCEPT
SKPINC ; TURN OFF CONTROL-O
JFCL
TRNE FL,DDTTYH ; IF HALF-DUPLEX...
JRST DDGTLA ; DON'T MESS ABOUT WITH ECHO.
MOVNI A2,1
GETLCH A2
TLZ A2,GL.LCP ; TURN ON
SETLCH A2 ; ECHO.
DDGTLA: PUSHJ SP,DDBRKB ; [E121] FORCE OUT ALL OUTPUT
TLNN FL,DDTMP1 ; UNLESS NO-PROMPT MODE,
OUTSTR [BYTE (7)15,12,76,76,40,0] ; CR LF PROMPT SPACE
TRNE FL,DDALIP ; IF IN AUTOLIST INPUT MODE
OUTSTR [ASCIZ/ /] ; OUTPUT A TAB TOO.
MOVEI A1,-5(FL) ; GET MAX LINE LENGTH, LESS PROMPT ETC.
ANDI A1,DDTTYW ; CLEAR OTHER BITS.
MOVEI A11,(A1) ; SAVE
TLZ FL,DDTMP2 ; USED TO REMEMBER IF IN DELETE.
INCHRW A2
TLZN FL,DDTMP1 ; IN NORMAL MODE ?
CAIE A2,.QUERY ; IS IT ?
JRST DDGTL5+1 ; NO.
HRRE A2,%DDTER(DB) ; YES - GET ADDR OF LAST ERR MSG.
JUMPE A2,DDGTLN ; NONE, OR NOVICE MODE.
AOJE A2,DDGTLN
OUTSTR [ASCIZ/
/] ; MSG & EXPERT MODE.
OUTSTR -1(A2) ; TYPE LONG MSG - HE'S NOT A REAL EXPERT
JRST DDGTLN ; TRY AGAIN.
DDGTL5: INCHRW A2 ; READ A CHARACTER.
JUMPE A2,DDGTL5 ; NULL.
CAIN A2,.DEL ; CHARACTER DELETE ?
JRST DDGTL1 ; YES - GO PROCESS.
TLZE FL,DDTMP1 ; WERE WE DELETING ?
TRNE FL,DDTTYH ; & FULL-DUPLEX ?
JRST DDGTLB ; NO.
OUTCHR [.BSLSH] ; YES - FINISH OFF (TYPE \)
OUTCHR A2 ; AND NEW CHAR.
PUSH SP,A2
MOVNI A2,1
GETLCH A2
TLZ A2,GL.LCP ; TURN ON ECHO.
SETLCH A2
POP SP,A2
DDGTLB: CAIN A2,.CTRLR ; RETYPE LINE ?
JRST DDGTL0 ; GO PROCESS.
CAIN A2,.CTRLU ; LINE DELETE ?
JRST DDGTL2 ; YES - GO PROCESS.
CAIL A2,.LF
CAILE A2,.FF ; ANY SORT OF END-OF-LINE ?
JRST DDGTL4 ; NO.
JRST DDGTL6 ; NO - LINE TERMINATED.
DDGTL4: CAIN A2,.ESC ; ALTMODE ?
JRST DDGTL6 ; YES
DDGTL7: CAIE A2,.SCOL ; COMMAND TERMINATOR ?
JRST DDGTL8 ; NO
DDGTL6: IDPB A2,A10
MOVE A2,[POINT 7,%DDTCB(DB)] ; [E106] SET UP BYTE POINTER
MOVEM A2,%DDTIP(DB) ; FOR DDGTCH
HRRZI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
HRRM A0,%CONC(DB) ; [E1000] ^C INTERCEPT
POPJ SP, ; [E1000] RETURN
DDGTL8: TLZN FL,DDTMP2 ; WAS LAST CHAR A : ?
CAIE A2,.EQU ; NO. THIS ONE A = ?
JRST DDGTL9 ; NO.
JRST DDGTL6 ; YES - FINISHED
DDGTL9: CAIN A2,.CONT ; CONTINUATION ?
JRST DDGTL6 ; YES - IS A BREAK CHAR.
CAIN A2,.COLON
TLO FL,DDTMP2 ; REMEMBER : FOR := TEST.
IDPB A2,A10 ; NO - PUT IN BUFFER.
SOJG A1,DDGTL5 ; & GET NEXT, UNLESS TOO LONG.
DDGTL2: ; CONTROL-U, OR SIMULATED FOR LONG LINE.
OUTSTR [ASCIZ /^U/] ; OUTPUT ECHO.
JRST DDGTLN ; 'NOTHER LINE
DDGTL1: ; Character delete.
CAIL A1,(A11)
JRST DDGTL2 ; START OF LINE - FORCE ^U
TRNN FL,DDTTYH ; IF 1/2 DUPLEX, ALWAYS DO \, ELSE
TLON FL,DDTMP1 ; ALREADY DONE \ ?
OUTCHR [.BSLSH] ; NO - DO IT.
LDB A2,A10 ; GET DELETED BYTE
OUTCHR A2 ; OUTPUT IT
DBP A2,A10 ; DECREMENT BYTE-POINTER (A2 IS SCRATCH)
TRNE FL,DDTTYH ; IF 1/2 DUPLEX,
AOJA A1,DDGTL5 ; PROCEED.
MOVNI A2,1
GETLCH A2 ; OTHERWISE
TLO A2,GL.LCP ; TURN OFF
SETLCH A2 ; ECHO,
AOJA A1,DDGTL5 ; AND PROCEED.
DDGTL0: ; Control-R. Retype input line, and let him go on typing.
MOVEI A2,0
IDPB A2,A10 ; MAKE ASCIZ.
OUTSTR [ASCIZ/
/]
OUTSTR %DDTCB(DB)
DBP A2,A10 ; BACK UP OVER THE NULL.
JRST DDGTL5
; DDTIN% is called from READ (in the main OTS) to get a char to A13.
DDTIN%: PUSH SP,A4
PUSHJ SP,DDGTLC ; GET CHAR TO A4.
MOVEI A13,(A4)
POP SP,A4
JRST (AX) ; CALLED FROM READ.
DDGTLC: ; Gets a character to A4. Ignores comments.
; %DDTIP(DB) is pointer in input buffer.
; Converts TAB to space, terminators to ;.
PUSHJ SP,DDGCA0 ; GET A CHAR.
JRST DDGCA3 ; A TERMINATOR.
CAIN A4,.HT
MOVEI A4,.SPACE
CAIN A4,.CR ; IF CARRIAGE-RETURN,
JRST DDGTLC ; IGNORE IT.
CAIE A4,.COMNT ; COMMENT ?
POPJ SP, ; NO - DONE.
PUSHJ SP,DDGCA4 ; YES - GET NEW LINE.
JRST DDGTLC ; TRY AGAIN.
DDGCA3: CAIE A4,.EQU ; LEAVE TERM IF =,
MOVEI A4,.SCOL ; ELSE MAKE IT A ;
POPJ SP,
DDGTCA: ; Get a character to A4. No terminator. Ignores nothing.
; Does know about continuation-lines.
; Intended only to be called from quoted-string input.
PUSHJ SP,DDGCA0 ; GET CHAR - HANDLE CONTINUATION.
JRST DDGCA1 ; TERMINATOR CHAR.
POPJ SP, ; NOT - DONE.
DDGCA1: PUSH SP,A1 ; SAVE AC'S
PUSH SP,A2 ; THAT
PUSH SP,A10 ; DDGTLN
PUSH SP,A11 ; CLOBBERS.
PUSHJ SP,DDGTLX ; GET MORE INPUT - NO PROMPT.
POP SP,A11
POP SP,A10
POP SP,A2
POP SP,A1
POPJ SP,
DDGCA0: MOVE A4,%DDTFL(DB) ; GET FLAGS
TRNN A4,DDALST ; IN AUTOLIST ?
JRST DDGC.I ; NO - READ FROM INPUT DEVICE
MOVE A4,@%DDTIP(DB) ; YES - GET AUTOLIST POINTER
TLNE A4,760000 ; AT END OF A WORD ?
JRST DDGC.A ; NO - CARRY ON
MOVE A4,1(A4) ; YES - GET NEXT WORD
TLNE A4,-1 ; LINK TO NEXT WORD ?
JRST DDGC.A ; NO - JUST READ CHAR
HRLI A4,(POINT 7,0) ; YES - FORM NEW POINTER
MOVEM A4,@%DDTIP(DB) ; AND REWRITE TO MEMORY
DDGC.A: ILDB A4,@%DDTIP(DB) ; READ CHAR FROM AUTOLIST
CAIA ; AND SKIP
DDGC.I: ILDB A4,%DDTIP(DB) ; NOT AUTOLIST - GET CHAR.
CAIN A4,.CONT ; CONTINUATION ?
JRST DDGCA2 ; YES
CAIE A4,.SCOL
CAIN A4,.ESC
POPJ SP, ; TERMINATOR - NON-SKIP RETURN.
CAIN A4,.EQU ; = ?
TLNE FL,DDGTMP ; YES - PRECEDED BY : ?
SKIPA
POPJ SP, ; NO - IS TERMINATOR.
CAIN A4,.COLON
TLOA FL,DDGTMP ; REMEMBER : (FOR := CHECK)
TLZ FL,DDGTMP
CAIL A4,.LF ; VERTICAL
CAILE A4,.FF ; PAPER-MOVER ?
JRST CPOPJ1 ; NO - SKIP RETURN.
POPJ SP, ; YES.
DDGCA2: PUSHJ SP,DDGCA4 ; GET LINE (WITH PROMPT)
JRST DDGCA0 ;
DDGCA4: PUSH SP,A1
PUSH SP,A2
PUSH SP,A10
PUSH SP,A11
PUSHJ SP,DDGTLN ; CONTINUATION - GET LINE (PROMPT)
POP SP,A11
POP SP,A10
POP SP,A2
POP SP,A1
POPJ SP, ;
DDGTCH: ; Get a character. Convert lower to upper-case.
PUSHJ SP,DDGTLC
CAIL A4,.LCA
CAILE A4,.LCZ
POPJ SP,
SUBI A4,.LCA-.A ; CONVERT TO UPPER.
POPJ SP,
DDIGCH: ; Gets a character to A4. Ignores blanks.
PUSHJ SP,DDGTCH
CAIN A4,.SPACE ; TABS HAVE ALREADY BEEN MADE SPACES.
JRST DDIGCH
POPJ SP,
DDGTIN: ; Get a line from an indirect file.
; Clobbers A10, A11.
MOVEI A1,^D130 ; MAX LINE LENGTH.
PUSH SP,FL
PUSH SP,A12 ; MAY BE IN AUTOLIST I/P MODE.
MOVE A2,A10 ; INBYTE CLOBBERS A10.
DDGTI3: PUSHJ SP,INBYTE ; GET CHAR TO A13 (==FL !!)
JRST DDGTI2 ; EOF.
CAIN A13,.CR ; EOL ?
JRST DDGTI6 ; YES.
CAIL A13,.LF ; VERTICAL
CAILE A13,.FF ; PAPER-MOVER ?
JRST DDGTI5 ; NO.
JRST DDGTI3 ; YES - IGNORE.
DDGTI5: IDPB A13,A2
CAIN A13,.SCOL ; END OF COMMAND ?
JRST DDGTI7 ; YES.
SOJG A1,DDGTI3 ; NO - GET NEXT CHAR, UNLESS
DDTERR ^D83 ; TOO LONG.
DDGTI6: ; Return a semi-colon.
MOVEI A13,.SCOL
JRST DDGTI5
DDGTI7: ; End of command.
MOVE A2,[POINT 7,%DDTCB(DB)] ; [E106] SET UP BUFFER POINTER
MOVEM A2,%DDTIP(DB)
POP SP,A12
POP SP,FL
POPJ SP,
DDGTI2:; End-of-file.
MOVEI FL,DDINDF ; CLEAR
ANDCAM FL,%DDTFL(DB) ; INDIRECT FILE FLAG.
HLRZ A1,%CHAN(DB) ; GET CHAN #
PUSH SP,A3
PUSHJ SP,RELESE ; RELEASE IT.
JFCL ; IGNORE ERROR.
POP SP,A3
HRROS %CHAN(DB) ; RESET I/P TO TTY:
JRST DDGTI6
SUBTTL Debugging system - command scanner subroutines.
SCAN: ; Gets an identifier. Puts in buffer %DDTIB(DB), in ASCII.
; Also puts it, complete with upper- and lower-case, and
; "."'s (readability symbols) in buffer %DDTFB(DB); A10 is
; left pointing to end of identifier in this last buffer.
; Delimiter is left in A4.
; Enter with first non-blank character in A4.
EDIT(106); Remember buffers can move if stack shifts.
MOVE A10,[POINT 7,%DDTFB(DB)]; [E106] SET UP BYTE POINTERS
MOVE A6,[POINT 7,%DDTIB(DB)] ; [E106] TO OUTPUT BUFFERS
MOVSI A5,%DDTFB(DB) ; [E106] AND CLEAR OUT
HRRI A5,%DDTFB+1(DB) ; [E106] BOTH BUFFERS
SETZM %DDTFB(DB) ; [E106] BEFORE SCANNING
BLT A5,%DDTFB+^D26(DB) ; [E106] OVER IDENTIFIER
MOVSI A5,%DDTIB(DB) ; ..
HRRI A5,%DDTIB+1(DB) ; ..
SETZM %DDTIB(DB) ; ..
BLT A5,%DDTIB+^D13(DB) ; ..
MOVEI A5,^D64 ; MAX LENGTH.
CAIL A4,.A
CAILE A4,.Z ; UPPER-CASE ALPHABETIC ?
JRST SCANA1 ; NO
SCANA4: IDPB A4,A6 ; YES.
SOJL A5,DDER6 ; MORE THAN 64 CHARS ?
SCANA2: IDPB A4,A10 ; TO OTHER BUFFER.
SCANA6: PUSHJ SP,DDGTLC ; GET CHARACTER TO A4
CAIL A4,.A ; IS IT
CAILE A4,.Z ; UPPER-CASE ALPHA ?
JRST SCANA3 ; NO
JRST SCANA4 ; YES - PUT IN BOTH BUFFERS.
SCANA1: CAIE A4,.PRCNT ; "%" ?
JRST SCANA3 ; NO
TLO FL,DD%FLG ; YES - REMEMBER
JRST SCANA2 ; PUT IN TYPEOUT BUFFER ONLY - GET NEXT
SCANA3: CAIN A4,.DOT ; PERIOD ?
JRST SCANA7 ; YES - TYPEOUT BUFFER ONLY GETS THESE
CAIL A4,.ZERO ; IS IT
CAILE A4,.NINE ; A DIGIT ?
JRST SCANA5 ; NO
JRST SCANA4 ; YES
SCANA5: CAIL A4,.LCA ; IS IT A
CAILE A4,.LCZ ; LOWER-CASE LETTER ?
POPJ SP, ; NO - IT'S A DELIMITER !
IDPB A4,A10 ; YES - AS IT IS TO TYPEOUT BUFFER
SUBI A4,.LCA-.A ; AND IN UPPER-CASE
IDPB A4,A6 ; TO IDENTIFIER BUFFER
SOJL A5,DDER6 ; TOO LONG ?
JRST SCANA6 ; NO - GET NEXT.
SCANA7: ; dot
PUSHJ SP,DDGTCH
CAIE A4,.LBRA ; BYTE-SUBSCRIPT ?
JRST SCANA8 ; NO - READABILITY SYMBOL
MOVEI A4,.BYTES ; YES - GET .[ PSEUDO-CHAR
POPJ SP, ; EXIT
SCANA8: PUSH SP,A4 ; SAVE NEW CHAR
MOVEI A4,.DOT
IDPB A4,A10
POP SP,A4 ; RESCUE NEW CHAR.
JRST SCANA6+1 ; DEAL WITH NEXT CHAR (WE ALREADY HAVE IT)
SCAN3: ; Same as SCAN, but see if delimiter is a space.
; If so, skip spaces.
PUSHJ SP,SCAN
CAIE A4,.SPACE
POPJ SP,
PJRST DDIGCH ; GET NEXT NON-SPACE.
SCAN4: ; Used to scan first element of command line.
; Understands about subscripts etc.
; Leaves the identifier in ASCII in buffer %DDTIB(DB).
; Whole field is left in buffer %DDTFB(DB), just as typed.
; A10 points to first character in %DDTFB-buffer after the identifier.
; Also sets flags in FL to say whether subscripted etc.
; Enter with non-blank character in A4.
; Exits with non-blank character in A4.
PUSHJ SP,SCAN3 ; GET IDENTIFIER.
CAIE A4,.SLASH
CAIN A4,.EQU
POPJ SP, ; IDENTIFIER IS COMMAND.
CAIN A4,.COMMA
POPJ SP,
CAIN A4,.SCOL
POPJ SP, ; END OF COMMAND LINE
MOVE A11,A10
CAIE A4,.LBRA ; SUBSCRIPT ?
JRST SCAN4A ; NO
TLO FL,DDSUBS ; YES - REMEMBER
SCAN4E: IDPB A4,A11 ; AND SAVE THE "[" IN TYPEOUT BUFFER
PUSHJ SP,DDIGCH ; GET NON-BLANK CHAR TO A4
CAIE A4,.PLUS ; +
CAIN A4,.MINUS ; OR - ?
JRST SCAN4D ; YES - OK
CAIL A4,.ZERO ; DIGIT ?
CAILE A4,.NINE ; ?
JRST SCAN4C ; NO
SCAN4D: IDPB A4,A11 ; YES - SAVE
PUSHJ SP,DDGTCH
CAIL A4,.ZERO
CAILE A4,.NINE
SKIPA ; NOT DIGIT
JRST SCAN4D ; DIGIT - LOOP
CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; IGNORE SPACES.
CAIE A4,.COLON ; ARRAY SLICE ?
JRST SCAN4F ; NO
TLO FL,DDSLIC ; YES - REMEMBER
JRST SCAN4E
SCAN4C: CAIE A4,.AST ; * ?
DDTERR 7 ; NO - NO MORE LEGAL ONES LEFT !
TLO FL,DDSLIC ; YES - ARRAY SLICE (ARRY[*,2])
IDPB A4,A11
PUSHJ SP,DDIGCH
SCAN4F: CAIN A4,.COMMA ; COMMA (NEXT SUBSCRIPT) ?
JRST SCAN4E ; YES - LOOP.
CAIE A4,.RBRA ; NO - ] ?
DDTERR 7 ; ONLY POSSIBILITY LEFT.
IDPB A4,A11 ; IT WAS
PUSHJ SP,DDIGCH ; GET NEXT.
CAIE A4,.DOT ; BYTE-SUBSCRIPTED STRING ARRAY?
JRST SCAN4Z ; NO
IDPB A4,A11
PUSHJ SP,DDGTCH ; BETTER BE [
CAIE A4,.LBRA
DDTERR ^D8 ; WASN'T.
JRST SCAN4G
SCAN4A: CAIE A4,.BYTES ; BYTE SUBSCRIPT ?
JRST SCAN4Z ; NO - DONE.
MOVEI A4,.DOT
IDPB A4,A11
MOVEI A4,.LBRA
SCAN4G: TLOE FL,DDBYTS ; SET FLAG. ALREADY SET ?
DDTERR ^D9 ; YES - SILLY.
JRST SCAN4E ; TREAT LIKE ARRAY SUBSCRIPT.
SCAN4Z: CAIE A4,.COLON ; TEST FOR :=
POPJ SP,
PUSHJ SP,DDGTCH ; NO SPACE ALLOWED BETWEEN : AND =
CAIE A4,.EQU ; OK ?
DDTERR ^D10 ; NO
MOVEI A4,.ASIGN ; YES - SUBSTITUTE "_"
POPJ SP,
SUBTTL Debugging system - entry routine - read symbol table.
DDGTCN: ; Get a free channel - returns with chan # in A1. Uses A0,A1,A2,A3,A4.
MOVEI A1,17(DB) ; START AT THE TOP.
DDGTC1: SKIPN %IODR(A1) ; IN USE ?
JRST DDGTC4 ; NO
CAILE A1,(DB) ; YES - MORE ?
SOJA A1,DDGTC1 ; YES
MOVEI A1,0
MOVNI A4,1
CTLJOB A4, ; FIND OUT IF CONTROLLED.
JFCL
JUMPGE A4,DDGTC6 ; YES: USE CHANNEL 0 REGARDLESS.
TTCALL 3,[ASCIZ/
?ALGNFC No free channel for debugging system. Which one can I free ? /]
DDGTC2: INCHWL A4 ; GET CHAR OF ANSWER.
CAIE A4,.SPACE
CAIN A4,.HT
JRST DDGTC2 ; IGNORE SPACES & TABS.
CAIL A4,.ZERO
CAILE A4,.NINE
JRST DDGTC3
IMULI A1,^D10
ADDI A1,-.ZERO(A4)
JRST DDGTC2
DDGTC3: CAIN A4,.CR ; IF CR
INCHWL A4 ; THEN SUCK UP LF TOO
CAILE A1,^D15 ; SENSIBLE # ?
JRST DDGTC5 ; NOT VERY.
DDGTC6: PUSHJ SP,RELESE ; YES - GET IT BACK.
JFCL ; REGARDLESS.
POPJ SP,
DDGTC4: SUBI A1,(DB) ; "DELOCATE" CHANNEL #
POPJ SP,
DDGTC5: OUTSTR [ASCIZ/
Bad channel # - must be less than 16. Try again:/]
MOVEI A1,0
JRST DDGTC2
DDINIT: SETZM .JBINT ; TURN OFF CONTROL-C INTERCEPT.
PUSHJ SP,DDGTCN ; GET FREE CHANNEL.
MOVEI A2,1
MOVEM A2,%DDTST(DB) ; SAY UNSUCCESSFUL, UNTIL DONE.
; READ SWITCH.INI, IF THERE.
MOVNI A2,1 ; US.
CTLJOB A2, ; SEE IF BATCH.
JRST .+3 ; NO UUO.
SKIPL A2 ;
TLO A1,400000 ; REMEMBER.
JUMPL A1,DDINTF ; SKIP SWITCH.INI IF BATCH.
PUSH SP,%CHAN(DB) ; SAVE OLD CHANNELS.
HRLM A1,%CHAN(DB) ; SET OURS.
MOVEI A10,(A1) ;
MOVEI A2,0 ;
HRLZI A0,'DSK' ; SET DEVICE.
PUSHJ SP,INPT ; OPEN IT.
JUMPN A1,DDINTA ; FAILED.
MOVEI A1,(A10) ; RETRIEVE CHANNEL #
MOVE A2,[
SIXBIT/SWITCH/] ; FILENAME.
HRLZI A3,'INI' ; EXTENSION.
SETZB A4,A5 ; PPN.
PUSHJ SP,OPFILE ; OPEN IT.
JUMPN A0,DDINTA ; FAAIL.
DDINTB: SETZ A2,
JSP A3,DDINTD ; GETCHAR.
CAIL A13,.A ; LETTER
CAILE A13,.Z ; ?
JRST DDINTE ; NO.
LSH A2,6 ; YES.
IORI A2,-40(A13) ; YES - PUT IN, IN SIXBIT.
JRST DDINTB+1 ; AND GET NEXT.
DDINTE: CAMN A2,[
SIXBIT/ALGDDT/] ; US ?
CAIE A13,.SLASH ; YES - SWITCH ?
JRST DDINTC ; NO - IGNORE IT.
JSP A3,DDINTD ; GET 1ST CHAR OF SWITCH.
CAIN A13,"E" ; EXPERT ?
HLLOS %DDTER(DB) ; YES - REMEMBER.
JRST DDINTC ;
DDINTA: HLRZ A1,%CHAN(DB) ; GET OUR CHAN #
POP SP,%CHAN(DB) ; RESTORE ORIGINAL ONES.
PUSHJ SP,RELESE ; RELEASE IT.
JFCL ;
DDINTF: SKIPN %SFILE(DB) ; ANY SYMBOL FILE ?
DDTERR 1,^D94 ; NO - /PRODUCTION OR SOMETHING.
DDINTY: PUSH SP,A1
PUSHJ SP,DDINTX ; READ SYMBOL TABLE.
POP SP,A1
SKIPGE %DDTST(DB) ; SUCCESS ?
POPJ SP, ; YES.
JUMPL A1,CPOPJ ; BATCH - DON'T ASK.
PUSH SP,A1
OUTSTR [ASCIZ/
Is one available ?/]
DDINT1: PUSHJ SP,DDGTLN ; GET REPLY.
PUSHJ SP,DDGTCH ; GET CHARACTER.
CAIN A4,"N" ; NO ?
JRST [OUTSTR [ASCIZ/
The debugging system will not know about line-numbers or identifiers./]
POP SP,A1
POPJ SP,]
CAIN A4,"Y" ; YES ?
JRST DDINTZ ; YES - GET ITS NAME.
OUTSTR [ASCIZ/
Yes or No !/]
JRST DDINT1 ; TRY AGAIN.
DDINTZ: TTCALL 3,[ASCIZ/
Enter symbol filename: /]
PUSHJ SP,DDGTLN ; GET IT.
PUSHJ SP,DDGTCH ; GET FIRST CHAR.
MOVSI A6,'SYM' ; DEFAULT EXTENSION.
MOVSI A0,'DSK' ; DEFAULT DEVICE.
PUSHJ SP,DDGTFL ; GET FILE-NAME.
; RETURNS IT IN A5, EXT IN A6, PPN IN A7, DEVICE IN A0.
JRST DDINTZ ; NON-SKIP RETURN SAYS SYNTAX ERROR.
MOVEM A5,%SFILE+1(DB)
MOVEM A0,%SFILE(DB)
MOVEM A6,%SFILE+2(DB)
MOVEM A7,%SFILE+3(DB)
POP SP,A1
JRST DDINTY ; TRY TRY TRY AGAIN.
; SUBROUTINES FOR SWITCH.INI
DDINTC: ; Skip rest of line.
JSP A3,DDINTD ; GET CHAR.
CAIL A13,.LF ; LINE
CAILE A13,.FF ; TERMINATOR ?
JRST DDINTC ; NO.
JRST DDINTB ; YES.
DDINTD: ; GET CHAR TO A13. IGNORE BLANKS ETC. CONV L/C TO U/C.
; CALL BY JSP A3,
PUSHJ SP,INBYTE ; GET CHAR.
JRST DDINTA ; EOF.
CAIE A13,.SPACE ; [ P77]
CAIN A13,.HT ; IGNORE SPACES ETC.
JRST DDINTD ; YES.
CAIL A13,.LCA ; L/C ?
SUBI A13,.LCA-.A ; YES.
JRST (A3) ;
DDINTX: LSH A1,^D23 ; MOVE CHAN # TO ACC FIELD
MOVE A6,A1 ; SAVE
ADD A1,[
OPEN A2] ; MAKE A UUO.
MOVEI A2,16 ; DUMP MODE *****
MOVE A3,%SFILE(DB) ; DEVICE, LEFT BY COMPILER.
MOVEI A4,0
XCT A1 ; DO AN OPEN
DDTERR 1,^D11 ; NO DEVICE.
MOVE A1,A6 ; GET CHAN #
ADD A1,[
LOOKUP A2] ; MAKE ANOTHER UUO.
SKIPN A2,%SFILE+1(DB) ; FILENAME
MOVE A2,%IFDAT+1(DB) ; DEFAULT - USE LOAD-FILE NAME
SKIPN A3,%SFILE+2(DB) ; EXTENSION
MOVSI A3,'SYM' ; DEFAULT TO .SYM
MOVE A5,%SFILE+3(DB) ; PPN
SKIPN %SFILE+4(DB) ; SFD'S ?
JRST DDINT6 ; NO
SETZM %SFILE+2(DB) ; YES - CLEAR SCAN SWITCH
MOVEI A5,%SFILE+1(DB) ; PATH BLOCK ADDRESS (1ST WORD IGNORED)
DDINT6: SETZM A4
XCT A1 ; LOOKUP .SYM FILE
DDTERR 1,^D12 ; NOT THERE.
HLRE A4,A5 ; GET WORD-COUNT
SKIPL A4
DDTERR 1,^D13
MOVN A0,A4
ADDI A0,1 ; ALLOW FOR ZERO WORD ON END.
PUSHJ SP,GETOWN ; GET SOME SPACE FOR S.T.
HRL A1,A4 ; -COUNT,,ADDR
SUBI A1,1 ; MAKE IOWD
MOVEI A2,0 ; STOP WORD
MOVE A3,A6
ADD A3,[
IN A1] ; MORE UUO'S
XCT A3 ; DUMP MODE READ WHOLE THING.
SKIPA ; WORKED
DDTERR 1,^D14 ; DIDN'T
ADD A6,[
RELEASE ]
XCT A6 ; RELEASE CHANNEL.
; WE NOW HAVE SYMBOL TABLE IN CORE.
ADDI A1,1 ; MAKE IOWD INTO AOBJN WORD.
HLRZ A5,(A1) ; GET FIRST WORD.
CAIN A5,1044 ; IF IT'S S.T. TYPE,,LENGTH,
AOBJN A1,.+1 ; IGNORE IT,
CAIN A5,1044 ;
ADDI A4,1 ; AND UPDATE (-LENGTH)
MOVEM A1,%DDTST(DB) ; SAVE IT
SUBI A1,(A4) ; GET ADDRESS OF WORD AFTER S.T.
SETOM (A1) ; AND MARK IT (A4 = -LENGTH).
EDIT(066); Calculate BLKIDX correctly
SETZB A0,A1 ; [E066] SET COUNTS TO ZERO
HRRZ A2,%DDTST(DB) ; [E066] GET START OF S.T.
DDINT7: SKIPN A3,(A2) ; [E066] GUARD AGAINST ZERO WORDS
AOS A3,(A2) ; [E066] WHICH NOW HAVE LENGTH ONE !
ADDI A2,(A3) ; [E066] STEP ON TO NEXT ADDRESS
ADDI A4,(A3) ; [E066] AND ACCOUNT FOR LENGTH
HLRZ A3,A3 ; [E066] NOW GET ITEM TYPE
CAIN A3,'BLK' ; [E066] BLOCK HEADER ?
SUBI A1,1 ; [E066] YES - COUNT ONE MORE
SUBI A0,1 ; [E066] COUNT ONE MORE ITEM
JUMPL A4,DDINT7 ; [E066] REPEAT FOR ALL ITEMS
HRLM A0,%DDTST(DB) ; [E066] THEN UPDATE ITEM COUNT
HRLZM A1,%DDTBI(DB) ; [E066] SAVE SIZE OF BLKIDX
MOVN A0,A1 ; [E066] GET +SIZE OF BLKIDX
PUSHJ SP,GETOWN ; [E066] AND ASK FOR THE SPACE
ADDB A1,%DDTBI(DB) ; [E066] FORM AOBJN POINTER TO BLKIDX
MOVE A2,%DDTST(DB) ; [E066] AND GET POINTER OVER SYMBOL TABLE
TDZA A3,A3 ; [E066] SET DEPTH COUNT TO ZERO
DDINT8: AOBJP A2,STBERR ; [E066] CHECK NOT OFF END !
PUSH SP,[EXP 0] ; [E066] INITIALIZE BACK-LINK TO ZERO
DDINT9: MOVEI A4,(A2) ; [E066] GET CURRENT ADDRESS
MOVE A5,(A2) ; [E066] PICK OUT AN ITEM
ADDI A2,-1(A5) ; [E066] AND STEP OVER IT
HLRZ A5,A5 ; [E066] GET CODE INTO R.H.
CAIN A5,'BKS' ; [E066] BLOCK START ?
AOJA A3,DDINT8 ; [E066] YES - PROCESS INNER BLOCK
CAIE A5,'BLK' ; [E066] BLOCK HEADER ?
JRST DDNT12 ; [E066] NO - TRY NEXT ITEM
SOJL A3,STBERR ; [E066] DO WE EXPECT ONE ?
POP SP,A5 ; [E066] YES - GET BACK LINK
DDNT10: SKIPN A6,A5 ; [E066] IS LINK ZERO ?
JRST DDNT11 ; [E066] YES - ALL LINKED
HLRZ A5,(A6) ; [E066] NO - GET NEXT ADDRESS
HRLM A1,(A6) ; [E066] POINT IT TO HERE
JRST DDNT10 ; [E066] AND TRY AGAIN
DDNT11: HRL A4,(SP) ; [E066] PICK UP BACK LINK
MOVEM A4,(A1) ; [E066] STORE LINK,,ADDRESS
SKIPE A3 ; [E066] IF NOT AT LEVEL 0
HRRZM A1,(SP) ; [E066] SET NEW BACK LINK
AOBJP A1,DDNT13 ; [E066] AND STEP BLKIDX POINTER
DDNT12: AOBJN A2,DDINT9 ; [E066] READ NEXT ENTRY FROM S.T.
STBERR: HRRZS %DDTST(DB) ; [E066] SYMBOL TABLE FOULED UP
DDTERR 1,^D16 ; [E066] MARK AS UNREAD, TELL USER
DDNT13: JUMPN A3,STBERR ; [E066] CHECK DEPTH IS NOW 0
POP SP,A0 ; [E066] O.K. - TIDY UP STACK
HRRZ A0,%DDTST(DB) ; [E066] GET BASE ADDRESS OF S.T.
MOVN A0,A0 ; [E066] AND GET THE NEGATIVE
MOVE A1,%DDTBI(DB) ; [E066] GET AOBJN POINTER
ADDM A0,(A1) ; [E066] CONVERT ADDRESS TO OFFSET
AOBJN A1,.-1 ; [E066] LOOP FOR EACH ENTRY
;
; Here, BLKIDX is completed. Its format is:
; 1 word for each block of the program in the same order as the blocks in the S.T.
; L.H. pointer-to-BLKIDX-entry-for-containing-block
; R.H. offset-in-s.t.-of-this-block's-block-header.
; The outermost block (which had better be the last entry!) has LH = 0.
;
; Now link the 'MRK' sentinel records through the L.H. of the second word.
; The links are as follows :-
; Type 0 'exit' not used
; Type 1 'for' points to matching 'do'
; Type 2 'do' " " " " " 'od'
; Type 3 'od' " " " " " 'for'
; Type 4 'if' " " " " " 'then'
; Type 5 'then' " " " " " 'else' or 'fi'
; Type 6 'else' " " " " " 'fi'
; Type 7 'fi' not used
; Type 8 'go' points to matching 'to'
; Type 9 'to' contains relative PC of transfer instruction
HRRZ A3,%DDTST(DB) ; Get start address of S.T.
DDNT14: PUSHJ SP,GETMRK ; Get next sentinel record
JRST [CAIN A2,'MOD' ; No more. End of module, or S.T. ?
JRST DDNT14 ; Another module - process it
POPJ SP,] ; End of S.T. - all done
PUSHJ SP,DDNT15 ; Go process one construct
JRST MRKERR ; Bad match - give up
JRST DDNT14 ; and repeat until S.T. exhausted
DDNT15: HRLM A3,(SP) ; Save current address on stack
CAIG A2,^D9 ; Is item type within range ?
XCT DDNT16(A2) ; Yes - dispatch on item type
POPJ SP, ; No - error
DDNT16: PHASE 0 ; To define symbols M.XXXX
M.EXIT: JRST CPOPJ1 ; Type 0 ('exit') - return
M.FOR: JRST DDNT17 ; Type 1 ('for')
M.DO: POPJ SP, ; Type 2 ('do')
M.OD: POPJ SP, ; Type 3 ('od')
M.IF: JRST DDNT21 ; Type 4 ('if')
M.THEN: POPJ SP, ; Type 5 ('then')
M.ELSE: POPJ SP, ; Type 6 ('else')
M.FI: POPJ SP, ; Type 7 ('fi')
M.GO: JRST DDNT25 ; Type 8 ('go')
M.TO: POPJ SP, ; Type 9 ('to')
DEPHASE
SCANST: ADD A3,(A3) ; Add length (step to next entry)
MOVEI A3,(A3) ; Clear L.H. to avoid overflow
HLRZ A2,(A3) ; Get record type
CAIE A2,'MOD' ; If this is next module,
CAIN A2,777777 ; or end of S.T.
POPJ SP, ; Take non-skip return
JRST CPOPJ1 ; otherwise skip
GETMRK: PUSHJ SP,SCANST ; Get next entry from S.T.
POPJ SP, ; No more in this module
CAIE A2,'MRK' ; Is this a sentinel record ?
JRST GETMRK ; No - try next entry
HRRZ A2,1(A3) ; Yes - get sub-type
JRST CPOPJ1 ; And take skip return
MRKERR: HRRZS %DDTST(DB) ; Mark symbol table as unuseable
DDTERR 1,^D97 ; And give error message
DDNT17: ; 'for' statement linkage
PUSHJ SP,DDNT18 ; Perform forward linkage
POPJ SP, ; Can't - error
HLRZ A2,(SP) ; Then get address of 'for' entry
HRLM A2,1(A3) ; and point 'od' item to it
JRST CPOPJ1 ; Take skip return
DDNT18: HRLM A3,(SP) ; Store address for LNKMRK
JSP A1,CHKMRK ; Find next sentinel record
JFCL M.DO ; And check that is a 'do'
DDNT19: PUSHJ SP,GETMRK ; Get next sentinel record
POPJ SP, ; Error (end of module)
CAIN A2,M.OD ; Is this the terminator ?
JRST DDNT20 ; Yes - link it, and exit
PUSHJ SP,DDNT15 ; No - process substatement
POPJ SP, ; Failed
JRST DDNT19 ; And try again
DDNT20: ; Found desired terminator
JSP A1,LNKMRK ; Perform forward linkage
JRST CPOPJ1 ; And return
DDNT21: ; 'if' statement linkage
JSP A1,CHKMRK ; Find next sentinel record,
JFCL M.THEN ; and check that it is a 'then'
DDNT22: PUSHJ SP,GETMRK ; Get next sentinel record
POPJ SP, ; Error (end of module)
CAIN A2,M.FI ; Is this the end ?
JRST DDNT20 ; Yes - link it, and return
CAIN A2,M.ELSE ; No - if .. then .. else ?
JRST DDNT23 ; Yes
PUSHJ SP,DDNT15 ; No - process substatement
POPJ SP, ; Error
JRST DDNT22 ; And try again
DDNT23: JSP A1,LNKMRK ; 'else' - link from 'then'
DDNT24: PUSHJ SP,GETMRK ; Get next sentinel record
POPJ SP, ; Error (end of module)
CAIN A2,M.FI ; Is this the terminator ?
JRST DDNT20 ; Yes - link it, and return
PUSHJ SP,DDNT15 ; No - process substatement
POPJ SP, ; Error
JRST DDNT24 ; And try again
DDNT25: ; 'goto' statement linkage
JSP A1,CHKMRK ; Find next sentinel record,
JFCL M.TO ; And check that it is a 'to'
JRST CPOPJ1 ; Then return
CHKMRK: PUSHJ SP,GETMRK ; Get next sentinel record
POPJ SP, ; Error (end of module)
CAIE A2,@(A1) ; Is it the correct type ?
POPJ SP, ; No - error
LNKMRK: HLRZ A2,(SP) ; Yes - get previous address
HRLM A3,1(A2) ; Store forward link
HRLM A3,(SP) ; Update previous address
JRST (A1) ; And return
SUBTTL Debugging system - find address routine.
; Given a PC value (in A4) this routine finds it in the S.T.
; Returns with the line #(right half) and statement-with-line #(left half)
; in A4. It also sets up %DDTBE(DB) to the address of the context-block's
; entry in BLKIDX (which in turn points to the block's block header in the
; S.T. and to the containing block), and %DDTBT to xwd address of the LINK
; S.T.E., address of STN item, if not already set.
; Also returns Radix-50 module-name in A5. Skips if O.K.
; Uses AC's A0-A6.
; ASSUMPTION : that LINK s.t. is in descending order of addresses
; (at least for type-0 items, i.e. titles.)
FNDADR: PUSH SP,A4
SKIPN %DDTST(DB) ; S.T. IN CORE?
PUSHJ SP,DDINIT ; NO - GET IT THERE.
POP SP,A4
SKIPL %DDTST(DB) ; SUCESSFULL ?
DDTERR 1,1 ; NO.
FNDAD0: SKIPN A6,.JBSYM ; GET POINTER TO LINK S.T.
JRST [
MOVEI A1,1 ; NOT THERE -
MOVEM A1,%DDTST(DB) ; THIS IS FAIRLY FATAL, SO
DDTERR 1,^D17 ] ; TURN OFF DEBUGGER.
FNDAD3: MOVE A5,(A6) ; GET LINK S.T. ITEM
TLNN A5,740000 ; TYPE = 0 ?
JRST FNDAD1 ; YES.
FNDAD2: AOBJN A6,.+1 ; ADVANCE TO NEXT ITEM OF LINK S.T.
AOBJN A6,FNDAD3
POPJ SP, ; [E1000] NONE - CAN'T RESOLVE ADDR.
FNDAD1: HRRZ A2,1(A6) ; TYPE 0 - GET ADDR.
CAIGE A4,(A2) ; FOUND ?
JRST FNDAD2 ; NO.
; Here, A5 is module-name, in right-justified RADIX50.
; A6 is pointer to item in LINK symbol-table.
MOVE A7,A5 ; Get module name into A7
PUSHJ SP,FNDMOD ; Get address of Link S.T. entry
POPJ SP, ; ? Don't be silly !
MOVEI A10,(A10) ; Clear possible junk from L.H.
CAIE A10,(A6) ; Is this the same entry ?
POPJ SP, ; No - return
; The above test can only fail if there are two link S.T. entries with the
; same 'name'. This is most likely to occur when the name of the users Algol
; main program is the same as the name of a library routine.
SUBI A4,(A2) ; DELOCATE REQUIRED ADDR.
SKIPL A3,%DDTST(DB) ; GET POINTER TO OUR S.T.
DDTERR 1,1 ; NONE.
MOVEI A0,0 ; INITIALIZE BLOCK COUNTER.
FNDAD9: HLRZ A2,(A3) ; GET TYPE CODE FROM OUR S.T.
CAIN A2,'BLK' ; BLOCK HEADER ?
AOJA A0,FNDAD4 ; YES - COUNT IT.
CAIN A2,'MOD' ; NO - MODULE HEADER ?
CAME A5,2(A3) ; YES - RIGHT ONE ?
JRST FNDAD4 ; NO.
; here, we've found module. Scan for STN with appropriate addr.
PUSH SP,A5 ; SAVE MODULE NAME
SETZB A1,A5 ; INIT 'PREVIOUS' POINTER.
; **NOTE THAT THIS WORKS, BECAUSE 1(A1) = A1 I.E. 0
; D O N O T CHANGE AC USAGE TO OTHER THAN A1 !!
FNDAD5: MOVE A2,(A3) ; ADVANCE TO NEXT ITEM IN OUR S.T.
ADDI A3,-1(A2) ; ACCOUNT FOR LENGTH
AOBJP A3,FNDAD6 ; EXIT IF AT END
HLRZ A2,(A3) ; GET TYPE CODE.
CAIN A2,'MOD' ; NEXT MODULE ?
JRST FNDAD6 ; YES - NO FIND.
CAIN A2,'BKS' ; BLOCK START ?
AOJA A5,FNDAD5 ; YES - COUNT IT
CAIN A2,'BLK' ; BLOCK HEADER ?
AOJA A0,[SOJA A5,FNDAD5] ; YES - COUNT IT.
CAIE A2,'STN' ; STATEMENT # ?
JRST FNDAD5 ; NO - SKIP.
CAML A4,1(A1) ; REQUIRED ADDR BETWEEN 'PREVIOUS'
CAML A4,1(A3) ; AND 'THIS' ?
JRST FNDAD8 ; NO.
; Found.
; Now look for appropriate block-end (BLK) item,
; to establish context.
FNDAD6: JUMPE A1,.+3 ; IF BEFORE FIRST STN, USE THAT.
MOVE A3,A1 ; RESTORE S.T. POINTER TO CONTEXT'S
HLRZ A0,A0 ; RESTORE BLOCK-COUNT.
MOVE A4,2(A3) ; GET LINE # WORD.
SKIPE %DDTBE(DB) ; ANY CONTEXT YET ?
JRST [POP SP,A5
JRST CPOPJ1] ; YES - DON'T SET AGAIN.
HRLM A6,%DDTPT(DB) ; SAVE ADDR OF LINK S.T.E., AND
HRRM A3,%DDTPT(DB) ; SAVE ADDR OF STN ITEM.
MOVE A6,A5 ; GET BLOCK COUNT TO A6
POP SP,A5 ; AND RESTORE MODULE NAME TO A5
TDZN A1,A1 ; IF WE HAVE SET UP CONTEXT
SOSL A1,A6 ; TO OR BEFORE A STN ITEM
AOJA A1,FNDAD7 ; THEN CARRY ON
POPJ SP, ; BAD LUCK - GIVE UP
FNDAD7: SKIPN A6,(A3) ; GUARD AGAINST
MOVEI A6,1 ; ZERO WORDS.
HRLI A6,1
ADD A3,A6 ; ADVANCE TO NEXT ITEM.
JUMPGE A3,DDER16 ; HORRORS - OFF THE END.
;This means that compiler output fewer BLK's than BKS's.
HLRZ A6,(A3) ; GET ITEM TYPE.
CAIN A6,'BKS' ; BLOCK START ?
AOJA A1,FNDAD7 ; YES - COUNT IT.
CAIE A6,'BLK' ; BLOCK END ?
JRST FNDAD7 ; NO
ADDI A0,1 ; YES - COUNT IT.
SOJG A1,FNDAD7 ; SEE IF RIGHT LEVEL
ADD A0,%DDTBI(DB) ; GET ADDR OF BLKIDX ENTRY.
SUBI A0,1 ; ADJUST.
MOVEM A0,%DDTBE(DB) ; AND SAVE.
JRST CPOPJ1 ; AND EXIT.
FNDAD8: MOVE A1,A3 ; SAVE THIS AS PREVIOUS
HRL A0,A0 ; & SAVE BLOCK-COUNT
JRST FNDAD5 ; AND TRY NEXT.
FNDAD4: ; advance to next item in our S.T.
MOVE A2,(A3) ; GET ITEM LENGTH
ADDI A3,-1(A2) ; ACCOUNT FOR IT
AOBJN A3,FNDAD9 ; AND REPEAT IF MORE LEFT
POPJ SP, ; MODULE NOT FOUND IN OUR S.T.
; This means that the address was either in a non-ALGOL procedure,
; or in an ALGOL procedure compiled with the /P switch.
DDER16: DDTERR 1,^D16 ; SEE NOTE ABOVE.
SUBTTL Debugging system - find line # routine.
FNDLIN: ; Converts a line-# (and statement-#-within-line) and module-name
; into an address.
; Enter with stmnt-#,,line-# in A0, module-name (in right-just RADIX50) in
; A1 (zero means this module).
; Exits with address in A2, pointer to BLKIDX entry in A3.
; Also sets up A5 to point to STN item in S.T.
; Also right-justified RAD50 module-name in A1 (always).
JUMPE A0,DDER20 ; MUST HAVE A LINE NUMBER
MOVSS A0 ; MAKE LINE#,,STMNT#
MOVEI A5,0 ; INIT BLOCK COUNT.
JUMPN A1,FNDLN1 ; THIS MODULE ?
HLRZ A1,%DDTPT(DB) ; YES - GET ITS NAME
JUMPE A1,FNDLN1 ; IF ZERO, LEAVE IT.
MOVE A1,0(A1) ; FROM CURRENT LOADER S.T. ENTRY.
FNDLN1: SKIPL A3,%DDTST(DB) ; POINTER TO OUR SYMBOL-TABLE.
DDTERR 1 ; NOT THERE.
FNDLN2: HLRZ A2,(A3)
CAIN A2,'MOD' ; MODULE HEADER ?
JRST FNDLN4 ; YES
CAIN A2,'BLK' ; BLOCK HEADER ?
ADDI A5,1 ; COUNT IT.
FNDLN3: HRRZ A2,(A3) ; ADVANCE TO
HRLI A2,1 ; NEXT
ADD A3,A2 ; ENTRY
JUMPL A3,FNDLN2 ; IF ANY.
DDTERR ^D19 ; MODULE NOT FOUND.
FNDLN4: SKIPN A1 ; If no current module, use main
; program. (Which by LOADER-law is the first module.)
MOVE A1,2(A3)
CAME A1,2(A3) ; RIGHT MODULE ?
JRST FNDLN3 ; NO
; Module found - now find line-#
FNDLN5: HRRZ A2,(A3) ; GET SIZE OF ITEM
ADDI A3,-1(A2) ; STEP OVER IT
AOBJP A3,DDER20 ; LINE-# NOT FOUND.
HLRZ A2,(A3) ; GET TYPE CODE
CAIN A2,'BLK' ; END OF BLOCK ?
AOJA A5,FNDLN5 ; YES - COUNT IT
CAIE A2,'MOD' ; NEXT MODULE ?
CAIN A2,777777 ; OR END OF TABLE ?
DDTERR ^D20 ; YES - HE LOSES
CAIE A2,'STN' ; STATEMENT ITEM ?
JRST FNDLN5 ; NO.
MOVS A2,2(A3) ; YES - GET ITS LINE#,,STMNT#
CAMGE A2,A0 ; SPOT-ON, OR GOOD GUESS ?
JRST FNDLN5 ; NO.
; FOUND - NOW FIND CORRESPONDING BLOCK ITEM
PUSH SP,A3 ; SAVE ADDRESS OF STN ITEM
PUSH SP,A7 ; GET A WORK REGISTER
SETZ A7, ; AND CLEAR IT
FNDLN6: HRRZ A2,(A3) ; GET SIZE OF ITEM
ADDI A3,-1(A2) ; STEP OVER IT
AOBJP A3,DDER20 ; ERROR IF OFF END
HLRZ A2,(A3) ; GET TYPE CODE
CAIN A2,'BKS' ; BLOCK START ?
AOJA A7,FNDLN6 ; YES - COUNT IT
CAIE A2,'MOD' ; IF NEXT MODULE,
CAIN A2,777777 ; OR END FLAG
DDTERR ^D16 ; SOMETHING IS WRONG
CAIE A2,'BLK' ; BLOCK HEADER ?
JRST FNDLN6 ; NO - TRY NEXT ITEM
ADDI A5,1 ; YES - STEP BLKIDX
SOJG A7,FNDLN6 ; CONTINUE IF INNER BLOCKS FOUND
; now we have to find this module in LOADER S.T.
PUSH SP,A10
MOVE A7,A1 ; GET RADIX50 NAME.
PUSHJ SP,FNDMOD ; GET POINTER TO A10
DDTERR ^D21 ; NOT FOUND - SYSTEM ERROR.
MOVE A2,A10 ; FOUND - GET POINTER.
POP SP,A10
POP SP,A7
HRRZ A2,1(A2) ; GET MODULE'S RELOCATION.
HRRZ A3,(SP) ; GET STN ADDRESS AGAIN
ADD A2,1(A3) ; RELATIVE PC OF LINE.
HRRZ A3,%DDTBI(DB) ; GET BLKIDX ADDRESS
ADDI A3,(A5) ; OF CORRECT ENTRY
POP SP,A5 ; RESTORE STN ADDRESS
POPJ SP,
SUBTTL Debugging system - search symbol table.
; SEARCH looks up an identifier in the symbol table, having
; regard to scope rules.
; A symbol table symbol entry looks like:
; XWD Code,length-in-words ; Code is SIXBIT/SYM/
; XWD Lexeme,Value
; ASCII /name/
;
; On entry:
; Identifier is in buffer %DDTIB(DB);
; %DDTBE(DB) is pointer to current block's BLKIDX entry.
; Sets A11 to be DL of identifier's context.
; Also A7 to point to containing block's BLKIDX entry.
SEARCH: TLNE FL,DD%FLG ; %IDENT (PSEUDO-VARIABLE) ?
JRST SERCH% ; YES - SPECIAL CASE
SKIPL %DDTST(DB) ; NO - MUST HAVE SYMBOL TABLE
DDTERR 1 ; NOT THERE - ERROR
SKIPA A7,%DDTBE(DB) ; O.K. - GET BLOCK INDEX POINTER
SERCH1: HLRZ A7,(A7) ; GET CONTAINING BLOCK POINTER
JUMPE A7,SERCH4 ; NO OUTER BLOCK - ERROR
HRRZ A1,%DDTST(DB) ; GET BASE ADDRESS OF SYMBOL TABLE
ADD A1,(A7) ; FORM ADDRESS OF ACTUAL BLK ITEM
SERCH2: MOVEI A5,%DDTIB(DB) ; GET ADDRESS OF IDENTIFIER BUFFER
SKIPN A3,(A5) ; AND FIRST WORD OF IDENTIFIER
DDTERR ^D22 ; COMPLAIN IF BLANK
; Note that we fall in to this code directly from SERCH1 and SERCH2,
; but this can not cause any items to be missed, as the item pointed
; to by A1 will either be a BLK item (arrived via SERCH1), or a STN
; item with a partial match (arrived via SERCH2).
SERCH3: MOVEI A1,(A1) ; CLEAR LEFT HALF TO AVOID OVERFLOW
ADD A1,(A1) ; AND STEP ON TO NEXT ITEM
HLRZ A2,(A1) ; GET TYPE CODE OF NEXT ITEM
CAIN A2,'BLK' ; BLOCK HEADER OF NEXT BLOCK ?
JRST SERCH1 ; YES - MOVE TO CONTAINING BLOCK
CAIE A2,'MOD' ; MODULE HEADER OF NEXT MODULE
CAIN A2,777777 ; OR END-OF-SYMBOL-TABLE MARKER ?
SERCH4: POPJ SP, ; YES - SYMBOL CAN NOT BE FOUND
CAIN A2,'SYM' ; IS THIS A SYMBOL ITEM ?
CAME A3,2(A1) ; IF SO, IS FIRST WORD RIGHT ?
JRST SERCH3 ; NO TO EITHER - TRY NEXT ITEM
SETCM A2,(A1) ; SET LEFT HALF OF A2 TO MINUS
MOVSI A2,3(A2) ; THE NUMBER OF WORDS IN SYMBOL
HRRI A2,2(A1) ; (A2 IS AOBJN POINTER TO SYMBOL)
SERCH5: AOBJP A2,SERCH6 ; JUMP IF NO MORE SYMBOL TO CHECK
SKIPE A3,1(A5) ; GET NEXT WORD OF TYPED IN IDENTIFIER
CAME A3,(A2) ; AND CHECK IT AGAINST SYM ENTRY
JRST SERCH2 ; DIFFERENT - TRY NEXT ITEM IN S.T.
AOJA A5,SERCH5 ; STILL MATCHES - CHECK REST OF NAME
SERCH6: SKIPE 1(A5) ; REACHED END OF TYPED IDENTIFIER ?
JRST SERCH2 ; NO - NOT REALLY A MATCH
; A match has been found. A1 points to SYM item in S.T.,
; A7 points to BLKIDX entry for the block containing it.
PUSHJ SP,DDGTDL ; SET CONTEXT DL INTO A11
MOVE A6,1(A1) ; AND GET "LEXEME".
TLNN FL,DDSUBS ; DID HE TYPE A SUBSCRIPT ?
JRST SERCH7 ; NO
TLNE A6,$KIND ; YES - IS THIS AN ARRAY
TLNE A6,$KIND-$ARR ; IDENTIFIER ?
DDTERR ^D24 ; NO - SUBSCRIPT IS ILLEGAL
SERCH7: TLNE FL,DDBYTS ; BYTE SUBSCRIPT TYPED ?
TLNN A6,$TYPE-$S ; YES - MUST BE STRING VARIABLE
AOSA (SP) ; ALL O.K. - SKIP RETURN
DDTERR ^D25 ; BAD SYNTAX - COMPLAIN.
POPJ SP, ; RETURN
SERCH%: TLNE FL,DDSUBS!DDBYTS ; IS A PSEUDO. SUBSCRIPTED ?
DDTERR ^D26 ; COMPLAIN IF SO.
MOVSI A1,-DD%TBL
MOVEI A2,%DDTIB(DB) ; GET ADDRESS OF TEXT BUFFER
SKIPN A2,(A2) ; GET 1ST WORD OF IDENT.
DDTERR ^D22 ; ERROR IF BLANK
SERCH8: CAMN A2,DD%TAB(A1) ; COMPARE
JRST SERCH9 ; FOUND
AOBJN A1,SERCH8 ; TRY NEXT
DDTERR ^D23 ; NO FIND.
SERCH9: MOVE A6,DD%LEX(A1) ; GET FAKE LEXEME,,VALUE
AOS (SP) ; SET UP SKIP
POPJ SP, ; AND RETURN
DDGTDL: ; Enter with pointer to BLKIDX entry in A7. Returns
; context DL in A11.
PUSH SP,A1
MOVE A11,(A7) ; GET ADDRESS OF BLKHDR
ADD A11,%DDTST(DB) ; ADD START OF S.T.
HRRZ A11,2(A11) ; GET PROCEDURE LEVEL.
HLRZ A1,%DDTPC(DB) ; GET APPROPRIATE DISPLAY
ADDI A1,(DB) ; (RELOCATE)
;
; See note at ERRM3B above for logic of this.
;
ADDI A11,-1(A1) ; GET APPROPRIATE CONTEXT DL FROM DISPLAY
MOVEI A11,@(A11) ; AND RELOCATE IT.
POP SP,A1
POPJ SP,
; Define the table of pseudo-identifiers, such as %DB, %PLBLKL etc.
; Each one has a V macro call in the definition of macro DDT%.
; Format: V Name,Value,Type
; where: Name is (up to 5 ASCII chars) its name (without %)
; Value is its address - can have index reg and @.
; Type is its (fake) type, $B to get typed in octal,
; $I to get typed in decimal
;
DEFINE DDT% <
;V NAME,VALUE,TYPE
V SP,SP,$B
V DB,DB,$B
V DL,DL,$B
V AX,AX,$B
V FL,FL,$B
V CONDL,CONDL(DL),$B
V PRGLNK,PRGLNK(DL),$B
V PMBPTR,PMBPTR(DL),$B
V BLKPTR,BLKPTR(DL),$B
V CHAN,%CHAN(DB),$B
V TTYCH,%TTYCH(DB),$B
V RAND,%RAND(DB),$B
V PLBLKL,PLBLKL(DL),$I
V VERSHN,%SYS23(DB),$B
V SHIFTS,%SYS20(DB),$I
V DYNLVL,%TRLV(DB),$I
V TRPTR,%TRPTR(DB),$B
V TRLNTH,%TRLNTH(DB),$I
V HEPWDS,%SYS24(DB),$I
V DDTST,%DDTST(DB),$B
V DDTBK,%DDTBK(DB),$B
V DDTAL,%DDTAL(DB),$B
V DDTBI,%DDTBI(DB),$B
V DDTTY,%DDTTY(DB),$B
V DDTPT,%DDTPT(DB),$B
V DDTIP,%DDTIP(DB),$B
V DDTER,%DDTER(DB),$B
V DDTFL,%DDTFL(DB),$B
V DDTPC,%DDTPC(DB),$B
V DDTUW,%DDTUW(DB),$B
V HEPBAS,%SYS2(DB),$B
V TRCVEC,%SYS22(DB),$B
; ETC.
>
DEFINE V(A,B,C) <
<ASCII/A/>
>
DD%TAB: DDT%
DD%TBL==.-DD%TAB ; # OF ENTRIES.
DEFINE V(A,B,C) <
<<C_^D18>+B>
>
DD%LEX: DDT%
PURGE DDT%,V
SUBTTL Debugging system - fetch or store a variable.
; Value in or out is in A0 (and perhaps A1), except for tricky cases
; (i.e. whole or sliced arrays, and unsubscripted strings), when the
; address of the header (of string or array) is left in A2.
; Skip returns, except for address-in-A2 cases.
; May clobber all AC's (because of thunks), except FL (preserved).
;
; On entry: Context DL is in A11. Lexeme,,value is in A6.
; Understands formals by name and value, etc.
DDGET: TLOA FL,DDTMP2 ; FLAG GET
DDPUT: TLZ FL,DDTMP2
MOVEM FL,%DDTFL(DB) ; SAVE FL OVER THUNKS.
TLNE FL,DD%FLG ; PSEUDO ? (%DB ETC)
JRST DDGT12 ; YES
HRRZ A2,A6 ; GET VALUE
JUMPE A2,DDER27 ; UNREFERENCED - CAN'T DO.
TLNN A6,$DEC ; DECLARED ?
DDTERR ^D28 ; NO - VERY SILLY.
TLNN A6,$TYPE-$L ; LABEL ?
DDTERR ^D29 ; CAN'T DO THOSE.
TLNE A6,200000 ; OR
TLNN A6,100000 ; PROCEDURES
JRST .+2
DDTERR ^D30
TLNE A6,200000 ; ARRAY ?
JRST DDGT5 ; YES.
TLNN A6,$TYPE-$S ; STRING ?
JRST DDGT5 ; YES
TLNE A6,200 ; OWN ? (200)
TLNE A6,500 ; ?
JRST DDGT1 ; NO
HLRZ A3,%DDTPT(DB) ; GET RELOCATION
HRRZ A3,1(A3) ; FROM LOADER S.T. ENTRY
ADDI A3,(A6) ; AND RELOCATE VALUE.
HRRZ A2,(A3) ; GET VARIABLE'S ADDR FROM AN INSTRUCTION.
EDIT(067); Allow for displaced instructions
HLRZ A4,(A3) ; [E067] GET OPCODE
CAIN A4,(BREAK) ; [E067] IS IT A BREAKPOINT UUO ?
HRRZ A2,BP.INS(A2) ; [E067] YES - GET REAL INSTRUCTION
DDGT3: ; Here, address of variable is in A2.
MOVEI A2,@A2 ; STATISCISE IT.
TLNE FL,DDTMP2 ; GET OR PUT ?
SKIPA A3,(A2) ; GET
MOVEM A0,(A2) ; PUT
TLNN A6,20000 ; 1-WORD ?
JRST DDGT2 ; YES - DONE
TLNE FL,DDTMP2
SKIPA A1,1(A2)
MOVEM A1,1(A2)
DDGT2: TLNE FL,DDTMP2 ; IF GET
MOVE A0,A3 ; RETRIEVE FIRST WORD
JRST CPOPJ1
DDGT12: ; It's a pseudo-variable, e.g. %DB
MOVE A0,@A6 ; MUST BE GET !
TLNN A6,20000 ; 1-WORD ?
JRST CPOPJ1 ; YES - DONE.
MOVE A1,A6
ADDI A1,1
MOVE A1,@A1 ; GET SECOND WORD.
; Fall into CPOPJ1
CPOPJ1: AOS (SP) ; SKIP RETURN (GENERALLY AVAILABLE)
CPOPJ: POPJ SP,
DDGT1: ; Not OWN. Local, or formal-by-name or by-value.
TLO A2,A11 ; PREPARE TO INDEX BY CONTEXT DL
TLNE A6,100 ; FORMAL-BY-NAME ? (500)
TLNN A6,400 ; (TEST WORKS BECAUSE 700 CAN'T HAPPEN)
JRST DDGT3 ; NO.
TLNN FL,DDTMP2 ; GET OR PUT ?
JRST DDGT4 ; PUT
PUSH SP,A6
PUSH SP,A10 ; THESE (& FL) ARE THE ONLY AC'S NOT CLOBBERED.
TLO A2,(<XCT>) ; MAKE INTO XCT F[0]
PUSH SP,A2
PUSH SP,[
JRST .+2]
JRST -1(SP) ; EXECUTE THUNK.
SUB SP,[2,,2] ; CLEAR STACK.
POP SP,A10
POP SP,A6
MOVE FL,%DDTFL(DB) ; RESTORE FL (MAY BE CLOBBERED BY THUNKS).
JRST CPOPJ1 ; DONE.
DDGT4: MOVEI A3,@A2 ; STATISCISE. (CAN'T STORE INTO THUNK.)
PUSH SP,A0 ; SAVE VALUE OVER THUNK.
PUSH SP,A1
XCT 1,(A3) ; PUT - GET ADDRESS TO A2 F[0]
POP SP,A1 ; RESCUE VALUE.
POP SP,A0
XCT 1(A3) ; PUT VALUE F[1]
JRST CPOPJ1 ; DONE
DDGT5: ; It's an array or string.
TLNE A6,200 ; OWN
TLNE A6,500 ; ?
JRST DDGT6 ; NO
HLRZ A3,%DDTPT(DB) ; YES - GET RELOCATION
HRRZ A3,1(A3) ; FROM LOADER S.T. ENTRY
ADDI A3,(A6) ; RELOCATE VALUE
HRRZ A2,(A3) ; AND GET ADDRESS OF OBJECT.
TLNE A6,200000 ; ARRAY ?
JRST DDGT8 ; YES.
JRST DDGT11
DDGT6: TLO A2,A11 ; PREPARE TO INDEX BY CONTEXT DL
TLNE A6,200000 ; ARRAY ?
JRST DDGT8 ; YES - ALWAYS STATIC
TLNE A6,100 ; FORMAL-BY-NAME ?
TLNN A6,400
JRST DDGT11 ; NO
TLNN FL,DDTMP2 ; [E016] IF PUT,
EDIT (016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
PUSH SP,A0 ; THUNK WILL CLOBBER VALUE (IF BYTESUBSC)
PUSH SP,A6
PUSH SP,A10
TLNN FL,DDTMP2 ; [E016] IF PUT,
TLOA A2,(<XCT 1,>) ; [E016] USE XCT 1, TO PROHIBIT CLOBERING EXPR A.P.'S
EDIT(016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
TLO A2,(<XCT>) ; ELSE,MAKE INTO XCT F[0]
PUSH SP,A2
PUSH SP,[
JRST .+2]
JRST -1(SP) ; EXECUTE THUNK.
SUB SP,[2,,2] ; RESET STACK.
POP SP,A10
POP SP,A6
MOVE FL,%DDTFL(DB) ; RESTORE FL (MAY BE CLOBBERED BY THUNKS).
TLNN FL,DDTMP2 ; [E016] IF PUT,
POP SP,A0
; String. A10 should point to the "." in i/p buffer.
; Syntax has already been checked and spaces removed.
DDGT11: TLNN FL,DDBYTS ; BYTE-SUBSCRIPTED ?
POPJ SP, ; NO - NON-SKIP RETURN.
TLZ A6,$TYPE ; YES - MAKE IT
TLO A6,$I ; AN INTEGER.
IBP A10 ; SKIP "."
IBP A10 ; AND "["
PUSHJ SP,DDGTNM ; GET SUBSCRIPT.
SOJL A4,DDER31 ; 0 OR -VE IS ILLEGAL
PUSH SP,A0 ; [E016]
PUSH SP,A1 ; [E016] THESE MAY CONTAIN STRING HDR.
TDNN A2,A2 ; [E016] IF HDR IS IN A0/A1,
MOVEI A2,-1(SP) ; [E016] USE STACK INSTEAD.
EDIT(016)
MOVEI A1,1(A4) ; 1 IS FIRST BYTE.
JSP AX,PBYTE ; GET BYTE-POINTER TO A2.
SUB SP,[2,,2] ; [E016] PUT STACK BACK.
TLNN FL,DDTMP2 ; GET OR PUT ?
JRST DDGT9 ; PUT
LDB A0,A2 ; GET
JRST CPOPJ1
DDGT9: DPB A0,A2 ; PUT
JRST CPOPJ1
DDGT8: ; Array. Header address is in A2.
; A10 should point to the "[" in the i/p buffer.
; Syntax has been checked and spaces removed.
MOVEI A2,@A2 ; STATISCISE.
TLNE FL,DDSUBS ; IF UNSUBSCRIPTED
TLNE FL,DDSLICE ; OR SLICE
POPJ SP, ; THEN TOO HARD FOR US.
PUSH SP,A0 ; SAVE VALUES
PUSH SP,A1 ; AGAINST CHKARR.
MOVEI A0,1 ; SUBSCRIPT COUNT
IBP A10 ; SKIP "["
DDGT10: PUSHJ SP,DDGTNM ; GET NUMBER
PUSH SP,A4 ; GIVE TO CHKARR
CAIN A3,.COMMA ; LOOK AT NUMBER TERMINATOR.
AOJA A0,DDGT10 ; COMMA - GET NEXT SUBSCRIPT.
JSP AX,CHKARR ; NOT - GET ADDRESS OF ELEMENT.
POP SP,A1 ; GET VALUE BACK
POP SP,A0
TLNN A6,$TYPE-$S ; STRING - MIGHT BE BYTE-SUBSCRIPTED!
JRST DDGT11 ; DO IT IF NEEDED.
JRST DDGT3 ; NOT - DO VALUE GET OR PUT.
DDGTNM: ; Get a number to A4 from buffer whose pointer is in A10.
; Buffer contains syntax-checked and space-suppressed string, so
; no checks needed here.
; Leaves number in A4 and its terminator character in A3.
TLZ FL,DDTMP1
MOVEI A4,0
DDGTN1: ILDB A3,A10
CAIE A3,.MINUS
JRST .+2
TLOA FL,DDTMP1 ; REMEMBER NEGATIVE.
CAIN A3,.PLUS
JRST DDGTN1 ; IGNORE + SIGN
CAIL A3,.ZERO ; DIGIT ?
CAILE A3,.NINE ; ?
JRST DDGTN2 ; NO
IMULI A4,^D10 ; YES
ADDI A4,-.ZERO(A3) ; PUT IN
JRST DDGTN1 ; AND GET NEXT
DDGTN2: TLZE FL,DDTMP1 ; NEGATIVE ?
MOVN A4,A4 ; YES - NEGATE
POPJ SP,
SUBTTL Debugging system - command routine - TYPE
DDTYPE: TLZ FL,DD%FLG!DDSUBS!DDSLIC!DDBYTS
PUSHJ SP,SCAN4 ; GET NAME.
CAIN A4,.COMMA ; TERMINATED BY COMMA ?
TLOA FL,DDMTYPE!DDMTY2 ; YES - MULTI-TYPE MODE
TLZ FL,DDMTY2 ; NO.
PUSHJ SP,SEARCH ; GET LEXEME.
DDTERR ^D23 ; CANT FIND IT
DDTYP.: ; Type out a variable.
; On entry, A10 points to end of identifier in field buffer.
; A6 contains lexeme,,value
;
; ***WARNING*** PRINT etc. clobber many AC's, notably FL (A13)!
PUSHJ SP,DDBRKB
TDNN FL,[
DDMTYPE,,DDINDF!DDALST] ; IN AUTOLIST, OR MULTI-VARIABLE TYPEOUT?
JRST DDTYP0
OUTSTR [ASCIZ/
/]
OUTSTR %DDTFB(DB) ; YES - PRINT NAME
OUTSTR [ASCIZ/ = /]
DDTYP0: MOVEM FL,%DDTFL(DB)
PUSHJ SP,DDGET ; GET VALUE OF VARIABLE.
; CLOBBERS ALL AC'S EXCEPT A6,A10,FL
JRST DDTYP1 ; NASTY ONE - ADDRESS IN A2
; EASY ONE - VALUE IN A0 (AND A1)
TLNN A6,$TYPE-$B ; BOOLEAN ?
JRST DDTYP2 ; SPECIAL
;Integer, real or long-real. Easy - use PRINT.
LDB A2,[
POINT 2,A6,5] ; 0=INT, 1=REAL, 2=LONG REAL! LUCKY.
SETZB A3,A4 ; ASK FOR STANDARD MODE.
TRNN A2,3 ; INTEGER ?
MOVEI A3,1 ; YES - ASK FOR NO LEADING SPACES.
PUSHJ SP,PRINT. ; PRINT IT
JRST DDTYPZ
DDTYP2: ; BOOLEAN.
TLNE FL,DD%FLG ; IF PSEUDO..
JRST DDTP5A ; ALWAYS DO IN OCTAL.
JUMPN A0,DDTYP4 ; NOT FALSE
MOVEI A1,[ASCIZ/ False/]
JRST DDTYPD
DDTYP4: CAME A0,[-1] ; ASSIGNED TRUE ?
JRST DDTP5A ; NO
MOVEI A1,[ASCIZ/ True /]
DDTYPD: PUSHJ SP,DDTOU%
JRST DDTYPZ
DDTP5A: PUSHJ SP,DDTYP5
JRST DDTYPZ
DDTYP5: ; Neither assigned TRUE nor FALSE. Print in octal half-words.
HLRZ A1,A0 ; GET FIRST HALF-WORD
PUSHJ SP,PROCT ; PRINT
HRRZ A1,A0 ; SECOND HALF
PUSHJ SP,PROCT
MOVE FL,%DDTFL(DB)
MOVEI A1,[ASCIZ/(true)/]
TLNN FL,DD%FLG ; IF NOT PSEUDO...
PUSHJ SP,DDTOU% ; SAY 'TRUE'
PJRST DDBRKB
DDTYP1: ; Unsubscripted string, or
; sliced or whole array.
; Address of header is in A2.
MOVEI A2,@A2 ; STATISCISE
TLNN A6,200000 ; ARRAY ?
JRST DDTPSA ; NO - SIMPLE STRING.
TLNN FL,DDSLIC ; YES - SLICE ?
TLNN FL,DDSUBS ; OR WHOLE THING ?
JRST DDTYP3 ; YES.
; NO - SINGLE ELEMENT OF STRING ARRAY (STRING ADDR ALREADY IN A2)
DDTPSA: PUSHJ SP,DDTYPS
JRST DDTYPZ
DDTYPS: SKIPN STR1(A2) ; IF FIRST WORD ZERO...
JRST DDTYPF ; ...COMPLETELY NULL.
PUSH SP,A7 ; [E016] SAVE A7 (USED IN STRING ARRAY TYPEOUT).
;
; WARNING!!! A2 may be pointing to A0 !!!
;
EDIT(016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
JUMPN A2,.+4 ; [E016] STRING IN A0,A1?
MOVE A6,A0 ; [E016] YES - FIX THAT.
MOVE A7,A1 ; [E016]
MOVEI A2,A6 ; [E016] AND SAY SO.
MOVE A0,STR2(A2) ; LENGTH.
TLZ A0,STRBCC
MOVEI A1,[ASCIZ/(/]
PUSH SP,A2
PUSHJ SP,DDTOU%
PUSHJ SP,DPRNT% ; PRINT LENGTH.
MOVEI A13,.COMMA
JSP AX,OUCHAR
LDB A0,[
POINT 6,@(SP),11] ; BYTE-SIZE
PUSHJ SP,DPRNT% ; PRINT BYTE-SIZE
MOVEI A1,[ASCIZ/)/]
PUSHJ SP,DDTOU%
POP SP,A2
LDB A0,[
POINT 6,STR1(A2),11]
MOVE A5,STR1(A2) ; GET BYTE-POINTER
MOVE A6,STR2(A2) ; AND LENGTH
POP SP,A7 ; [E016]
TLZ A6,STRBCC ; CLEAR OTHER BITS
JUMPN A6,.+3 ; NULL ?
DDTYPF: MOVEI A1,[ASCIZ/ Null/] ; SAY SO.
PJRST DDTOU%
CAIE A0,7 ; ASCII
CAIN A0,6 ; OR SIXBIT ?
JRST DDTYP6 ; YES
DDTYP8: ILDB A4,A5 ; GET A BYTE
MOVEI A1,^D12 ; AND PRINT
MOVEI A3,0 ; IN ZERO-SUPPRESSED OCTAL.
DDTYP7: LSHC A3,3
SOSLE A1
JUMPE A3,DDTYP7 ; SKIP LEADING ZEROS
MOVEI A13,.ZERO(A3) ; MAKE ASCII
PUSHJ SP,DDOUCH
HRLZI A3,40000 ; SIGNIFICANCE TRIGGER
JUMPG A1,DDTYP7 ; END OF BYTE ?
SOJLE A6,CPOPJ ; YES - ANY MORE ?
MOVEI A13,.COMMA ; YES
PUSHJ SP,DDOUCH ; OUTPUT COMMA,
JRST DDTYP8 ; AND DO NEXT BYTE.
POPJ SP,
DDTYP6: ; Ascii or sixbit.
MOVEI A13,.DQUOTE
PUSHJ SP,DDOUCH
DDTYPB: ILDB A13,A5 ; GET BYTE
CAIN A0,6 ; SIXBIT ?
ADDI A13,40 ; YES - MAKE ASCII
CAIL A13,40 ; CONTROL CHARACTER ?
JRST DDTYP9 ; NO (UNLESS IT'S <DEL>)
MOVE A3,DDCTTB(A13) ; YES - GET ITS NAME
MOVEI A4,0
MOVEI A1,A3
PUSHJ SP,DDTOU%
DDTYPA: SOJG A6,DDTYPB ; MORE BYTES ?
MOVEI A13,.DQUOTE
PJRST DDOUCH
DDTYP9: CAIE A13,.DEL ; DELETE ?
JRST DDTYPC ; NO
MOVEI A1,[ASCIZ/<DEL>/] ; YES
PUSHJ SP,DDTOU%
JRST DDTYPA
DDTYPC: PUSHJ SP,DDOUCH
PUSHJ SP,DDBRKB
JRST DDTYPA
DDTYPZ: PUSHJ SP,DDBRKB ; CLEAR OUT BUFFERS.
MOVE FL,%DDTFL(DB)
TLZN FL,DDMTY2 ; MULTI-TYPE ?
POPJ SP, ; NO - DONE.
PUSHJ SP,DDIGCH ; YES - GET NEXT.
JRST DDTYPE
DDTYP3: ; Sliced or whole array.
; Address of header is in A2.
; A10 points to the [ if any.
EDIT(074);SAVE HEADER ADDRESS DELOCATED
MOVEI A7,(A2) ; GET HEADER ADDRESS
CAIL A7,(DB) ; IS HEADER ADDRESS
CAILE A7,(SP) ; DYNAMIC ?
JRST .+3 ; NO
SUBI A7,(DB) ; YES - DELOCATE IT
HRLI A7,DB ; AND SET DB IN INDEX
PUSH SP,A7 ; STACK ADDRESS
HLRE A7,1(A2) ; - # SUBSCRIPTS.
MOVN A0,A7 ; + # SUBSCRS.
LSH A0,1 ; * 2
PUSHJ SP,GETOWN ; GET CONTROL BLOCK.
POP SP,A2
MOVEI A2,@A2 ; STATICIZE ADDRESS AGAIN
MOVEI A5,(A1)
TLNE FL,DDSUBS ; WHOLE THING ?
JRST DDSLC1 ; NO - SLICE.
MOVE A7,1(A2) ; POINTER TO DOPE-VECTOR.
DDSLCD: HRLZ A3,(A7) ; LOBOUND
HRR A3,1(A7) ; HIBOUND.
MOVEM A3,(A1) ; TO CONTROL-BLOCK.
AOS A1
AOS A7
AOBJN A7,DDSLCD ; & GET NEXT
JRST DDSLC0
DDSLC1: IBP A10 ; THROW [
MOVE A7,1(A2) ; ADDRESS OF DOPE-VECTOR.
DDSLC5: PUSHJ SP,DDGTNM ; GET NUMBER TO A4, TERM TO A3.
CAIE A3,.AST ; WHOLE OF THIS DIMENSION ?
JRST DDSLC2 ; NO
HRLZ A4,(A7) ; YES - COPY
HRR A4,1(A7) ; DOPE-VECTOR ELEMENT
MOVEM A4,(A1) ; TO CONTROL-BLOCK.
ILDB A3,A10 ; GET NEXT CHAR (COMMA OR ])
JRST DDSLC4
DDSLC2: CAIE A3,.COLON ; SLICE ?
JRST DDSLC3 ; NO - SINGLE SUBSCRIPT.
CAMGE A4,(A7) ; YES - LOBOUND VALID ?
DDTERR ^D32 ; NO.
HRLM A4,(A1) ; YES - TO CONTROL-BLOCK.
PUSHJ SP,DDGTNM ; GET HIBOUND OF SLICE.
CAMLE A4,1(A7) ; IN RANGE ?
DDTERR ^D32 ; NO.
HRRM A4,(A1)
JRST DDSLC4
DDSLC3: CAML A4,(A7) ; SINGLE VALUE - IN RANGE ?
CAMLE A4,1(A7)
DDTERR ^D32 ; NO
HRL A4,A4 ; YES - MAKE IT BOTH BOUNDS OF SLICE.
MOVEM A4,(A1)
DDSLC4: AOS A1 ; ADVANCE
AOS A7 ; POINTERS.
CAIN A3,.COMMA ; MORE ?
AOBJN A7,DDSLC5 ; YES - MORE WANTED ?
CAIE A3,.RBRA ; END - ] COINCIDES ?
DDTERR ^D33 ; NO - WRONG # OF SUBSCRS.
AOBJN A7,.-1 ; TOO FEW.
DDSLC0: ; here, our "pseudo-dope-vector" is set up in the control-block
; (each dimension has one word: FROM,,TO.)
; Its address is in A5.
; Array header's address is still in A2.
PUSH SP,A6 ; -4(SP)
PUSH SP,A2 ; -3(SP)
HLL A5,1(A2) ; - # DIMENSIONS.
PUSH SP,A5 ; -2(SP) : POINTER TO PSEUDO-D.V.
HLRE A0,A5
MOVN A0,A0 ; # DIMS
MOVE A10,A5
ADD A10,A0 ; POINTER TO SUBSCRS IN CONTROL-BLK
PUSH SP,A10 ; -1(SP)
HLRE A4,(A5) ; GET A LOBOUND
MOVEM A4,(A10) ; PUT IN SUBSCR IN CONTROL-BLK
AOBJN A5,.+1 ; ANOTHER
AOBJN A10,.-3
SUBI A10,1 ; POINTER TO JUNIOR SUBSCR
PUSH SP,A10 ; 0(SP)
HRRZI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PUSHJ SP,DDSTI1 ; [E1000] ^C INTERCEPT
PUSHJ SP,DDSLC6 ; COMPUTE # ELEMENTS/LINE OF OUTPUT,
; ALSO TYPE FIRST SUBSCRIPTS. CLOBBERS A0-A6, A10-A13!
DDSLCL: MOVE A4,-1(SP) ; POINTER TO ACTUAL SUBSCRS.
MOVEI A1,[ASCIZ/ /] ; TWO SPACES
PUSHJ SP,DDTOU%
HLRE A0,A4
MOVN A0,A0 ; # DIMS
MOVE A2,-3(SP) ; GET ADDR OF HEADER.
PUSH SP,(A4) ; PUT SUBSCRIPTS
AOBJN A4,.-1 ; ON STACK.
JSP AX,CHKARR ; GET ELEMENT ADDRESS.
MOVE A6,-4(SP)
TLNN A6,$TYPE-$S ; STRING ?
JRST DDSLC8 ; YES - SPECIAL.
MOVE A0,(A2) ; NO - GET VALUE.
TLNE A6,20000 ; TWO-WORD ?
MOVE A1,1(A2) ; YES - GET SECOND WORD.
TLNN A6,$TYPE-$B ; BOOLEAN ?
JRST DDSLC9 ; YES.
LDB A2,[
POINT 2,A6,5] ; NO - 0=INT, 1=REAL, 2=LONG-REAL.
SETZB A3,A4 ; STANDARD PRINT
PUSH SP,A7
PUSHJ SP,PRINT.
POP SP,A7
JRST DDSLCX ; END OF THIS ELEMENT.
DDSLC9: ; Boolean.
JUMPN A0,DDSLCA ; NOT FALSE.
MOVEI A1,[ASCIZ/ False/] ; 18. CHARS FOR BOOLS.
PUSHJ SP,DDTOU%
JRST DDSLCX
DDSLCA: CAME A0,[-1] ; GENUINE TRUE ?
JRST DDSLCB ; NO
MOVEI A1,[ASCIZ/ True/]
PUSHJ SP,DDTOU%
JRST DDSLCX
DDSLCB: PUSHJ SP,DDTYP5 ; OCTAL (TRUE).
DDSLCX: ; End of element. Increment subscripts etc.
; If other than the most junior subscript is incremented,
; we force a new-line & type the subscripts.
; # of elements/line of output is in A7.
MOVE A4,(SP) ; POINTER TO JUNIOR SUBSCR.
MOVE A3,-1(SP) ; POINTER TO FIRST SUBSCR.
SUBI A3,1 ; NOW PTR TO JUNIOR BOUND-PAIR.
HLRE A0,-2(SP)
MOVN A0,A0 ; # DIMS
DDSLCW: AOS A1,(A4) ; INCREMENT A SUBSCRIPT.
HRRE A5,(A3) ; GET HIBOUND
CAMG A1,A5 ; OVER THE TOP ?
JRST DDSLCY ; NO - OK.
MOVEI A7,1 ; YES - ENSURE NEWLINE HAPPENS.
SOJLE A0,DDSLCZ ; ANY MORE DIMS ?
HLRE A5,(A3) ; YES - RESET THIS ONE
MOVEM A5,(A4) ; TO LOBOUND.
SUBI A3,1 ; TRY NEXT MOST SENIOR
SOJA A4,DDSLCW
DDSLCY: SOJG A7,.+2 ; NEED NEWLINE ?
PUSHJ SP,DDSLC6 ; YES - DO IT (SETS UP A7 TOO).
JRST DDSLCL ; AND LOOP.
DDSLCZ: HRRZ A1,-2(SP)
MOVEI A0,0
PUSHJ SP,GETOWN ; RELEASE CONTROL-BLK
SUB SP,[5,,5] ; RETARD STACK.
JRST DDTYPZ ; & EXIT.
DDSLC8: ; String.
PUSHJ SP,DDTYPS ; DO STRING.
JRST DDSLCX ; & GET NEXT ELEMENT.
DDSLC6: ; Type newline & subscripts. Also compute # elements / line of typeout,
; & put in A7.
MOVEI A1,[ASCIZ/
[/]
PUSHJ SP,DDTOU%
MOVE FL,%DDTFL(DB)
MOVEI A7,-1(FL) ; GET
ANDI A7,DDTTYW ; LINE-WIDTH.
SKIPA A6,-2(SP) ; GET PTR TO CURRENT SUBSCRS.
DDSL6A: PUSHJ SP,DDOUCH
MOVE A0,(A6) ; GET SUBSCR
PUSHJ SP,DPRNT% ; PRINT; RETURNS # DIGITS IN A3.
SUBI A7,1(A3) ; ALLOW FOR CHARS DPRNT% PRINTED.
MOVEI A13,.COMMA
AOBJN A6,DDSL6A ; LOOP OVER ALL SUBSCRS.
MOVEI A13,.RBRA
PUSHJ SP,DDOUCH
; Now, compute # entries / line.
MOVE A6,-5(SP) ; RESTORE A6.
TLNN A6,$TYPE-$S ; STRING ?
MOVEI A1,(A7) ; YES - ALWAYS 1 PER LINE.
TLNN A6,$TYPE-$B ; BOOLEAN ?
MOVEI A1,^D20
TLNN A6,$TYPE-$I ; INTEGER ?
MOVEI A1,INTDIG+3
TLNN A6,$TYPE-$R ; REAL ?
MOVEI A1,SRDIG+^D8 ; ALLOW FOR SIGN, &, ETC.
TLNN A6,$TYPE-$LR ; LONG-REAL ?
MOVEI A1,^D25
IDIVI A7,(A1) ; CALC HOW MANY WILL FIT.
MOVE FL,%DDTFL(DB)
POPJ SP,
; Table of names of control characters. 1 word only each please !
DDCTTB: ASCII/<NUL>/
ASCII/<^A>/
ASCII/<^B>/
ASCII/<^C>/
ASCII/<^D>/
ASCII/<^E>/
ASCII/<^F>/
ASCII/<^G>/
ASCII/<^H>/
ASCII/<TAB>/
ASCII/<LF>/
ASCII/<VT>/
ASCII/<FF>/
ASCII/<CR>/
ASCII/<^N>/
ASCII/<^O>/
ASCII/<^P>/
ASCII/<^Q>/
ASCII/<^R>/
ASCII/<^S>/
ASCII/<^T>/
ASCII/<^U>/
ASCII/<^V>/
ASCII/<^W>/
ASCII/<^X>/
ASCII/<^Y>/
ASCII/<^Z>/
ASCII/<ESC>/
ASCII/<^\>/
ASCII/<^]>/
ASCII/<^^>/
ASCII/<^_>/
SUBTTL Debugging system - command routine - DUMP.
DDUMP: ; Dump a block or blocks. Syntax is :
; DUMP [SCALARS] [n] or [ALL]
; where n (default = 1) is the number of blocks "outwards" to dump.
; If SCALARS is present, arrays are not dumped.
TLZ FL,DDMPSC
MOVEI A7,1
SKIPL %DDTST(DB) ; WAS SYMBOL TABLE READ OK ?
DDTERR 1 ; NO : NO DUMPS THEN !
DDUMP0: CAIL A4,.ZERO
CAILE A4,.NINE
JRST DDUMP1 ; NOT NUMBER.
PUSHJ SP,DDGTV1 ; # - GET IT.
MOVEI A7,(A5) ; SAVE IT.
JRST DDUMP0
DDUMP1: CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; SKIP BLANKS.
CAIN A4,.SCOL ; END OF LINE ?
JRST DDUMP2 ; YES.
CAIL A4,.A ; ALPHA ?
CAILE A4,.Z
DDTERR ^D56 ; NO - BAD CHAR.
PUSHJ SP,SCAN3 ; GET WORD.
MOVEI A2,%DDTIB(DB)
MOVE A1,[
XWD -2,[
SIXBIT/ALL/
SIXBIT/SCALAR/]]
PUSHJ SP,UNIQUE ; CHECK LEGAL ABBREVIATION.
DDTERR ^D57 ; NOT
DDTERR ^D57
TLNE A1,1 ; -1 MEANS "SCALARS"
TLOA FL,DDMPSC ; SO SET FLAG.
MOVEI A7,-1 ; OTHERWISE IT'S "ALL" - GET BIG #.
JRST DDUMP0
; End of command.
DDUMP2: HLRE A4,%DDTER(DB) ; GET REDIRECT CHANNEL.
HRRM A4,%CHAN(DB) ; SET UP.
JUMPL A4,DDUMP8
; Not TTY: - do headings.
DUMP%: PUSH SP,A7 ; ENTRY FROM ALGLIB.
SKIPN %DDTST(DB) ; S.T. READ IN ?
PUSHJ SP,DDINIT ; NO - DO IT.
SKIPL %DDTST(DB) ; WORKED ?
PJRST DDPOPF ; NO - LOSE SAVED A7 & EXIT.
MOVEM FL,%DDTFL(DB)
MOVEI A1,[ASCIZ/
Dump of ALGOL-60 program /]
PUSHJ SP,DDTOU%
HRROI A4,JBTPRG ; GET OUR
GETTAB A4, ; PROGRAM NAME.
SKIPA A4,[
SIXBIT/NONAME/] ; DEFAULT
JUMPE A4,.-1 ; IF HE WON'T TELL.
PUSHJ SP,DDOSIX ; PRINT NAME.
MOVEI A1,[ASCIZ/ at /]
PUSHJ SP,DDTOU%
PUSHJ SP,DDOTIM ; TIME.
MOVEI A1,[ASCIZ/ on /]
PUSHJ SP,DDTOU%
PUSHJ SP,DDODAT ; DATE.
EDIT(121); Tidy up DUMP output
PUSHJ SP,CRLF% ; [E121] Start new line
TLNE DB,INDDT ; [E121] Called from library via DUMP UUO ?
JRST DMPNOW ; [E121] No - just do the DUMP
MOVEI A4,@-1(SP) ; [E121] Yes - get return PC
HRRM A4,%DDTPC(DB) ; [E121] Save it for HSTPRT
TLZ DB,TMPFL3 ; [E121] Ensure typeout
PUSHJ SP,HSTPRT ; [E121] Print history & set context
DMPNOW: POP SP,A7
MOVEI FL,DD.LPW ; GET LPT: WIDTH.
MOVNI A1,1 ;
CTLJOB A1, ; IF BATCH JOB,
JFCL ;
SKIPL A1 ;
MOVEI FL,DD.BTW ; USE SHORTER LINE .
HRRM FL,%DDTFL(DB) ; SAVE.
MOVE FL,%DDTFL(DB)
DDUMP8: TLNE DB,INDDT ; IF IN DDT (IE NOT CALLED FROM LIB)
PUSHJ SP,[ ; [E1000]
HRRZI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PJRST DDSETI ] ; [E1000] ^C INTERCEPT.
EDIT(143) ; Reset context if unknown on entry from batch.
SKIPE %DDTBE(DB) ; [E143] Context found yet ?
JRST DDUM10 ; E143] Yes - so OK
MOVEI A4,@%SYS0(DB) ; [E143] No - so set it at %BEGIN
MOVE A4,(A4) ; [E143] ...
HRRZM A4,%DDTPC(DB) ; [E143] ...
PUSHJ SP,FNDADR ; [E143] ...
DDTERR ^D18 ; [E143] ...
DDUM10: MOVE A4,%DDTBE(DB) ; PTR TO CURRENT BLKIDX ENTRY
DDUMP6: EXCH A7,A4 ; GET BLKIDX PTR TO A7, SAVE OLD A7.
PUSHJ SP,DDGTDL ; SET UP CONTEXT DL IN A11.
EXCH A7,A4 ; RESTORE AC'S AS THEY WERE.
PUSH SP,A4 ; SAVE A4 FOR LATER.
HRRZ A4,(A4) ; OFFSET IN S.T. OF ITS BLK ITEM.
ADD A4,%DDTST(DB) ; MAKE ADDRESS.
MOVEI A1,[ASCIZ/
**BLOCK /] ; NEW BLOCK -
PUSH SP,A4
PUSH SP,A11 ; SAVE CONTEXT OVER OUTPUT CALLS
PUSHJ SP,DDTOU% ; TELL HIM.
HLRZ A0,1(A4) ; GET CURBLK
PUSHJ SP,DPRNT% ; & TELL HIM.
POP SP,A11 ; RESTORE CONTEXT.
POP SP,A4
DDUMP5: HRRZ A3,(A4) ; LENGTH OF ITEM.
ADDI A4,(A3) ; ADVANCE TO NEXT ITEM.
HLRZ A2,(A4) ; GET ITEM TYPE
CAIN A2,'SYM' ; SYMBOL ?
JRST DDUMP4 ; YES - GO DUMP IT.
CAIE A2,-1 ; END OF S.T., OR
CAIN A2,'MOD' ; NEW MODULE ?
JRST DDUMP9 ; YES - END.
CAIE A2,'BLK' ; NEW BLOCK ?
JRST DDUMP5 ; NO - NOT INTERESTING.
SOJLE A7,DDUMP9 ; NEED MORE BLOCKS ?
POP SP,A4
HLRZ A4,(A4) ; CONTAINING BLOCK.
JUMPN A4,DDUMP6 ; IF ANY.
SKIPA
DDUMP9: ; All done.
POP SP,A6 ; IF NOT DONE ALREADY.
MOVEI A1,[ASCIZ/
/]
PUSHJ SP,DDTOU%
PUSHJ SP,DDBRKB
TLNE DB,INDDT ; IF NOT CALLED FROM LIB
HLLOS %CHAN(DB) ; SET O/P = TTY:
ANDI FL,DDALST!DDINDF ; REMEMBER IMPORTANT FLAGS
PUSH SP,FL ; DESTROYED BY DDTTYC
PUSHJ SP,DDTTYC ; GET TTY: CHARACTERISTICS
POP SP,FL ; GET FLAGS AGAIN
IORB FL,%DDTFL(DB) ; AND RESTORE INPUT FLAGS
POPJ SP, ; AND RETURN
DDUMP4: ; Dump a symbol.
MOVE A6,1(A4) ; A6 = LEXEME
TLNE A6,200000 ; IS IT
TLNN A6,100000 ; A PROCEDURE
TLNN A6,$TYPE-$L ; OR A LABEL ?
JRST DDUMP5 ; YES - DON'T DUMP THOSE.
TRNN A6,-1 ; IS IT UNREFERENCED ?
JRST DDUMP5 ; YES - INACCESSIBLE.
TLNE A6,200000 ; SCALAR ?
TLNN FL,DDMPSC ; NO - WANTED ?
JRST DDUMP7 ; YES - PRINT IT.
JRST DDUMP5 ; NOT WANTED.
DDUMP7: PUSH SP,A11
PUSH SP,A7
PUSH SP,A4
MOVEI A1,[ASCIZ/
/]
PUSHJ SP,DDTOU%
HRRZ A3,(A4) ; LENGTH.
MOVEI A1,2(A4) ; FROM
ADDI A3,-2(A1) ; END
MOVEI A4,0
EXCH A4,(A3) ; MAKE ASCIZ
PUSHJ SP,DDTOU% ; PRINT NAME.
EXCH A4,(A3) ; PUT WORD BACK.
TLNE A6,200000 ; ARRAY ?
PUSHJ SP,DDDIM0 ; YES - GIVE CURRENT BOUNDS.
MOVEI A1,[ASCIZ/ = /]
PUSHJ SP,DDTOU%
MOVE A11,-2(SP) ; RESCUE CONTEXT DL.
PUSHJ SP,DDTYP0 ; TYPE VALUE.
POP SP,A4
POP SP,A7
POP SP,A11
JRST DDUMP5
SUBTTL Debugging system - Command routine - DIMENSION
DDDIMS: ; Type current dimensions of an array.
PUSHJ SP,SCAN4 ; GET NAME
PUSHJ SP,SEARCH ; GET LEXEME
DDTERR ^D23 ; CANT FIND IT
TLNE A6,$KIND
TLNE A6,$KIND-$ARR ; ARRAY ?
DDTERR ^D34 ; NO
TRNN FL,DDALST!DDINDF ; IN AUTO-LIST
JRST DDDIM0 ; NO
OUTSTR [ASCIZ/
Dimensions of array /]
OUTSTR %DDTFB(DB) ; YES - TYPE NAME, ETC.
OUTSTR [ASCIZ/ = /]
DDDIM0: PUSHJ SP,DDGET ; GET ADDRESS TO A2
; CLOBBERS ALL AC'S EXCEPT A6,A10,FL.
SKIPA A7,1(A2) ; OK - GET DOPE-VECTOR POINTER
DDTERR ^D35 ; SYSTEM ERROR.
MOVEM FL,%DDTFL(DB)
MOVEI A13,.LBRA
DDDIM1: PUSHJ SP,DDOUCH
MOVE A0,(A7) ; GET LOBOUND
PUSHJ SP,DPRNT% ; PRINT
AOS A7
MOVEI A13,.COLON
PUSHJ SP,DDOUCH
MOVE A0,(A7) ; HIBOUND
PUSHJ SP,DPRNT%
MOVEI A13,.COMMA
AOBJN A7,DDDIM1 ; MORE ?
MOVEI A13,.RBRA
PUSHJ SP,DDOUCH
PUSHJ SP,DDBRKB
MOVE FL,%DDTFL(DB)
POPJ SP,
SUBTTL Debugging system - Command routine - SET
DDSET: ; Change a varaible.
; On entry, A10 points to the end of the identifier in field buffer.
; SEARCH has been called, and A6=lexeme,,value.
;
; **WARNING** READ clobbers many AC's, especially FL (=A13).
TLNE FL,DD%FLG!DDSLICE ; PSEUDO, OR ARRAY-SLICE ?
DDTERR ^D36 ; CAN'T SET THOSE.
TLNE A6,$KIND
TLNE A6,$KIND-$ARR ; ARRAY ?
JRST DDSET1 ; NO
TLNN FL,DDSUBS ; YES - SUBSCRIPTED ?
DDTERR ^D36 ; NO - CAN'T SET WHOLE ARRAYS.
DDSET1: TLNN A6,$TYPE-$S ; STRING ?
TLNE FL,DDBYTS ; AND NOT BYTE-SUBSCRIPTED ?
JRST DDSET2 ; NO.
PUSHJ SP,DDPUT ; YES - GET ADDRESS TO A2
SKIPA ; YES. CLOBBERS ALL AC'S EXCEPT A6,A10,FL.
DDTERR ^D35 ; SYSERR - DDPUT THINKS IT'S NOT STRING!
; Read string
HRRI A2,@A2 ; STATISCISE ADDRESS.
MOVE A10,STR2(A2) ; GET LENGTH.
TLZ A10,STRBCC ; CLEAR FLAGS
LDB A6,[
POINT 6,STR1(A2),11] ; GET BYTE-SIZE
TLNE A2,17 ; IF DYNAMIC...
SUBI A2,(DB) ; ...DELOCATE (STACK MAY SHIFT).
PUSHJ SP,DDIGCH ; GET CHAR, IGNORE BLANKS
CAIE A4,.LPAR ; ( ?
JRST DDSST1 ; NO - DOESN'T WANT TO CHANGE LENGTHS.
PUSHJ SP,DDGTVL ; YES - READ NUMBER (DECIMAL)
CAIE A4,.COMMA ; ANOTHER ?
JRST DDSST4 ; NO - THAT WAS BYTE SIZE
MOVE A10,A5 ; YES - THAT WAS LENGTH
PUSHJ SP,DDGTVL ; SO GET BYTE-SIZE.
DDSST4: CAILE A5,^D36 ; SENSIBLE ?
DDTERR ^D37 ; NO
MOVEI A6,(A5)
CAIE A4,.RPAR ; ) ?
DDTERR ^D38
PUSHJ SP,DDIGCH ; GET CHAR, IGNORE BLANKS
DDSST1: SETO A0,
PUSH SP,A2
PUSHJ SP,GETOWN ; FLEX GET SPACE.
POP SP,A2
HLRZ A12,-1(A1) ; FIND TOP OF
ADDI A12,-2(A1) ; PIECE GIVEN.
MOVEI A11,(A1) ; SAVE START ADDR.
MOVEI A3,(A6)
LSH A6,^D24 ; ALIGN BYTE-SIZE FIELD
TLO A6,440000 ; ADD POSITION FIELD
HRRI A6,(A1) ; MAKE BYTE-POINTER
PUSH SP,A6 ; SAVE (FOR STRING HEADER LATER.)
MOVEI A7,0 ; BYTE COUNTER
CAIE A4,.SQUOTE ; SINGLE-QUOTE
CAIN A4,.DQUOTE ; OR DOUBLE-QUOTE ?
JRST DDSST5 ; YES - QUOTED STRING
SETO A5,
LSH A5,(A3) ; NO - MAKE TRUNCATION TEST MASK
DDSST8: PUSHJ SP,DDGTOC ; GET OCTAL VALUE.
TDNE A0,A5 ; WILL IT BE TRUNCATED ?
SETO A5, ; YES - REMEMBER.
CAILE A12,1(A6) ; SAFE TO STORE ?
JRST DDSST6 ; YES
CCORE1 ^D128 ; NO - GET MORE.
HRLZI A3,^D128
ADDM A3,-1(A11) ; UPDATE LENGTH
ADDI A12,^D128 ; AND TOP ADDRESS
DDSST6: IDPB A0,A6
CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; IGNORE BLANKS
CAIE A4,.COMMA ; MORE BYTES ?
AOJA A7,DDSST7 ; NO
PUSHJ SP,DDIGCH
AOJA A7,DDSST8 ; YES - COUNT & GET NEXT.
DDSST7: AOSN A5 ; ANY BYTES TRUNCATED ?
OUTSTR [ASCIZ/
%Byte(s) too long - truncated./]
DDSSTC: TLNE A2,17 ; IF IT WAS DYNAMIC...
ADDI A2,(DB) ; ...RELOCATE IT.
MOVEI A4,0
CAML A7,A10 ; SHORTER THAN OLD/SPECIFIED ?
JRST .+3 ; NO
IDPB A4,A6 ; YES - NULL FILL
AOJA A7,.-3 ; THE REST.
TLO A7,STRDYN
PUSH SP,A2
MOVEI A0,0
SKIPE A1,STR1(A2) ; UNLESS THERE WASN'T ONE,
PUSHJ SP,GETOWN ; DELETE OLD STRING.
POP SP,A2
POP SP,A6
MOVEM A6,STR1(A2) ; SET
MOVEM A7,STR2(A2) ; NEW STRING.
; Here we return unused space, if any. A3 is byte size, A7 is length.
MOVEI A4,^D36
IDIVI A4,(A3) ; GET # BYTES/WORD.
TLZ A7,-1 ; CLEAR FLAGS.
IDIVI A7,(A4) ; GET # WORDS.
SKIPE A10 ; ROUND
ADDI A7,1 ; UP.
ADDI A7,1 ; ALLOW FOR HEAP LINK WORD.
HLRZ A5,-1(A11) ; GET LENGTH OF CHUNK.
HRLZM A7,-1(A11) ; SET NEW LENGTH.
SUBI A5,(A7) ; GET LENGTH OF SPARE.
JUMPE A5,CPOPJ ; NONE
MOVEI A1,-1(A11) ; GET
ADDI A1,1(A7) ; ADDR OF SPARE PIECE (SKIP LINK WORD)
HRLZM A5,-1(A1) ; SET ITS LENGTH.
MOVEI A0,0 ; TELL GETOWN TO DELETE.
PJRST GETOWN ; DELETE SPARE & RETURN.
DDSST5: ; Quoted string.
CAIE A3,6 ; SENSIBLE
CAIN A3,7 ; BYTE-SIZE ?
SKIPA ; YES
DDTERR ^D39 ; NO
DDSSTA: PUSHJ SP,DDGTCA ; GET CHAR
CAIE A4,.SQUOTE ; QUOTE
CAIN A4,.DQUOTE ; ?
JRST DDSST9 ; YES
DDSSTB: CAIN A3,6 ; SIXBIT ?
SUBI A4,40 ; YES
CAILE A12,1(A6) ; SAFE TO STORE ?
JRST DDSSTR ; YES
CCORE1 ^D128 ; NO - GET MORE
HRLZI A5,^D128
ADDM A5,-1(A11)
ADDI A12,^D128
DDSSTR: IDPB A4,A6
AOJA A7,DDSSTA ; COUNT & GET NEXT.
DDSST9: PUSHJ SP,DDGTCH ; QUOTE FOUND - WHAT'S NEXT CHAR ?
CAIE A4,.SQUOTE
CAIN A4,.DQUOTE ; ANOTHER QUOTE ?
JRST DDSSTB ; YES - PUT 1 OF THEM IN.
JRST DDSSTC ; NO - DONE.
DDSET2: ; Not string.
TLNN A6,$TYPE-$B ; BOOLEAN ?
JRST DDSET3 ; YES
; Integer, real or long-real. Let READ do it, but he gets his characters
; from our input routine.
LDB A2,[
POINT 2,A6,5] ; 0=INT, 1=REAL, 2=LONG REAL.
TLNN A6,$TYPE-$S ; STRING ?
MOVEI A2,0 ; YES - PRETEND INTEGER.
PUSH SP,A6 ; SAVE
PUSH SP,FL ; ALL
PUSH SP,A11 ; OUR
PUSH SP,A10 ; WORLD.
PUSHJ SP,READ. ; READ NUMBER.
POP SP,A10 ; RESTORE
POP SP,A11 ; ALL
POP SP,FL ; OUR
POP SP,A6 ; WORLD.
DDSET0: PUSHJ SP,DDPUT ; STORE VALUE
DDTERR ^D35 ; SYSERR - DDPUT THINKS IT'S STRING!
POPJ SP, ; CLOBBERS ALL AC'S, EXCEPT A6,A10,FL.
DDSET3: ; Boolean.
PUSHJ SP,DDIGCH ; GET CHAR, IGNORE BLANKS.
CAIE A4,.PRCNT ; % ?
CAIN A4,.HASH ; # ?
JRST DDSET4 ; YES - OCTAL COMING.
CAIE A4,.T ; T
CAIN A4,.F ; /F
JRST DDSET5 ; YES - TRUE/FALSE COMING.
PUSHJ SP,DDGTOC ; NO - ASSUME RAW OCTAL.
JRST DDSET0 ; GO STORE.
DDSET4: PUSHJ SP,DDIGCH
PUSHJ SP,DDGTOC ; % OR $ SEEN - GET OCTAL VALUE.
JRST DDSET0
DDSET5: ; T(rue) / F(alse).
MOVE A3,[
POINT 7,A7] ; USE EXISTING ROUTINE.
PUSH SP,A10 ; NEEDED LATER BY DDPUT.
SETZB A7,A10
IDPB A4,A3
DDSETA: PUSHJ SP,DDGTCH
CAIL A4,.A
CAILE A4,.Z ; LETTER ?
JRST DDSETB ; NO
DDSETC: IDPB A4,A3 ; YES.
TRNN A7,376 ; FULL ?
JRST DDSETA ; NO
DDSETB: MOVE A1,[
XWD -2,[
SIXBIT/TRUE/
SIXBIT/FALSE/]] ; TABLE FOR UNIQUE TEST
MOVEI A2,A7
PUSHJ SP,UNIQUE
DDTERR ^D40 ; NOT TRUE/FALSE
DDTERR ^D35 ; NOT UNIQUE - V SILLY.
POP SP,A10 ; NEEDED BY DDPUT (PTR TO [ IF ARRAY)
HLRE A0,A1 ; -2 = TRUE, -1 = FALSE.
AOJA A0,DDSET0 ; -1 = TRUE, 0 = FALSE !
DDGTVL: ; Get decimal value, from TTY: to A5; terminator in A4.
; Clobbers A0-A3, A10, A11.
PUSHJ SP,DDIGCH ; GET CHAR, IGNORE BLANKS.
DDGTV1: MOVEI A5,0
DDGTV2: CAIL A4,.ZERO
CAILE A4,.NINE ; DIGIT ?
POPJ SP, ; NO - DONE.
IMULI A5,^D10
ADDI A5,-.ZERO(A4)
PUSHJ SP,DDGTCH ; GET ANOTHER.
JRST DDGTV2
DDGTOC: ; Get value in octal from TTY: to A0. Clobbers A1,A3,A4,A10,A11
; Terminator in A4. Expects first character already to be in A4 on entry.
MOVEI A3,^D12 ; MAX LENGTH
MOVEI A0,0
DDGOC1: CAIL A4,.ZERO
CAILE A4,.SEVEN
POPJ SP, ; EXIT IF NON-OCTAL DIGIT.
SOJL A3,DDGOC2 ; IF TOO LONG, SKIP REST.
MOVEI A1,-.ZERO(A4)
ROT A1,-3 ; GET TO L.H. END
LSHC A0,3 ; ACCUMULATE.
DDGOC2: PUSHJ SP,DDGTCH
JRST DDGOC1 ; LOOP
SUBTTL Debugging system - command routine - PAUSE
; Output is a breakpoint control block, whose format is:
;
; Word 0: XWD addr of module's loader s.t. entry, addr of BLKIDX entry
; Word 1: bit 0 (BP.PSH) 1=break is on a PUSHJ SP, instruction
; bit 1 (BP.OCT) 1=octal address.
; bit 2 (BP.SIL) 1=silent (no "Pause at line n" message)
; bit 3 (BP.PRO) 1=procedure.
; bit 4 (BP.LAB) 1=label, 0=line-number.
; bit 5 (BP.PRI) 1="PRIVATE" (UN-NAMED) AUTOLIST.
; bit 6-8 (BP.ACT) Action on error processing autolist:
; 1 - IGNORE.
; 2 - CONTINUE (Type message)
; 3 - KILL (Reference to this a/l from this b/p)
; 4 - STOP (and return control to ALGDDT cmd level)
; bit 9 (BP.NXT) 1=NEXT command (kill automatically).
;
; bit 10-17 (BP.STN) Statement # within line.
; bits 18 - 35: line number (if bit 4 = 0), or
; ptr to SYM item for label (if bit 4 = 1).
; Word 2: Proceed counter.
; Word 3: Count-down to automatic "KILL"
; Word 4: Left half - address of entry in b/p table.
; Right half - pointer to autolist, if "private", or
; pointer to a/l list slot if "public"
; Word 5: Displaced instruction.
; If BP.PSH is 0
; Word 6: JRST Breakpoint site + 1
; Word 7: JRST Breakpoint site + 2
; If BP.PSH is 1
; Word 6: PUSH SP,Word 8
; Word 7: JRST Called Routine
; Word 8: Breakpoint site + 1
;
; The BREAK uuo is planted at the breakpoint site: its address-field
; points to the control block.
; Also, the address of the breakpoint and of the control block is
; put into a slot in the breakpoint list, a pointer to which is
; held in %DDTBK(DB) (AOBJN pointer).
PAUSE: SETZB A10,A11 ; INIT PROCEED CNTR,LINE-#
SETZB A7,A12 ; MODULE & AUTOLIST PTR
PAUSE0: ; Object command enters here with A12 -ve
SKIPA ; NORMAL CASE
PAUS0A: PUSHJ SP,DDIGCH ; ALTERNATE LOOP - IGNORE CHARACTER
CAIL A4,.ZERO
CAILE A4,.NINE ; IF DIGIT..
SKIPA
JRST PAUSE4 ; IT'S LINE #
CAIN A4,.HASH ; IF #...
JRST PAUS33 ; ..IT'S OCTAL ADDRESS.
CAIN A4,.SCOL ; IF SEMI-COLON...
JRST SETBRK ; END OF COMMAND.
CAIN A4,.LPAR ; IF LEFT-PARENTHESIS...
JRST PAUSE1 ; PROCEED-COUNT.
CAIN A4,.DOT ; IF PERIOD...
JRST PAUS0A ; IGNORE (HERE IS DEFAULT)
CAIL A4,.A ; IF
CAILE A4,.Z ; NOT ALPHA
DDER42: DDTERR ^D42 ; THERE ARE NO MORE POSSIBILITIES.
PUSH SP,A10
PUSHJ SP,SCAN3 ; READ WORD - CLOBBERS A10.
POP SP,A10
CAIN A4,.COLON ; IF DELIMITED BY A COLON...
JRST PAUS21 ; IT'S A LABEL.
SKIPA A1,.+1
XWD -PSMANY,PSWTAB
MOVEI A2,%DDTIB(DB)
PUSHJ SP,UNIQUE ; LOOK UP THE WORD.
DDTERR ^D42 ; UNKNOWN
DDTERR ^D42 ; NOT UNIQUE.
MOVE A1,PSWDSP-PSWTAB(A1) ; GET DISPATCH.
JRST (A1)
PSWTAB: SIXBIT/BEGIN/
SIXBIT/HERE/
SIXBIT/AUTO/
SIXBIT/MODES/
SIXBIT/PROCED/ ; PROCEDURE.
PSMANY=.-PSWTAB
PSWDSP: EXP PAUSE6
EXP PAUSE0
EXP PAUSE5
EXP PAUS28
EXP PAUS32
PAUS21: ; PAUSE <label>
TLZE FL,DD%FLG ; %IDENT ?
DDTERR ^D60 ; YES - ERROR
EDIT(106) ; Make PAUSE Label: work correctly
PUSHJ SP,SEARCH ; [E106] LOOK UP LABEL
DDTERR ^D23 ; [E106] CAN'T FIND IT
;
; A6 has lexeme. A11 clobbered.
; A7 has pointer to BLKIDX entry.
;
TLNE A6,$TYPE-$L ; LABEL ?
DDTERR ^D62 ; NO
TLNN A6,400 ; FORMAL ?
TLNE A6,200000 ; SWITCH ?
DDTERR ^D62 ; YES
MOVEI A11,(A1) ; PTR TO SYM ITEM IN S.T.
TLO A11,BP.LAB ; MARK AS SUCH.
PUSH SP,A7 ; SAVE BLKIDX POINTER
SETZ A7, ; [E106] Clear module name
JRST PAUS0A ; CONTINUE, SKIPPING ":"
PAUS32: ; Procedure.
PUSH SP,A10
PUSHJ SP,SCAN3 ; GET NAME.
POP SP,A10
TLZE FL,DD%FLG ; %-IDENT ?
DDTERR ^D60 ; YES - SILLY.
PUSHJ SP,SEARCH ; [E106] Look up procedure name
DDTERR ^D23 ; [E106] Can't find it !
TLNE A6,200000 ; IS IT
TLNN A6,100000 ; A PROCEDURE ?
DDTERR ^D84 ; NO - COMPLAIN.
PUSH SP,A7 ; SAVE BLKIDX PTR
MOVEI A11,(A1) ; SAVE STE ITEM ADDR.
TLO A11,BP.PRO ; MARK AS PROCEDURE.
SETZ A7, ; [E106] Clear module name
JRST PAUSE0 ; CONTINUE.
PAUS28: ; MODES (OBJECT command). 1st char is in A4.
JUMPGE A12,DDER42 ; ILLEGAL UNLESS OBJECT CMD.
TLZ A12,377777 ; CLEAR DEFAULTS.
PAUS31: MOVSI A3,-PAUS29 ; TABLE LENGTH.
CAIE A4,@PAUS30(A3) ; MATCH ?
AOBJN A3,.-1 ; NO - TRY NEXT.
IOR A12,PAUS30(A3) ; YES - SET FLAG.(R.H. DOESN'T MATTER)
TLNE A12,OBJERR ; ERROR CHAR ?
DDTERR ^D42 ; YES.
PUSHJ SP,DDIGCH ; GET NEXT CHAR.
CAIE A4,.COMMA ; MORE MODES ?/
JRST PAUSE0 ; NO.
PUSHJ SP,DDIGCH ; YES - GET NEXT MODE.
JRST PAUS31
PAUS30: ; Table of mode chars. Bits 13 - 17 must be zero !!!
XWD OBJOCT,"O" ; OCTAL
XWD OBJASC,"7" ; ASCII
XWD OBJASC,"A" ; "
XWD OBJSIX,"6" ; SIXBIT
XWD OBJSYM,"S" ; SYMBOLIC INSTRUCTION.
XWD OBJINT,"I" ; INTEGER
XWD OBJINT,"D" ; "
XWD OBJREA,"R" ; REAL
XWD OBJREA,"F" ; "
XWD OBJLR,"L" ; LONG REAL.
; add extra ones here.
PAUS29==.-PAUS30
XWD OBJERR,0 ; CATCH-ALL FOR OTHER CHARS.
PAUSE1: ; PROCEED-COUNT.
PUSHJ SP,DDGTVL ; GET DECIMAL NUMBER.
MOVEI A10,(A5) ; AND REMEMBER VALUE
CAIN A4,.RPAR ; CORRECT TERMINATOR ?
JRST PAUS0A ; YES - CARRY ON
CAIN A4,.COLON ; PAUSE (M:N) ?
SKIPGE A12 ; AND NOT OBJECT COMMAND ?
DDTERR ^D38 ; NO TO ONE OR THE OTHER
PUSHJ SP,DDGTVL ; READ UPPER BOUND
CAILE A10,(A5) ; VALID RANGE SPECIFICATION ?
DDTERR ^D96 ; NO
HRLI A10,(A5) ; REMEMBER IT IN L.H.
CAIE A4,.RPAR ; CLOSING PARENTHESIS ?
DDTERR ^D38 ; NO - ERROR
JRST PAUS0A ; YES - CARRY ON
PAUSE4: ; LINE-#
PUSHJ SP,DDGTV1 ; GET IT.
MOVEI A11,(A5) ; SAVE
CAIE A4,.COMMA ; STMNT # ?
JRST PAUSE2 ; NO.
PUSHJ SP,DDGTVL ; YES - GET IT.
HRLI A11,(A5)
PAUSE2: PUSHJ SP,DDGTMD
; GET "IN MODULE-NAME" IF PRESENT - TO A7 IN RAD50
CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; GET A NON-SPACE.
JRST PAUSE0
PAUS33: ; Octal address.
JUMPGE A12,DDER42 ; FOR NOW, ONLY ALLOWED IN 'OBJECT' CMD.
PUSHJ SP,DDGTCH
PUSHJ SP,DDGTOC ; GET OCTAL VALUE TO A0.
HRRZ A11,A0
TLO A11,BP.OCT ; MARK AS OCTAL ADDRESS.
JRST PAUSE2 ; GET 'IN MODULE' IF PRESENT.
PAUSE6: ; BEGIN AUTOLIST.
JUMPL A12,DDER42 ; NOT ALLOWED FOR OBJECT CMD.
TRNE FL,DDALST ; EXECUTING AN AUTOLIST ?
DDTERR ^D91 ; YES - CAN'T HANDLE NESTING.
PUSHJ SP,PAUSE9 ; PROCESS SWITCH IF ANY.
; SETS BITS IN L.H. A12
TLOE A12,10 ; REMEMBER IT'S "PRIVATE"
DDTERR 1,^D42 ; DISSALLOW BAUSE 7 BEGIN BEGIN !
MOVEI A0,ALSIZE+1 ; GET SIZE NEEDED
PUSHJ SP,GETOWN ; GET SPACE FOR A/L
SETZM ALSIZE(A1) ; AND CLEAR LINK
HRRI A12,(A1) ; SAVE ADDRESS.
HRRZ A1,%DDTAL(DB) ; IF NOT
TRNN A1,-1 ; ALREADY DONE,
PUSHJ SP,PAUS10 ; SET UP AUTOLIST TABLE, TO ALLOW NESTING.
JRST PAUSE0
PAUSE5: ; AUTO AUTOLIST-NAME
JUMPL A12,DDER42 ; NOT ALLOWED FOR OBJECT CMD.
PUSHJ SP,PAUSE9 ; PROCESS SWITCH.
CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; GET NAME (1 ALPHA CHAR)
CAIL A4,.A
CAILE A4,.Z ; ALPHA ?
DDTERR ^D44 ; NO.
HRRZ A1,%DDTAL(DB) ; POINTER TO TABLE.
TRNN A1,-1 ; IF SET UP
PUSHJ SP,PAUS10 ; NOT YET - DO SO.
ADDI A1,-.A(A4)
HRRI A12,(A1) ; GET ADDR OF TABLE-SLOT.
JRST PAUS0A
PAUS10: ; SET UP AUTO-LIST TABLES.
MOVEI A0,^D26+1+DDNEST ;
PUSHJ SP,GETCLR
HRRM A1,%DDTAL(DB)
POPJ SP,
PAUSE9: ; SCAN FOR AUTOLIST SWITCH.
CAIE A4,.SLASH ; SWITCH ?
POPJ SP, ; NO.
PUSH SP,A10
PUSHJ SP,DDGTCH
PUSHJ SP,SCAN3 ; GET WORD.
POP SP,A10 ; SCAN3 CLOBBERS THIS.
PAUS12: MOVEI A2,%DDTIB(DB) ; GET ADDR OF SCAN3 O/P BUFFER.
SKIPA A1,.+1
XWD -5,PAUS13
PUSHJ SP,UNIQUE
DDTERR ^D45 ; UNKNOWN
DDTERR ^D46 ; NOT UNIQUE.
SUBI A1,PAUS13 ; GET OFFSET.
TRNN A1,-1 ; ZERO (=SILENT) ?
TLOA A12,100 ; YES: REMEMBER.
DPB A1,[
POINT 3,A12,17] ; NO - SAVE OFFSET AS CODE.
JRST PAUSE9 ; AND SEE IF MORE SWITCHES.
PAUS13: <SIXBIT/SILENT/> ; 0(MUST BE) - NO MESSAGE.
<SIXBIT/IGNORE/> ; 1
<SIXBIT/CONTINUE/> ; 2
<SIXBIT/KILL/> ; 3
<SIXBIT/STOP/> ; 4
LIST7C: ; Table of ASCII switch-names, for LIST command. N.B. 2 words each !!
ASCIZ/ignore/
ASCIZ/continue/
ASCIZ/kill/
Z
ASCIZ/stop/
Z
SETBRK: ; All read. Here, A7 = module-name (RADIX-50) or 0
; A10 = upper bound,,proceed-count.
; A11 = Statement-#,,line-# or 0 (0=here)
; or label (R.H. = SYM item address).
; or octal address.
; A12 = Autolist flags,,autolist address, or 0 (or -1 if OBJECT cmd.)
JUMPN A11,PAUS7A ; "HERE" ?
SKIPL %DDTST(DB) ; YES - DOES SYMBOL TABLE EXIST ?
DDTERR 1 ; NO - ERROR (OBJECT COMMAND)
HRRZ A11,%DDTPT(DB) ; YES - GET ADDR OF STN ITEM
MOVE A11,2(A11) ; GET LINE-# FROM IT.
PAUS7A: TLNE A11,BP.OCT!BP.PRO!BP.LAB ; PROCEDURE OR LABEL OR OCTAL ?
JRST PAUS22 ; YES.
MOVE A0,A11
TLZ A0,777777-BP.STN ; CLEAR FLAGS.
MOVE A1,A7 ; GET MODULE-NAME.
PUSHJ SP,FNDLIN ; FIND ADDRESS.
MOVE A7,A1 ; IN SOME CASES, A1 GETS SET UP.
PAUS26: ; here, A2 is address.
JUMPL A12,OBJEC0 ; LEAVE THIS CODE IF OBJECT CMD.
TRNE A2,400000 ; HI-SEG ?
DDTERR ^D47 ; ILLEGAL.
HLRZ A5,(A2) ; GET L.H. OF INSTR.
CAIN A5,(<JRST 0>) ; JRST ?
JRST PAUS25 ; YES - SEE IF LABEL
CAIN A5,(<JSP AX,@>) ; SPECIAL CASE ?
JRST PAUS15 ; MAYBE.
CAIN A5,(PUSHJ SP,) ; PUSH-JUMP ?
JRST PAUS67 ; YES - CAREFUL !
CAIN A5,(<BREAK>) ; ALREADY BREAKPOINTED ?
JRST PAUS36 ; YES - ILLEGAL UNLESS 'NEXT'
PAUS14: MOVEI A0,BP.INS+3 ; GET LENGTH OF BLOCK
MOVEI A4,(A2) ; GET ADDRESS INTO A4
PUSHJ SP,GETCLR ; GET SPACE FROM HEAP
MOVE A5,(A4) ; GET DISPLACED INSTR.
MOVEM A5,BP.INS(A1) ; STORE IN BLOCK
MOVSI A5,(JRST) ; THEN GET ORDINARY RETURN
HRRI A5,1(A4) ; TO BREAK+1, AND STORE
MOVEM A5,BP.INS+1(A1) ; IN WORD AFTER INSTRUCTION
ADDI A5,1 ; AND ALSO SET UP NEXT WORD
MOVEM A5,BP.INS+2(A1) ; IN CASE OF SKIPS
JRST PAUS16 ; GO SET UP REST OF BLOCK.
PAUS36: ; IT'S A BREAK UUO.
HRRZ A1,(A2) ; GET R.H. OF BREAK UUO.
TLNE A11,BP.NXT ; IF THIS IS 'NEXT' COMMAND,
POPJ SP, ; FORGET THE WHOLE THING.
MOVE A5,BP.FLG(A1) ; GET FLAG WORD.
TLNN A5,BP.NXT ; IS IT A 'NEXT' ONE ?
DDTERR ^D48 ; NO - PAUSE ALREADY EXISTS ERROR.
JRST PAUS37 ; YES - USE SAME BLOCK.
PAUS22: ; It's a label or proc. A11 points to its SYM item in S.T.
; or, it's an octal address, in A11.
; A7 = module name or 0.
TLNN A11,BP.OCT ; UNLESS IT'S AN OCTAL ADDRESS,
POP SP,A3 ; RETRIEVE BLKIDX PTR.
JUMPN A7,PAUS23 ; THIS MODULE ?
TLNE A11,BP.OCT ; IS IT AN OCTAL ADDRESS ?
TDZA A1,A1 ; YES - NO DEFAULT RELOCATION.
HLRZ A1,%DDTPT(DB) ; NO - GET ITS RELOCATION.
EDIT(075); Set relocation correctly for "OBJECT #n in FOO"
JRST PAUS24
PAUS23: ; A7 has right-justified RADIX-50 module name.
PUSH SP,A10
PUSHJ SP,FNDMOD ; LOOK FOR NAME IN LINK S.T.
DDTERR ^D19 ; NOT THERE.
MOVE A1,A10 ; FOUND - GET POINTER.
POP SP,A10
; Here A1 points to LINK S.T. entry for the module, or else it holds zero.
; If A1 holds zero, 1(A1) will address A1, and hence set A2 to zero also.
; If A1 is a pointer, A2 will be set to the relocation offset for the module.
PAUS24: HRRZ A2,1(A1) ; [E075] GET RELOCATION
TLNE A11,BP.OCT ; OCTAL ADDRESS ?
SKIPA A1,A11 ; YES - GET IT.
HRRZ A1,1(A11) ; NO - GET VALUE FROM S.T.E.
ADDI A2,(A1) ; RELOCATE IT.
MOVSI A5,$EXT-$OWN ; [E106] Check for external procedures
TLNE A11,BP.PRO ; [E106] Pause on Procedure ?
TDNN A5,1(A11) ; [E106] And External procedure ?
JRST PAUS26 ; [E106] No
MOVE A2,(A2) ; [E106] Yes - get instruction
TLC A2,(<BREAK 0>) ; [E106] Check for BREAK UUO
TLZN A2,777777 ; [E106] Was it BREAK ?
HRRZ A2,BP.INS(A2) ; [E106] Yes - get real address
JRST PAUS26 ; DONE.
PAUS25: HRRZ A1,(A2) ; JRST - GET EFFECTIVE ADDRESS
CAIL A1,(A2) ; IF BACKWARD JUMP,
CAILE A1,20(A2) ; OR TOO FAR FORWARD
JRST PAUS14 ; CAN'T POSSIBLY BE A PMB
MOVE A4,(A1) ; COULD BE - GET TARGET INSTRUCTION
MOVE A5,1(A1) ; AND FOLLOWING WORD
CAMN A4,[JSP AX,@%ALGDR+52] ; IF THIS IS NOT A CALL TO TRLAB,
CAIE A5,1(A2) ; OR PMB ADDRESS IS INCORRECT
JRST PAUS14 ; THIS IS NOT A LABEL
MOVEI A2,(A1) ; OTHERWISE POINT A2 TO TRLAB
PAUS27: ADDI A2,2 ; SKIP OVER CALL TO GOLAB/TRLAB
JRST PAUS26 ; AND GO TRY AGAIN
PAUS35: HRRZ A5,3(A2) ; GET NUMBER OF FORMALS
ADDI A2,3(A5) ; STEP PAST BLOCK
JRST PAUS26 ; AND GO TRY NEXT
PAUS15: HRRZ A4,(A2) ; GET ADDRESS
CAIE A4,%ALGDR+3 ; GOLAB ?
CAIN A4,%ALGDR+52 ; TRLAB ?
JRST PAUS27 ; YES - SKIP THEM
CAIE A4,%ALGDR+1 ; PARAM ?
CAIN A4,%ALGDR+2 ; PAR0 ?
JRST PAUS35 ; YES - SKIP THESE ALSO
JRST PAUS14 ; OTHERWISE TREAT AS NORMAL
PAUS67: MOVEI A0,BP.INS+4 ; SPECIAL CASE - PUSHJ SP,Routine
MOVEI A4,(A2) ; SAVE ADDRESS OF BREAK
PUSHJ SP,GETCLR ; GET SPACE FOR BLOCK
MOVE A5,(A4) ; GET DISPLACED INSTRUCTION
MOVEM A5,BP.INS(A1) ; AND STORE IN BLOCK
HRLI A5,(JRST 0) ; CHANGE "PUSHJ SP," TO "JRST"
MOVEM A5,BP.INS+2(A1) ; AND STORE AS SECOND INSTRUCTION
MOVEI A5,BP.INS+3(A1) ; THAT WILL BE EXECUTED. THIS
HRLI A5,(PUSH SP,) ; SIMULATES A PUSHJ SP,address
MOVEM A5,BP.INS+1(A1) ; BY PUSH SP,[.+1]; JRST address;
MOVEI A5,1(A4) ; FINALLY SET UP THE WORD
MOVEM A5,BP.INS+3(A1) ; THAT WILL BE PUSHED
TLO A11,BP.PSH ; REMEMBER THIS IS A SPECIAL !
PAUS16: ; displaced instruction(s) has been done.
HRLI A1,(<BREAK>) ; MAKE B/P UUO.
MOVEM A1,(A4) ; PUT IN OBJECT PROG.
HRRZ A5,%DDTPC(DB) ; GET CURRENT OBJECT PROGRAM ADDRESS
CAIN A5,(A4) ; IS THIS WHERE WE ARE SETTING B.P. ?
HRLM A1,%DDTAL(DB) ; YES - STORE CONTROL BLOCK ADDR
PAUS37: MOVEM A11,BP.LIN(A1) ; SAVE LINE-#
HRRZM A10,BP.CNT(A1) ; & PROCEED COUNTER
HRRM A3,BP.PTR(A1) ; & BLKIDX POINTER.
SETOM BP.LIM(A1) ; ASSUME NO UPPER BOUND
TLNE A10,-1 ; WAS ONE SPECIFIED ?
HLRZM A10,BP.LIM(A1) ; YES - REMEMBER IT
PUSHJ SP,FNDMOD ; GET LOADER S.T. PTR.
DDTERR ^D19 ; CAN'T BE FOUND.
HRLM A10,BP.PTR(A1) ; SAVE POINTER TO MODULE'S LOADER S.T. ENTRY
; CONTROL-BLOCK IS ALMOST COMPLETED. ITS ADDRESS IS IN A1.
; THE ADDRESS OF THE B/P IS IN A4.
; NOW, MAKE AN ENTRY IN THE B/P LIST, IN THE FORM:
; XWD ADDR-OF-B/P,ADDR-OF-CONTROL-BLOCK
PUSH SP,A1
SKIPN A3,%DDTBK(DB) ; PTR TO B/P LIST
JRST PAUS17 ; NOT SET UP YET - DO IT.
PAUS19: SKIPE A5,(A3) ; FIND A
AOBJN A3,.-1 ; ZERO SLOT.
JUMPE A5,PAUS18 ; FOUND ONE ?
SKIPE A3,(A3) ; NO. MORE TABLE ?
JRST PAUS19 ; YES - TRY THAT.
; THE TABLE IS IN 10-WORD PIECES - THE LAST WORD OF EACH
; PIECE IS EITHER 0 OR AN AOBJN PTR (-7,,ADDR) TO ANOTHER
; PIECE.
; NO FREE SLOT - GET A NEW PIECE OF TABLE AND CHAIN IT ON.
PAUS17: MOVEI A0,10 ; LENGTH OF PIECE
PUSHJ SP,GETCLR ; GET IT, ZEROED.
HRLI A1,-7 ; MAKE AOBJN PTR.
MOVEI A3,(A1) ; SAVE 1ST ADDR AS FREE SLOT.
EXCH A1,%DDTBK(DB) ; PUT NEW PIECE ON FRONT.
MOVEM A1,7(A3) ; OF OLD PIECE.
PAUS18: ; R.H. A3 IS ADDR OF FREE SLOT.
POP SP,A1 ; GET ADDR OF CONTROL BLOCK.
HRLI A1,(A4) ; ADDR OF B/P
MOVEM A1,(A3) ; STORE IN TABLE.
HRLZM A3,BP.ALP(A1) ; BACKPOINTER TO BLOCK.
; THE B/P IS NOW SET UP.
HRRM A12,BP.ALP(A1) ; SAVE AUTOLIST ADDR IF ANY.
TLNE A12,10 ; PRIVATE ?
TRO FL,DDALIP ; YES - REMEMBER.
HLLZ A2,A12
LSH A2,^D9 ; SHIFT FLAGS TO L.H.
TLZ A2,BP.STN ; JUST FLAGS.
IORM A2,BP.FLG(A1) ; SAVE IN BLOCK.
HRLI A12,(A12) ;
; WITH DDALIP SET, MAIN LOOP WILL READ COMMANDS INTO THE
; AUTOLIST. A12 IS KEPT AS PTR-TO-FREE-WORD,,ADDR-OF-ST.
; COMMANDS ARE CHECKED FOR SYNTAX ONLY, N O T FOR SEMANTICS.
; MAIN LOOP ROUTINES (DDGTLN, SCAN4, UNIQUE ETC) MUST
; RESPECT A12 !!!
HRRM FL,%DDTFL(DB) ; ENSURE DDALIP GETS KEPT!
POPJ SP, ; DONE.
SUBTTL Debugging system - find module routine, and read module-name.
FNDMOD: ; Finds a module-name in the LINK symbol table.
; Call with the name, in Radix50 (right-justified!) in A7.
; Returns (skip) with pointer in A10.
; Non-skip return if not found.
; A7 is the only AC clobbered.
;
; N.B.:
; 'IF' name is found in more than 1 title item 'THEN'
; 'BEGIN' 'IF' one of them is main.program 'THEN'
; use that one 'ELSE'
; DDTERR ^D49 'FI'
; 'END''FI';
; We check for 'main.program' by comparing its relocation with
; %BEGIN.
; The error-condition is most unlikely: the only feasible way
; of getting it is to have two (MACRO) procedures with the
; same TITLEs, but different ENTRY's !!!
;
; DDTERR ^D17 if no LINK symbol-table.
JUMPN A7,.+3 ; IF NAME IS ZERO,
HLRZ A10,%DDTPT(DB) ; USE CURRENT
JRST CPOPJ1 ; AND GIVE GOOD RETURN.
PUSH SP,A2
PUSH SP,A3
SKIPN A2,.JBSYM ; GET POINTER TO LINK S.T.
DDTERR ^D17 ; NONE
TLZ A7,740000
SETZ A10,
MOVE A3,@%SYS0(DB) ; GET VALUE
FNDMD1: CAMN A7,(A2) ; NAMES THE SAME ?
JRST FNDMD2 ; YES - CHECK UNIQUENESS ETC.
FNDMD3: AOBJN A2,.+1 ; ADVANCE TO
AOBJN A2,FNDMD1 ; NEXT ITEM.
POP SP,A3 ; END - RESTORE
POP SP,A2 ; AC'S
TLNN A10,-1 ; ANY FOUND ?
POPJ SP, ; NO.
TLNN FL,DDTMP1 ; YES - ONLY ONE ? (FLAG CLEAR)
MOVS A10,A10 ; YES - GET IT TO R.H. A10 FOR RETURN.
TLNE FL,DDTMP1 ;
TRNE A10,-1 ; NOT UNIQUE - USE MAIN.PROGRAM ONE IF ANY.
JRST CPOPJ1 ; GOOD RETURN.
DDTERR ^D49 ; NOT UNIQUE, AND NONE HAS RELOC = %BEGIN.
FNDMD2: ; FOUND ONE.
TLNE A10,-1 ; FIRST ONE ?
TLO FL,DDTMP1 ; NO - REMEMBER NOT UNIQUE.
HRR A10,1(A2) ; GET RELOCATION OF THIS ONE.
CAIE A3,(A10) ; = %BEGIN ?
TRZA A10,-1 ; NO - RESTORE ZERONESS OF POINTER TO %BEGIN ONE.
HRR A10,A2 ; YES - SAVE POINTER TO IT.
HRL A10,A2 ; IN ANY CASE, SAVE POINTER TO THIS ONE.
JRST FNDMD3 ; AND SEE IF ANY MORE.
DDGTMD: ; Read "IN module-name" if present. Return it in RAD50 in A7 , or 0
; Clobbers A0-A4, A10.
PUSH SP,A11 ;
CAIN A4,.SPACE
PUSHJ SP,DDIGCH ; IGNORE BLANKS
MOVEI A7,0 ; DEFAULT THIS MODULE.
CAIE A4,"I" ; "IN <MODULE>" ?
JRST DDGTM1 ; exit
PUSHJ SP,DDGTCH
CAIE A4,"N"
DDTERR ^D42
PUSHJ SP,DDIGCH ; GET CHAR OF NAME.
DDGTM0: IMULI A7,50 ; TO RADIX-50
TLNE A7,740000 ; TOO LONG ?
DDTERR ^D43 ; YES.
CAIN A4,.DOT ; DEAL
MOVEI A4,.Z+1 ; WITH
CAIN A4,.DOLLR ; THE
MOVEI A4,.Z+2 ; THREE
CAIN A4,.PRCNT ; SPECIAL
MOVEI A4,.Z+3 ; CASES.
CAIL A4,.A ; LETTER ?
SUBI A4,7
ADDI A7,-57(A4)
PUSHJ SP,DDGTCH
CAIE A4,.SPACE ; END ?
CAIN A4,.SCOL ;
SKIPA ;
JRST DDGTM0
DDGTM1: POP SP,A11 ;
POPJ SP, ;
SUBTTL Debugging system Control-C (Automatic 'NEXT')
DDT.CC::SKIPLE %DDTST(DB) ; Have we tried to read S.T. ?
POPJ SP, ; Yes - can't do a 'next' if no S.T.
TLO DB,INDDT ; Say we are in ALGDDT
SETZM %DDTBE(DB) ; Say no context (for FNDADR)
SKIPL %DDTST(DB) ; Have we tried to read S.T. before ?
PUSHJ SP,DDINIT ; No - try now.
HRRZ A4,.JBOPC## ; Then get User PC
MOVEM A4,%DDTPC(DB) ; Save it for later
SKIPGE %DDTST(DB) ; And unless S.T. not available
PUSHJ SP,FNDADR ; Convert address to line number
TLZ DB,INDDT ; Failure !
TLNN DB,INDDT ; Did we succeed ?
POPJ SP, ; No - return to ALGOTS
POP SP,A0 ; Yes - tidy up the stack
MOVE A0,SP ; As DDCON% will update the
SUBI A0,(DB) ; stack from the value in
MOVEM A0,%ACCS+SP(DB) ; %ACCS+SP, which is delocated
HRRI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PUSHJ SP,DDSETI ; [E1000] ^C trap
SETO A0, ; And force channel -1
EXCH A0,%CHAN(DB) ; for output, remembering
MOVEM A0,%DDTTY(DB) ; The original setting
PUSHJ SP,DDTTYC ; Set TTY characteristics
TLO DB,TMPFL3 ; Set 'no typeout' flag
PUSHJ SP,HSTPR0 ; And establish context
HRROS %DDTCC(DB) ; [E114] Flag 'automatic next'
; **** JRST DDNEXT ; Fall into 'NEXT' command
SUBTTL Debugging system - command routine - NEXT.
DDNEXT: ; 'NEXT' command.
; Puts a breakpoint at the physically next statement;
; sets bit BP.NXT in the control-block,
; which causes the breakpoint to get killed automatically.
SKIPL %DDTST(DB) ; Any symbols ?
DDTERR 1 ; No - can't be done.
SKIPE %DDTNL(DB) ; Already doing a 'next' ?
PUSHJ SP,NBKILL ; Yes - go delete old one
HRRZ A3,%DDTPT(DB) ; Get address of current 'STN' item
JRST DDNXT1 ; And go read next S.T. entry
NEXT.6: ; 'else' - step to after 'fi'
HLRZ A3,1(A3) ; Get S.T. address of 'fi'
NEXT.7: ; 'fi' - ignore
DDNXT1: PUSHJ SP,SCANST ; Get next S.T. entry
DDTERR ^D92 ; No more S.T. - error
CAIN A2,'STN' ; Statement item ?
JRST DDNXT2 ; Yes - go set pause
CAIE A2,'MRK' ; Sentinel item ?
JRST DDNXT1 ; No - keep looking.
HRRZ A2,1(A3) ; Yes - get sub-type
JRST @DDNTAB(A2) ; And dispatch via table
DDNXT2: PUSHJ SP,SETNBP ; Go set a 'next' breakpoint
JRST CONTIN ; Restart his program.
DDNTAB: EXP NEXT.0 ; Type 0 'exit'
EXP NEXT.1 ; Type 1 'for'
EXP NEXT.2 ; Type 2 'do'
EXP NEXT.3 ; Type 3 'od'
EXP NEXT.4 ; Type 4 'if'
EXP NEXT.5 ; Type 5 'then'
EXP NEXT.6 ; Type 6 'else'
EXP NEXT.7 ; Type 7 'fi'
EXP NEXT.8 ; Type 8 'go'
EXP NEXT.9 ; Type 9 'to'
SETNBP: SETZB A7,A10 ; this module, no proceed count
SETZ A12, ; No autolist.
MOVE A11,2(A3) ; Get statement,,line.
TLO A11,BP.NXT ; Say it's "next" (kill automatically).
PUSHJ SP,SETBRK ; Set up breakpoint.
; N.B. SETBRK returns the address of the breakpoint control block in A1.
SKIPE BP.LNK(A1) ; Is this B.P. already linked ?
POPJ SP, ; Yes - return
SKIPN A2,%DDTNL(DB) ; No - get address of last B.P.
SETO A2, ; This is the first - flag it
MOVEM A2,BP.LNK(A1) ; Store value in link field
HRL A1,%DDTDL(DB) ; Then get top-level DL
MOVEM A1,%DDTNL(DB) ; store with B.P. address
POPJ SP, ; Return
NEXT.0: ; 'exit' - exit from procedure
MOVEI A4,@PRGLNK(DL) ; Get return address for procedure
PUSHJ SP,FNDADR ; And convert to line number
DDTERR ^D98 ; Failure - say so
MOVE A0,A4 ; Then convert back to return
MOVE A1,A5 ; Address, to see if we need to set
PUSHJ SP,FNDLIN ; break on this or the next statement
MOVEI A3,(A5) ; Get address of STN item
CAIE A2,@PRGLNK(DL) ; Return to start of next statement ?
JRST DDNXT1 ; No (typed procedure within expression)
JRST DDNXT2 ; Yes (return from procedure statement)
NEXT.3: ; 'od' - step back to corresponding 'for'
HLRZ A3,1(A3) ; L.H. of 'od' points to 'for'
NEXT.1: ; 'for'
NEXT.4: ; 'if'
HLRZ A3,1(A3) ; Get next sentinel ('then' or 'do')
NEXT.2: ; between 'for' and 'do', or
NEXT.5: ; between 'if' and 'then'.
NX25.0: HLRZ A4,1(A3) ; Get limit for S.T. search
NX25.1: PUSHJ SP,SCANST ; Read next S.T. entry
DDTERR ^D97 ; Can't find one - error
CAIG A4,(A3) ; Earlier than next sentinel ?
JRST NX25.2 ; No - null 'then', 'else' or 'do'
CAIE A2,'STN' ; Yes - is this a 'STN' entry ?
JRST NX25.1 ; No - try again
PUSH SP,A4 ; Save pointer into S.T.
PUSHJ SP,SETNBP ; Set a breakpoint here
POP SP,A3 ; Restore S.T. pointer
JRST DDNXT1 ; And go set other breakpoint(s)
NX25.2: MOVEI A3,(A4) ; Empty 'then', 'else' or 'do' clause
HRRZ A2,1(A3) ; Get type of next delimiter
CAIE A2,M.ELSE ; ('else', 'fi', or 'od')
JRST DDNXT1 ; 'fi' or 'od' - try again
JRST NX25.0 ; 'else' - pause after 'else' and 'fi'
NEXT.8: ; 'go' (goto command)
HLRZ A3,1(A3) ; Get address of corresponding 'to'
NEXT.9: ; 'to' - control transfer
HLRZ A1,%DDTPT(DB) ; Get address of LINK S.T.E. for this module
SKIPN A1,1(A1) ; N.B. if A1=0, 1(A1) addresses A1 !!
DDTERR ^D17 ; If not there, say no G.S.T.
HLRZ A4,1(A3) ; Get R.A. of transfer instruction
ADDI A4,(A1) ; And relocate it
HRRZ A2,%DDTPC(DB) ; Get current address
HRRZ A5,%DDTPT(DB) ; [E115] Get current STN entry
HRRZ A5,1(A5) ; [E115] Get statement address
ADDI A5,(A1) ; [E115] And relocate it.
CAIE A5,(A4) ; [E115] Is this the transfer instruction ?
JRST NXT9.0 ; No - not just simple 'go to label'
MOVE A4,(A2) ; Get the actual instruction
HLRZ A5,A4 ; Get the opcode into A5
CAIN A5,(<BREAK 0>) ; And if this is a break UUO
MOVE A4,BP.INS(A4) ; Get the replaced instruction
TLC A4,(JRST 0) ; Swap bits
TLNE A4,777777 ; Was this really a JRST ?
DDTERR ^D99 ; No - what can we do now ?
PUSHJ SP,FNDADR ; Yes - convert address to line-number
DDTERR ^D98 ; Can't do it - error !
JRST DDNXT2 ; And go set up breakpoint
NXT9.0: ; 'go to designational expression' or 'go to formal label'
MOVS A5,(A4) ; Get the instruction
CAIN A5,(<JUMPN A2,(A2)>) ; If this is not the right sort,
CAILE A2,(A4) ; Or if it has been passed
DDTERR ^D99 ; Issue emergency message
HRL A4,%DDTDL(DB) ; O.K. - Get top-level DL
MOVEM A4,%DDTNL(DB) ; Save (setting 'next' flag)
MOVE A5,[JRST GONXT0] ; Replace transfer instruction
MOVEM A5,(A4) ; with jump to ALGDDT routine
JRST CONTIN ; And continue program
GO.NXT::; Exit from GOLAB/FORLAB - check for pending 'next'
SKIPN A1,%DDTNL(DB) ; Are we doing a 'next' ?
AOJA AX,CNC.AX## ; No - return to program
HRLZ A0,%DDTDL(DB) ; Yes - get current top DL
CAMLE A0,A1 ; Got down far enough yet ?
AOJA AX,CNC.AX## ; No - continue program
MOVE A0,(A1) ; Get word addressed by A1
CAMN A0,[JRST GONXT0] ; CB address, or instruction ?
AOJA AX,GONXT1 ; 'goto' type next - remove it
PUSH SP,AX ; Other sort of 'next' pending
PUSHJ SP,NBKIL0 ; Unlink and kill breakpoint(s)
POP SP,AX ; Then restore target PC
AOJA AX,GONXT2 ; And go process this pause
GONXT0: MOVEI AX,(A2) ; Get tranfer address
CAIN AX,%FRLAB## ; Go to formal label ?
JRST %FRLAB## ; Yes - sort it out
GONXT1: HRRZ A4,%DDTNL(DB) ; No - get changed address
SETZM %DDTNL(DB) ; Clear 'next' flag
MOVSI A0,(<JUMPN A2,(A2)>) ; And replace original instruction
MOVEM A0,(A4) ; (Clobbered by 'next' command)
JUMPN AX,GONXT2 ; Easy if branch would have been taken
MOVEI AX,1(A4) ; Otherwise get return PC
SKIPA A1,AX ; And save a copy of it in A1
GONXT2: SETZ A1, ; Normal case - set A1 to zero
MOVE A0,SP ; Get current stack top
SUBI A0,(DB) ; Delocate it
MOVEM A0,%ACCS+SP(DB) ; And save (for continue)
PUSH SP,A1 ; Save flag
HRRZM AX,.JBOPC## ; Store address (for 'continue')
TLO DB,INDDT ; Say we are in DDT
HRRI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PUSHJ SP,DDSETI ; [E1000] control-C intercept
PUSHJ SP,DDTTYC ; and TTY characteristics
SETO A0, ; Set channel to -1
EXCH A0,%CHAN(DB) ; (TTCALL I/O channel)
MOVEM A0,%DDTTY(DB) ; And remember original setting
MOVEI A0,(DL) ; Get current DL
SUBI A0,(DB) ; Delocate it
HRL A0,.JBOPC## ; Get current PC as well
MOVSM A0,%DDTPC(DB) ; And save this too
SETZM %DDTBE(DB) ; Force FNDADR to set context
HRRZ A4,%DDTPC(DB) ; Get transfer address
PUSHJ SP,FNDADR ; Convert it to a line-number
JRST GONXT4 ; Can't - what now ?
HRRZ A3,%DDTPT(DB) ; Get address of STN entry
POP SP,A0 ; Restore orignal PC
JUMPE A0,GONXT3 ; Branch was taken - carry on
HLRZ A1,%DDTPT(DB) ; Get address of Link S.T.E.
SKIPN A1,1(A1) ; And get module relocation
DDTERR ^D17 ; Error if no Link G.S.T.
SUBI A0,(A1) ; Get offset address within module
CAMLE A0,1(A3) ; Really next statement ?
SOJA A0,GONXT5 ; No - hidden instructions !
GONXT3: PUSHJ SP,SETNBP ; Set a breakpoint on this statement
HRRZS %DDTAL(DB) ; Ensure break will occur
JRST CONTIN ; And continue execution
GONXT4: TLO DB,TMPFL3 ; Suppress typeout
PUSHJ SP,HSTPR0 ; And establish context
DDTERR ^D98 ; Then issue error messsage
GONXT5: PUSHJ SP,SCANST ; Get next S.T. entry
DDTERR ^D97 ; Give up if no more
CAIE A2,'MRK' ; Is this a sentinel ?
JRST GONXT5 ; No - try next entry
HRRZ A2,1(A3) ; Yes - get type code
CAIE A2,M.TO ; Is ths the 'to' ?
JRST GONXT5 ; No - try again
HLRZ A2,1(A3) ; Yes - get address offset
CAMN A2,A0 ; Is it this one ?
JRST DDNXT1 ; Yes - do a 'next'
CAMG A2,A0 ; No - too far ?
JRST GONXT5 ; No - try again
DDTERR ^D97 ; Yes - give up
NBKILL: PUSHJ SP,NBWARN ; Warn user about earlier BP
MOVE A1,%DDTNL(DB) ; Get 'next' breakpoint address
MOVE A1,(A1) ; Get instruction, if 'goto' break
CAME A1,[JRST GONXT0] ; Is it a jump into ALGDDT ?
JRST NBKIL0 ; No - delete linked pauses
MOVSI A0,(<JUMPN A2,(A2)>) ; Yes - replace original
MOVEM A0,(A1) ; instruction in users code
SETZM %DDTNL(DB) ; Clear 'next' flag
POPJ SP, ; and return
NBKIL0: HRRZ A1,%DDTNL(DB) ; Get 'next' breakpoint address
NBKIL1: PUSH SP,BP.LNK(A1) ; Save its link field,
SETZM BP.LNK(A1) ; And delete links
HLRZ A0,%DDTAL(DB) ; Get current breakpoint, if any
CAIN A0,(A1) ; Is this the current pause ?
JRST NBKIL2 ; Yes - leave it alone
HLRZ A5,BP.ALP(A1) ; Get breakpoint table address
MOVSI A0,BP.NXT ; Get 'next' flag into L.H. of A0
SKIPE BP.LIM(A1) ; If activation count exhausted
TDNE A0,BP.FLG(A1) ; or this is a 'next' breakpoint
PUSHJ SP,KILLX ; Delete it
NBKIL2: POP SP,A1 ; Get original link field
JUMPG A1,NBKIL1 ; Repeat if more left
SETZM %DDTNL(DB) ; Otherwise clear 'next' flag
POPJ SP, ; And return
NBWARN: DDTERR 1,^D100 ; Soft error - warn the user
SUBTTL Debugging system - command routine - LIST
LIST: ; Syntax:
;
; LIST; ! all breakpoints, and names of DEFINEd AUTOlists;
; LIST label: or LIST line-#[,stmnt-#];
; ! list a breakpoint, and its AUTOlist;
; LIST A; ! list DEFINEd AUTOlist A;
; LIST ALL; ! list all breakpoints, and all DEFINEd AUTOlists.
PUSHJ SP,DDKL ; CALL COMMON LIST/KILL CMD SCANNER.
; here, A5 = b/p block addr or a/l slot addr. L.H. = flags.
TLNE A5,DDKL.A ; "ALL" ?
JRST LIST11 ; YES.
TLNE A5,DDKL.N ; NULL (LIST;) ?
JRST LIST1 ; YES.
TLNE A5,DDKL.L ; AUTOLIST ?
JRST LIST10 ; YES.
; Here, A5 points to desired breakpoint control-block.
SKIPN BP.CNT(A5) ; ANY PROCEED-COUNT ?
JRST LIST6 ; NO.
MOVEI A1,[ASCIZ/
Proceed count = /]
PUSHJ SP,MONIT
MOVE A0,BP.CNT(A5)
PUSH SP,A5
PUSHJ SP,IPRNT%
PUSHJ SP,CRLF%
POP SP,A5
LIST6: HRRZ A4,BP.ALP(A5) ; AUTOLIST PTR.
JUMPE A4,CPOPJ ; NONE. DONE.
MOVE A3,BP.FLG(A5)
TLNE A3,BP.PRI ; PRIVATE ? (I.E. INPUT VIA "BEGIN")
JRST LIST7 ; YES.
MOVEI A1,[ASCIZ/
Public autolist /]
PUSHJ SP,MONIT
HRRZ A3,%DDTAL(DB) ; AUTOLIST TABLE ADDR.
SUBI A4,-.A(A3) ; PRODUCE ASCII NAME.
MOVEI A13,(A4)
PUSHJ SP,DDOUCH
HRRZ A4,BP.ALP(A5)
HRRZ A4,(A4)
JUMPN A4,LIST7A ; IF EXISTS, LIST IT.
MOVEI A1,[ASCIZ/ (undefined)./]
PUSHJ SP,MONIT
PJRST DDBRKB ; EXIT VIA BREAKOUTPUT.
LIST7: MOVEI A1,[ASCIZ/
Private autolist/]
PUSHJ SP,MONIT
LIST7A: ; A5 = pointer to breakpoint control block. Save A4.
LDB A3,[
POINT 3,BP.FLG(A5),8] ; GET AUTOLIST ERROR-ACTION-CODE.
JUMPE A3,LIST7B ; ZERO - NO SWITCH.
MOVEI A13,.SLASH
PUSHJ SP,DDOUCH
LSH A3,1 ; 2 WORD ENTRIES.
MOVEI A1,LIST7C-2(A3) ; GET ASCII SWITCH-NAME
PUSHJ SP,DDTOU% ; & PRINT.
LIST7B: MOVEI A1,[ASCIZ/:
/]
PUSHJ SP,DDTOU%
PJRST LIST8
LIST10: SKIPN A4,(A5) ; GET ADDR OF AUTOLIST, IF ANY.
DDTERR ^D65 ; NONE.
;pjrst LIST8 ; LIST IT.
LIST8: ; Here to list 1 autolist, address in A4. Preserve A5.
MOVEI A3,-1(A4) ; GET ADDRESS TO A3
LIST8A: SKIPN 1(A3) ; IS NEXT COMMAND 'END' ?
PJRST CRLF% ; YES - EXIT VIA CRLF%
HRLI A3,(POINT 7,0,35) ; MAKE A3 A BYTE POINTER
MOVE A1,[POINT 7,%DDTCB(DB)] ; [E106] %DDTCB IS SPARE AT THIS POINT
LIST8B: TLNE A3,760000 ; AT END OF A WORD ?
JRST LIST8C ; NO - GET NEXT CHAR
MOVE A2,1(A3) ; YES - GET NEXT WORD
TLNN A2,-1 ; LINK TO NEXT CHUNK ?
HRRI A3,-1(A2) ; YES - FOLLOW LINK
LIST8C: ILDB A2,A3 ; GET CHAR OF AUTOLIST.
JUMPE A2,LIST8B ; DON'T PUT NULLS IN.
IDPB A2,A1
CAIE A2,.EQU ; END OF
CAIN A2,.SCOL ; A LINE ?
TDZA A2,A2 ; YES.
JRST LIST8B ; NO - GET NEXT.
IDPB A2,A1 ; MAKE IT ASCIZ
PUSHJ SP,CRLF% ; TYPE A NEWLINE
MOVEI A1,%DDTCB(DB) ; POINT A1 TO BUFFER
PUSHJ SP,MONIT ; TYPE IT
JRST LIST8A ; AND TYPE NEXT COMMAND
LIST1: ; LIST; ! list all breakpoints, and names of DEFINEd autolists.
SKIPN A7,%DDTBK(DB) ; GET BREAKPOINT TABLE ADDR.
JRST [
MOVEI A1,[ASCIZ/
No pauses exist./]
PUSHJ SP,MONIT
JRST LIST1N] ; NO BREAKPOINTS.
MOVEI A1,[ASCIZ/
Proceed-count Autolist Where
/]
PUSHJ SP,MONIT
LIST1A: HRRZ A6,(A7)
JUMPE A6,LIST1B ; EMPTY SLOT
MOVE A0,BP.CNT(A6) ; PROCEED COUNT.
SKIPE A0 ; IF ZERO, DON'T PRINT.
PUSHJ SP,IPRNT%
MOVEI A13,.HT
PUSHJ SP,DDOUCH
PUSHJ SP,DDOUCH
HRRZ A13,BP.ALP(A6) ; AUTOLIST PTR.
JUMPE A13,LIST1E
MOVE A2,BP.FLG(A6)
TLNN A2,BP.PRI ; PRIVATE ?
JRST LIST1F ; NO.
MOVEI A1,[ASCIZ/private/]
PUSHJ SP,MONIT
JRST LIST1E
LIST1F: HRRZ A2,%DDTAL(DB)
SUBI A13,-.A(A2) ; PRODUCE ASCII NAME.
PUSHJ SP,DDOUCH
LIST1E: MOVEI A13,.HT
PUSHJ SP,DDOUCH
PUSHJ SP,DDOUCH
MOVE A3,BP.FLG(A6)
TLNE A3,BP.LAB!BP.PRO ; LABEL OR PROCEDURE ?
JRST LIST1C ; YES.
HRRZ A0,BP.LIN(A6) ; NO - GET LINE #
PUSHJ SP,IPRNT% ; & PRINT.
HLRZ A0,BP.FLG(A6) ; STMNT-#
ANDI A0,BP.STN ; CLEAR RUBBISH
JUMPE A0,LIST1D ; ZERO - DON'T PRINT.
MOVEI A13,.COMMA
PUSHJ SP,DDOUCH
PUSHJ SP,IPRNT%
LIST1D: PUSHJ SP,DDBRKB
PUSHJ SP,DDOUMD ; TYPE MODULE-NAME.
PUSHJ SP,CRLF%
LIST1B: AOBJN A7,LIST1A ; NEXT ENTRY.
SKIPE A7,(A7) ; DONE THIS PIECE - MORE PIECES ?
JRST LIST1A ; YES.
LIST1N: MOVEI A1,[ASCIZ/
Defined autolists: /]
PUSHJ SP,MONIT
HRRZ A4,%DDTAL(DB)
JUMPE A4,LIST1Z ; NONE.
MOVEI A5,0
MOVEI A0,0
MOVEI A6,.A-1
LIST1H: AOS A6
SKIPN A3,(A4) ; DEFINED ?
JRST LIST1G ; NO.
SKIPN A5 ; YES - IN A RANGE (E.G. A-C) ?
MOVEI A5,(A6) ; NO - SAVE THIS ONE AS POSSIBLE FIRST.
CAIG A6,.Z ; DONE ?
AOJA A4,LIST1H ; NO.
LIST1G: JUMPE A5,LIST1K+1 ; IN A RANGE ?
MOVEI A7,-1(A6) ; YES - AVOID A-A.
CAIE A7,(A5)
JRST LIST1L ; A REAL RANGE.
SKIPE A13,A0 ; GET EITHER , OR NULL.
PUSHJ SP,DDOUCH ; OUTPUT IF ,
LIST1M: MOVEI A13,(A7)
PUSHJ SP,DDOUCH
MOVEI A0,.COMMA ; SET UP SEPARATING COMMA.
JRST LIST1K
LIST1L: SKIPE A13,A0 ; A RANGE - GET , OR NULL.
PUSHJ SP,DDOUCH ; AND OUTPUT IT IF ,
MOVEI A13,(A5)
PUSHJ SP,DDOUCH
MOVEI A13,.MINUS
PUSHJ SP,DDOUCH
JRST LIST1M
LIST1K: MOVEI A5,0 ; CLEAR RANGE-START.
CAIGE A6,.Z ; WERE WE HERE BECAUSE OF END ?
AOJA A4,LIST1H ; NO
JUMPN A0,CRLF% ; YES - EXIT VIA CRLF, UNLESS THERE WERE NONE.
LIST1Z: MOVEI A1,[ASCIZ/ none.
/]
PUSHJ SP,MONIT
PJRST DDBRKB
LIST1C: ; Label or procedure.
HRRZ A4,BP.LIN(A6) ; GET PTR TO SYM ENTRY FOR LABEL.
HRRZ A5,(A4) ; GET LENGTH OF SYM ITEM.
MOVEI A1,2(A4) ; START OF NAME.
ADDI A5,-2(A1) ; GET ADDR OF LAST WORD + 1
MOVEI A4,0
EXCH A4,(A5) ; MAKE ASCIZ
PUSHJ SP,MONIT
EXCH A4,(A5) ; RESTORE DISPLACED WORD.
TLNN A3,BP.LAB ; LABEL ?
JRST LIST1D ; NO - NO COLON.
MOVEI A13,.COLON
PUSHJ SP,DDOUCH
JRST LIST1D
LIST11: ; LIST ALL;
HRRZ A5,%DDTAL(DB) ; GET AUTOLIST TABLE ADDR.
JUMPE A5,LIST1 ; SKIP IF NONE DEFINED.
MOVEI A6,(A5)
MOVEI A1,[ASCIZ/
public autolists:
/]
PUSHJ SP,MONIT
LIST13: SKIPN (A5) ; DEFINED ?
JRST LIST12 ; NO.
MOVEI A13,.A(A5)
SUBI A13,(A6)
PUSHJ SP,DDOUCH
MOVEI A13,.COLON
PUSHJ SP,DDOUCH
PUSHJ SP,CRLF%
HRRZ A4,(A5) ; GET AUTOLIST ADDR.
PUSHJ SP,LIST8 ; LIST 1 AUTOLIST.
LIST12: ADDI A5,1
CAIE A5,^D26(A6) ; DONE ?
JRST LIST13 ; NO.
JRST LIST1 ; YES CONT AS FOR LIST;
SUBTTL Debugging system - common LIST/KILL command scanner.
DDKL: MOVEM FL,%DDTFL(DB)
CAIN A4,.SCOL
JRST DDKL1 ; NULL
CAIL A4,.ZERO
CAILE A4,.NINE ; LINE-# ?
JRST DDKL2 ; NO.
PUSHJ SP,DDGTV1 ; YES - READ IT.
MOVEI A11,(A5)
CAIE A4,.COMMA ; ,STMNT-# ?
JRST DDKL3 ; NO.
PUSHJ SP,DDGTVL ; YES - GET IT.
HRLI A11,(A5)
DDKL3: PUSHJ SP,DDGTMD ; GET "IN module" TO A7, OR 0.
PUSHJ SP,FNDMOD ; GET LOADER S.T. PTR TO A10.
DDTERR ^D19 ; NO FIND.
DDKL4: ; Here with word 1 in A101, ptr to module's loader s.t. entry in A1.
; A12 = wanted block number, or 0
SKIPN A6,%DDTBK(DB) ; GET BREAKPOINT TABLE PTR.
DDTERR ^D58 ; NO BREAKPOINTS.
DDKL9: HRRZ A5,(A6) ; GET BREAKPOINT TABLE ENTRY.
HLRZ A4,BP.PTR(A5) ; GET MODULE PTR.
CAIE A4,(A10) ; RIGHT MODULE ?
JRST DDKL5 ; NO.
MOVE A4,BP.LIN(A5) ; YES - GET LINE-# WORD.
TLZ A4,^-<BP.LAB!BP.PRO!BP.STN> ; CLEAR FLAGS, EXCEPT LABEL/PROC.
TLNE A11,BP.LAB!BP.PRO ; LABEL/PROC?
JRST DDKL6 ; YES.
CAMN A4,A11 ; RIGHT LINE ?
POPJ SP, ; YES.
DDKL5: AOBJN A6,DDKL9 ; STEP TO NEXT TABLE ENTRY.
SKIPE A6,(A6) ; DONE THIS PIECE - MORE ?
JRST DDKL9 ; YES - USE IT.
TLNE A11,BP.LAB!BP.PRO ; UNLESS LABEL/PROC...
TRNN A11,-1 ; ...AND NAME FOUND,
DDTERR ^D59 ; IT'S A NO FIND.
MOVEI A5,(A11) ; ELSE, GET POINTER TO SYM ITEM,
POPJ SP, ; AND EXIT.
DDKL2: ; Letter.
PUSHJ SP,SCAN3 ; GET THE WORD.
CAIE A4,.COLON ; LABEL ?
JRST DDKL10 ; NO.
HRLZI A11,BP.LAB ; YES - REMEMBER.
PUSHJ SP,DDIGCH ; GET NEXT NON-SPACE.
DDKL14: PUSHJ SP,DDGTMD ; GET "IN MODULENAME"
PUSHJ SP,FNDMOD ; GET LOADER S.T. PTR TO A10.
DDTERR ^D19 ; NO FIND.
CAIN A4,.SPACE ;
PUSHJ SP,DDIGCH ; GET NON-BLANK.
MOVEI A12,0 ; SET BLOCK NUMBER UP.
CAIE A4,"B" ; COULD IT BE "BLOCK" ?
JRST DDKL4 ; NO CHANCE.
MOVE A1,[ ;
POINT 7,[ ;
ASCII/LOCK/]] ; YES - CHECK REST OF WORD.
DDKL6C: PUSHJ SP,DDGTCH ; GET CHAR OF WORD.
CAIN A4,.SPACE ; END ?
JRST DDKL6D ; YES - MATCH.
ILDB A2,A1 ;
CAIE A2,(A4) ; COMPARE A CHAR.
DDTERR ^D42 ; MISMATCH.
JRST DDKL6C ; OK - DO NEXT CHAR, IF ANY.
DDKL6D: PUSHJ SP,DDGTVL ; GET BLOCK # TO A5.
MOVEI A12,(A5) ; AND SAVE IT.
JRST DDKL4 ; FIND AND DO IT.
DDKL10: ; Not label:.
MOVE A3,%DDTIB(DB) ; GET FIRST WORD OF BUFFER.
CAMN A3,[ASCII/ALL/] ; MUST TYPE WHOLE WORD.
JRST DDKL11 ; HE DID.
TLNE A3,3777 ; 1 CHAR ?
JRST DDKL12 ; NO - SEE IF PROC.
ROT A3,7 ; TO RIGHT-HAND.
HRRZ A5,%DDTAL(DB) ; AUTOLIST TABLE ADDR.
SKIPN A5 ; ANY DEFINED YET ?
DDTERR ^D65 ; NO - THEN HE'S OUT OF LUCK.
ADDI A5,-.A(A3) ; GET ADDR OF WANTED SLOT.
TLO A5,DDKL.L ; SAY A/L
POPJ SP, ; DONE
DDKL11: HRLZI A5,DDKL.A ; SAY "ALL"
POPJ SP,
DDKL1: HRLZI A5,DDKL.N ; SAY NULL
POPJ SP,
DDKL12: ; See if "PROCEDURE proc-name".
MOVE A1,[
XWD -1,[
SIXBIT/PROCED/]]
MOVEI A2,%DDTIB(DB) ; CHECK FOR UNIQUE ADDR OF PROCEDURE
PUSHJ SP,UNIQUE
DDTERR ^D42
DDTERR ^D42
PUSHJ SP,SCAN ; IS OK. GET PROC-NAME.
HRLZI A11,BP.PRO ; REMEMBER.
JRST DDKL14 ; GET "IN MODULENAME".
DDKL6: ; Here if we're looking for named label/proc.
; A11 has label/proc flag, otherwise zero.
; %DDTIB(DB) contains name we're looking for.
; module already checked.
; R.H. A11 used to remember first find (2 = ambiguous = fail)
; R.H. A4 points to SYM item for this b/p.
; Preserve A5,A6.
HLRZ A3,A11 ; WANTS LABEL, AND
TLNN A4,(A3) ; AND THIS IS PROC, OR VICE VERSA ?
JRST DDKL5 ; YES - IGNORE.
HRRZ A1,(A4) ; LENGTH OF ITEM.
SUBI A1,2 ; LENGTH OF NAME.
MOVEI A3,%DDTIB(DB) ; NAME BUFFER
JUMPE A12,DDKL6A ; NO BLOCK OPTION.
HRRZ A2,BP.PTR(A5) ; GET BLKIDX PTR.
HRRZ A2,(A2) ; GET OFFSET IN S.T. OF BLK ITEM
ADD A2,%DDTST(DB) ; GET S.T. ADDR OF BLK ITEM
HLRZ A2,1(A2) ; GET BLK # OF THIS B/P.
CAIE A2,(A12) ; ONE HE WANTED ?
JRST DDKL5 ; NO.
DDKL6A: MOVE A2,2(A4) ; GET WORD OF THIS NAME.
CAME A2,(A3) ; = WANTED ?
JRST DDKL5 ; NO.
ADDI A3,1 ;
SUBI A1,1 ;
SKIPE (A3) ; WANTED NAME ALL GONE ?
JUMPG A1,DDKL6A ; NO - THIS NAME ALL USED ?
; Here, one or the other is all used.
; If both, it's a find.
ADD A1,(A3) ;
JUMPN A1,DDKL5 ; ONLY ONE IS FINISHED - UNEQUAL.
TRNE A11,-1 ; EQUAL - FIRST FIND ?
DDTERR ^D88 ; NO - ERROR. NOT UNIQUE.
HRRI A11,(A5) ; YES - REMEMBER IT.
JRST DDKL5 ; AND CONTINUE LOOKING.
DDKL.A==200000
DDKL.N==100000
DDKL.L==40000
SUBTTL Debugging system - command routine - DEFINE
DEFINE: ; An autolist. Syntax:
; DEFINE X; where X is a single upper-case letter.
; Major functions: GETOWN core for the first chunk,
; set pointer into table (table addr in R.H. %DDTAL(DB) ),
; set DDALIP in FL, so commands are read into autolist,
; set up A12 to point to autloist area.
TDZA A12,A12 ; Flag this is DEFINE
EXTEND: ; An autolist. Same syntax as DEFINE
SETO A12, ; Flag this is EXTEND
CAIL A4,.A
CAILE A4,.Z ; UPPER-CASE LETTER ?
DDTERR ^D44 ; NO - ILLEGAL.
MOVEI A7,-.A(A4) ; YES - MAKE NUMBER.
PUSHJ SP,DDIGCH ; CHECK REST OF
CAIE A4,.SCOL ; LINE IS
DDTERR ^D44 ; JUST ;
HRRZ A1,%DDTAL(DB) ; BASE OF AUTOLIST TABLE.
TRNN A1,-1 ; EXISTS YET ?
PUSHJ SP,PAUS10 ; NO - SET UP.
ADDI