Trailing-Edge
-
PDP-10 Archives
-
BB-5471C-BM_1982
-
algol-sources/algddt.mac
There are 8 other files named algddt.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
SUBTTL ASSEMBLY SWITCHES AND GLOBALS
SEARCH ALGPRM,ALGSYS ; SEARCH PARAMETER FILES
.GTLIM=40 ; [243] GETTAB INDEX FOR BATCH STATUS
JB.LBT=200 ; [243] "I'M A BATCH JOB" BIT IN GETTAB 40
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)
>
EDIT(232)
;[232]; RE-DEFINE DOUBLE-LENGTH LOAD/STORE FOR OTS KA/KI INDEPENDENCE
;[232]
;[232] DEFINE LRLOAD(A,B),<
;[232] MOVE A,B
;[232] MOVE 1+A,1+B
;[232]>
;[232]
;[232] DEFINE LRSTOR(A,B),<
;[232] MOVEM A,B
;[232] MOVEM 1+A,1+B
;[232]>
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,
EDIT (241) ; [241] DON'T LET ALGDDT START IF JACCT IS ON
;[241] THIS SUBROUTINE CHECKS TO SEE IF THE JACCT BIT IS SET. IF
;[241] IT IS, AN ERROR MESSAGE IS TYPED AND THE PROGRAM ABORTS. OTHERWISE
;[241] THE SUBROUTINE RETURNS TO THE CALLING ROUTINE. A6 IS ALTERED.
;[241]
CHKJCT: HRROI A6,0 ; [241] SET UP A6 TO GETTAB PRIVS FOR OUR JOB
GETTAB A6, ; [241] GET PRIV WORD
GTBERR: PORTAL [OUTSTR [ASCIZ/
?GETTAB TO READ JACCT PRIVILEGE BIT FAILED
%Please contact your system manager
/] ;[303]
MOVEI A6,GTBERR ; [241] LOAD REENTER ADDRESS
MOVEM A6,.JBREN ; [241] MAKE REENTER COME HERE
EXIT] ; [241] EXIT AFTER GETTAB FAILS
TLNN A6,1 ; [241] IS THE JACCT BIT SET FOR THIS PROG?
AOS (SP) ; [241] NO, PREPARE FOR SKIP RETURN
POPJ SP, ; [241] RETURN TO CALLING ROUTINE
PRVERR: MOVEI A6,PRVREN ; [241] LOAD REENTER ADDRESS
MOVEM A6,.JBREN ; [241] MAKE REENTER COME HERE
PRVREN: PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
OUTSTR [ASCIZ/
?FATAL PROGRAM ERROR WHILE RUNNING WITH JACCT BIT SET
%Please contact your system manager
/]
EXIT ; [241] STOP THE PROGRAM
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 parametgr 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] ; LOAD BYTE POINTER TO A6
OUTSTR [BYTE(7)15,12,76,0,0] ; TYPE A CR-LF AND RT. ANGLE BKT
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: PUSHJ SP,CHKJCT ; [241] CHECK JACCT BIT
JRST PRVERR ; [241] JACCT IS ON - PUNT!
HRRI A0,DDCCML ; [E1000] [241] CONTINUE IF JACCT IS OFF
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.
;
;
Edit(147) ; Don't assume DL safe over errors in ALGDDT.
;
MOVE A0,SP
SUBI A0,(DB) ; DELOCATE STACK-POINTER
MOVEM A0,%ACCS+SP(DB) ; AND SAVE (FOR RESET LATER)
MOVE A0,DL ; [E147] Save delocated DL
SUBI A0,(DB) ; [E147] "
MOVEM A0,%ACCS+DL(DB) ; [E147] "
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: MOVE A2,[-1,,.GTLIM] ; [243] LOAD GETTAB TABLE INDEX
GETTAB A2, ; [243] GET THE TABLE INFORMATION
LIBERR 5, ; [243] COMPLAIN IF GETTAB FAILS
TLNE A2,JB.LBT ; [243] IS THIS A BATCH JOB?
JRST DDTTY3 ; [243] YES, JUMP AHEAD
PJOB A2, ; [243] NO, GET OUR JOB #
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
;
Edit(150); Make line number correct if PC a return address.
;
SOJ A4, ; [E150] This is the next statement
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
;
Edit(146); Fix various bugs with scope of GOTO command.
;
DDSTA1: JSP A0,CONRES ; [E146] 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
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
DDGOT5: RPOP DL ; AND RESTORE CORRECT DL
MOVE FL,%DDTFL(DB) ; RESET FLAGS (THUNKS DESTROY THEM)
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
CAIE DL,(DB) ; [E146] Are we at level 0.0 ?
JRST DDGO12 ; [E146] No - all is well.
HRRZ A0,@%SYS0(DB) ; [E146] Yes - trying to start ?
CAMN A2,A0 ; [E146] ...
JRST DDSTA1 ; [E146] Yes, so START properly.
JRST DDFIN% ; [E146] Otherwise we want to FINISH.
DDGO12: 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
CAIE DL,(DB) ; [E146] Are we at level 0.0 ?
JRST RETRY1 ; [E146] No - all is well.
HRRZ A0,.JBSA ; [E146] Yes - have we STARTed yet
CAIE A0,RSTRT% ; [E146] ...
JRST DDSTA1 ; [E146] No - so START it.
JRST DDFIN% ; [E146] Yes - so FINISH it.
RETRY1: 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.
;
Edit(163); Treat backspace as a delete character.
;
CAIN A2,10 ; [E163] Backspace ?
JRST DDGTBS ; [E163] 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 ; [271] NO, IS THIS ONE AN = ?
JRST DDGTL9 ; [271] NO, SKIP AHEAD
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
DDGTBS: ; [E163] Backspace.
TLNE FL,DDTMP1 ; [E163] Deleting already ?
JRST DDGTL1 ; [E163] Yes - treat as rubout
CAIL A1,(A11) ; [E163] Start of line ?
JRST DDGTL2 ; [E163] Yes - force ^U
DBP A2,A10 ; [E163] Decrease pointer.
AOJA A1,DDGTL5 ; [E163] and try again.
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 [BYTE(7)15,12,76,76,40,0] ; [264] DISPLAY ALGDDT PROMPT
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
MOVE A4,[-1,,.GTLIM] ; [243] LOAD GETTAB TABLE INDEX
GETTAB A4, ; [243] GET THE TABLE INFORMATION
LIBERR 5, ; [243] COMPLAIN IF GETTAB FAILS
TLNE A4,JB.LBT ; [243] IS THIS A BATCH JOB?
JRST DDGTC6 ; [243] YES, USE CHANNEL 0
OUTSTR [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.
MOVE A4,[-1,,.GTLIM] ; [243] LOAD GETTAB TABLE INDEX
GETTAB A4, ; [243] GET THE TABLE INFORMATION
LIBERR 5, ; [243] COMPLAIN IF GETTAB FAILS
TLNE A4,JB.LBT ; [243] IS THIS A BATCH JOB?
TLO A1,400000 ; [243] YES, REMEMBER.
JUMPL A1,DDINTF ; [243] DON'T READ SWITCH.INI IF BATCH
PUSH SP,%CHAN(DB) ; [243] ELSE 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 ; [241] SAVE A1 TEMPORARILY
PUSHJ SP,DDINTX ; [241] TRY TO READ SYMBOL TABLE
POP SP,A1 ; [241] (RESTORE A1)
SKIPGE %DDTST(DB) ; [241] SUCCESSFUL ?
POPJ SP, ; [241] YES, RETURN
JUMPL A1,CPOPJ ; [241] NO, DON'T PROCEED IF BATCH JOB
PUSHJ SP,CHKJCT ; [241] CHECK JACCT BIT IF NOT BATCH JOB
POPJ SP, ; [241] JACCT IS ON - RETURN NOW!
PUSH SP,A1 ; [241] JACCT IS OFF - CONTINUE
OUTSTR [ASCIZ/
Is one available (Y or N)?/] ; [241] ASK USER ABOUT .SYM FILE
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.
/] ; [241] TELL USER ABOUT ALGDDT'S PROBLEM
POP SP,A1
POPJ SP,]
CAIN A4,"Y" ; YES ?
JRST DDINTZ ; YES - GET ITS NAME.
OUTSTR [ASCIZ/
Respond with Y or N./] ; [241] USER GAVE BAD INPUT - HELP HIM
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 ; LOOKUP FAILED, TELL USER
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
SOJL A7,FNDLN7 ; [E146] Any more blocks ?
ADDI A5,1 ; YES - STEP BLKIDX
JRST FNDLN6 ; [E146] CONTINUE IF INNER BLOCKS FOUND
; now we have to find this module in LOADER S.T.
FNDLN7: PUSH SP,A10 ; [E146]
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 ONLY AC'S NOT SMASHED
TLO A2,(<XCT>) ; MAKE INTO XCT F[0]
PUSH SP,A2
PUSH SP,[JRST .+2] ; [303]
JRST -1(SP) ; EXECUTE THUNK.
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
SUB SP,[2,,2] ; CLEAR STACK.
POP SP,A10
POP SP,A6
MOVE FL,%DDTFL(DB) ; RESTORE FL
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]
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
POP SP,A1 ; RESCUE VALUE.
POP SP,A0
XCT 1(A3) ; PUT VALUE F[1]
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
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
PUSH SP,A6
PUSH SP,A10
TLNN FL,DDTMP2 ; [E016] IF PUT,
TLOA A2,(<XCT 1,>) ; [E016] 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] ; [303]
JRST -1(SP) ; EXECUTE THUNK.
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
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.
MOVE A1,[-1,,.GTLIM] ; [243] LOAD GETTAB TABLE INDEX
GETTAB A1, ; [243] GET THE TABLE INFORMATION
LIBERR 5, ; [243] COMPLAIN IF GETTAB FAILS
TLNE A1,JB.LBT ; [243] IS THIS A BATCH JOB?
MOVEI FL,DD.BTW ; [243] YES, USE SHORTER LINE .
HRRM FL,%DDTFL(DB) ; [243] NO, 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.
;
Edit(157); Save context DL over stack shift when typing arrays.
;
DDUMP7: DPUSH A11 ; [E157] Save delocated CONDL
ADDI A11,(DB) ; [E157] but relocate it for DDDIM0
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.
ADDI A11,(DB) ; [E157] and relocate it
PUSHJ SP,DDTYP0 ; TYPE VALUE.
POP SP,A4
POP SP,A7
RPOP A11 ; [E157] Restore & relocate CONDL
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.
DDTERR ^D40 ; [271] NO, ERROR - INVALID INPUT
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,>) ; [303] 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] ; [303] 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: CAML A7,[<377777,,-1>/50] ; [264] WILL IMULI OVERFLOW?
DDTERR ^D43 ; [264] YES, TOO MUCH INPUT ALREADY
IMULI A7,50 ; [264] ROTATE MODULE NAME OVER
CAML A7,[<RADIX50 0,000000>*50] ; [264] 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.
CAIG A4,.Z+3 ; [264] INVALID CHR.?
CAIGE A4,.ZERO ; [264]
DDTERR ^D103 ; [264] YES, ERROR
CAIG A4,"@" ; [264] NO, BUT CHECK AGAIN
CAIGE A4,":" ; [264]
SKIPA ; [264] NO, OK - SKIP
DDTERR ^D103 ; [264] YES, FAIL
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 A7,(A1) ; GET SLOT ADDR.
SKIPE A1,(A7) ; ALREADY DEFINED ?
JRST DEFIND ; YES.
MOVEI A0,ALSIZE+1 ; NO - GET SIZE WANTED
PUSHJ SP,GETOWN ; GET NEW SPACE.
SETZB A12,ALSIZE(A1) ; AND CLEAR LINK WORD
HRRZM A1,(A7) ; SET ADDR INTO TABLE.
DEFIND: JUMPE A12,DEFNEW ; ALL DONE IF NEW DEFINITION
; Here on an EXTEND command to find last word in A/L
MOVEI A12,(A1) ; GET BASE OF CHUNK
SKIPE A1,ALSIZE(A12) ; CHAINED TO ANOTHER ?
JRST .-2 ; YES - FOLLOW LINK
MOVEI A1,(A12) ; NO - GET BASE AGAIN
SKIPE (A1) ; IS THIS WORD EMPTY ?
AOJA A1,.-1 ; NO - TRY NEXT
TLOA A12,(A1) ; YES - SET UP L.H. OF A12
DEFNEW: HRLS A12,A1 ; GET BASE TO BOTH HALVES OF A12
TRO FL,DDALIP ; TELL MAIN LOOP
HRRM FL,%DDTFL(DB) ; TO READ INTO AUTOLIST.
POPJ SP,
SUBTTL Debugging system - command routine - AUTO
DDAUTO: ; AUTO <AUTOLISTNAME>
; invokes an autolist.
; nesting is allowed up to maximum depth DDNEST.
; usually executed from another autolist.
; uses a table which follows after autolist table (DDNEST+1 words long.)
; first word of table is zero, as a marker,
; remaining words are byte-pointers into autolists,
; with %DDTIP(DB) pointing at the latest (i.e. the current) entry:
; it's a 1-word byte-pointer itself.
CAIL A4,.A ; DID HE GIVE
CAILE A4,.Z ; AN ALPHA AUTOLIST-NAME ?
DDTERR ^D44 ; NO - ERROR.
HRRZ A1,%DDTAL(DB) ; AUTOLIST TABLE BASE.
TRNN A1,-1 ; SET UP ?
DDTERR ^D51 ; NO !!
ADDI A4,-.A(A1) ; GET ADDR OF WANTED ENTRY.
SKIPN A4,(A4) ; GET TABLE ENTRY.
DDTERR ^D51 ; ZERO = UNDEFINED.
DDAUTX: ; A4 is table entry.
; *** entered here from pause action code ***
HRLI A4,440700 ; MAKE IT A BYTE-POINTER.
TROE FL,DDALST ; EXECUTED FROM AN AUTOLIST ?
JRST DDAUT1 ; YES.
MOVEI A1,DDALST
IORM A1,%DDTFL(DB) ; SAVE NEW FLAG FOR POSTERITY.
HRRZ A1,%DDTAL(DB)
MOVEI A1,^D26(A1) ; GET ADDR OF NESTING TABLE.
SETZM (A1) ; MARK BOTTOM.
HRLI A1,004400 ; MAKE BYTE-POINTER TO IT.
MOVEM A1,%DDTIP(DB) ; SAVE.
DDAUT1: HRRZ A1,%DDTAL(DB)
HRRZ A3,%DDTIP(DB) ; CURRENT ENTRY.
CAIL A3,^D27+DDNEST(A1) ; NO MORE ROOM ?
DDTERR ^D90 ; ERROR - TOO MUCH NESTING.
IDPB A4,%DDTIP(DB)
POPJ SP,
; Note that the nesting limit also catches recursion.
SUBTTL Debugging system - command routine - KILL
KILL: ; a breakpoint, or autolist.
; Syntax: KILL line-#[,stmnt-#] [IN module-name];
; or KILL ALL;
; or KILL label: [IN module-name];
; or KILL; !the current breakpoint, if any, else error.
PUSHJ SP,DDKL ; CALL COMMON LIST/KILL CMD SCANNER.
; returns with A5 = b/p block addr or a/l slot addr. L.H. = flags
TLNE A5,DDKL.N ; NULL ? (KILL THIS B/P)
JRST KILL6
TLNE A5,DDKL.A ; ALL ?
JRST KILL1 ; YES
TLNN A5,DDKL.L ; AUTOLIST ?
JRST KILL2 ; NO - JUST 1 B/P.
HRRZ A1,(A5) ; YES - GET A/L ADDR
SETZM (A5) ; ZAP TABLE SLOT.
JUMPE A1,CPOPJ ; NO A/L TO RELEASE.
MOVEI A0,0
PJRST KILLAL ; EXIT VIA KILLAL DELETE
KILL2: HLRZ A5,BP.ALP(A5) ; GET TABLE SLOT ADDR.
JRST KILLX ; GO KILL IT.
KILL1: ; ALL breakpoints.
SKIPN A5,%DDTBK(DB) ; GET TABLE POINTER.
DDTERR ^D58 ; NONE TO KILL.
KILL5: SKIPE (A5) ; FOR ALL NON-ZERO ENTRIES,
PUSHJ SP,KILLX ; KILL THE B.P.
AOBJN A5,KILL5
SKIPE A5,(A5) ; MORE TABLE ?
JRST KILL5 ; YES - USE.
POPJ SP, ; DONE.
KILL6: ; Kill current breakpoint.
HLRZ A4,%DDTAL(DB) ; GET CURRENT B.P. BLOCK ADDRESS.
JUMPE A4,DDER61 ; ERROR IF NOT IN B.P.
HLRZ A5,BP.ALP(A4) ; GET TABLE ENTRY ADDR.
;JRST KILLX ; KILL IT AND EXIT.
KILLX: ; Kill a breakpoint, whose table entry is pointed to by A5.
HLRZ A4,(A5) ; GET OBJECT PROGRAM ADDRESS.
HRRZ A3,(A5) ; AND CONTROL-BLOCK ADDR.
HLRZ A2,%DDTAL(DB) ; GET CURRENT B.P. BLK ADDR, IF ANY.
CAIE A2,(A3) ; KILLING IT ?
JRST KILLX2 ; NO - OK.
HRRZS %DDTAL(DB) ; YES - FIX IT SO...
HRRM A4,.JBOPC ; ...CONTINUE WILL WORK.
KILLX2: SETZM (A5) ; RELEASE TABLE-SLOT.
MOVE A2,BP.INS(A3) ; GET DISPLACED INSTRUCTION.
MOVEM A2,(A4) ; REPLACE IT.
MOVE A2,BP.FLG(A3)
TLNN A2,BP.PRI ; PRIVATE AUTOLIST ?
JRST KILLX1 ; NO.
HRRZ A1,BP.ALP(A3) ; YES-GET ITS ADDRESS.
JUMPE A1,KILLX1 ; NONE.
MOVEI A0,0
PUSHJ SP,KILLAL ; RELEASE IT.
KILLX1: MOVEI A1,(A3)
MOVEI A0,0
PJRST GETOWN ; RELEASE CONTROL-BLOCK, & EXIT.
DDER61: DDTERR ^D61 ; NO CURRENT B.P.
SUBTTL Debugging system - command routine - END
DDEND: ; End of autolist input.
; Have to release spare core to HEAP.
TRZN FL,DDALIP ; TURN OFF I/P MODE. WAS IT ON ?
DDTERR ^D50 ; NO - NAUGHTY.
MOVEI A5,DDALIP
ANDCAM A5,%DDTFL(DB) ; ENSURE PERMANTLY OFF.
SETZ A0, ; FLAG GETOWN DELETE
SKIPE A1,ALSIZE(A12) ; ANY MORE CHUNKS ?
PUSHJ SP,KILLAL ; YES - DELETE THEM
SETZM ALSIZE(A12) ; CLEAR LINK WORD
HLRZ A1,A12 ; THEN MARK END OF
SETZM (A1) ; A/L WITH A ZERO
JRST DDTLUP ; AND GET NEXT COMMAND
KILLAL: HRLM A1,(SP) ; SAVE CHUNK ADDRESS
SKIPE A1,ALSIZE(A1) ; YET ANOTHER CHUNK ?
PUSHJ SP,KILLAL ; YES - DELETE THAT FIRST
HLRZ A1,(SP) ; THEN RESTORE THIS CHUNK
PJRST GETOWN ; AND GO RETURN SPACE
SUBTTL Debugging system - Pause action routine.
BREAK%: ; Here on BREAK UUO.
; Its address field points at the breakpoint control block.
EDIT(116); Don't take breakpoints if already in ALGDDT
TLOE DB,INDDT ; [E116] Already in ALGDDT (DUMP/TYPE) ?
JRST BREAKY ; [E116] Yes - ignore breakpoint
HRRI A0,DDCONC ; [E1000] SET "ACTION ABANDONED"
PUSHJ SP,DDSETI ; [E1000] ^C intercept.
PUSHJ SP,DDTTYC ; Set TTY characteristics
; LRLOAD A0,%SYS16(DB)
SETZM %SYS17(DB) ; So continue works !
;MOVEM A0,%ACCS+A0(DB) ; Save
MOVE A0,SP ; the
SUBI A0,(DB) ; outside
MOVEM A0,%ACCS+SP(DB) ; world.
MOVE A0,DL ; [E147] (including DL)
SUBI A0,(DB) ; [E147] "
MOVEM A0,%ACCS+DL(DB) ; [E147] "
;MOVEI A0,%ACCS+A1(DB)
;BLT A0,%ACCS+SP-1(DB)
SKIPL %DDTST(DB) ; Did the S.T. read fail ?
DDTERR 1 ; Yes - world's end.
HRRZ A6,.JBUUO ; Get addr of B/P control-block.
HRLM A6,%DDTAL(DB) ; Save B/P blk addr.
SKIPE %DDTNL(DB) ; Are we expecting a 'next' ?
SKIPN BP.LNK(A6) ; and is this a 'next' B.P. ?
JRST BREAK1 ; No
PUSHJ SP,NBKIL0 ; Yes - delete spare pauses
JRST BREAK3 ; And always take the break
BREAK1: SKIPL BP.LIM(A6) ; If no limit on breakpoint,
SOSL BP.LIM(A6) ; Or limit not yet reached,
JRST BREAK2 ; Normal breakpoint action
PUSHJ SP,KILL6 ; Limit reached - kill breakpoint
JRST DDCON% ; And continue
BREAK2: SOSLE BP.CNT(A6) ; Proceed-count finished ?
JRST BREAKX ; No - XCT displaced instruction.
TDZA A7,A7 ; Not 'next' - clear flag
BREAK3: SETO A7, ; This is 'next' - remember
HLRZ A1,BP.ALP(A6) ; Get address of table slot
HLRZ A1,(A1) ; and hence object prog addr.
HRRM A1,%DDTPC(DB) ; and save it (mainly for 'where' cmd)
MOVEM A1,%UWCON(DB) ; [E127] and for 'back'
MOVE A1,%DDTPL(DB) ; Get dynamic procedure depth
MOVEM A1,%DDTUW(DB) ; And save for unwind
MOVEM A1,%UWTOP(DB) ; [E127] as current and top levels
MOVNI A1,1
EXCH A1,%CHAN(DB) ; Fix tty as o/p device.
MOVEM A1,%DDTTY(DB) ; Save old one.
PUSH SP,A7 ; Save A7 ('next' breakpoint flag)
MOVE A5,BP.FLG(A6) ; Get breakpoint flags
TLNE A5,BP.SIL ; Silent ?
JUMPE A7,BREAK6 ; Yes - skip messages, unless 'next'
PUSHJ SP,CRLF% ; No - force output onto a new line
MOVEI A1,[ASCIZ/Pause at /] ; Get common part of pause message
PUSHJ SP,MONIT ; And type it
TLNE A5,BP.PRO!BP.LAB ; Label or proc ?
JRST BREAK4 ; Yes
MOVEI A1,[ASCIZ/line /] ; No - get first part of message
PUSHJ SP,MONIT ; Type it
HRRZ A0,BP.LIN(A6) ; Get the line number
PUSHJ SP,IPRNT% ; And type that
HLRZ A0,BP.FLG(A6) ; Get statement number within line
ANDI A0,BP.STN ; Mask out extraneous junk
JUMPE A0,BREAK5 ; Dont type if sub-statement 0
PUSH SP,A0 ; Otherwise save value
MOVEI A1,[ASCIZ/, statement /]; Get second part of message
PUSHJ SP,MONIT ; And type it
POP SP,A0 ; Restore saved statement number
PUSHJ SP,IPRNT% ; And type that
JRST BREAK5 ; Go type module name
BREAK4: MOVEI A1,[ASCIZ/label /] ; Label/procedure - assume label.
TLNE A5,BP.PRO ; Really procedure ?
MOVEI A1,[ASCIZ/procedure /] ; Yes.
PUSHJ SP,MONIT ; Type next part of message
HRRZ A4,(A5) ; Get length of S.T. item
MOVEI A1,2(A5) ; Advance to name field.
ADDI A4,-2(A1) ; Get end address
PUSH SP,(A4) ; Save original contents,
SETZM (A4) ; and put in an ASCIZ terminator
PUSHJ SP,MONIT ; Type name.
POP SP,(A4) ; Restore S.T. entry
BREAK5: PUSHJ SP,DDOUMD ; Then type module name
PUSHJ SP,DDBRKB ; And send output to the terminal
BREAK6: HRRZ A4,DL ; Get current value of DL
SUBI A4,(DB) ; Delocate it.
HRLM A4,%DDTPC(DB) ; And save (for search).
SETZM %DDTBE(DB) ; Zap context
HRRZ A4,%DDTPC(DB) ; Get address of breakpoint.
PUSHJ SP,FNDADR ; Set up contexts.
JRST DD2ERR ; Supposedly impossible.
SETZM %DDTCC(DB) ; Clear Control-C flag
HLRZ A6,%DDTAL(DB) ; Restore B/P block addr.
POP SP,A7 ; Restore 'next' flag
JUMPE A7,BREAK7 ; If not 'next' break, can't delete yet
SETZM %DDTNL(DB) ; Clear address of last 'next' breakpoint
SKIPLE BP.LIM(A6) ; And unless limit already reached,
SOS BP.LIM(A6) ; (or no limit) count down by one
MOVE A4,BP.FLG(A6) ; Get breakpoint flags
TLNN A4,BP.NXT ; And if this is a temporary breakpoint,
SKIPN BP.LIM(A6) ; Or if activation limit reached
JRST BREAKD ; Go delete breakpoint
JRST DDTLUP ; Otherwise get commands (ignoring A/L)
BREAK7: HRRZ A4,BP.ALP(A6) ; Not 'next' - get autolist address.
JUMPE A4,BREAK9 ; None - get command from TTY:.
LDB A0,[POINT 3,BP.FLG(A6),8]; Get error action-code.
DPB A0,[POINT 3,%DDTFL(DB),20]; Save for error-routines.
MOVE A0,BP.FLG(A6) ; Get breakpoint flags
TLNN A0,BP.PRI ; Public A/L ?
JRST BREAK8 ; Yes - go set it up.
PUSHJ SP,DDAUTX ; No - (private), set it up,
JRST DDTLUP ; Go to main-line.
BREAK8: SKIPN A4,(A4) ; Public A/L - get address from table
DDTERR ^D51 ; Error - undefined autolist
PUSHJ SP,DDAUTX ; Set up to accept commands from A/L
BREAK9: SKIPN BP.LIM(A6) ; Finished with this breakpoint ?
BREAKD: PUSHJ SP,KILL6 ; Yes - delete it
JRST DDTLUP ; No - go get command
BREAKX: ; Now execute displaced instruction(s), and return to program.
HRRZ A6,%ACCS+SP(DB)
ADDI A6,(DB) ; Restore stack-pointer.
MOVEI A2,(SP)
SUBI A2,(A6)
HRLI A2,(A2)
SUB SP,A2
JSP A1,CNCTR% ; Turn on ^C intercept.
HLRZ A6,%DDTAL(DB) ; Get B/P blk addr.
HRRZS %DDTAL(DB) ; And clear it
TLZA DB,INDDT ; [E116] Skip over BREAKY entry point
BREAKY: HRRZ A6,.JBUUO## ; [E116] Get B/P block address from UUO
SKIPGE BP.FLG(A6) ; Special (BP.PSH set ?)
JRST BP.INS+1(A6) ; Yes - go to next word
HLRZ A1,BP.INS(A6) ;[222] Get instruction, is it call of formal procedure?
CAIE A1,(<XCT 0(DL)>) ;[222] If so, it is XCT n(DL).
JRST BP.INS(A6) ;[222] No, so just go execute instruction.
MOVE A2,@BP.INS(A6) ;[222] Maybe, check the right half.
CAME A2,%PROF0## ; Or if this is not a formal procedure,
JRST BP.INS(A6) ; Just go execute the instruction
HRRZ A1,BP.INS+1(A6) ; Otherwise set A1 to AP address
PUSH SP,A1 ; Stack it (simulate PUSHJ)
MOVEI A2,@BP.INS(A6) ; Get address of F[0]
JRST %SPRO3## ; And transfer to ALGOTS routine
SUBTTL Debugging system - command routines - EXPERT and NOVICE
EXPERT: HLLOS %DDTER(DB) ; REMEMBER EXPERT MODE
POPJ SP,
NOVICE: HLLZS %DDTER(DB)
POPJ SP,
SUBTTL Debugging system - command routine - OBJECT
OBJECT: ; Print object code for statement.
; Syntax: OBJECT [(n)]; !this statement, by default.
; OBJECT [(n)] line-#[,statement-#] [IN module-name];
; OBJECT [(n)] label: [IN module-name];
; n is # words to dump. Default is 1.
MOVEI A10,1 ; DEFAULT # WORDS.
MOVSI A12,400000!OBJDEF ; FLAG TO PAUSE CMD SCAN & DEF MODES.
SETZB A11,A7 ; INIT LINE-#, MODULE-NAME.
JRST PAUSE0 ; BORROW PAUSE COMMAND SCANNER.
OBJEC0: ; PAUSE returns here, with A2 = address, A10 = # of statements ( words if octal address).
MOVEI A4,(A2) ; START ADDRESS.
TLZE A11,BP.OCT!BP.LAB!BP.PRO; OCTAL ADDRESS, LABEL OR PROCEDURE ?
JRST OBJEC3 ; YES - A10 IS CORRECT
; PAUSE Command scanner exited via SETBRK, which called FNDLIN, leaving
; A5 set up pointing to address of STN item
HRRZ A6,1(A5) ; GET RELATIVE PC OF THIS STATEMENT
MOVEI A1,(A6) ; INITIALIZE FINAL ADDRESS
OBJEC1: HRRZ A2,(A5) ; GET SIZE OF ENTRY
ADDI A5,-1(A2) ; STEP ON TO NEXT ITEM
AOBJP A5,OBJEC2 ; IF OFF END, GIVE UP
HLRZ A3,(A5) ; GET TYPE CODE INTO A3
CAIE A3,'MOD' ; NEXT MODULE ?
CAIN A3,-1 ; OR END FLAG ?
JRST OBJEC2 ; YES - ERROR
CAIE A3,'STN' ; STATEMENT NUMBER ?
JRST OBJEC1 ; NO - TRY NEXT ITEM
HRRZ A1,1(A5) ; YES - GET RELATIVE PC
SOJG A10,OBJEC1 ; REPEAT FOR DESIRED #
SKIPA A10,A1 ; GET # OF WORDS INTO A10
OBJEC2: AOS A10,A1 ; DEFAULT LAST STN SIZE TO 1
SUBI A10,(A6) ; SUBTRACT ORIGINAL OFFSET
OBJEC3: MOVEI A5,(A4) ; ADD START ADDRESS TO
ADDI A5,(A10) ; SIZE TO GET END ADDRESS
TRNN A5,400000 ; HISEG ?
SKIPA A6,.JBREL ; NO - GET HIGHEST LOSEG ADDR.
HRRZ A6,.JBHRL ; YES - GET HIGHEST HISEG ADDR.
CAILE A5,(A6) ; END ADDR ILLEGAL ?
MOVEI A5,(A6) ; YES - USE HIGHEST LEGAL.
HLL A5,A12 ; GET MODE FLAGS.
PJRST DUMP1 ; GO DO IT.
OBJOCT==200000 ; FLAGS IN L.H. A12 (LATER IN L.H. A5)
OBJASC==100000
OBJSIX==40000
OBJSYM==20000
OBJINT==10000
OBJREA==4000
OBJLR==2000
OBJERR==1000
OBJDEF==OBJOCT!OBJSYM ; DEFAULTS.
SUBTTL Debugging system - command routines - UNWIND, BACK.
UNWIND: ; Change context to outer worlds.
EDIT(127); Enhanced UNWIND Command
; Formats:
; UNWIND; Same as BACK - return to original context.
; UNWIND n; change to dynamic proc lvl <n>
; UNWIND n.m; change to dynamic proc lvl <n>, block lvl <m> [E127]
; UNWIND -n; change by <n> lvls
; UNWIND -.m change by <m> block lvls [E127]
; UNWIND 0; change to outer-most world.
CAIN DL,(DB) ; [E127] LEVEL 0.0 ?
DDTERR ^D101 ; [E127] YES - SILLY !
SKIPL %DDTUW(DB) ; [E127] ARE WE UNWOUND ?
PUSHJ SP,DDSCBL ; [E127] NO - SET CBL IN CASE
CAIN A4,.SCOL ; [E127] - ALL THIS.
JRST DDBACK ; [E127] UNWIND; = BACK;
CAIN A4,.MINUS ; [E127] RELATIVE ?
JRST DDUW3 ; [E127] YES.
PUSHJ SP,DDGTP1 ; [E127] GET DYNAMIC PL REQUD
CAML A5,%UWTOP(DB) ; [E127] VALID LEVEL NUMBER ?
DDTERR ^D89 ; [E127] NO.
MOVE A7,A5 ; [E127] PL REQUIRED IN A7
CAIE A4,.DOT ; [E127] UNWIND n.m ?
SKIPA A5,[-1] ; [E127] NO - SET BLOCK NUMBER TO -1
PUSHJ SP,DDGTVP ; [E127] YES - GET BLOCK NUMBER IN A5
JSP A6,DDSCCS ; [E127] SAVE CURRENT CONTEXT
HRRZ A6,%DDTUW(DB) ; [E127] GET CURRENT DYNAMIC PL.
CAMGE A7,A6 ; [E127] FURTHER DOWN THE STACK ?
JRST DDUW2 ; [E127] YES - EASY
DDUW1: ; [E127] Go to innermost lvl and back outwards.
PUSH SP,A7 ; [E127] SAVE SUPPLIED NUMBER
PUSHJ SP,DDBACK ; [E127] RESET TO INNERMOST LEVEL
MOVE A7,(SP) ; [E127] RECOVER NUMBER
CAML A7,%DDTUW(DB) ; [E127] POSSIBLE ?
JRST DDUWE1 ; [E127] NO
PUSHJ SP,DDSCBL ; [E127] YES - SET CBL
POP SP,A7 ; [E127] FINALLY RECOVER SAVED NUMBER
MOVE A6,%DDTUW(DB) ; [E127] GET MAX LVL + 1
DDUW2: SUBM A6,A7 ; [E127] A7 = LEVELS TO UNWIND
SOJA A7,DDUW6 ; [E127] CORRECT AND GO DO IT
DDUW0: ; [E127] Entry point from WHERE routine.
MOVE A6,%DDTUW(DB) ; [E127] GET MAX LEVEL + 1
SUBM A6,A7 ; [E127] A7 = LVLS TO UNWIND +1
SOJA A7,DDUW5 ; [E127] CORRECT AND SAVE CONTEXT
DDUW3: ; [E127] RELATIVE.
PUSHJ SP,DDIGCH ; [E127] NEXT CHARACTER
CAIE A4,.DOT ; [E127] BLOCK-UNWIND ?
JRST DDUW4 ; [E127] NO - PROC-UNWIND
PUSHJ SP,DDGTVP ; [E127] YES - HOW MANY LVLS?
HLRZ A7,%DDUWB(DB) ; [E127] GET CURRENT LVL
CAILE A5,(A7) ; [E127] POSSIBLE ?
DDTERR ^D89 ; [E127] NO - ERROR
JSP A6,DDSCCS ; [E127] SAVE CURRENT CONTEXT
AOJA A5,DDUW12 ; [E127] ADJUST AND GO DO IT
DDUW4: ; RELATIVE PROCEDURE-UNWIND
PUSHJ SP,DDGTP1 ; [E127] GET # OF PL'S TO UNWIND.
MOVE A7,A5 ; [E127] LVLS TO UNWIND IN A7
HRRZ A6,%DDTUW(DB) ; [E127] GET CURRENT DEPTH
CAIL A7,(A6) ; [E127] TRYING TO GO TOO FAR ?
DDTERR ^D89 ; [E127] YES - TELL HIM
CAIN A4,.DOT ; [E127] UNWIND -n. ?
DDTERR ^D42 ; [E127] YES - ERROR
SETOM A5 ; [E127] NO BLOCKS TO UNWIND
DDUW5: JSP A6,DDSCCS ; [E127] SAVE CURRENT CONTEXT
DDUW6: ; Procedure unwinding.
JUMPE A7,DDUW8 ; [E127] IF PROCS TO UNWIND
HLRZ A10,%DDTPC(DB) ; [E127] GET CURRENT CONTEXT
ADDI A10,(DB) ; [E127] AND RELOCATE IT
DDUW7: HRRZ A4,PRGLNK(A10) ; [E127] GET PROGRAM LINK
MOVEI A10,@LINKDL(A10) ; [E127] STEP BACK ONE LEVEL
SOS %DDTUW(DB) ; [E127] COUNT UNWIND LEVEL DOWN
SOJG A7,DDUW7 ; [E127] AND LOOP
SUBI A10,(DB) ; [E127] GET DELOCATED DL AGAIN
HRLM A10,%DDTPC(DB) ; [E127] SET UP NEW "DL"
SETZM %DDTBE(DB) ; [E127] CLEAR CONTEXT, FNDADR WILL SET IT
PUSH SP,A5 ; [E127] SAVE A5 AROUND FNDADR
PUSHJ SP,FNDADR ; [E127] AND ESTABLISH CONTEXT
JRST DDUWE2 ; [E127] FAILURE.
POP SP,A5 ; [E127] RECOVER A5
PUSHJ SP,DDSCBL ; [E127] NOW SET NEW CURRENT BLOCK LVL
AOJE A5,DDUW15 ; [E127] ANY BLOCKS TO UNWIND ?
SOJA A5,DDUW10 ; [E127] YES - FIX A5 AND DO IT
DDUW8: ; Block unwinding.
AOJN A5,DDUW9 ; [E127] ANY BLOCKS EXPLICITLY STATED
HLRZ A5,%DDUWB(DB) ; [E127] NO - ARE WE AT INNERMOST
HRRZ A7,%DDUWB(DB) ; [E127] BLOCK LEVEL AT THIS
CAIL A5,(A7) ; [E127] PROC LEVEL ?
JRST DDUW15 ; [E127] YES - OK
SETOM A5 ; [E127] NO - MUST GET THERE
HRRZ A7,%DDTUW(DB) ; [E127] BY GOING
SOJA A7,DDUW1 ; [E127] "IN" AND"BACK"
DDUW9: SUBI A5,1 ; [E127] ADJUST A5
DDUW10: HLRZ A4,%DDUWB(DB) ; [E127] GET CURRENT UNWOUND BLOCK LVL
CAIL A4,(A5) ; [E127] UP OR DOWN ?
JRST DDUW11 ; [E127] DOWN
HRRZ A4,%DDUWB(DB) ; [E127] UP - GET HIGHEST BLOCK LEVEL
CAMLE A5,A4 ; [E127] POSSIBLE ?
JRST DDUWE1 ; [E127] NO - ERROR
HRRZ A7,%DDTUW(DB) ; [E127] YES - GET CURRENT PROC LVL
SOJA A7,DDUW1 ; [E127] ADJUST AND GO "IN" AND "BACK"
DDUW11: SUBM A4,A5 ; [E127] SET A5 TO
AOJ A5, ; [E127] NUMBER OF LVLS TO MOVE + 1
DDUW12: HLRZ A7,%DDUWB(DB) ; [E127] PICK UP CURRENT BLOCK LEVEL
MOVE A4,%DDTBE(DB) ; [E127] PICK UP BLKIDX ENTRY
DDUW13: SOJE A5,DDUW14 ; [E127] ANY FURTHER TO GO ?
HLRZ A4,(A4) ; [E127] YES - FOLLOW CHAIN
SUBI A7,1 ; [E127] STEP CBL DOWN
JRST DDUW13 ; [E127] AND LOOP
DDUW14: MOVEM A4,%DDTBE(DB) ; [E127] REMEMBER WHERE WE ARE
HRLM A7,%DDUWB(DB) ; [E127] AND NEW CBL
DDUW15: HRROS %DDTUW(DB) ; [E127] SHOW UNWIND DONE
SUB SP,[3,,3] ; [E127] FIX STACK
POPJ SP, ; [E127] FINISHED.
; [E127] Error exits
DDUWE1: JSP A6,DDROC ; [E127] NONEXISTANT LEVEL - RECOVER
DDTERR ^D89 ; [E127] ORIGINAL CONTEXT AND COMPLAIN.
DDUWE2: POP SP,A4 ; [E127] NON-ALGOL CONTEXT - FORGET SAVED A5
JSP A6,DDROC ; [E127] RECOVER ORIGINAL CONTEXT
DDTERR ^D87 ; [E127] AND COMPLAIN.
DDBACK: ; Restore context to proper place after UNWIND's
SKIPL %DDTUW(DB) ; [E127] ARE WE UNWOUND ?
POPJ SP, ; [E127] NO - EASY
TLO DB,TMPFL3 ; [E1001] NO TYPEOUT
PUSHJ SP,HSTPR0 ; [E1001] CALL HSTPRT
SKIPGE %DDTUW(DB) ; [E1001] ARE WE STILL UNWOUND ?
DDTERR 1,^D102 ; [E1001] YES - WARN USER
POPJ SP, ; [E1001] NO - RETURN
DDGTVP: ; [E127] Get value if present - if not - syntax error.
PUSHJ SP,DDGTCH ; [E127] GET FIRST CHARACTER
DDGTP1: CAIL A4,.ZERO ; [E127] IF NOT A
CAILE A4,.NINE ; [E127] DECIMAL DIGIT -
DDTERR ^D42 ; [E127] SYNTAX ERROR
PJRST DDGTV1 ; [E127] OTHERWISE GET IN A5.
DDSCBL: ; [E127] Set current block level in database
HRRZ A10,%DDTUW(DB) ; [E127] CALCULATE NUMBER OF
MOVE A7,%UWTOP(DB) ; [E127] PROC LEVELS
SUBM A7,A10 ; [E127] TO MOVE
MOVEI A7,(DL) ; [E127] PICK UP BLOCK LEVEL
SOJL A10,DDSCB1 ; [E127] STEP DOWN
MOVEI A7,@LINKDL(A7) ; [E127] AND FOLLOW CHAIN
JRST .-2 ; [E127] AND LOOP
DDSCB1: HRRZ A10,PLBLKL(A7) ; [E127] PICK UP MAX BLOCK LVL
HRRZM A10,%DDUWB(DB) ; [E127] AND SET IT AS MAX
HRLM A10,%DDUWB(DB) ; [E127] AND CURRENT
POPJ SP, ; [E127] RETURN
; [E127] 2 routines to push and pop current context
; [E127] both are called by JSP A6,name
DDSCCS: ; [E127] Save current context on stack
PUSH SP,%DDTUW(DB) ; [E127]
PUSH SP,%DDUWB(DB) ; [E127]
HRRZ A4,%DDTBE(DB) ; [E127]
HLL A4,%DDTPC(DB) ; [E127]
PUSH SP,A4 ; [E127]
JRST (A6) ; [E127]
DDROC: ; [E127] Recover original context.
POP SP,A4 ; [E127]
HLLM A4,%DDTPC(DB) ; [E127]
HRRM A4,%DDTBE(DB) ; [E127]
POP SP,%DDUWB(DB) ; [E127]
POP SP,%DDTUW(DB) ; [E127]
JRST (A6) ; [E127]
SUBTTL OBJECT CODE DUMP ROUTINE
DUMP1: ; Enter with: A4 = start address, A5 = flags,,end address.
TLZ A5,ZERFLG ; CLEAR ZERO FLAG
DUMP2: MOVEI A13,CR
JSP AX,OUCHAR
MOVEI A13,LF
JSP AX,OUCHAR ; CR-LF
DUMP3: CAIL A4,(A5) ; FINISHED?
PJRST DDBRKB ; YES - EXIT VIA CLEAR O/P BUFFER.
MOVE A6,(A4) ; NO - PICK UP NEXT WORD
HLRZ A1,(A4) ; SEE IF BREAK-POINT.
CAIN A1,(<BREAK>) ; ?
MOVE A6,BP.INS(A6) ; YES - GET DISPLACED INSTRUCTION.
JUMPN A6,DUMP4 ; ZERO?
TLON A5,ZERFLG ; YES - ZERO FLAG SET?
AOJA A4,DUMP2 ; NO - GO VIA CR-LF
AOJA A4,DUMP3 ; YES - NO CR-LF
DUMP4: HRRZ A1,A4
PUSHJ SP,PROCT ; PRINT ADDRESS IN OCTAL
HRRZ A1,%DDTPC(DB) ; GET CURRENT ADDRESS.
CAIE A4,(A1) ; EQUAL ?
JRST .+3 ; NO.
MOVEI A13,"*" ; YES - PRINT
JSP AX,OUCHAR ; ASTERISK.
PUSHJ SP,DUMP9 ; DOUBLE TAB
TLNN A5,OBJOCT ; OCTAL REQUIRED ?
JRST DUMP4A ; NO.
HLRZ A1,A6
PUSHJ SP,PROCT ; PRINT LH IN OCTAL
PUSHJ SP,DUMP10 ; TAB
HRRZ A1,A6
PUSHJ SP,PROCT ; PRINT RH IN OCTAL
PUSHJ SP,DUMP9 ; DOUBLE TAB
DUMP4A: TLNN A5,OBJSIX ; SIXBIT ?
JRST DUMP4B ; NO.
MOVE A1,A6
PUSHJ SP,DUMP11 ; PRINT IN SIXBIT
PUSHJ SP,DUMP10 ; TAB
DUMP4B: TLNN A5,OBJASC ; ASCII ?
JRST DUMP5A ; NO.
MOVE A2,[
POINT 7,A6,] ; SET UP BYTE POINTER
MOVEI A3,5 ; AND BYTE COUNT
DUMP5: ILDB A13,A2 ; GET ASCII BYTE
CAIL A13,40
CAIL A13,174
MOVEI A13," " ; REPLACE UNPRINTABLES BY SPACES
JSP AX,OUCHAR ; AND PRINT
SOJN A3,DUMP5 ; ANY MORE?
PUSHJ SP,DUMP10 ; NO - TAB
DUMP5A: TLNN A5,OBJSYM ; SYMBOLIC INSTRUCTION ?
JRST DUMP8A ; NO.
LDB A1,[
POINT 9,A6,8] ; EXTRACT FUNCTION CODE
CAIL A1,700 ; 700 GROUP?
JRST DUMP6 ; YES
MOVE A1,DUMP18(A1) ; NO - GET SIXBIT VERSION
PUSHJ SP,DUMP11 ; AND PRINT IT
PUSHJ SP,DUMP10 ; TAB
LDB A1,[
POINT 4,A6,12] ; GET ACCUMULATOR FIELD
PUSHJ SP,DUMP14 ; AND PRINT IT
JRST DUMP7
DUMP6: LDB A1,[
POINT 3,A6,12] ; GET IO FUNCTION CODE
MOVE A1,DUMP19(A1) ; AND GET SIXBIT VERSION
PUSHJ SP,DUMP11 ; AND PRINT IT
JSP AX,SPACE% ; SPACE
LDB A1,[
POINT 7,A6,9] ; GET IO DEVICE CODE
PUSHJ SP,DUMP13 ; AND PRINT IT
DUMP7: MOVEI A13,","
JSP AX,OUCHAR ; COMMA
MOVEI A13," " ; PREPARE A SPACE
HRRZ A1,A6
CAIL A1,%ALGDR ; [303] CHECK ALGOTS DISPATCH TABLE
CAIL A1,%ALGDR+%DRSIZ; IF NOT AN ALGOTS ENTRY POINT,
JRST DUMP7A ; [303] REMEMBER TO CHECK INDIRECT BIT
SUBI A1,%ALGDR ; OTHERWISE GET OFFSET
MOVE A1,DUMP20(A1) ; GET SYMBOLIC NAME
JSP AX,OUCHAR ; PRINT THE SPACE
MOVEI A13,"@" ; [303] LOAD INDIRECT BIT INDICATOR
TLNE A6,(@) ; [303] IS INDIRECT BIT SET IN CODE?
JSP AX,OUCHAR ; [303] YES, PRINT IT
PUSHJ SP,DUMP11 ; PRINT ROUTINE NAME
JRST DUMP7C ; AND SEE ABOUT INDEX FIELD
DUMP7A: TLNE A6,(@) ; [303] IS INDIRECT BIT SET?
MOVEI A13,"@" ; [303] YES, PRINT IT
DUMP7B: JSP AX,OUCHAR ; PRINT RELEVANT CHARACTER
PUSHJ SP,PROCT ; PRINT ADDRESS
DUMP7C: LDB A1,[POINT 4,A6,17] ; GET INDEX FIELD
JUMPE A1,DUMP8 ; IGNORE IF ZERO
MOVEI A13,"(" ; OTHERWISE
JSP AX,OUCHAR ; PRINT "("
PUSHJ SP,DUMP14 ; PRINT INDEX FIELD
MOVEI A13,")"
JSP AX,OUCHAR ; PRINT ")"
DUMP8: PUSHJ SP,DUMP9 ; DOUBLE TAB
DUMP8A: PUSH SP,A5
PUSH SP,A4 ; SAVE A4 AND A5
TLNN A5,OBJINT ; INTEGER ?
JRST DUMP8B ; NO.
MOVE A0,A6
MOVEI A2,0
SETZB A3,A4
PUSHJ SP,PRINT. ; PRINT IN INTEGER FORMAT
PUSHJ SP,DUMP10 ; TAB
DUMP8B: MOVE A5,-1(SP)
TLNN A5,OBJREA ; REAL ?
JRST DUMP8C ; NO.
MOVE A0,@(SP) ; RESTORE DATA
MOVEI A2,1
SETZB A3,A4
PUSHJ SP,PRINT. ; PRINT IN REAL FORMAT
DUMP8C: MOVE A5,-1(SP)
TLNN A5,OBJLR ; LONG REAL ?
JRST DUMP8D ; NO.
PUSHJ SP,DUMP10 ; TAB.
MOVE A1,(SP) ; RESTORE
MOVE A0,(A1) ; DATA
MOVE A1,1(A1) ; 2 WORDS.
MOVEI A2,2 ; ASK FOR LONG REAL.
SETZB A3,A4
PUSHJ SP,PRINT.
DUMP8D: POP SP,A4
POP SP,A5 ; RESTORE A4,A5
AOJA A4,DUMP1 ; PREPARE FOR NEXT WORD
DUMP9: MOVEI A13," " ; DOUBLE TAB ROUTINE
JSP AX,OUCHAR
DUMP10: MOVEI A13," " ; SINGLE TAB ROUTINE
JSP AX,OUCHAR
POPJ SP,0
DUMP11: MOVE A2,[
POINT 6,A1,] ; PRINT SIXBIT ROUTINE - SET UP BYTE POINTER
MOVEI A3,6 ; AND BYTE COUNT
DUMP12: ILDB A13,A2 ; GET NEXT BYTE
ADDI A13,40 ; ADD SIXBIT OFFSET
JSP AX,OUCHAR ; AND PRINT IT
SOJN A3,DUMP12 ; ANY MORE?
POPJ SP,0 ; NO
DUMP13: MOVE A2,[
POINT 3,A1,26] ; PRINT IO DEVICE CODE ROUTINE
MOVEI A3,3 ; SET UP BYTE POINTER AND COUNT
JRST DUMP15
DUMP14: CAIGE A1,DB ; SPECIAL MNEMONIC ?
JRST DMP14A ; NO.
MOVE A2,[
POINT 6,[
SIXBIT/DB/
SIXBIT/DL/
SIXBIT/AX/
SIXBIT/SP/]-DB(A1)]
MOVEI A3,2
PJRST DUMP12 ; PRINT MNEMONIC.
DMP14A: MOVE A2,[
POINT 3,A1,29] ; PRINT ACCUMULATOR ROUTINE
MOVEI A3,2 ; SET UP BYTE POINTER AND COUNT
DUMP15: ILDB A13,A2 ; GET NEXT OIT
ADDI A13,"0" ; ADD ASCII OFFSET
JSP AX,OUCHAR ; AND PRINT IT
SOJN A3,DUMP15 ; ANY MORE?
POPJ SP,0 ; NO
; TABLE OF ORDER CODE MNEMONICS IN SIXBIT FORM
DUMP18: SIXBIT / DUMPR SYSER1SYSER2IOERR LIBERRCCORE CCORE1
BREAK DDTERR RESET.IN. OUT.
DATA. FIN. RTB. WTB. MTOP. SLIST.INF. OUTF.
RERED.NLI. NLO. DEC. ENC. /
SIXBIT /CALL INIT CALLI
OPEN TTCALL RENAMEIN OUT
SETSTSSTATO GETSTSSTATZ INBUF OUTBUFINPUT OUTPUT
CLOSE RELEASMTAPE UGETF USETI USETO LOOKUPENTER /
SIXBIT /UJEN
DFAD DFSB DFMP DFDV
DMOVE DMOVN FIX DMOVEMDMOVNMFIXR FLTR
UFA DFN FSC IBP ILDB LDB IDPB DPB /
SIXBIT /FAD FADL FADM FADB FADR FADRI FADRM FADRB
FSB FSBL FSBM FSBB FSBR FSBRI FSBRM FSBRB
FMP FMPL FMPM FMPB FMPR FMRRI FMPRM FMPRB
FDV FDVL FDVM FDVB FDVR FDVRI FDVRM FDVRB /
SIXBIT /MOVE MOVEI MOVEM MOVES MOVS MOVSI MOVSM MOVSS
MOVN MOVNI MOVNM MOVNS MOVM MOVMI MOVMM MOVMS
IMUL IMULI IMULM IMULB MUL MULI MULM MULB
IDIV IDIVI IDIVM IDIVB DIV DIVI DIVM DIVB /
SIXBIT /ASH ROT LSH JFFO ASHC ROTC LSHC
EXCH BLT AOBJP AOBJN JRST JFCL XCT
PUSHJ PUSH POP POPJ JSR JSP JSA JRA
ADD ADDI ADDM ADDB SUB SUBI SUBM SUBB /
SIXBIT /CAI CAIL CAIE CAILE CAIA CAIGE CAIN CAIG
CAM CAML CAME CAMLE CAMA CAMGE CAMN CAMG
JUMP JUMPL JUMPE JUMPLEJUMPA JUMPGEJUMPN JUMPG
SKIP SKIPL SKIPE SKIPLESKIPA SKIPGESKIPN SKIPG /
SIXBIT /AOJ AOJL AOJE AOJLE AOJA AOJGE AOJN AOJG
AOS AOSL AOSE AOSLE AOSA AOSGE AOSN AOSG
SOJ SOJL SOJE SOJLE SOJA SOJGE SOJN SOJG
SOS SOSL SOSE SOSLE SOSA SOSGE SOSN SOSG /
SIXBIT /SETZ SETZI SETZM SETZB AND ANDI ANDM ANDB
ANDCA ANDCAIANDCAMANDCABSETM SETMI SETMM SETMB
ANDCM ANDCMIANDCMMANDCMBSETA SETAI SETAM SETAB
XOR XORI XORM XORB IOR IORI IORM IORB /
SIXBIT /ANDCB ANDCBIANDCBMANDCBBEQV EQVI EQVM EQVB
SETCA SETCAISETCAMSETCABORCA ORCAI ORCAM ORCAB
SETCM SETCMISETCMMSETCMBORCM ORCMI ORCMM ORCMB
ORCB ORCBI ORCBM ORCBB SETO SETOI SETOM SETOB /
SIXBIT /HLL HLLI HLLM HLLS HRL HRLI HRLM HRLS
HLLZ HLLZI HLLZM HLLZS HRLZ HRLZI HRLZM HRLZS
HLLO HLLOI HLLOM HLLOS HRLO HRLOI HRLOM HRLOS
HLLE HLLEI HLLEM HLLES HRLE HRLEI HRLEM HRLEB /
SIXBIT /HRR HRRI HRRM HRRS HLR HLRI HLRM HLRS
HRRZ HRRZI HRRZM HRRZS HLRZ HLRZI HLRZM HLRZS
HRRO HRROI HRROM HRROS HLRE HLREI HLREM HLRES
HRRE HRREI HRREM HRRES HLRE HLREI HLREM HLRES /
SIXBIT /TRN TLN TRNE TLNE TRNA TLNA TRNN TLNN
TDN TSN TDNE TSNE TDNA TSNA TDNN TSNN
TRZ TLZ TRZE TLZE TRZA TLZA TRZN TLZN
TDZ TSZ TDZE TSZE TDZA TSZA TDZN TSZN /
SIXBIT /TRC TLC TRCE TLCE TRCA TLCA TRCN TLCN
TDC TSC TDCE TSCE TDCA TSCA TDCN TSCN
TRO TLO TROE TLOE TROA TLOA TRON TLON
TDO TSO TDOE TSOE TDOA TSOA TDON TSON /
DUMP19: SIXBIT /BLKI DATAI BLKO DATAO CONO CONI CONSZ CONSO /
DUMP20: SIXBIT /INITIAPARAM PAR0 GOLAB ARRAY OARRAYCHKARRCOMPAR/
SIXBIT /PBYTE BLKBEGBLKENDCPYSTRCPYARRGETOWNGETCLRMONIT /
SIXBIT /MONIT0RDOCT PROCT INBYTEOUBYTENXTBYTBRKBYTINCHAR/
SIXBIT /OUCHARBRKCHRREAD. PRINT.SELIN SELOUTINPT OUTPT /
SIXBIT /RELESEOPFILECLFILEXFILE BSPACEENFILEREWND.STRASS/
SIXBIT /FUNCT.TRLPRTTRLAB TRSTD STRDECDDDUMP/
%DRSIZ=.-DUMP20
SUBTTL Debugging system - command routine - REDIRECT
REDIRECT:
MOVEI A2,(A4) ; SAVE CHAR OVER RELESE.
HLRE A1,%DDTER(DB) ; GET OLD CHANNEL #
JUMPL A1,REDIR2 ; OLD ONE WAS TTY:.
PUSHJ SP,RELESE ; WASN'T - RELEASE IT.
JFCL
REDIR2: MOVEI A4,(A2) ; RESTORE SAVED CHAR.
CAIE A4,.SCOL ; NULL ?
JRST REDIR1 ; NO.
HRROS %DDTER(DB) ; SET TTY:
POPJ SP,
REDIR1: MOVSI A6,'LST' ; DEFAULT EXTENSION.
MOVSI A0,'DSK' ; DEFAULT DEVICE.
PUSHJ SP,DDOPFL ; READ FILE-NAME & OPEN IT.
HRLM A1,%DDTER(DB) ; SAVE CHANNEL #
POPJ SP,
SUBTTL Debugging system - open file routine.
; Reads a file-mame from TTY:, and open it. Finds a free channel
; Exits with channel-# in A1. Enter with default extension in L.H. A6.,
; default device in A0, first character in A4.
; If r.h. A0 is 1, try SYS: after default DEV: (not if explicit dev: given).
DDOPFL: TDZA A11,A11 ; OPEN FOR O/P - FLAG.
DDIPFL: MOVEI A11,1 ; OPEN FOR I/P - FLAG.
PUSHJ SP,DDGTFL
JRST DDER99 ; NON-SKIP = ERROR.
JRST DDFL88
DDGTFL: ; Entry for INIT routine.
MOVEI A7,0
SKIPA A5,.+1
SIXBIT/ALGDDT/ ; SET DEFAULT FILENAME.
DDFL0: MOVEI A2,0
SKIPA A3,[
POINT 6,A2]
DDFL2: PUSHJ SP,DDGTCH
CAIL A4,.A
CAILE A4,.Z
JRST DDFL4
DDFL3: SUBI A4,40 ; TO SIXBIT.
TRNN A2,77 ; FULL UP ?
IDPB A4,A3 ; NO - PUT IN CHAR.
JRST DDFL2
DDFL4: CAIL A4,.ZERO
CAILE A4,.NINE
SKIPA
JRST DDFL3
CAIE A4,.COLON
JRST DDFL5 ; NOT DEVICE.
MOVE A0,A2
PUSHJ SP,DDGTCH
JRST DDFL0
DDFL5: SKIPE A2
MOVE A5,A2
CAIE A4,.DOT ; EXTENSION?
JRST DDFL6 ; NO.
MOVE A3,[
POINT 6,A6]
MOVEI A6,0
DDFL9: PUSHJ SP,DDGTCH
CAIL A4,.A
CAILE A4,.Z
SKIPA
JRST DDFL8
CAIL A4,.ZERO
CAILE A4,.NINE
JRST DDFL6 ; END OF EXTENSION.
DDFL8: SUBI A4,40 ; TO SIXBIT.
TRNN A6,770000 ; 3 CHARS ?
IDPB A4,A3 ; NO - PUT ANOTHER IN.
JRST DDFL9
DDFL6: ; Only [ or ; left.
CAIE A4,.LBRA ; [ ?
JRST DDFL7 ; NO
GETPPN A10, ; YES - SET UP FOR DEFAULT PPN'S.
JFCL ; STRANGE PRIV JOB RETURN.
PUSHJ SP,DDGTCH
MOVE A12,A0
CAIE A4,.MINUS ; DEFAULT PPN ?
JRST DDFL6A ; NO
MOVE A7,A10
PUSHJ SP,DDGTCH
JRST DDFL6B
DDFL6A: CAIE A4,.COMMA ; DEFAULT PROJ ?
JRST DDFL6C ; NO.
HLLZ A7,A10
PUSHJ SP,DDGTCH
JRST DDFL6D
DDFL6C: ; Not default proj - read it.
PUSHJ SP,DDGTOC
HRLZ A7,A0
CAIE A4,.COMMA
DDTERR 1,^D52
PUSHJ SP,DDGTCH
DDFL6D: CAIE A4,.RBRA ; DEFAULT PROG ?
JRST DDFL6E ; NO
HRRI A7,(A10)
JRST DDFL6F
DDFL6E: PUSHJ SP,DDGTOC ; NOT DEFAULT - READ IT.
HRR A7,A0
DDFL6B: CAIE A4,.RBRA
DDTERR 1,^D52
DDFL6F: ; PPN read.
MOVE A0,A12
JRST DDFL2
DDFL7: ; Here, A0 = Device, A5 = filename, A6 = extension, A7 = PPN.
; If r.h. A0 = 1, try SYS: too.
CAIE A4,.SCOL ; ONLY LEGAL CHAR LEFT.
DDTERR 1,^D53
JRST CPOPJ1
DDFL88: PUSH SP,A0
PUSHJ SP,DDGTCN ; GET FREE CHAN TO A1.
POP SP,A0
DDFL89: HRRZ A12,A0
CAIN A12,1 ; 'TRY SYS:' FLAG?
TRZ A0,1 ; YES - REMOVE IT FROM DEV-NAME.
MOVEI A10,(A1)
MOVEI A2,0 ; MODE.
PUSH SP,A5
PUSH SP,A6
PUSH SP,A7 ; IN/OUTPT CLOBBER MANY AC'S.
PUSHJ SP,@[
EXP OUTPT
EXP INPT](A11) ; GO TO RIGHT ROUTINE.
SKIPE A1 ; DID IT WORK ?
DDTERR ^D54 ; NO
MOVEI A1,(A10) ; RECOVER CHAN #
POP SP,A5 ; PPN
POP SP,A3 ; EXT
POP SP,A2 ; FILENAME.
MOVEI A4,0 ; STANDARD PROTECTION.
PUSHJ SP,OPFILE ; OPEN IT.
JUMPE A0,CPOPJ ; SUCCESS.
CAIE A12,1 ; 'TRY SYS:' ?
DDTERR ^D55 ; NO - FAILURE.
MOVSI A0,'SYS' ; YES - DO IT.
MOVE A7,A5
MOVE A5,A2
MOVE A6,A3 ; GET NAME, EXT ETC BACK.
JRST DDFL89 ; RETRY (R.H. A0 = 0 NOW!)
SUBTTL Debugging system - command routine - HELP
DDHELP: ; Types a file (any ASCII file !) on TTY:
; Default is HLP:ALGDDT.HLP
TRNE FL,DDINDF ; NOT ALLOWED IN
DDTERR ^d85 ; INDIRECT FILE.
MOVSI A6,'HLP' ; DEFAULT EXTENSION
MOVSI A0,'HLP' ; AND DEVICE.
TRO A0,1 ; SAY 'TRY SYS: TOO'
DDHLP1: PUSHJ SP,DDIPFL ; READ NAME, IF ANY, & OPEN IT.
TRO FL,DDINDF
HRRM FL,%DDTFL(DB) ; THIS MAKES ^C RELEASE THE FILE.
HRLO A1,A1 ; SET O/P = TTY:
EXCH A1,%CHAN(DB) ; SELECT CHANNELS.
PUSHJ SP,XFILE ; TRANSFER FILE.
PUSHJ SP,DDBRKB ; JUST IN CASE.
MOVEI A2,DDINDF ; TURN OFF
ANDCAM A2,%DDTFL(DB) ; INDIRECT-FILE MODE.
EXCH A1,%CHAN(DB) ; DESELECT.
HLRE A1,A1
JUMPL A1,CPOPJ ; FAIRLY SILLY (I/P = TTY:)
PUSHJ SP,RELESE ; RELEASE I/P CHAN
JFCL
POPJ SP,
DDSORS: ; Same, but default is: DSK:ALGDDT.ALG
MOVSI A0,'DSK'
MOVSI A6,'ALG'
JRST DDHLP1
SUBTTL Debugging system - error handlers.
DDCCML: ; [E1000] COMMAND LEVEL ^C INTERCEPT
; [E1000] HANDLE CONTINUE CORRECTLY
PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
PUSH SP,%CONC+2(DB) ; [E1000] STACK PC AT INTERCEPT
PUSH SP,.JBOPC ; [E1000] SAVE "OLD PC"
SETZM %CONC+2(DB) ; [E1000] CLEAR INTERCEPT PC
OUTSTR [ASCIZ/^C/] ; [274] ECHO ^C TO USER
EXIT 1, ; [E1000] AND GO TO MONITOR LEVEL
POP SP,.JBOPC ; [E1000] RECOVER "OLD PC"
POPJ SP, ; [E1000] AND RETURN TO WHERE WE WERE
DDCONC: PORTAL .+1 ; [303] HANDLE EXECUTE-ONLY
HRRI A1,DDCCML ; [E1000] SET CMD LVL
HRRM A1,%CONC(DB) ; [E1000] ^C INTERCEPT
PUSHJ SP,BRKBYT ; EMPTY OUPUT BUFFER.
JFCL
CLRBFO ; & MONITOR'S BUFFER.
OUTSTR [ASCIZ/
Action abandoned./]
MOVE FL,%DDTFL(DB)
TRZ FL,DDALST!DDALIP ; CLEAR AUTOLIST FLAGS.
HRRM FL,%DDTFL(DB)
JRST DDER99 ; GET STACK RESET.
; Error-jumps, used where we want JUMPE AC,ERROR etc.
DDER5: DDTERR 5
DDER6: DDTERR 6
DDER20: DDTERR ^D20
DDER27: DDTERR ^D27
DDER31: DDTERR ^D31
DDTER%: ; Here on error (UUO DDTERR n)
; n is error-#. 0 is silly (undefined error).
; AC field says where to go after error-message is typed:
; 0 Clear the stack and prompt for command.
; 1 POPJ SP,
PUSHJ SP,DDBRKB ; [274] BREAKOUTPUT BEFORE TYPING MSG.
HRRZ A6,.JBUUO ; GET ERROR #
CAIL A6,DDERMX ; TOO BIG ?
MOVEI A6,0 ; YES - USE CATCH-ALL MESSAGE.
MOVE A5,DDERTB(A6) ; GET MSG ADDR.
HRRZ A4,%DDTER(DB) ; 0 = NOVICE.
TRNE A4,-1
MOVS A5,A5 ; EXPERT - GET SHORT MSG.
DDTER1: MOVE FL,%DDTFL(DB)
TRNN FL,DDALST ; IN AUTOLIST ?
TROA A7,-1 ; NO - REMEMBER.
LDB A7,[
POINT 3,FL,20] ; YES - GET ERROR ACTION-CODE.
MOVE A7,DDALET+1(A7) ; GET ACTION.
JUMPL A7,DDER98 ; IF BIT 0 IS SET, NO MESSAGE.
DDTER2: OUTSTR [ASCIZ/
/]
OUTSTR (A5)
OUTSTR [ASCIZ/
/] ; [241] ADD CR-LF TO ERROR MSG. TYPEOUT
TRNE A4,-1 ; IF EXPERT,
HLRM A5,%DDTER(DB) ; SAVE LONG MSG ADDR.
LDB A6,[
POINT 4,.JBUUO,12] ; GET AC FIELD.
JUMPE A6,DDER98 ; 0 - COMMAND LEVEL
SOJE A6,CPOPJ ; 1 - POPJ
JRST DDER98
DDALET: ; Autolist error action table.
; Bit 0 = 1 : no message. R.H. = dispatch addr after msg.
EXP DDER99 ; -1 ENTRY: NON-AUTOLIST CASE.
EXP DDER95 ; 0 DEFAULT = STOP.
XWD 400000,DDER97 ; 1 - IGNORE.
EXP DDER97 ; 2 - CONTINUE (WITH AUTOLIST)
EXP DDER96 ; 3 - KILL & CONTINUE (PROGRAM)
EXP DDER95 ; 4 - STOP (GO TO ALGDDT CMD LVL).
DDERM%: ; Here with error from main OTS.
; A1 = BYTE(12)FLAGS(6)TRAPNO(18)ERRMSGADDR.
AOSE %DDERD(DB) ; [E1000] SET ERROR DETECTED FLAG
JRST DD2ERR ; [E1000] SECOND ERROR - DIE GRACEFULLY
PUSHJ SP,DDBRKB ; [274] BREAKOUTPUT
MOVE DL,%ACCS+DL(DB) ; [E147] Restore saved DL
ADDI DL,(DB) ; [E147] ... a thunk may change it.
HLRZ A2,A1
ANDI A2,TRAPNO ; GET TRAP #
CAIL A2,40 ; I/O
CAILE A2,55 ; ERROR ?
SKIPA A5,A1 ; NO - GET MSG ADDR.
DDTERR DDERIO-40(A2) ; YES - USE OUR MSG.
CAIN A2,11 ; ASSIGN TO EXPRESSION ERROR ?
DDTERR ^D67 ; YES - GIVE SPECIAL MSG.
SETZB A4,.JBUUO ; FORCE NOVICE MODE & 0 AC FIELD (I.E. RESET STACK)
JRST DDTER1 ; NO - USE HIS MSG.
DDER99: MOVE FL,%DDTFL(DB)
TRZN FL,DDINDF ; IN INDIRECT FILE ?
JRST DDER97 ; NO
HRRM FL,%DDTFL(DB)
HLRE A1,%CHAN(DB)
SKIPL A1
PUSHJ SP,RELESE ; YES - RELEASE IT.
JFCL
JRST DDER97
DDER98: JRST (A7) ; DISPATCH.
DDER96: ; KILL REFERENCE, CONTINUE PROGRAM.
HLRZ A4,%DDTAL(DB) ; PAUSE BLOCK ADDR.
MOVE A3,BP.FLG(A4) ; FLAGS
TLZN A3,BP.PRI ; PRIVATE ?
JRST DDER94 ; NO.
MOVEM A3,1(A4) ; CLEAR FLAG.
HRRZ A1,3(A4) ; GET AUTOLIST ADDR.
MOVEI A0,0
PUSHJ SP,GETOWN ; RELEASE CORE.
DDER94: HLLZS 3(A4) ; CLEAR AUTOLIST POINTER.
JRST BREAKX ; CONTINUE PROGRAM.
%DDREE:: ; [E1000] ENTRY FROM ^C REENTER
POP SP,.JBOPC ; [E1000] RECOVER SAVED PC
MOVE FL,%DDTFL(DB) ; [E1000] GET REAL FLAGS
DDER95: ; GO TO ALGDDT CMD LVL.
TRZ FL,DDALST ; CLEAR BIT.
HRRM FL,%DDTFL(DB) ; PERMANENTLY.
DDER97: HRRI A1,DDCCML ; [E1000] SET CMD LVL
HRRM A1,%CONC(DB) ; [E1000] ^C INTERCEPT
SETOM %CHAN(DB) ; RESTORE I/O TO TTY:
HRRZ A1,%ACCS+SP(DB) ; GET OLD (DELOCATED) SP.
ADDI A1,(DB) ; AND RELOCATE IT.
MOVEI A2,(SP)
SUBI A2,(A1) ; GET AMOUNT TO RETARD SP BY
HRLI A2,(A2)
SUB SP,A2 ; AND DO IT.
SETZM %DDTCC(DB) ; CLEAR CONTROL-C TRAP
JRST DDTLUP ; AND GET NEXT COMMAND.
;[E1000] SECOND ERROR WHILE PROCESSING ERROR
DD2ERR: MOVE A1,.JBUUO ; [270] PICK UP LAST ALGOL ERROR UUO
CAMN A1,[SYSER1 2,] ; [270] ARE WE HAVING BAD CORE PROBLEMS?
JRST [SETOM %DDERD(DB) ; [270] YES, RESET ERROR COUNT
MOVEI A1,[ASCIZ/?Can't continue ALGDDT - not enough core/]
JRST .+2] ; [270] TELL USER ABOUT OUR PROBLEM
MOVEI A1,[ ; [270][E1000] SET UP MESSAGE ..
ASCIZ/?ALGSPR System error in ALGDDT - Please submit an SPR/]
PUSHJ SP,MONIT0 ; [E1000] .. PRINT IT ..
EXIT ; [E1000] .. AND GIVE IN
SUBTTL Debugging system - output routines.
; *** NOTE *** A13 = FL ***
DDOSIX: ; Output sixbit word from A4. Stops at space. Clobbers A3.
PUSH SP,FL
MOVEI A3,0
LSHC A3,6
JUMPE A3,DDPOPF ; RESTORE FL & EXIT.
MOVEI A13,40(A3)
PUSHJ SP,DDOUCH
JRST DDOSIX+1
DDOTIM: ; Print today's time. Clobbers A2,A3.
Edit(156); Don't use GETTABs for date and time.
PUSH SP,FL ; [E156] Save the flags
MSTIME A2, ; [E156] Get the time
IDIVI A2,^D1000 ; [E156] Convert to seconds
IDIVI A2,^D3600 ; [E156] Hours in A2
PUSH SP,A3 ; [E156]
PUSHJ SP,DDOTM1 ; [E156] Send hours
MOVEI A13,.COLON ; [E156] And a ":"
PUSHJ SP,DDOUCH ; [E156] . . .
POP SP,A2 ; [E156]
IDIVI A2,^D60 ; [E156] Minutes in A2
PUSH SP,A3 ; [E156]
PUSHJ SP,DDOTM1 ; [E156] Send minutes
MOVEI A13,.COLON ; [E156] And a ":"
PUSHJ SP,DDOUCH ; [E156] . . .
POP SP,A2 ; [E156] Rescue seconds
PUSHJ SP,DDOTM1 ; [E156] and send them
DDPOPF: POP SP,FL
POPJ SP,
DDOTM1: IDIVI A2,^D10 ; [E156] Send digits with leading zeros
MOVEI A13,.ZERO(A2) ; [E156] . . .
PUSHJ SP,DDOUCH ; [E156] . . .
MOVEI A13,.ZERO(A3) ; [E156] . . .
PJRST DDOUCH ; [E156] . . .
DDODAT: ; Print today's date.
PUSH SP,FL ; [E156] Save the flags
DATE A0, ; [E156] Get the date
IDIVI A0,^D31 ; [E156] Days-1 in A1
EXCH A0,A1 ; [E156]
AOJ A0, ; [E156] Days in A0
PUSH SP,A1 ; [E156]
PUSHJ SP,DPRNT% ; [E156] Print days
MOVEI A13,.MINUS ; [E156] Print a "-"
PUSHJ SP,DDOUCH10 ; [E156] . . .
POP SP,A0 ; [E156]
IDIVI A0,^D12 ; [E156] Months-1 in A1
LSH A1,1 ; [E156] Get offset into MONTAB
ADDI A1,MONTAB ; [E156] . . .
PUSHJ SP,DDTOU% ; [E156] Print the month
PUSHJ SP,DDOUCH ; [E156] and another "-"
ADDI A0,^D1964 ; [E156] Print the year
PUSHJ SP,DPRNT% ; [E156] . . .
PJRST DDPOPF ; [E156] All done
MONTAB: ; 2 words each !
ASCIZ/January/
ASCIZ/February/
ASCIZ/March/
ASCIZ/April/
ASCIZ/May/
Z
ASCIZ/June/
Z
ASCIZ/July/
Z
ASCIZ/August/
ASCIZ/September/
ASCIZ/October/
ASCIZ/November/
ASCIZ/December/
DDOUCH: ; Output a character from A13.
PUSH SP,A10
PUSH SP,A11
PUSH SP,A12
PUSHJ SP,OUBYTE
JFCL
PJRST DDPOP3
DDOUMD: ; Output module-name. Enter with control-blk addr in A6.
; Clobbers A4,A5.
HLRZ A4,(A6)
MOVE A4,(A4) ; MODULE-NAME IN RAD50
MODPRT: PUSH SP,FL
MOVEI A1,[ASCIZ/ in module /]
PUSHJ SP,DDTOU%
PUSH SP,[0] ; MARKER.
IDIVI A4,50
JUMPE A5,.-1
PUSH SP,A5
JUMPN A4,.-3
DDOUM1: POP SP,A13 ; GET RADIX-50 CHAR.
JUMPE A13,DDPOPF ; END
CAIL A13,13 ; LETTER ?
ADDI A13,7
ADDI A13,57 ; TO ASCII
PUSHJ SP,DDOUCH
JRST DDOUM1
DDSETI: ; Set control-C intercept routine.
HRLI A0,-1 ; [E1000] MARK TO BUILD BLOCK
DDSTI1: PUSH SP,A0 ; [E1000] SAVE ROUTINE ADDRESS
MOVE A0,[-1,,.GTLIM] ; [243] LOAD GETTAB TABLE INDEX
GETTAB A0, ; [243] GET THE TABLE INFORMATION
LIBERR 5, ; [243] COMPLAIN IF GETTAB FAILS
TLNE A0,JB.LBT ; [243] IS THIS A BATCH JOB?
JRST DDSTI3 ; [243] YES, DON'T SET ^C INTERCEPT
MOVE A0,(SP) ; [E1000] [243] NO
JUMPGE A0,DDSTI2 ; [E1000] - DON'T
SETZM %CONC+2(DB) ; [E1000] BUILD
MOVEI A0,CONCF ; [E1000] CONTROL
MOVEM A0,%CONC+1(DB) ; [E1000] BLOCK
DDSTI2: POP SP,A0 ; [E1000] RECOVER ROUTINE ADDRESS
HRLI A0,4 ; [E1000] NOW SET THE FLAG
MOVEM A0,%CONC(DB) ; [E1000] INSTALL ROUTINE ADDRESS
MOVEI A0,%CONC(DB) ; [E1000] GET CONTROL BLOCK ADDRESS
MOVEM A0,.JBINT## ; [E1000] AND SET TRAP
POPJ SP,
DDSTI3: POP SP,(SP) ; [E1000] FIX STACK
POPJ SP, ; [E1000]
SUBTTL Debugging system - Error message text table
DEFINE M(A,B,C,D) <
XWD [ASCIZ&A&],[ASCIZ&B'C'D&]
>
; The actual change here was to allow multiple arguments to the M macro,
; for message # 90.
DDERTB:
M <??????>,<Undefined error-message number.> ; 0
M <No S.T.>,<A previous attempt to read the .SYM file failed.> ; 1
M <Syntax>,<% or [ in what looks like a command.> ; 2
M <Cmd ?>,<Unrecognised command keyword.> ; 3
M <Cmd ?>,<Command abbreviation is not unique.> ; 4
M <Not in A/L>,<This command is illegal within an Autolist.> ; 5
M <Id too long>,<More than 64 characters in identifier.> ; 6
M <Syntax>,<Bad character in subscript.> ; 7
M <Syntax>,<. (for byte subscript) not followed by [.> ; 8
; ***** Note that error-numbers are DECIMAL *****
M <Syntax>,<More than 1 byte subscript.> ; 9
M <Syntax>,<Colon used illegally.> ; 10
M <No Dev>,<Device (to read .SYM file) unavailable.> ; 11
M <No .SYM>,<The debugger's symbol (.SYM) file can't be found.> ; 12
M <.SYM too big>,<The Monitor says the .SYM file is bigger than 128K !> ; 13
M <.SYM I/O err>,<Error while reading the .SYM file.> ; 14
M <SYSER 1>,<System error: a block has level = 0.> ; 15
M <SYSER 2>,<Syser 2: compiler output different number of block-starts and block-ends.> ; 16
M <No G.S.T.>,<The normal (LINK) symbol table can't be found in memory.> ; 17
M <SYSER 3>,<System error: the address can't be resolved into a line #.> ; 18
M <Module ?>,<Module specified does not exist.> ; 19
M <Line # ?>,<Line # specified does not exist.> ; 20
M <SYSER 4>,<System error: module specified appears in ALGOL symbol-table, but not in LINK's symbol-table.> ; 21
M <No`Id>,<No Identifier specified in command.> ; 22
M <Ident ?>,<Identifier specified does not exist, or is out of scope.> ; 23
M <Not array>,<An identifier which is not an array is subscripted.> ; 24
M <Not string>,<An identifier which is not a string is byte-subscripted.> ;25
M <Syntax>,<%-identifiers may not be subscripted.> ; 26
M <Unref.>,<Identifier is unreferenced in the program, and is inaccessible to the Debugging System.> ; 27
M <Undecl>,<Identifier is undeclared in the program.> ; 28
M <Label>,<Labels can't be accessed like this.> ; 29
M <Proc>,<Procedures can't be accessed like this.> ; 30
M <Syntax>,<Zero or negative byte-subscript.> ; 31
M <Bounds>,<Array slice exceeds bounds of array.> ; 32
M <# subscrs>,<Wrong number of subscripts.> ; 33
M <Not array>,<Identifier is not an array.> ; 34
M <Inter 2>,<Internal error 2.> ; 35
M <Cant assign>,<Assignments can't be made to %-identifiers, whole arrays or slices.> ; 36
M <.gt. 36>,<Byte-size is too large.> ; 37
M <No ) or ]>,<Missing right parenthesis or bracket.> ; 38
M <Use octal>,<Quoted strings can only have 6- or 7-bit bytes.> ; 39
M <Bad bool>,<Bad boolean value.> ; 40
M <Bad octal>,<Bad octal value.> ; 41
M <Syntax>,<Unrecognised or omitted parameter in command.> ; 42
M <Too long>,<Module-name has more than 6 characters.> ; 43
M <Bad a/l>,<Autolist name should be 1 letter.> ; 44
M <Switch?>,<Unrecognised switch-name.> ; 45
M <Switch?>,<Switch-name not unique.> ; 46
M <Hiseg>,<Attempt to put a PAUSE in the high segment.> ; 47
M <P on P>,<There is already a PAUSE at that point.> ; 48
M <Module?>,<Module occurs more than once in the LINK symbol-table.> ; 49
M <Not in a/l>,<END may only end definition of an Autolist.> ; 50
M <Undef a/l>,<Attempt to execute an undefined Autolist.> ; 51
M <ppn ?>,<Invalid project-programmer number.> ; 52
M <Filspec>,<Invalid character in file specification.> ; 53
M <Dev?>,<Device is not available.> ; 54
M <File ?>,<File not found or protection failure.> ; 55
M <Syntax>,<Invalid character in DUMP command.> ; 56
M <Syntax>,<Unrecognised keyword in DUMP command.> ; 57
M <No b.p's>,<No pauses exist.> ; 58
M <No b.p.>,<Pause specified does not exist.> ; 59
M <% ??!>,<% in a label or procedure name ??!!> ; 60
M <No b.p.>,<No current pause.> ; 61
M <Not label>,<Identifier is not a label.> ; 62
M <Out-of-bounds switch.>,<The actual parameter is a switch whose subscript is out of range.> ; 63
M <Syntax>,<Must be a 1-character name, or ALL.> ; 64
M <Undef>,<Autolist is undefined.> ; 65
M <Nested @>,<Indirect files may not be nested.> ; 66
M <Expr:=>,<Attempt to alter value of a constant or expression.> ; 67
DDERIO==^D68 ; Here follow the I/O errors (14 of them).
M <Dev?>,<Device is not available> ; 68 = trap # 40.
M <Mode?>,<Device does not support ASCII mode.> ; 69 = 41
M <Syserr>,<Syserr: undefined channel.> ; 70 = 42
M <Syserr>,<Syserr: no file open (should have defaulted.)> ; 71 = 43
M <??????>,<Undefined I/O error.> ; 72 = 44
M <File?>,<File is not available.> ; 73 = 45
M <EOF>,<End-of-file on output file (full disc?).> ; 74 =46
M <I/O err>,<Transfer error on input/output file.> ; 75 = 47
M <Ill char>,<Illegal character in numeric data.> ; 76 = 50
M <Too big>,<Number is too large.> ; 77 = 51
M <Close err>,<Error condition closing a file.> ; 78 = 52
M <Syserr>,<Syserr: illegal operation on I/O file.> ; 79 = 53
M <??????>,<Undefined I/O error.> ; 80 = 54
M <Ovrlay>,<Channel is in use by the overlay handler.> ; 81 = 55
M <@ in a/l>,<Indirect files may not be called from an Autolist.> ; 82
M <@ too long>,<A line in an indirect file is too long (max = 130. chars).> ; 83
M <Not proc>,<Identifier is not a procedure.> ; 84
M <Help in @>,<The HELP command is illegal in an indirect file.> ; 85
M <Twice ?>,<The program has already been STARTed once.> ; 86
M <Not in S.T.>,<There is no ALGDDT symbol information available for this module.>; 87
M <2 b/p's>,<There is more than 1 PAUSE of the same name: use BLOCK option.> ; 88
M <Too far>,<Attempt to UNWIND to a non-existent level.> ; 89
RADIX 10 ; to make \DDNEST below come out right !
M <A/L loop>,<Attempt to nest autolists too deep - more than >,\DDNEST, levels. ; 90
RADIX 8
M <Not in a/l>,<The BEGIN option of PAUSE may not be executed in an autolist.> ; 91
M <No next>,<There is no statement to execute 'NEXT'.> ; 92
M <Unwound>,<GOTO is not allowed if context is not set to the innermost procedure level.
Either ALGDDT was not able to establish context there on entry, or the user
has issued an UNWIND command. Reset context first by typing BACK.> ; 93
M <No s.t.>,<No symbol file was produced for this program
(/PRO or /NOSYM to ALGOL,or /NOSYM to LINK):
the debugging system will not know about line numbers or identifiers.> ; 94
M <Scope ?>,<The specified line number is in a section of Algol code such that
had there been a label on that line, it would be out of scope.> ; 95
M <Range ?>,<Initial proceed count exceeds breakpoint activation limit.> ; 96
M <Consistency error 1>,<The order of the entries in the .SYM file is incorrect (Compiler error).
Please submit an SPR, with details of the program and any TTY dialogue.> ; 97
M <Not in S.T.>,<Control is about to pass to a section of code for which the debugger
has no symbol table (Either non-algol code, or /NOSYMBOLS specified).> ; 98
M <Consistency error 2>,<The output from the compiler is not in the format expected by the debugger.
Please submit an SPR, with details of the program and any TTY dialogue.> ; 99
M <lost next>,<% ALGDDT can only keep track of one 'next' command at a time.
An earlier (uncompleted) next command has now been forgotten.> ; 100
M <Level 0.0>,<Cannot UNWIND from level 0.0.> ; [E127] 101
M <Still Unwound>,<There is no ALGDDT symbol information for the innermost procedure level.> ; [E1001] 102
M <Syntax>,<Invalid character in module name.> ; [264] 103
DDERMX==.-DDERTB>
; *******************************
; * *
; * END OF IFN FTDDT *
; * *
; *******************************
END