Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
cobddt.mac
There are 20 other files named cobddt.mac in the archive. Click here to see a list.
; UPD ID= 1934 on 6/18/79 at 10:45 AM by W:<WRIGHT>
TITLE COBDDT VERSION 12A
SUBTTL COBOL DEBUG PACKAGE
;COPYRIGHT (C) 1974, 1979 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.
EDIT==26
VERSION==1201
; EDIT 26 FIXED BUG IN 'ACCEPT TALLY'. (DIDN'T WORK)
; FIXED BUG IN 'BREAK TALLY'. (DID AN ACCEPT!)
; IMPLEMENTED 'DDT' COMMAND.
; IMPLEMENTED 'LOCATE' COMMAND.
; IMPLEMENTED 'STEP' COMMAND.
; IMPLEMENTED 'GO' COMMAND.
; IMPLEMENTED 'TRACE BACK' COMMAND.
; ALLOWED BREAKPOINTS AT SECTION NAMES.
; ALLOWED MODULES COMPILED WITH /P TO BE LINKED IN.
; MOVED SOME CODE AROUND SO IT IS A LITTLE MORE UNDERSTANDABLE.
; SUBSTITUTED MNEMONIC LABELS FOR IMPLEMENTORS'S INITIALS!!!!
; EDIT 25 ADDED BETTER COMMENTS, MINOR BUG FIXES.
; ADDED REQUIREMENT THAT STOP COMMAND BE TYPED IN FULL.
; ONLY THE CODE CHANGES ARE IDENTIFIED WITH ;[25] COMMENTS.
; EDIT 24 ADDED "NEXT <INTEGER>" COMMAND.
; EDIT 23 FIX BREAKPOINT INSERTION AFTER .REENTER.
; EDIT 22 FIX "? ITEM TOO LARGE FOR TEMP" ERROR TO DISPLAY CORRECTLY
; EDIT 21 IMPLEMENT REENTER COMMAND
; EDIT 20 ALLOW COBDDT TO UNDERSTAND LOWER CASE.
; EDIT 17 FIX SYMBOL TABLE SEARCH FOR QUALIFIED VARIABLES.
; EDIT 16 FIX MEMORY PROTECTION FAILURE FOR QUALIFIED ITEMS.
; EDITS 14 & 15 INADVERTANTLY FIXED IN V10.
; EDIT 13 FIX SO THAT MODULE COMMAND DOES NOT INTERFERE WITH RUNNING (TRACING)
;[12] /JEF SKIP OVER FOUR START UP INSTRUCTIONS (DBMS)
; TO AVOID ILL MEM REF.
MLON
SALL
SEARCH INTERM,COMUNI
IFN TOPS20,< SEARCH MONSYM ;[26]
>
INFIX% ;DEFINE %FILES INDICES
;Entry and exit documentation for COBDDT.
;COBDDT can be invoked in various ways and at various entry points.
;Some invocations cause an action to take place followed by a return to
;the caller. Other invocations cause an action to take place followed by
;entry to COBDDT's dialogue mode, in which it converses with the user at the
;terminal. The user has various options for getting out of dialogue
;mode, and that gives COBDDT various ways of exiting.
ENTRY CBDDT. ;Initialization code - user prog does JSP 16,CBDDT.
;goes into dialogue mode.
ENTRY C.TRCE ;Tracing code - user prog does PUSHJ 17,C.TRCE
;If REEBRK switch is set, a simulated break is done
; and dialogue mode is entered.
;Issues trace message if tracing is on.
;Remembers procedure names for possible abort message.
;Returns with POPJ 17, if not in dialogue mode.
ENTRY BTRAC. ;Error abort code - entered from LIBOL by JRST BTRAC.
;prints last seen sect/par names.
;enters dialogue mode.
ENTRY TRPD. ;PERFORM push code - entered from prog by PUSHJ 17,TRPD.
;Remembers current sect/par names before executing PERFORM.
;returns with POPJ 17,
ENTRY TRPOP. ;PERFORM pop code - entered from prog by PUSHJ 17,TRPOP
;Restores saved sect/par names after return from PERFORM range.
;returns with POPJ 17,
;COBOL user code may not be resident either because it uses
;the COBOL program segmentation feature, or because it was linked
;into overlays. In either case, breakpoints cannot be set if the
;code is not in memory at the time that the breakpoint is requested.
;LINK overlay code requires various bookkeeping functions so that
;the histogram featue and the breakpoint features will work.
ENTRY SFOV. ;LINK overlay initialization - entered with PUSHJ 17,SFOV.
;Does the bookkeeping each time a new LINK overlay is loaded.
;If the user has turned on the OVERLAY break feature,
; dialogue mode is entered. Otherwise, returns with POPJ.
;Entered from the PUTF. routine in LIBOL, which is called
;from the inline code at every ENTRY in a module.
ENTRY SBPSG. ;Segmentation initialization - entered by PUSHJ 17,SBPSG.
;Does the bookkeeping for non-resident segments each time
; they are loaded.
;Returns with POPJ 17,
ENTRY CNTRC. ;CANCEL bookkeeping - entered by PUSHJ 17,CNTRC.
;When a module is CANCELled, all LINK overlays 'below it',
;as well as the LINK overlay containing it are 'forgotten'.
;This code does the necessary bookkeeping.
;returns with a POPJ 17,
ENTRY HSRPT. ;HISTORY report check - entered by PUSHJ 17,HSPRT.
;If a STOP RUN is entered before terminating a histogram,
;LIBOL guarantees the report is written by entering
;COBDDT here.
;returns by POPJ 17,
;The following are locations in COBDDT that are not defined as ENTRYs.
; CBREE. ;REENTER code - entered from monitor on REENTER command.
;(address is supplied to monitor by COBDDT's init code.)
;asks the user whether he wants to enter COBDDT, or just
;take a RERUN dump. If user indicates he wants to enter
;COBDDT a switch is set so that a simulated break will
;occur at the NEXT tracepoint.
;returns by JRST @.JBOPC or by taking rerun dump (LIBOL).
; BCOM ;break code - entered from user program by the sequence:
; JSR bptabl ;(in user's prog)
;bptabl:JSA TA,BCOM ;(in breakpoint table)
;Prints breakpoint information
;enters dialogue mode.
; DECOD ;dialogue code - entered by JRST DECOD from all over COBDDT.
;prompts for COBDDT command,
;reads and decodes the command, calls for command execution.
;Stays in a loop until an 'exiting command' is read.
;Exits by:
;STOP - goes to LIBOL's STOP RUN code.
;STEP or PROCEED - returns to the user program in various
; ways depending on how COBDDT got entered.
; IF entered at C.TRCE, or SFOV.,returns by POPJ.
; If entered at CBDDT., returns by JRST @PROGST.
; If entered at BCOM, returns by executing the
; user instruction at point of break,
; then a JRST.
;GO - JRST to the location named.
EXTERNAL .JBREL,.JBSA,.JBDDT ;[26]
;AC DEFINITIONS
SW=0 ;SWITCH REGISTER, RH IS CHARACTER POSITION
;DURING SCANNING OF COMMAND LINE.
LIT=1 ;STACK POINTER FOR LITERAL POOL
COD=2 ;STACK POINTER FOR CODE ROLL
DT=3 ;PNTR TO DATAB OR PROTAB
W1=6 ;HOLDS XWD IN CODE GENERATION
W2=7 ;EXTRA WORD FOR CODE GENERATORS
NM==10 ;NMTAB INDEX
CH==11 ;MOST RECENTLY RETRIEVED CHARACTER
;FROM THE COMMAND LINE.
;TE THRU TA ARE OFTEN USED TO HOLD UP TO A 30 CHAR
;COBOL NAME FROM THE COMMAND LINE (IN SIXBIT).
TE=12 ;TEMPORARIES
TD=13
TC=14
TB=15
TA=16
PP=17 ;PUSH-DOWN POINTER
TK==1
TJ==2
TI==3
TH==4
TG==5
TF==10
;OPERATORS
DIS==3 ;DISPLAY
ACC==1 ;ACCEPT
;SWITCH DEFINITIONS FOR 'SW'
FASIGN==1B18 ;"A" OPERAND IS SIGNED
FBSIGN==1B19 ;"B" OPERAND IS SIGNED
FANUM==1B20 ;"A" OPERAND IS NUMERIC
FBNUM==1B21 ;"B" OPERAND IS NUMERIC
PRNMFG==1B1 ;[26]PROCEDURE NAME EXPECTED IN COMMAND
BLNFLG==1B2 ;AT LEAST ONE BLANK!TAB SEEN IN SKPBLN
FQFLAG==1B3 ;CURRENT UPWARD SEARCH IS FULLY QUALIFIED (NO SKIPS YET)
NUQFLG==1B4 ;TWO NON-FULLY QUALIFIED MATCHES HAVE BEEN FOUND
CLRFLG==1B5 ;CLEAR COMMAND SEEN
NUIFLG==1B6 ;TWO PROPER INITIAL SEGMENTS OF SYMBOLS HAVE BEEN FOUND
ALTFLG==1B7 ;LINE TERMINATED W/ALTMODE
LOCFLG==1B8 ;LOCATE COMMAND SEEN
GOFLG==1B9 ;GO COMMAND SEEN
;FLAGS IN WORD RETURNED BY RPACS JSYS.
RDACC==1B2 ;[26]PAGE IS READ ACCESSIBLE
EXCACC==1B4 ;[26]PAGE IS EXECUTABLE
PGXSTS==1B5 ;[26]PAGE EXISTS
;USEFUL TABLES AND DEFINITIONS FOR CODE GENERATORS
CODE9==1 ;PICTURE CODE FOR "9"
CODEM==3 ;FOR FLOATING "-"
CODES==10 ;FOR INSERTED "-"
CODEP==11 ;FOR "."
; THESE CODES ARE BASED UPON USAGE CODE -1
; INDEX IS CHANGED TO COMP-1 AND ITS # IS USED BY EDITED
D6MODE==0 ;SIXBIT
D7MODE==1 ;ASCII
D9MODE==2 ;EBCDIC
DSMODE==2 ;HIGHEST DISPLAY MODE
D1MODE==3 ;1-WORD DECIMAL
D2MODE==4 ;2-WORD DECIMAL
FPMODE==5 ;FLOATING POINT
EDMODE==6 ;EDITED -USES INDEX SLOT
C3MODE==7 ;COMP-3
%US.IN==7 ;ACTUAL USAGE CODE FOR INDEX TYPE
CHAC: POINT 4,CH,12 ;AC-FIELD IN "CH"
BYTE.S: OCT 6 ;SIXBIT BYTE SIZE
OCT 7 ;ASCII BYTE SIZE
OCT 9 ;EBCDIC BYTE SIZE
BYTE.W: OCT 6 ;SIXBIT BYTES PER WORD
OCT 5 ;ASCII BYTES PER WORD
OCT 4 ;EBCDIC BYTES PER WORD
;BYTE POINTERS BASED UPON MODE
BYPTRS: POINT 6,0
POINT 7,0
POINT 9,0
POINT 6,0
POINT 6,0
POINT 6,0
0
POINT 9,0 ;COMP-3
;MULTIPLE-PRECISION ARITHMETIC OP-CODES
;OP CODES
DEFINE OPCODE (NAME,VAL,AC) <NAME==VAL'B26+AC'B30>
OPCODE (MOVE%,200,0)
OPCODE (MOVM%,214,0)
OPCODE (MOVEM%,202,0)
OPCODE (MOVMM%,216,0)
EXTERNAL EDIT.S,EDIT.U
;NOTE COBDDT WILL USE EDIT.S AND EDIT.U EVEN WHEN RUNNING ON A KL-10
EXTERNAL MAG.,DSPLY.,ACEPT.,MOVE.,C.D6D7,C.D6D9,C.D7D6,C.D7D9
EXTERNAL C.D9D6,C.D9D7,PD6.,PD7.,PD9.,PC3.,GD6.,GD7.,GD9.,GC3.
EXTERNAL FLOT.2,DSP.FP,GETNM.,PPOT4.,ISBPS.
;DATAB DEFINITIONS
DTLKP==1 ;WORD # OF LINKAGE PTR
DTLVL==3 ;WORD # OF WORD CONTAINING THE LEVEL NUMBER
DTFLAG==4 ;WORD # OF FLAGS
DTSON==2 ;WORD # OF FATHER/BROTHER/SON LINKS
DTBP==^D9 ;WORD # OF EDIT MASK
DTSUBW==6 ;WORD # OF SUBSCRIPT INFO
DTOCCL==000004 ;OCCURS AT THIS LEVEL
CL.NUM==2 ;CLASS NUMERIC
;BYTE POINTERS
DTCLAS: POINT 2,DTFLAG(DT),1 ;CLASS FIELD
DTDPL: POINT 6,DTFLAG(DT),35 ;DECIMAL PLACES FIELD
DTESIZ: POINT 18,5(DT),17 ;EXTERNAL SIZE
DTISIZ: POINT 18,5(DT),35 ;INTERNAL SIZE
DTNOCC: POINT 15,DTSUBW(DT),14 ;NUMBER OF OCCURANCES
DTRESD: POINT 6,3(DT),11 ;RESIDUE FIELD
DTUSAG: POINT 4,3(DT),17 ;USAGE FIELD
;BITS SET IN FIFTH WORD OF DATAB ENTRY
;LEFT HALF
DTNUM==400000 ;NUMERIC
DTSYNL==100000 ;SYNCHRONIZED LEFT
DTSYNR==040000 ;SYNCHRONIZED RIGHT
DTSIGN==020000 ;SIGNED
DTBWZ==010000 ;BLANK WHEN ZERO
DTSUBS==004000 ;MUST BE SUBSCRIPTED
DTEDIT==002000 ;EDITED
DTLINK==001000 ;FATHER (1) OR BROTHER (0) LINK
DTDEF==000400 ;DEFINED
;RIGHT HALF
DTLKS==000100 ;LINKAGE SECTION FLAG
DTPLOC==1B30 ;DECIMAL POINT IS TO RIGHT OF WORD
DTSYLL==1B25 ;SYNCS AT LOWER LEVELS
;CODE ROLL ALLOCATIONS
N.TMP==^D100 ;MAX TEMP STORAGE
N.COD==^D30 ;MAX CODE ROLL SIZE
N.LIT==^D30 ;MAX LIT POOL SIZE
;BITS SET IN THIRD WORD OF PRTAB ENTRY
;RIGHT HALF
PRLINK==1B25 ;PARAGRAPH-NAME (1) OR SECTION-NAME (0)
;BYTE POINTERS
NMLINK: POINT 15,(TD),17 ;LINK UP TO NAMTAB
SECNAM: POINT 15,1(TD),17 ;LINK UP TO SECTION-NAME
;PARAMETERS FOR PRTAB
PRFLGS==2 ;WORD # OF FLAGS
;TABLE TYPE PARAMETERS
DTTYPE==100000 ;DATAB TYPE
PRTYPE==400000 ;PRTAB TYPE
TYPMSK==700000 ;MASK FOR TYPE FIELD
;DEFINITION OF FIELDS IN COBDDT'S LINK-10 OVERLAY BLOCKS.
OVLTN==0 ;LINK TO NEXT.
OVNAM==1 ;SIXBIT MODULE NAME.
OVSMD==2 ;FIRST LOCATION IN MODULE (LH)
OVEPA==2 ;MAIN ENTRY POINT ADDRESS (RH)
OV%NM==3 ;%NM.
OV%DT==4 ;%DT.
OV%PR==5 ;%PR.
OVSLK==6 ;FIRST LOCATION IN THE LINK (LH).
OVLKN==6 ;LINK NUMBER (RH).
OVBKSZ==7 ;SIZE OF THE BLOCK.
;DEFINITIONS OF FIELDS AND FLAGS IN LINK'S TABLES.
F.LIC==(1B0) ;LINK IN CORE
F.MDL==(1B1) ;ROUTINE IN MULTIPLE LINKS.
F.RLC==(1B2) ;LINK IS RELOCATED.
CS.NUM==2 ;LINK NUMBER
CS.PTR==4 ;PREVIOUS CONTROL SECTION,,NEXT CONTROL SECTION.
CS.COR==7 ;LENGTH OF LINK,,FIRST LOC IN LINK.
CS.EXT==10 ;AOBJN PTR TO EXTERNAL TRANSFER TABLES.
CS.INT==11 ;AOBJN PTR TO INTERNAL TRANSFER TABLES.
JT.FLG==0 ;FLAGS (BITS 0-8)
JT.ADR==0 ;ADDRESS IF IN CORE (RH)
JT.CST==1 ;ADDRESS OF THIS CONTROL SECTION (RH)
JT.MDL==1 ;POINTER TO MULTIPLY DEFINED TABLE.
;GENERAL "SW" TESTER
DEFINE SWTEST (A,B) <
XLIST
IFLE A-777777,<TR'B SW,A>
IFG A-777777,<
IFN A&777777,<TD'B SW,[A]>
IFE A&777777,<TL'B SW,(A)>
>
LIST
>
DEFINE SWON (A) <SWTEST A,O> ;TURN ON FLAGS
DEFINE SWOFF (A) <SWTEST A,Z> ;TURN OFF FLAGS
DEFINE TSWC (A) <SWTEST A,C> ;COMPLEMENT FLAG
DEFINE TSWF (A) <SWTEST A,NE> ;TEST FLAG AND SKIP IF OFF
DEFINE TSWT (A) <SWTEST A,NN> ;TEST FLAG AND SKIP IF ON
DEFINE TSWFZ (A) <SWTEST A,ZE> ;CLEAR FLAG, SKIP IF IT WAS OFF
DEFINE TSWTZ (A) <SWTEST A,ZN> ;CLEAR FLAG, SKIP IF IT WAS ON
DEFINE TSWFS (A) <SWTEST A,OE> ;SET FLAG, SKIP IF IT WAS OFF
DEFINE TSWTS (A) <SWTEST A,ON> ;SET FLAG, SKIP IF IT WAS ON
DEFINE TSWFC (A) <SWTEST A,CE> ;COMP. FLAG, SKIP IF IT WAS OFF
DEFINE TSWTC (A) <SWTEST A,CN> ;COMP. FLAG, SKIP IF IT WAS ON
DEFINE SWONS (A) <SWTEST A,OA> ;SET FLAG AND ALWAYS SKIP
DEFINE SWOFFS (A) <SWTEST A,ZA> ;CLEAR FLAG AND ALWAYS SKIP
DEFINE ERR0(FOO) <[JSP TA,PUTERR
ASCIZ FOO]>
DEFINE ERR(FOO) <
JRST ERR0(FOO)
>
;COME HERE FOR "ACCEPT" COMMAND EXECUTION.
;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE LITERAL TYPED
;ON THE TERMINAL AND "B" IS THE IDENTIFIER TYPED IN ACCEPT COMMAND.
ACCGEN: MOVEI W1,BASEB ;SET UP 'B' OPERAND
PUSHJ PP,SETOPN
MOVE TE,[XWD BASEB,BASEA]
BLT TE,BASAX ;MAKE 'A' = 'B'
MOVE TE,DTFLAG(DT) ;GET FLAGS
MOVEI TD,EDMODE
TLNE TE,DTEDIT ;EDITED?
HRRM TD,MODEB ;YES: SET MODE
HRLZ W1,SIZEB ;SET UP SIZE IN PARAM
TLO W1,(<1B7>) ;SKIP TO CRLF
LDB TE,DTCLAS ;CHECK ON CLASS
CAIN TE,CL.NUM ;NUMERIC?
JRST ACEP15 ;YES:
;FIELD IS ALPHANUMERIC
HRRZ TE,MODEB
CAIN TE,D7MODE ;ASCII?
JRST ACEP20 ;OK TO USE DIRECTLY
;FIELD IS EITHER ASCII-EDITED OR NON-ASCII ALPHANUMERIC
; SO ACCEPT INTO ASCII TEMP AND MOVE AFTER
ACEP10: MOVE TE,SIZEA ;GET SIZE FOR TEMP CALC
ADDI TE,4
IDIVI TE,5 ;NUMBER OF WORDS
PUSHJ PP,GETEMP ;ALLOCATE AND RETURN ADDR
MOVEM TE,INCRA
MOVE TE,[XWD ^D36,TEMROL]
MOVEM TE,BASEA
MOVEI TE,D7MODE ;'A' IS ASCII
MOVEM TE,MODEA
PUSHJ PP,ACEP20
SWOFF FASIGN!FANUM
JRST MXX. ;STASH AWAY
;FIELD IS NUMERIC OR NUMERIC EDITED
; SO ACCEPT INTO AC 0,1 AND THEN MOVE TO DESTINATION
ACEP15: PUSHJ PP,ACEP25
SETZM EAC ;AC := 0
SWON FASIGN!FANUM
MOVEI TE,D2MODE ;USE 2-WORD COMP
MOVEM TE,MODEA
JRST MACX. ;STASH AWAY
;CREATE LITERAL AND CALL FOR ALPHANUMERIC
ACEP20: LSH W1,6
HLR W1,RESA ;BYTE RESIDUE
ROT W1,-6
HRR W1,BASEA ;ADDRESS
ADD W1,INCRA ;INCREMENT
ACEP21: PUSH LIT,W1 ;STORE LITERAL
MOVSI CH,(MOVEI 16,)
HRR CH,LIT ;LITERAL ADDR
PUSH COD,CH ;STASH CODE
PUSH COD,[PUSHJ PP,ACEPT.] ;CALL ACCEPT
POPJ PP,
;CREATE LITERAL AND CALL FOR NUMERIC
ACEP25: TLO W1,(<1B6>) ;NUMERIC
MOVE TA,DPLA
JUMPGE TA,ACEP26 ;OK IF POSITIVE
MOVNS TA
TRO TA,40 ;SET SIGN
ACEP26: HRR W1,TA ;DECIMAL PLACES
JRST ACEP21
;COME HERE FOR "DISPLAY" COMMAND EXECUTION.
;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE IDENTIFIER TYPED IN
;THE DISPLAY COMMAND AND "B" IS THE TERMINAL.
DISPGN: LDB TC,DTUSAG ;GET USAGE
JRST @DISPDO(TC)
;DISPLAY DISPATCH TABLE
DISPDO: EXP DISERR ;0 - NO SUCH
EXP DISPD6 ;[22] 1 - DISPLAY 6
EXP DISPD7 ;2 - DISPLAY 7
EXP STNDRD ;3 - DISPLAY 9
EXP STNDRD ;4 - 1 WORD COMP
EXP STNDRD ;5 - 2 WORD COMP
EXP DISPFP ;6 - COMP-1
EXP STNDRD ;7 - INDEX
EXP STNDRD ;10 - COMP-3
;CALL MOVE GENERATOR FOR A LITTLE HELP
; MOVE TO AN ASCII TEMP - POSSIBLY EDITED
STNDRD: PUSHJ PP,MXTMP.
STND2: TLZ W1,(<1B7>) ;CRLF AT END OF LINE
PUSH LIT,W1
MOVSI CH,(MOVEI 16,)
HRR CH,LIT
PUSH COD,CH
PUSH COD,[PUSHJ PP,DSPLY.] ;DISPLAY IT
POPJ PP,
;DISPLAY ASCII
DISPD7: MOVEI W1,BASEA ;SET UP 'A' OPERAND
PUSHJ PP,SETOPN
TSWF FANUM ;NUMERIC?
JRST STNDRD ;YES: USE STANDARD
MOVE TE,DTFLAG(DT)
HRRZ W1,SIZEA ;GET CORRECT SIZE
TLNE TE,DTEDIT ;IF EDITED
LDB W1,DTESIZ ;USE EXTERNAL SIZE
CAILE W1,1777 ;[22] WILL IT FIT IN ONE OPERATION?
JRST [SUBI W1,^D1020 ;[22] NO
PUSH PP,W1 ;[22] SAVE REMAINDER
MOVEI W1,^D1020 ;[22] SAVE THE FIRST PART
PUSHJ PP,.+1 ;[22] DO THE FIRST PART
MOVEI W1,^D1020/5 ;[22]
ADDM W1,INCRA ;[22] POINT TO SECOND PART
POP PP,W1 ;[22] GET BACK REMAINDER
JRST .+1] ;[22] CONTINUE
ROT W1,-^D12
HLR W1,RESA
ROT W1,-6
HRR W1,BASEA
ADD W1,INCRA
JRST STND2
;DISPLAY SIXBIT
DISPD6: MOVEI W1,BASEA ;[22] SET UP 'A' OPERAND
PUSHJ PP,SETOPN ;[22]
TSWF FANUM ;[22] NUMERIC?
JRST STNDRD ;[22] YES, USE STANDARD
MOVE TE,DTFLAG(DT) ;[22]
HRRZ W1,SIZEA ;[22] GET CORRECT SIZE
TLNE TE,DTEDIT ;[22] IF EDITED
LDB W1,DTESIZ ;[22] USE EXTERNAL SIZE
CAILE W1,1777 ;[22] WILL IT FIT IN ONE OPERATION?
JRST [SUBI W1,^D1020 ;[22] NO
PUSH PP,W1 ;[22] SAVE REMAINDER
MOVEI W1,^D1020 ;[22] SIZE OF FIRST PART
PUSHJ PP,.+1 ;[22] DO THE FIRST PART
MOVEI W1,^D1020/6 ;[22]
ADDM W1,INCRA ;[22] POINT TO SECOND PART
POP PP,W1 ;[22] GET BACK REMAINDER
JRST .+1] ;[22] CONTINUE
ROT W1,-^D12 ;[22]
HLR W1,RESA ;[22]
ROT W1,-6 ;[22]
HRR W1,BASEA ;[22]
ADD W1,INCRA ;[22]
TLZ W1,(<1B7>) ;[22] CRLF AT END OF LINE
PUSH LIT,W1 ;[22]
MOVSI CH,(MOVEI 16,) ;[22]
HRR CH,LIT ;[22]
PUSH COD,CH ;[22]
PUSH COD,[PUSHJ PP,DSPL.6##] ;[22] DISPLAY IT
POPJ PP, ;[22]
;DISPLAY A COMP-1 FIELD
DISPFP: MOVEI W1,BASEA ;SET UP 'A' OPERAND
PUSHJ PP,SETOPN
MOVEI TE,4
MOVEM TE,EAC ;USE AC(5)
MOVSI CH,MOVE%
TSWT FASIGN ;SIGNED?
MOVSI CH,MOVM% ;NO: USE MAGNITUDE ONLY
PUSHJ PP,GENOPA
PUSH COD,[PUSHJ PP,DSP.FP]
POPJ PP,
;SET UP OPERAND PARAMETERS
;ENTER WITH EITHER BASEA OR BASEB IN W1 & PNTR TO 'DATAB'
;ENTRY IN DT. SUBSCRIPTING IS DONE IF NECESSARY AND 'INCRX'
;AND 'RESX' ARE UPDATED.
SETOPN: HRRZ TA,1(DT) ;GET ADDR OF ELEMENT
HRRZM TA,BASEX(W1)
SETZM INCRX(W1) ;CLR INCREMENT
LDB TE,DTUSAG ;GET USAGE
SUBI TE,1
CAIN TE,%US.IN-1 ;INDEX
MOVEI TE,D1MODE ;YES: USE 1-WORD COMP
MOVEM TE,MODEX(W1)
LDB TE,DTRESD ;GET BYTE RESIDUE
HRLM TE,RESX(W1) ;AND STASH
LDB TE,DTDPL ;GET DECIMAL PLACES
TRZE TE,DTPLOC ;NEGATIVE?
MOVNS TE ;YES: NEGATE
MOVEM TE,DPLX(W1) ;ANS STASH IT
LDB TE,DTISIZ ;USE INTERNAL SIZE
MOVEM TE,SIZEX(W1)
MOVE TD,DTFLAG(DT) ;FLAGS
TLNN TD,DTDEF ;MAKE SURE DEFINED
JRST UNDEF
TRNE TD,DTLKS ;LINKAGE SECTION?
JRST SETOP1 ;YES
TLNN TD,DTSUBS ;NEED SUBSCRIPTS?
JRST [SKIPE NSUBS
JRST NOSUB
JRST .+2]
SETOP1: PUSHJ PP,SUBSCR ;YES: DO CHECK
MOVE TD,DTFLAG(DT) ;GET FLAGS BACK
CAIN W1,BASEA ;DOING 'A'?
JRST SETOP2 ;YES:
;'B' OPERAND
TLNE TD,DTSIGN ;SIGNED?
SWONS FBSIGN
SWOFF FBSIGN
TLNN TD,DTEDIT ;EDITED
TLNN TD,DTNUM ;NO: NUMERIC
SWOFFS FBNUM
SWON FBNUM
POPJ PP, ;RETURN
;'A' OPERAND
SETOP2: TLNE TD,DTSIGN ;SIGNED?
SWONS FASIGN
SWOFF FASIGN
TLNN TD,DTEDIT ;EDITED
TLNN TD,DTNUM ;NO: NUMERIC
SWOFFS FANUM
SWON FANUM
POPJ PP, ;RETURN
;DO SUBSCRIPTING
SUBSCR: SKIPE NSUBS ;DO WE HAVE ANY?
JRST SUBSC0 ;YES
TRNN TD,DTLKS ;IN LINKAGE SECTION?
JRST NEDSUB ;NO: TOUGH
SUBSC0: MOVEM DT,SAVDT ;SAVE DATAB PNTR
SETZB CH,REMAN
HLRZ W2,RESX(W1) ;CALC B.P. TO 1ST ELEMENT
ROT W2,-6 ;SET UP RESIDUE
HRR W2,INCRX(W1)
MOVE TD,DTFLAG(DT) ;LINKAGE SECTION?
TRNN TD,DTLKS
JRST SUBSC2 ;NO
HLRZ TD,DTLKP(DT) ;YES, GET LINKAGE PTR
ADD W2,(TD)
SKIPE NSUBS ;0 SUBSCRIPTS?
JRST SUBSC2 ;NO
MOVE TE,W2 ;YES, GET TO THE END
JRST SUBSC8
SUBSC2: MOVE TE,DTSUBW(DT) ;OCCURS AT THIS LEVEL?
TLNE TE,DTOCCL
JRST SUBSCA
LDB DT,[POINT 15,DTSUBW+1(DT),17]
ADD DT,@%DT
SUBSCA: ;GET PROPER BYTE SIZE FOR RECORD
LDB TC,DTUSAG ;GET USAGE
CAIN TC,%US.IN ;INDEX?
MOVEI TC,D1MODE+1 ;USE COMP
HLRZ TA,BYPTRS-1(TC) ;SKELETON BYTE POINTER
TRZ TA,770077 ;JUST LEAVE BYTE SIZE
TLO W2,(TA) ;PUT BYTE SIZE IN
SUBSC1: LDB TA,DTNOCC ;NUMBER OF OCCURRANCES
SKIPG TC,SUB0.(CH) ;[24]SUBSCRIPT POSITIVE?
JRST SMLSUB ;[24]NO, ERROR
CAMLE TC,TA ;IN BOUNDS?
JRST LRGSUB
SOS TC ;OK, DECR
LDB TE,DTUSAG ;GET USAGE
XCT SUBSIZ(TE) ;GET # OF BYTES
IMUL TA,TC
ADDM TA,REMAN ;ACCUMULATE SUM
SUBSC3: AOS TE,CH ;NEXT SUBSCRIPT
LDB TA,[POINT 15,DTSUBW+1(DT),17]
CAML TE,NSUBS
JRST SUBSC4 ;NO MORE TYPED
JUMPE TA,TOOFEW ;TOO MANY
HRRZ DT,TA ;PNTR TO NEXT LEVEL
ADD DT,@%DT
JRST SUBSC1 ;LOOP
SUBSC4: JUMPE TA,SUBSC6 ;ALL EVEN?
JRST NOTNUF ;NOT ENUF
SUBSC6: MOVE TD,REMAN ;GET COMPUTED OFFSET
LDB TE,[POINT 6,W2,11]
MOVEI TB,^D36
IDIV TB,TE ;BYTES/WORD
IDIV TD,TB ;NUMBER OF WORDS
MOVE TE,W2
ADD TE,TD ;CALC NEW OFS
SUBSC7: SOJL TC,SUBSC8 ;ANY BYTES LEFT OVER?
IBP TE ;YES: BUMP BYTE PNTR
JRST SUBSC7 ;LOOP
SUBSC8: HRRZM TE,INCRX(W1) ;STORE OFFSET
LDB TE,[POINT 6,TE,5]
HRLM TE,RESX(W1) ;AND RESIDUE
MOVE DT,SAVDT ;GET BACK DT PTR
POPJ PP, ;RETURN
;A TABLE WHICH DETERMINES SIZE OF ITEM (ALWAYS IN BYTES)
SUBSIZ: JRST BADBAD ;0
PUSHJ PP,SUBSZX ;1 SIXBIT
PUSHJ PP,SUBSZX ;2 ASCII
PUSHJ PP,SUBSZX ;3 EBCDIC
MOVEI TA,6 ;4 1-WORD COMP
MOVEI TA,^D12 ;5 2-WORD COMP
MOVEI TA,6 ;6 COMP-1
MOVEI TA,6 ;7 INDEX
PUSHJ PP,SUBSZC ;10 COMP-3
SUBSZX: LDB TA,DTESIZ ;EXTERNAL SIZE
SUBSZ1: MOVE TD,DTFLAG(DT)
TDNN TD,[XWD DTSYNL!DTSYNR,DTSYLL]
POPJ PP, ;NO SYNCS - OK
EXCH TE,TA
IDIV TE,BYTE.W-1(TA)
SKIPE TD
ADDI TE,1
IMUL TE,BYTE.W-1(TA)
EXCH TE,TA
POPJ PP,
SUBSZC: ;COMP - 3
LDB TA,DTESIZ ;EXTERNAL SIZE
ADDI TA,2 ;FOR SIGN AND ROUND OUT BYTE
LSH TA,-1 ;DIVIDE BY 2
JRST SUBSZ1
;MOVE AN ITEM TO TEMPORARY FOR USE BY "DISPLAY"
;ENTER WITH 'DT' POINTING TO AN OPERAND.
;EXIT WITH DISPLAY LITERAL IN 'W1'
MXTMP.: SETZM EAC ;START AN AC(0)
MOVEI W1,BASEA ;SET UP 'A' OPERAND
PUSHJ PP,SETOPN
MOVE TE,[XWD BASEA,BASEB]
BLT TE,BASBX ;MAKE 'B' = 'A'
MOVEI TE,D7MODE
MOVEM TE,MODEB ;ASCII
TSWF FANUM ;IS 'A' NUMERIC
JRST MXTMP4 ;YES: TREAT SPECIAL
MOVE TE,DTFLAG(DT)
TLNN TE,DTEDIT ;EDITED FIELD?
JRST MXTMP1 ;NO:
LDB TE,DTESIZ ;YES: USE EXTERNAL SIZE
MOVEM TE,SIZEA
MOVEM TE,SIZEB
;INPUT FIELD IS NON-ASCII, NON-NUMERIC
MXTMP1: HRLZ W2,SIZEA ;CONSTRUCT LIT IN W2
MOVE TE,SIZEB
ADDI TE,4 ;GET SIZE OF 'B' IN WORDS
IDIVI TE,5
PUSHJ PP,GETEMP ;GET SOME TEMP LOCS
MOVEM TE,INCRB
MOVE TE,[XWD ^D36,TEMROL]
MOVEM TE,BASEB
HRR W2,BASEB
ADD W2,INCRB
PUSHJ PP,MXX. ;GENERATE MOVE
TLO W2,(<^D36B5>) ;BYTE RESIDUE
MOVE W1,W2 ;RETURN LITERAL
POPJ PP,
;ITEM IS NUMERIC, AND THEREFORE MUST BE EDITED.
MXTMP4: SWON FBSIGN!FBNUM ;'B' IS ALWAYS SIGNED ETC.
SKIPL DPLA ;NEGATIVE DECIMAL PLACES?
JRST MXTMP5 ;NO:
MOVM TE,DPLA ;YES: 'B' IS SIZE - DEC. PL.
ADD TE,SIZEA
MOVEM TE,SIZEB
SETZM DPLB
JRST MXTMP9
MXTMP5: MOVE TE,SIZEA ;NEGATIVE INTEGRAL PLACES?
SUB TE,DPLA
JUMPGE TE,MXTMP6 ;NO: OK
MOVE TE,DPLA ;YES: SIZE IS # DECIMAL PLACES
MOVEM TE,SIZEB
JRST MXTMP9
MXTMP6: ;MOVE EVERYTHING TO A TEMP TO BE SURE NUMBER IS IN CORRECT FORM
; HRRZ TE,MODEA ;IS ITEM DISPLAY USAGE?
; CAIG TE,DSMODE
; JRST MXTM10 ;YES: DON'T MOVE TO TEMP
MXTMP9: MOVEI TE,D6MODE ;NO: MOVE TO TEMP
MOVEM TE,MODEB
MOVE TE,SIZEB ;CALC # OF WORDS
ADDI TE,5
IDIVI TE,6
PUSHJ PP,GETEMP ;GET SOME SPACE
MOVEM TE,INCRB
MOVE TE,[XWD ^D36,TEMROL]
MOVEM TE,BASEB
MOVE TE,[XWD BASEB,SAVEA]
BLT TE,SAVAX ;SAVE 'B' PARAMETERS
PUSHJ PP,MXX. ;MOVE TO TEMP
MOVE TE,[XWD SAVEA,BASEA]
BLT TE,BASAX
MOVE TE,[XWD SAVEA,BASEB]
BLT TE,BASBX
;IT IS (OR HAS BEEN CONVERTED TO) DISPLAY USAGE.
HRRZI W1,1(LIT) ;ADDR OF LITERAL
HRLI W1,(<^D36B5>)
SETZM BASEB ;BYTE COUNTER
MOVEI TA,0
MOVE TB,[POINT 4,TA] ;INITIALIZE
MOVE TC,SIZEB
SUB TC,DPLB
JUMPE TC,MXT11B ;ALL TO RIGHT IF DECIMAL
MOVEI CH,CODES ;PRETEND THERE IS ONE INTEGER
CAIE TC,1 ;IS THAT TRUE?
AOSA BASEB ;NO: LEAVE ROOM FOR SIGN
PUSHJ PP,MXTM20 ;YES: JAM INSERT SIGN
MOVEI CH,CODEM ;SET UP FOR "FLOAT SIGN"
MXTM11: SOJLE TC,MXT11A ;ONLY ONE LEFT?
PUSHJ PP,MXTM20 ;NO:
JRST MXTM11
MXT11A: MOVEI CH,CODE9 ;USE "9" FOR LAST INTEGRAL PLACE.
PUSHJ PP,MXTM20
JRST MXTM12
MXT11B: MOVEI CH,CODES ;USE INSERT SIGN
PUSHJ PP,MXTM20
MXTM12: SKIPN TC,DPLB
JRST MXTM13
MOVEI CH,CODEP ;INSERT POINT
PUSHJ PP,MXTM20
MOVEI CH,CODE9 ;FINISH OFF WITH "9"'S
PUSHJ PP,MXTM20
SOJG TC,.-1
;MASK HAS BEEN CREATED FOR NUMERIC ITEM--FINISH UP.
MXTM13: MOVEI CH,17
IDPB CH,TB
PUSH LIT,TA
HRLZ W2,BASEB ;FIELD SIZE TO LITERAL
TLO W2,(<^D36B5+1B6>)
MOVE TE,BASEB
ADDI TE,4
IDIVI TE,5 ;SIZE IN WORDS
PUSHJ PP,GETEMP ;GET SOME PLACE TO PUT IT
MOVEM TE,INCRB
MOVE TE,[XWD ^D36,TEMROL]
MOVEM TE,BASEB
HRR W2,TE ;ADDR TO LIT ALSO
ADD W2,INCRB
MOVEI TE,D7MODE ;ASCII
MOVEM TE,MODEB
MOVEI TE,MDES. ;ASSUME SIGNED
TSWT FASIGN ;IS IT?
MOVEI TE,MDEU. ;NO: USE UNSIGNED ROUTINE
PUSHJ PP,(TE)
MOVE W1,W2 ;RETURN LIT
POPJ PP,
;ROUTINE TO PUT NEXT EDIT CHAR IN WORD AND STASH LIT IF
;NECESSARY. CLEAR 'TA' AND PUT B.P. IN 'TB'.
MXTM20: IDPB CH,TB ;STORE AWAY
AOS BASEB ;KEEP COUNT
TLNE TB,770000 ;FULL WORD?
POPJ PP, ;NO: JUST EXIT
PUSH LIT,TA ;YES: STASH LIT
MOVEI TA,0
MOVE TB,[POINT 4,TA]
POPJ PP, ;RE-INIT AND EXIT
;DISPATCH ROUTINES FOR MOVE GENERATORS
;MOVE THE AC'S TO SOMETHING
MACX.: HRRZ TE,MODEA ;CHECK MODES
CAIE TE,D2MODE ;ONLY LEGAL
JRST BADCOD
HRRZ TE,MODEB
JRST @MACX.T(TE) ;DO ROUTINE
MACX.T: EXP MACD. ; SIXBIT
EXP MACD. ; ASCII
EXP MACD. ; EBCDIC
EXP MAC1C. ; 1-WORD COMP
EXP MAC2C. ; 2-WORD COMP
EXP MACFP. ; COMP-1
EXP MACE. ; EDITED
EXP MACD.1 ;COMP-3
;MOVE SOMETHING TO SOMETHING
MXX.: HRRZ TA,MODEA
HRRZ TB,MODEB ;CHECK LEGAL MODES
CAILE TB,EDMODE
JRST BADCOD
CAILE TA,D2MODE
JRST [ CAIN TA,C3MODE
JRST MDD.1 ;COMP-3
JRST BADCOD ]
LSH TA,2 ;MOVT.(4*MODEA+MOBEB/2)
ROT TB,-1
ADDI TA,(TB)
TLNE TB,1B18 ;LEFT HALT DISPATCH
SKIPA TC,MOVT.(TA) ;NO:
MOVS TC,MOVT.(TA) ;YES:
JRST (TC) ;GO DO ROUTINE
;TABLE OF ENTRANCE POINTS TO "MOVE" ROUTINES.
MOVT.: XWD MDD.,MDD. ;S-S,S-A
XWD MDD.,BADCOD ;S-E,S-1C
XWD BADCOD,BADCOD ;S-2C,S-F
XWD MDED.,BADCOD ;S-EDIT
XWD MDD.,MDD. ;A-S,A-A
XWD MDD.,BADCOD ;A-E,A-1C
XWD BADCOD,BADCOD ;A-2C,A-F
XWD MDED.,BADCOD ;A-EDIT
XWD MDD.,MDD. ;E-S,E-A
XWD MDD.,BADCOD ;E-E,
XWD BADCOD,BADCOD
XWD MDED.,BADCOD ;E-EDIT
XWD M1CD.,M1CD. ;1C-S,1C-A
XWD M1CD.,BADCOD ;1C-E,1C-1C
XWD BADCOD,BADCOD ;1C-2C,1C-FP
XWD BADCOD,BADCOD ;-,1C-EDIT
XWD M2CD.,M2CD. ;2C-S,2C-A
XWD M2CD.,BADCOD ;2C-E,2C-1C
XWD BADCOD,BADCOD ;2C-2C,2C-FP
XWD BADCOD,BADCOD ;-,2C-EDIT
BADCOD: TTCALL 3,[ASCIZ "? ILLEGAL MOVE ARGS"]
JRST XECUTX
;GENERATE CODE TO MOVE FROM DISPLAY TO DISPLAY
;FOR UNEDITED FIELDS OF SAME SIZE
; NUMERIC DISPLAYS ALWAYS GO TO SIXBIT - TEMP FOR EDIT
MDD.: MOVE TE,SIZEB ;CHECK ARGS
CAMN TE,SIZEA ;FOR SAME SIZE AND
TSWF FBNUM ;NON-NUMERIC RECIEVER
JRST MDD.E
PUSHJ PP,BYTE.A ;GET 'A' PARAMETER
PUSH LIT,TA
PUSH COD,LIT ;ADDR OF LITERALS
PUSHJ PP,BYTE.C ;GET 'B' PARAMETER
PUSH LIT,TA
MOVEI CH,(MOVEI 16,)
HRLM CH,0(COD) ;MOVEI 16,PARAMS
HRRZ TC,MODEA ;GET CORRECT ROUTINE
HRRZ TE,MODEB
PUSH COD,@GMOVET(TC) ;GET ROUTINE
POPJ PP,
GMOVET: GM6(TE) ;C.D6XX
GM7(TE) ;C.D7XX
GM9(TE) ;C.D9XX
GM6: PUSHJ PP,MOVE. ;SIXBIT TO SIXBIT
PUSHJ PP,C.D6D7
PUSHJ PP,C.D6D9
GM7: PUSHJ PP,C.D7D6
PUSHJ PP,MOVE.
PUSHJ PP,C.D7D9
GM9: PUSHJ PP,C.D9D6
PUSHJ PP,C.D9D7
PUSHJ PP,MOVE.
MDD.E: ;MOVING SAME TO SAME NOW
; CAME TE, SIZEA ; SAME SIZE NUMERIC FIELDS?
; JRST MDD.1 ; NO - ITEM MUST BE SCALED
; TTCALL 3,[ASCIZ "? ERROR AT MDD."]
; JRST XECUTX
MDD.1: PUSHJ PP, BYTE.A ; SAME SEQUENCE AS MDD.
PUSH LIT, TA
PUSH COD, LIT
PUSHJ PP, BYTE.C
PUSH LIT, TA
MOVSI CH, (MOVEI 16,) ; GET PARAMETER POINTER
HLLM CH, (COD)
HRRZ TE, (COD) ; SAVE POS IN LIT POOL
HRRZ TD,MODEA ;SOURCE MODE
XCT GDXTB(TD) ;GET PROPER ROUTINE
HRLI CH,(PUSHJ PP,)
PUSH COD,CH ;STORE CODE
SKIPL TD, DPLA ; NUMBER SCALED ON LEFT OF DECIMAL POINT?
JRST MDD.2
PUSH PP, TE ;YES, SAVE POINTER TO LITERAL POOL.
SETZI TE, ;THE NUMBER IS IN AC 0.
PUSHJ PP, SCLE ;GO MULTIPLY THE NUMBER BY SOMETHING.
POP PP, TE ;RESTORE LITERAL POOL POSITION
; OF GD?. PARAMETERS.
MDD.2: MOVSI CH, (MOVEI 16,) ; NOW PUT CALL TO PD6.
HRRI CH, (TE) ; POINT TO ARG
AOJ CH,
PUSH COD, CH ; ADD THAT
PUSH COD,[PUSHJ PP,PD6.] ;ALWAYS TO 6 BIT
MOVE CH, SIZEA
TSWF FASIGN
TRO CH,(1B6)
DPB CH, [POINT 12, (TE), 17] ; FIX ARG IN LITROL
MOVE CH, SIZEB
TRO CH, 4000 ; FORCE LEAD BIT
DPB CH, [POINT 12, 1(TE), 17] ; FIX SECOND ARG
POPJ PP,
GDXTB: ;ROUTINE TO GET DISPLAY OR COMP-3
MOVEI CH,GD6.
MOVEI CH,GD7.
MOVEI CH,GD9.
OUTSTR [ASCIZ "?CBDINT GDXTB ERROR
"]
XCT .-1
XCT .-2
XCT .-3
MOVEI CH,GC3.
;MOVE A 1-WORD COMP TO A DISPLAY FIELD.
M1CD.: MOVSI CH,MOVE% ;MOVE TO AN AC
TSWT FASIGN!FBSIGN ;SIGNED?
MOVSI CH,MOVM% ;NOPE!
PUSHJ PP,GENOPA
SKIPL TD, DPLA
JRST MACD. ;CONVERT AND RETURN
MOVE TE, EAC ;FIND OUT WHERE THE NUMBER IS.
ADDI TE, 1
MOVE CH, SIZEB ;GET THE SIZE OF THE RESULT.
CAIG CH, ^D10 ;IF IT'S ONE WORD, ALL IS
JRST M2CD.3 ; WELL, GO SCALE THE NUMBER.
SOS CH, TE ;ALL IS NOT WELL, THE NUMBER
DPB CH, CHAC ; IS IN THE WRONG AC, MOVE
ADD CH, [MOVE 1] ; IT UP ONE AC.
PUSH COD, CH
JRST M2CD.3
;MOVE A 2-WORD COMP TO A DISPLAY FILED.
M2CD.: TSWT FASIGN!FBSIGN ;SIGNED?
JRST M2CD.1 ;NO: USE SPECIAL ROUTINE
MOVSI CH,MOVE% ;MOVE TO AC'S
PUSHJ PP,GENOPB
AOS INCRA
MOVSI CH,MOVE%
PUSHJ PP,GENOPA
JRST M2CD.2 ;GO SEE IF THE NUMBER IS SCALED.
M2CD.1: MOVE CH,[PUSHJ PP,MAG.] ;DOUBLE-PRECISION MOVE
PUSHJ PP,GENPUB ;OF MAGNITUDE
M2CD.2: SKIPL TD, DPLA ;IS THE NUMBER SCALED?
JRST MACD. ;NO, GO CONVERT IT.
MOVE TE, EAC ;FIND OUT WHERE IT WILL BE.
M2CD.3: PUSHJ PP, SCLE ;GO GENERATE CODE TO SCALE IT.
JRST MACD. ;GO CONVERT IT.
;GENERATE CODE TO SCALE THE NUMBER IN THE AC WHOSE NUMBER IS IN TE BY
; THE POWER OF 10 WHOSE NEGATIVE IS IN TD.
SCLE: MOVMS TD ;MAKE THE POWER POSITIVE.
CAILE TD, ^D10 ;IF IT'S TWO WORDS,
JRST SCLEH ; GO ON.
MOVEI CH, STENS(TD) ;SELECT THE APPROPRIATE NUMBER.
DPB TE, CHAC ;SET UP THE AC FIELD.
MOVE TE, SIZEA ;SEE WHAT THE SIZE OF THE NUMBER
; BEFORE THE MULTIPLICATION IS.
CAILE TE, ^D10 ;IF IT'S TWO WORDS,
JRST SCLED ; GO ON.
MOVE TE, SIZEB ;SEE WHAT THE SIZE OF THE NUMBER
; WILL BE AFTER THE MULTIPLICATION.
CAILE TE, ^D10 ;IF IT'S GOING TO BE TWO WORDS
TLOA CH, (MUL) ; USE MUL, OTHERWISE USE IMUL SO
TLO CH, (IMUL) ; THAT WE KEEP THE RESULT IN THE
; SAME AC.
PUSH COD, CH ;STASH THE INSTRUCTION.
POPJ PP, ;AND RETURN.
;THE NUMBER IS DOUBLE PRECISION.
SCLED: PUSHJ PP, SCLEL ;GO SAVE THE PARAMETER.
PUSH COD, [PUSHJ 17, MUL.21##]
POPJ PP,
;THE POWER IS DOUBLE PRECISION.
SCLEH: MOVEI CH, -^D11(TD) ;CONSTRUCT THE PARAMETER.
LSH CH, 1
MOVEI CH, DTENS(CH)
DPB TE, CHAC
PUSHJ PP, SCLEL ;GOSAVE IT.
PUSH COD, [PUSHJ PP, MUL.12##]
POPJ PP,
SCLEL: PUSH LIT, CH
HRRI CH, (LIT)
HRLI CH, (<MOVE 16,0>)
PUSH COD, CH
POPJ PP,
STENS: DEC 1
DEC 10
DEC 100
DEC 1000
DEC 10000
DEC 100000
DEC 1000000
DEC 10000000
DEC 100000000
DEC 1000000000
DEC 10000000000
DTENS: OCT 2 ;11
OCT 351035564000
OCT 35 ;12
OCT 032451210000
OCT 443 ;13
OCT 011634520000
OCT 5536 ;14
OCT 142036440000
OCT 70657 ;15
OCT 324461500000
OCT 1070336 ;16
OCT 115760200000
OCT 13064257 ;17
OCT 013542400000
OCT 157013326 ;18
OCT 164731000000
;GENERATE CODE TO MOVE ACCUMULATORS TO A DISPLAY FIELD.
MACD.: MOVE TE,DTFLAG(DT) ;FLAGS
TLNE TE,DTBWZ ;BLANK WHEN ZERO?
JRST MACE. ;YES: USE EDIT
MACD.1: HLRZ TA,RESB ;GENERATE 'B' PARAMETER
LSH TA,^D12
ADD TA,SIZEB
TSWF FBSIGN ;SIGNED
TRO TA,(<1B6>) ;YES:
HRLZS TA
HRR TA,BASEB ;EFFECTIVE ADDR
ADD TA,INCRB
PUSH LIT,TA
MOVEI CH,(LIT) ;ADDR OF LIT
MOVE TE,SIZEB ;1 OR 2 WORD COMP
MOVE TD,EAC
CAIG TE,^D10 ;?
ADDI TD,1
DPB TD,CHAC ;PLAC AC FIELD
PUSH LIT,CH ;SAVE PARAMETER WORD
MOVEI CH,(LIT) ;GET ITS ADDRESS
HRLI CH,(MOVE 16,) ;ADD IN MOVE 16,
PUSH COD,CH ;SAVE CODE
HRRZ TE,MODEB ;GET OUTPUT MODE
XCT MACDRU(TE) ;GET PROPER ROUTINE
HRLI CH,(PUSHJ PP,) ;CHANGE TO PUSHJ
PUSH COD,CH ;STASH CODE
POPJ PP,
MACDRU: ;AC'S TO DISPLAY OR COMP-3 ROUTINES
MOVEI CH,PD6.
MOVEI CH,PD7.
MOVEI CH,PD9.
OUTSTR [ASCIZ "?CDTINT MACD.1 ERROR
"]
XCT .-1
XCT .-2
XCT .-3
MOVEI CH,PC3. ;COMP-3
;GENERATE CODE TO MOVE AC'S TO A 1-WORD COMP OR INDEX.
MAC1C.: MOVSI CH,MOVEM%
TSWT FBSIGN ;SIGNED?
MOVSI CH,MOVMM% ;NO:
JRST GENOPD
;GENERATE CODE TO MOVE AC'S TO A 2-WORD COMP.
MAC2C.: TSWT FBSIGN ;SIGNED?
JRST MAC2C3 ;NO: USE MAGNITUDE
MAC2C2: MOVSI CH,MOVEM%
PUSHJ PP,GENOPE
MOVSI CH,MOVEM%
AOS INCRB
JRST GENOPD
;HERE FOR POSSIBLE UNSIGNED MOVE
MAC2C3: TSWT FASIGN ;'A' SIGNED?
JRST MAC2C2 ;NO - OK TO USE MOVE(S)
HRRZ CH,EAC
MOVE TE,EAC
DPB TE,CHAC
PUSH LIT,CH
MOVEI CH,(LIT)
HRLI CH,(MOVE 16,)
PUSH COD,CH
PUSH COD,[PUSHJ PP,MAG.]
SETZM EAC
JRST MAC2C2
;GENERATE CODE TO MOVE AC'S TO COMP-1
MACFP.: ;CONVERT TO COMP-1
HRRZ CH,EAC
MOVE TE,EAC
DPB TE,CHAC
PUSH LIT,CH
MOVEI CH,(LIT) ;GET ADDRESS
HRLI CH,(MOVE 16,)
PUSH COD,CH
PUSH COD,[PUSHJ PP,FLOT.2]
SOS TE ;RESULT IN C(EAC)
MOVEM TE,EAC
MOVEI TE,FPMODE
MOVEM TE,MODEA
JRST MAC1C.
;GENERATE CODE TO MOVE AC'S TO EDITED FIELD.
MACE.: MOVE TE,[XWD BASEB,SAVMB]
BLT TE,SVMBX ;SAVE 'B' PARAMETERS
MOVEI TE,D6MODE ;SET MODE TO SIXBIT
MOVEM TE,MODEB
MOVE TE,SIZEB ;GET A TEMP LOC
ADDI TE,5
IDIVI TE,6
PUSHJ PP,GETEMP
MOVEM TE,INCRB
MOVE TE,[XWD ^D36,TEMROL]
MOVEM TE,BASEB
MOVE TE,[XWD BASEB,SAVMA]
BLT TE,SVMAX ;SAVE AS 'A' PARAMETER
PUSHJ PP,MACD.1 ;MOVE TO DISPLAY FIELD
MOVE TE,[XWD SAVMA,BASEA]
BLT TE,BASBX ;GET BACK 'A' AND 'B'
JRST MDED. ;DO EDIT AND RETURN
;GENERATE CODE TO MOVE A DISPLAY FIELD TO AN EDITED FIELD.
MDED.: ;FIX UP MODEB IF NECESSARY
MOVE TE,MODEB
CAIE TE,EDMODE
JRST MDED.0 ;OK
LDB TE,DTUSAG ;GET REAL USAGE
SUBI TE,1 ;NORMALIZE
CAIN TE,%US.IN-1 ;INDEX??
MOVEI TE,D1MODE ;USE COMP
MOVEM TE,MODEB ;AND STORE IT
MDED.0: PUSHJ PP,BMASK ;GET EDIT MASK
TSWF FASIGN ;ANY SIGNS
TSWT FBSIGN
JRST MDEU. ;NO: USE UNSIGNED ROUTINE
;BOTH FILEDS ARE SIGNED
MDES.: MOVE TE,[XWD BASEA,SAVMA]
BLT TE,SVMAX ;SAVE 'A'
MOVE TE,SIZEA
SUBI TE,1
PUSHJ PP,M.IA ;FIND SIGN
HRRZ TE,MODEA
HRLZ TE,BYTE.S(TE)
MOVNS TE
ADDM TE,RESA ;MESS PARAM
PUSHJ PP,MBYTEA ;GET FIRST LITERAL
PUSH COD,LIT
MOVE TE,[XWD SAVMA,BASEA]
BLT TE,BASAX ;GET 'A' BACK
MOVE CH,[PUSHJ PP,EDIT.S##]
JRST MDEU.2 ;STASH CODE AND EXIT
;GENERATE CODE FOR AN UNSIGNED EDITED FIELD.
MDEU.: MOVE CH,[PUSHJ PP,EDIT.U##]
MOVEI TE,1(LIT) ;ADDR OF LIT
PUSH COD,TE
MDEU.2: MOVEI TE,(MOVEI 16,)
HRLM TE,0(COD)
PUSH COD,CH ;AND PUSHJ
PUSHJ PP,MBYTEA ;GET A BYTE POINTER
HRRZ TE,MODEB
MOVE TA,BYTE.S(TE)
LSH TA,6
MOVE TE,DTFLAG(DT) ;GET FLAGS
TLNE TE,DTBWZ ;BLANK WHEN ZERO?
IORI TA,40 ;YES: SET BIT 12
ROT TA,-^D12
HLR TA,RESB
ROT TA,-6 ;FORM B.P.
HRR TA,BASEB
ADD TA,INCRB
PUSH LIT,TA ;SASH AWAY
PUSH COD,W1 ;ALSO XWD LITERAL
POPJ PP, ;AND EXIT
;CREATE THE MASK FOR THE "B" FIELD.
BMASK: HRRZI W1,1(LIT) ;LOC OF LITERAL
HRLI W1,(<^D36B5>)
MOVE TC,DTFLAG(DT) ;GET FLAGS
TLNN TC,DTEDIT ;EDITED
JRST BMASK4 ;NO: BWZ THEN
HRRZ TC,DT ;FORM BYTEPNTRS
ADD TC,[POINT 4,DTBP,11]
LDB TD,[POINT 12,DTBP(DT),11]
DPB TD,[POINT 12,W1,17] ;SIGN CHARS
MOVEI TD,0 ;INIT REPEAT COUNT
BMASK1: MOVEI TA,0
MOVE TB,[POINT 4,TA]
BMASK2: ILDB TE,TC
CAIN TE,16 ;REPEAT??
JRST BMSK2B ;YES
BMSK2A: IDPB TE,TB ;STORE BYTE
CAIN TE,17 ;END?
JRST BMASK3 ;YES:
TLNN TB,770000 ;WORD FULL?
JRST BMSK2C ;YES - SAVE LITERAL
BMSK2D: SOJLE TD,BMASK2 ;GO TO TOP IF NOTHING TO REPEAT
JRST BMSK2A ;USE BYTE AGAIN
BMSK2C: PUSH LIT,TA ;YES: STASH
MOVEI TA,0 ;INIT LITERAL BUFFER
MOVE TB,[POINT 4,TA] ;AND POINTER
JRST BMSK2D ;AND CONTINUE
; REPEAT
; THE CODE IS FOLLOWED BY A COUNT OF THE NUMBER
; OF 4 BIT BYTES WHICH FOLLOW THE COUNT AND CONTAIN THE
; NUMBER OF REPEATS IN BINARY. THE BYTE FOLLOWING THE
; NUMBER OF REPEATS IS THE CHARACTER TO BE REPEATED.
BMSK2B:
PUSH PP,TA ;SAVE A FEW REGS
PUSH PP,TB
ILDB TD,TC ;GET NUMBER OF BYTES HOLDING FACTOR
LSH TD,2 ;COMPUTE BITS RIGHT
MOVE TE,[POINT 4,TD] ;RESULT POINTER
DPB TD,[POINT 6,TE,5] ;STORE BITS RIGHT
MOVEI TD,0 ;INITIALIZE REPEAT COUNT
LDB TA,TC ;GET BYTE COUNT BACK
BMSK2F: ILDB TB,TC ;GET BYTE OF COUNT
IDPB TB,TE ;SAVE IN REPEAT REGISTER
SOJG TA,BMSK2F ;MOVE??
POP PP,TB ;NO - DONE
POP PP,TA
JRST BMASK2 ;GO BACK TO TOP
BMASK3: PUSH LIT,TA ;STASH LAST OP
POPJ PP, ;AND EXIT
;ITEM IS NOT EDITED SO IT MUST BE "BLANK WHEN ZERO".
BMASK4: MOVE TB,SIZEB
BMASK5: CAIGE TB,^D9
JRST BMASK6
PUSH LIT,[0]
SUBI TB,^D9
JUMPG TB,BMASK5 ;LUP UNTIL DONE
BMASK6: MOVEI TA,0
MOVE TC,[POINT 4,TA]
JUMPE TB,BMASK7 ;NO RESIDUE
IBP TC
SOJG TB,.-1
BMASK7: MOVEI TE,17
IDPB TE,TC
JRST BMASK3
;RANDOM BYTE POINTER DIDLERS
;GET A BYTE POINTER TO "A"
BYTE.A: MOVEI TE,BASEA
BYTE.X: HRRZ TC,MODEX(TE)
HLRZ TA,RESX(TE)
LSH TA,6
ADD TA,BYTE.S(TC)
ROT TA,-^D12
BYTE.Y: HRR TA,BASEX(TE)
ADD TA,INCRX(TE) ;ADDR OR WORD
POPJ PP,
;SIMILAR TO BYTE.A, EXCEPT FOR "B"
BYTE.B: MOVEI TE,BASEB
JRST BYTE.X
;SIMILAR TO BYTE.B, EXCEPT SIZE PUT IN BITS 6-17
BYTE.C: MOVEI TE,BASEB
HLRZ TA,RESB
LSH TA,^D12
ADD TA,SIZEB
HRLZS TA
JRST BYTE.Y
;CREATE BYTE POINTER TO 'A' AND PUT IN LITROL
MBYTEA: HLRZ TA,RESA
ROT TA,-6
HRRZ TC,MODEA
MOVE TC,BYTE.S(TC)
DPB TC,[POINT 6,TA,11]
HRR TA,BASEA
ADD TA,INCRA
PUSH LIT,TA
POPJ PP,
;INCREMENT PARAMETERS OF "A" OPERAND BY THE NUMBER
;OF BYTES WHOSE VALUE IS IN "TE".
M.IA: MOVE TC,MODEA
IDIV TE,BYTE.W(TC) ;ADJUST INCREMENT
ADDM TE,INCRA
HLRZ TE,RESA
IMUL TD,BYTE.S(TC)
SUB TE,TD
CAML TE,BYTE.S(TC)
JRST M.IA1
CAIN TC,D7MODE
SUBI TE,1
M.IA1: JUMPG TE,M.IA2 ;TO BIT 35 OR BEYOND
AOS INCRA ;YES:
ADDI TE,^D36
M.IA2: HRLM TE,RESA ;NEW RESIDUE
POPJ PP,
;SOME RANDOM GENERATORS
;GEN <OP AC+1,"A">
GENOPA: MOVE TE,EAC
AOSA TE
;GEN <OP AC,"A">
GENOPB: MOVE TE,EAC
DPB TE,CHAC
;GEN <OP "A">
GENOPC: HRR CH,BASEA
ADD CH,INCRA
PUSH COD,CH
POPJ PP,
;GEN <OP AC+1,"B">
GENOPD: MOVE TE,EAC
AOSA TE
;GEN <OP AC,"B">
GENOPE: MOVE TE,EAC
DPB TE,CHAC
;GEN <OP "B">
GENOPF: HRR CH,BASEB
ADD CH,INCRB
PUSH COD,CH
POPJ PP,
;GEN <MOVE 16,LIT
; PUSHJ 17,"B">
;
; PUSHJ PP,"B" IS IN CH
GENPUA: MOVE TE,EAC
AOSA TE
GENPUB: MOVE TE,EAC
LSH TE,22 ;MOVE TO AC FIELD
SKIPA
GENPUC: SKIPA TE,BASEA
HRR TE,BASEA
ADD TE,INCRA
PUSH LIT,TE
MOVSI TE,(MOVE 16,)
HRR TE,LIT
PUSH COD,TE
PUSH COD,CH ;PUSHJ PP,ROUTINE
POPJ PP,
;ERROR ROUTINES
BADBAD: TTCALL 3,[ASCIZ "? ILLEGAL SUBCRIPT USAGE"]
JRST XECUTX
DISERR: TTCALL 3,[ASCIZ "? DISPLAY INTERNAL ERROR"]
JRST XECUTX
SMLSUB: TTCALL 3,[ASCIZ "? SUBSCRIPT NOT POSITIVE"] ;[24]
JRST XECUTX ;[24]
LRGSUB: TTCALL 3,[ASCIZ "? SUBSCRIPT TOO LARGE"]
JRST XECUTX
NEDSUB: TTCALL 3,[ASCIZ "? ITEM MUST BE SUBSCRIPTED"]
JRST XECUTX
NOSUB: TTCALL 3,[ASCIZ "? NO SUBSCRIPTS ALLOWED"]
JRST XECUTX
NOTNUF: TTCALL 3,[ASCIZ "? NOT ENOUGH SUBSCRIPTS"]
JRST XECUTX
TOOFEW: TTCALL 3,[ASCIZ "? TOO MANY SUBSCRIPTS"]
JRST XECUTX
UNDEF: TTCALL 3,[ASCIZ "? SYMBOL NOT DEFINED"]
JRST XECUTX
HIPART: TTCALL 3,[ASCIZ '? NOT ALLOWED FOR HI-SEGMENT PROCEDURES']
JRST XECUTX
;ROUTINE TO GET SOME TEMP STORAGE
GETEMP: ADD TE,TEMPC ;GET NEW TOP
CAIL TE,N.TMP ;OVER?
JRST NOTEMP
EXCH TE,TEMPC ;RETURN BASE
POPJ PP,
NOTEMP: TTCALL 3,[ASCIZ "? ITEM TOO LARGE FOR TEMP"]
JRST XECUTX
NOLAST: TTCALL 3,[ASCIZ "? NO PREVIOUS DATA-NAME"]
JRST XECUTX
;COME HERE ON SECOND DISPATCH FOR WHERE COMMAND.
;PRINT SUMMARY OF BREAK POINTS
WHERE: TTCALL 3,CRLF
SKIPE TA, EBRKOV ;IF WE'RE STOPED AT AN ENTRY,
; TYPE A SPECIAL MSG.
JRST [OUTSTR [ASCIZ "PROGRAM STOPPED UPON ENTRY TO MODULE "]
PUSHJ PP, PRTMNM
JRST WHERE1]
SKIPE REEFLG ;[26]SPECIAL BREAK?
JRST WHERE1 ;[26]YES, DON'T TRY TO REPEAT MESSAGE.
SKIPN CUR.BP ;[26]ARE WE AT NORMAL BREAK?
JRST WHERE1 ;[26]SKIP BREAK MESSAGE
TTCALL 3,[ASCIZ "PROGRAM STOPPED AT "]
MOVEI TD, CBPADS ;PICK UP ADDRESS OF THE CURRENT
; BREAK POINT'S PROTAB POINTERS.
PUSHJ PP,PRTBP ;PRINT BREAK MESSAGE
WHERE1: OUTSTR [ASCIZ /
BREAKPOINTS:
/]
MOVEI TE,0 ;INIT COUNTER OF FREE BPS
MOVEI TD,B1ADR ;INIT LOOP
WHERE2: SKIPN 0(TD) ;IN USE?
AOJA TE,WHERE3 ;NO: INCREMENT CNTR
PUSHJ PP,PRTBP ;YES: PRINT IT
TTCALL 3,CRLF
WHERE3: ADDI TD,LBA
CAIG TD,BNADR ;DONE?
JRST WHERE2
CAIL TE,NBP ;WAS THERE ANY?
TTCALL 3,[ASCIZ "**NONE**
"]
PUSHJ PP,PRNUM ;PRINT # OF FREE
TTCALL 3,[ASCIZ " UNUSED BREAK POINTS"]
JRST XECUTX
CRLF: BYTE (7)15,12
;PRINT BREAK POINT INFOR POINTED AT BY 'TD'
PRTBP: PUSH PP, TE
TTCALL 3,[BYTE (7)74,74]
HLRZ TE, 1(TD)
HRRZ TE, 1(TE)
HRRZ TA,0(TD)
LDB DT,[POINT 15,0(TA),17]
ADD DT,%%NM.(TE)
PUSHJ PP,PRNAM
HRRZ TA,1(TD) ;CHECK ON SECTION NAME
JUMPN TA,PRTBP1 ;[26]NO SECTION NAME ADDRESS MEANS
;THE NAME ITSELF IS A SECTION NAME
OUTSTR [ASCIZ " SECTION"] ;[26]
JRST PRTBP2 ;[26]
PRTBP1: LDB DT,[POINT 15,0(TA),17] ;[26]GET NAMTAB POINTER
ADD DT,%%NM.(TE)
MOVE TA,1(DT)
CAME TA,[SIXBIT /:GENER/] ;DON'T PRINT IF IT ISN'T USER NAME
PUSHJ PP,[TTCALL 3,[ASCIZ " IN "]
JRST PRNAM]
PRTBP2: HLRZ TA, 1(TD) ;[26]
SKIPE SUBSPR ;SKIP IF NO MODULES BESIDES THE MAIN ONE
PUSHJ PP, [OUTSTR [ASCIZ " IN MODULE "]
JRST PRTMNM]
TTCALL 3,[BYTE (7)76,76]
POP PP, TE
POPJ PP,
;YE OLDE RECURSIVE NUMBER PRINTER C(TE)
PRNUM: IDIVI TE,^D10
HRLM TD,0(PP)
JUMPE TE,PRNUM1
PUSHJ PP,PRNUM
PRNUM1: HLRZ TC,0(PP)
ADDI TC,"0"
TTCALL 1,TC
POPJ PP,
;BREAK POINT LOGIC
;COME HERE TO EXECUTE A "BREAK" COMMAND. NOTE THAT EXECUTING A
;BREAK COMMAND JUST MEANS SETTING UP THE PARAMETERS FOR THE BREAKPOINT.
;THE ACTUAL 'INSTALLATION' OF THE BREAK CODE (JSR) IS DONE LATER.
;AND THE 'BREAK' ITSELF OCCURS ONLY WHEN CONTROL PASSES THRU THE
;NAMED PROCEDURE NAME WHERE THE JSR HAS BEEN 'INSTALLED'.
;LOOK FOR FREE SLOT IN THE TABLE THAT CONTAINS THE 20 BREAKPOINT PARAMETERS.
SETBRK: MOVEI TE,B1ADR ;GET BASE ADDRESS
STBRK0: HRRZ TD,0(TE)
CAIE TD,0(DT) ;CHECK IF WE HAVE THIS BREAK ALREADY
SKIPN 0(TE) ;NO, IS THIS SLOT EMPTY?
JRST STBRK1 ;USE THIS ONE
ADDI TE,LBA ;NEXT ENTRY
CAIG TE,BNADR ;LAST?
JRST STBRK0
TTCALL 3,[ASCIZ "? OUT OF BREAK-POINTS"]
JRST XECUTX
;GET ADDRESS OF PROTAB ENTRY FOR FATHER (SECTION)
STBRK1: HRRZ TA,PRFLGS(DT) ;[26]IS THIS NAME A SECTION NAME?
ANDI TA,PRLINK ;[26]
JUMPE TA,STBRK2 ;[26]
LDB TA,[POINT 15,1(DT),17] ;[26]NO, GET FATHER'S ADDRESS
ADD TA,@%PR
STBRK2: HRRZ TD,1(DT) ;[26]GET ADDRESS OF THE BREAK
;PROHIBIT THE BREAK IF THE ADDRESS IS IN THE HIGH SEGMENT.
IFE TOPS20,<
CAMLE TD,.JBREL
JRST HIPART
>
MOVEM DT,0(TE) ;PROTAB ADDR OF PAR NAME.
MOVEM TA,1(TE) ;PROTAB ADDR OF SECT NAME.
MOVE TA,CUREPA ;SAVE THE CURRENT ENTRY POINT'S
HRLM TA,1(TE) ; ADDRESS TOO.
SETZM 2(TE) ;CLR PROCEED COUNTER
JRST XECUTX
;COME HERE TO EXECUTE A CLEAR COMMAND. NOTE THAT EXECUTING A CLEAR
;COMMAND MEANS ZEROING THE BREAK PARAMETERS. THE ACTUAL 'REMOVAL'
;OF THE BREAK CODE (JSR) HAS ALREADY BEEN DONE. THOSE THAT ARE STILL
;'SET' WHEN A 'PROCEED' OR 'GO' IS EXECUTED ARE AUTOMATICALLY REINSTALLED.
;CLEAR ALL BREAK PARAMETERS IF NO PROC NAME WAS GIVEN ON THE COMMAND.
CLRBRK: JUMPN DT,CLBRK0
MOVE TE,[XWD B1ADR,B1ADR+1] ;CLEAR ALL
SETZM B1ADR
BLT TE,BNADR+LBA-1
JRST XECUTX
;CLEAR ONLY THE ONE THAT WAS NAMED IN COMMAND.
CLBRK0: MOVEI TE,B1ADR ;GET TABLE BASE
CLBRK1: HRRZ TD,0(TE)
CAIN TD,0(DT)
JRST CLBRK2 ;FOUND
ADDI TE,LBA ;NEXT ENTRY
CAIG TE,BNADR ;LAST ENTRY?
JRST CLBRK1 ;LOOP UNTIL NO MORE
JRST XECUTX ;JUST QUIT
CLBRK2: SETZM 0(TE) ;CLEAR 3 PARAMETER WORDS
SETZM 1(TE)
SETZM 2(TE)
JRST XECUTX
;COME HERE TO EXECUTE A STOP RUN COMMAND.
;JUST USE THE LIBOL CODE. THE LIBOL CODE WILL REENTER COBDDT
;IF THERE IS A HISTORY THAT NEEDS TO BE TERMINATED. IT HAS TO BE
;PREPARED TO DO THAT IF THE USER DID THE STOP RUN FROM HIS CODE
;INSTEAD OF FROM THE TERMINAL.
STOPR: PUSHJ PP,STOPR.##
;COMMON ROUTINE TO HANDLE BREAK
;ENTERED BY THE JSA TA,BCOM THAT IS IN THE BP TABLE.
;THE JSA GOT CONTROL FROM A JSR THAT WAS INSTALLED IN THE GENERATED CODE.
;AC'S ARE ALL IN USER PROGRAM STATE. ONLY TA CAN BE USED.
;THIS COMMON CODE SETS UP INDIRECT POINTERS TO BE USED BY
;THE REST OF THE BREAK HANDLER CODE, SO THE REST OF THE BREAK HANDLER
;CODE GOES INDIRECT TO THE PARAMETERS FOR THIS BREAK.
BCOM: Z ;JSA TA,BCOM
SETZM EBRKOV ;[26]IN CASE AN OVERLAY
;[26]MODULE HAD NO SYMBOLS
POP TA,LEAV ;GET EXIT INSTRUCTION
MOVEI TA,B1SEC-B1INS+1(TA) ;GET ADDRESS OF SECTION'S
;PROTAB ENTRY
HRRZM TA,BCOM3
MOVEI TA,B1CNT-B1SEC(TA) ;GET ADDRESS OF PROCEED COUNT
HRRZM TA,BCOM2
MOVE TA,BP1-B1CNT(TA) ;GET RETURN ADDRESS
HLLM TA,LEAV1 ;SAVE FLAGS
EXCH TA,BCOM
SOSG @BCOM2 ;TEST PROCEED COUNTER
JRST BREAK ;BREAK - ALL AC'S IN PLACE
;NOT TIME TO BREAK YET, RETURN TO USER'S CODE.
MOVEM TA,SAV.TA ;STASH 'TA'
LDB TA,[POINT 9,LEAV,8] ;GET SWAPPED INSTRUCTION'S OPCODE
;TO SEE OF WE CAN JUST EXECUTE IT,
;OR WHETHER IT MUST BE INTERPRETED.
CAIL TA,(<JSR>/1000)
CAILE TA,(<JSA>/1000) ;JSA,JSP
TRNN TA,700 ;UUO?
JRST PRCED1 ;YES: USE PROCEED CODE
CAIE TA,(<PUSHJ>/1000)
CAIN TA,(<XCT>/1000) ;PUSHJ,XCT?
JRST PRCED1 ;MUST ALSO BE INTERPRETED
MOVE TA,SAV.TA ;OK TO JUST EXIT
JRSTF @LEAV1 ;EXIT
;HERE TO BREAK - SAVE WORLD AND SET UP PDL
BREAK: JSR SAVE ;...
SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM, GO
PUSHJ PP, HABP ; ACCUMULATE STATISTICS.
PUSHJ PP,REMOVB ;REMOVE BREAK-POINTS
TTCALL 3,[ASCII "BREAK AT "
BYTE (7)74,74]
MOVE TA,BCOM2
SUBI TA,2 ;GET ADDR OF BP
MOVEM TA,CUR.BP ;SAVE IT
MOVE DT,1(TA) ;POINTER TO SECTION NAME.
MOVEM DT,CBPADS+1
HRRZ TA,0(TA) ;PNTR TO PROTAB
MOVEM TA,CBPADS ;SAVE IT IN CASE HE CLEARS
; THE BREAK POINT.
LDB DT,[POINT 15,0(TA),17]
HRRZ TA,1(TA) ;ADDR IN USER'S PROGRAM
HRRM TA,PRCED0
ADD DT,@%NM ;NAMTAB ENTRY
PUSHJ PP,PRNAM ;PRINT BP NAME
HRRZ TA,@BCOM3 ;GET SECTION NAME
JUMPN TA,BREAK1 ;[26]NO SECTION NAME?
OUTSTR [ASCIZ / SECTION/] ;[26]MUST BE A SECTION NAME
JRST BREAK2 ;[26]
BREAK1: LDB DT,[POINT 15,0(TA),17] ;[26]GET NAMTAB ENTRY FOR SECTION NAME
ADD DT,@%NM
MOVE TA,1(DT) ;GET FIRST WORD OF NAME
CAME TA,[SIXBIT /:GENER/] ;SKIP IF IT'S COMPILER GENERATED
PUSHJ PP,[TTCALL 3,[ASCIZ " IN "]
JRST PRNAM]
BREAK2: HLRZ TA,@BCOM3 ;GET ENTRY POINT
SKIPE SUBSPR ;ARE THERE OTHER MODULES?
PUSHJ PP, [OUTSTR [ASCIZ " IN MODULE "]
JRST PRTMNM]
TTCALL 3,[BYTE (7)76,76]
; SET UP FOR BREAKING- SO THAT LIBOL PARAMS HAVE MODULE PROG
; FIRST MOVE LIBOL TO RUN TIME PARAMS
MOVE TA,@%NM ; [13] ADDR OF %NM
MOVEM TA,PNM ; [13] STORE INTO PROCEED
MOVE TA,@%DT ; [13] ADDR OF %DT
MOVEM TA,PDT ; [13] STORE INTO PROCEED
MOVE TA,@%PR ; [13] ADDR OF %PR
MOVEM TA,PPR ; [13] STORE INTO PROCEED
; NOW PUT BREAK PARAMS INTO LIBOL
MOVE TA,BNM ; [13] GET BREAK NM
MOVEM TA,@%NM ; [13] STORE INTO LIBOL NM
MOVE TA,BDT ; [13] GET BREAK DT
MOVEM TA,@%DT ; [13] STORE INTO LIBOL DT
MOVE TA,BPR ; [13] GET BREAK PR
MOVEM TA,@%PR ; [13] STORE INTO LIBOL PR
JRST XECUTX ;INTO MAIN LOOP
;COME HERE TO EXECUTE A 'STEP' COMMAND.
STEP: MOVEM W2,STPCTR ;[26]SAVE COUNTER, USE 'PROCEED' CODE.
;COME HERE TO EXECUTE A PROCEED COMMAND.
PROCED: SKIPE HFGTHR ;IF WE WERE DOING A HISTOGRAM
JRST HISSTE ; GO DO A BEGIN SO THAT WE DON'T
; ADD THE TIME WE SPENT IN COBDDT
; TO THE CURRENT PARAGRAPH.
PRCEDD: SKIPE DIED. ;ARE WE ALIVE?
JRST [TTCALL 3,[ASCIZ "?CANNOT PROCEED!"]
JRST XECUTX] ;NO
;IF THIS IS ONLY A SIMULATED BREAKPOINT (STEP OR ^C/REENTER),
;REEFLG WILL BE ON, MEANING WE ENTERED COBDDT WITH A PUSHJ AND CAN
;RETURN WITH A POPJ.
SKIPE REEFLG ; [21] TIME TO REENTER?
JRST REERTN ; [21] YES
; SET UP TO PROCEED-SO THAT LIBOL HAS RUN-TIME PARAMS
; FIRST MOVE LIBOL INTO BREAK
MOVE TC,@%NM ; [13] ADDR OF %NM
MOVEM TC,BNM ; [13] STORE INTO BREAK
MOVE TC,@%DT ; [13] ADDR OF %DT
MOVEM TC,BDT ; [13] STORE INTO BREAK
MOVE TC,@%PR ; [13] ADDR OF %PR
MOVEM TC,BPR ; [13] STORE INTO BREAK
; NOW PUT PROCEED PARAMS INTO LIBOL
MOVE TC,PNM ; [13] GET PROCEED NM
MOVEM TC,@%NM ; [13] STORE INTO LIBOL NM
MOVE TC,PDT ; [13] GET PROCEED DT
MOVEM TC,@%DT ; [13] STORE INTO LIBOL DT
MOVE TC,PPR ; [13] GET PROCEED PR
MOVEM TC,@%PR ; [13] STORE INTO LIBOL PR
SKIPE EBRKOV ;ENTRY POINT BREAK?
JRST PROV ;YES, GO CONTINUE WITHOUT
; RESTORING EVERYTHING.
SKIPN TA,CUR.BP ;CURRENT?
JRST START ;NO: START USERS PROG
SKIPN DT ;NUMBER GIVEN
MOVEI DT,1 ;NO: ASSUME ONE
MOVEM DT,2(TA) ;SAVE COUNT
PRCED0: HRRZI TB,0 ;ADDR MODIFIED !!!
PUSHJ PP,FETCH ;GET INSTRUCTION
MOVEM TA,LEAV
PUSHJ PP,INSRTB ;INSERT BREAK-POINTS
JRST PRCED2
;COME HERE FROM BREAK WHICH DID NOT ACTUALLY BREAK BECAUSE
;ITS PROCEED COUNT HAS NOT GONE TO 0 YET.
PRCED1: MOVE TA,SAV.TA ;GET SAVED AC
JSR SAVE ;SAVE WORLD
PRCED2: MOVEI TC,100 ;SET MAX LOOP COUNT
MOVEM TC,TEMP1
JRST IXCT5
IXCT4: CAIL TA,40 ;SYSTEM UUO?
JRST IXCT6 ;YES: DON'T INTERPRET
MOVEM TB,40 ;SAVE UUO
MOVEI TB,41
IXCT: SOSG TEMP1 ;LOOPING
JRST BPLUP
PUSHJ PP,FETCH
MOVEM TA,LEAV ;STASH INSTR
IXCT5: HRLZI 17,AC0 ;TEMP FETCH OF ACS
BLT 17,17
MOVEI TA,@LEAV ;GET EFFECTIVE ADDRS
DPB TA,[POINT 23,LEAV,35]
LDB TC,[POINT 4,LEAV,12]
LDB TA,[POINT 9,LEAV,8]
CAIN TA,(<PUSHJ>/1000)
JRST IPUSHJ ;INTERPRET PUSHJ
CAIN TA,(<JSR>/1000)
JRST IJSR ;INTERPRET JSR
CAIN TA,(<JSP>/1000)
JRST IJSP ;INTERPRET JSP
CAIN TA,(<JSA>/1000)
JRST IJSA ;INTERPRET JSA
MOVE TB,LEAV
TRNN TA,700
JRST IXCT4 ;INTERPRET UUO
CAIN TA,(<XCT>/1000)
JRST IXCT ;INTERPRET XCT
IXCT6: MOVEI TA,LEAV
IXCT7: SETOM TEMP2
IXCT8: JRST RESTOR
;VARIOUS INTERPRETERS
IPUSHJ: DPB TC,[POINT 4,CPUSHP,12]
SETZM TEMP2 ;STORE AC FIELD INTO A PUSH
MOVE TA,LEAV
JRST IXCT8
IJSA: MOVE TA,BCOM
HRL TA,LEAV
EXCH TA,AC0(TC)
JRST IJSR2
IJSR: MOVE TA,BCOM
HLL TA,FLGS.
IJSR2: MOVE TB,LEAV
PUSHJ PP,DEP
AOSA TA,LEAV
ISR3: MOVE TA,LEAV
JRST IXCT7
IJSP: MOVE TD,BCOM
HLL TD,FLGS.
MOVEM TD,AC0(TC)
JRST ISR3
;COME HERE IF BREAK POINT LOOPING
BPLUP: PUSHJ PP,REMOVB
JSR SAVE
TTCALL 3,[ASCIZ "? FATAL BREAK-POINT ERROR!"]
JRST XECUTX
;SAVE AND RESTORE WORLD CODE
SAVE: Z ;JSR ENTRY
MOVEM 17,PDL. ;CURRENT PDL
MOVEM 17,AC0+17
HRRZI 17,AC0
BLT 17,AC0+16 ;SAVE AC'S
MOVE TA,SAVE ;SAVE PROCESSOR FLAGS
HLLM TA,FLGS.
MOVE PP,PDL. ;RESTORE STACK POINTER
JRST @SAVE
;PROCEED CODE FOR PROCEEDING FROM ^C/REENTER OR STEP COMMAND.
REERTN: PUSHJ PP,INSRTB ; [26] INSERT ANY BREAKPOINTS
MOVE TA,REEFLG ; [21] GET ORIGINAL PDL
SETZM REEFLG ; [21] CLEAR
MOVE TB,0(TA) ; [21] GET DATA + FLAGS
CAME TA,AC0+PP ; [21] SAME ?
HALT . ; [21] NO
POP TA,0(TA) ; [21] CORRECT FOR JUMP
MOVEM TA,AC0+PP ; [21]
HLLZM TB,FLGS. ; [21] SET FLAGS AND FALL THROUGH
MOVEI TA,0(TB) ; [21]
SETOM TEMP2 ; [21] NO PUSH 0 NECESSARY
RESTOR: HRRM TA,SAVE ;SAVE EXIT ADDR
MOVE TA,FLGS.
HLLM TA,SAVE
HRLZI 17,AC0
BLT 17,17 ;RESTORE AC'S
SKIPL TEMP2
CPUSHP: PUSH 0,BCOM ;AC MODIFIED AT IPUSHJ
JRSTF @SAVE ;EXIT
;COME HERE TO START USER'S PROGRAM
START: PUSHJ PP,INSRTB ;INSERT BREAK-POINTS
MOVE PP,PDL.
JRST @PROGST
;CODE TO FETCH THE USER'S INSTRUCTION AT POINT OF BREAK.
FETCH: TRNN TB,-20 ;IS IT IN AN AC?
SKIPA TA,AC0(TB) ;YES: FETCH FROM SAVED AC'S
MOVE TA,0(TB) ;NO
POPJ PP,
;CODE TO DEPOSIT AN INSTRUCTION AT THE POINT OF BREAK.
DEP: TRNN TB,-20 ;IS IT IN AN AC?
JRST DEP1 ;YES
MOVEM TA,0(TB) ;NO
POPJ PP,
DEP1: MOVEM TA,AC0(TB) ;STORE INTO THE SAVED AC
POPJ PP,
;CODE TO REMOVE OR INSERT BREAKPOINTS
INSRTB: MOVE TE,[JSR BP1]
MOVEI TD,B1ADR
INSRT1: SKIPE TB, (TD) ;IF THE BP ISN'T ACTIVE OR IS
PUSHJ PP, CHKBP ; IN A NON RESIDENT SEGMENT,
JRST INSRT2 ; DON'T INSERT IT.
HRRZ TB,1(TB) ;YES: GET ADDR OF BP
PUSHJ PP,FETCH ;GET USER'S INSTRUCTION
CAME TA,TE ;[26]DON'T STORE IT IF A BREAK
;IS ALREADY THERE (^C/REENTER PROBLEM)
MOVEM TA,2(TE) ;SAVE IT
MOVE TA,TE
PUSHJ PP,DEP ;DEPOSIT "JSR"
INSRT2: ADDI TE,LBP
ADDI TD,LBA
CAIG TD,BNADR ;DONE??
JRST INSRT1
SETZM CUR.BP ;[26]FORGET CURRENT BREAK
POPJ PP, ;YES:
REMOVB: MOVEI TE,BP1
MOVEI TD,B1ADR
REMOV1: SKIPE TB,(TD) ;IF THE BP ISN'T ACTIVE OR IS
PUSHJ PP,CHKBP ; IN A NON RESIDENT SEGMENT,
JRST REMOV2 ; DON'T REMOVE IT.
HRRZ TB,1(TB) ;GET ADDR OF USER'S INSTRUCTION
MOVE TA,2(TE) ;GET USER'S INSTRUCTION
PUSHJ PP,DEP ;PUT IT BACK
REMOV2: ADDI TE,LBP
ADDI TD,LBA
CAIG TD,BNADR
JRST REMOV1
POPJ PP,
;COME HERE FROM LIBOL'S SEGMENT HANDLER TO PUT ANY BREAKPOINTS IN THE
; SEGMENT WHICH IT HAS JUST READ IN.
SBPSG.: MOVE TE, [JSR BP1]
MOVEI TD, B1ADR
SBPSGD: SKIPE TB, (TD) ;IF THERE ISN'T A BP SET OR
PUSHJ PP, CHKBP ; IT ISN'T IN THIS SEGMENT OR
JRST SBPSGH ; IT'S IN THE RESIDENT SEGMENT,
JUMPE TC, SBPSGH ; DON'T MESS WITH IT.
HRRZ TB, 1(TB) ;GET THE ADDRESS AT WHICH TO SET IT.
PUSHJ PP, FETCH ;GO GET THE INSTR WHICH IS THERE.
MOVEM TA, 2(TE) ;SAVE IT AND REPLACE IT
MOVE TA, TE ; WITH A JSR TO THE APPROPRIATE
PUSHJ PP, DEP ; BREAK POINT.
SBPSGH: ADDI TE, LBP ;BUMP UP TO THE NEXT BREAK
ADDI TD, LBA ; POINT.
CAIG TD, BNADR ;IF THERE ARE MORE,
JRST SBPSGD ; LOOP.
POPJ PP, ;OTHERWISE RETURN.
;CHECK TO SEE IF A BREAKPOINT IS IN A NON-RESIDENT SEGMENT WHICH IS
; NOT CURRENTLY IN CORE. IF IT IS RESIDENT OR IS CURRENTLY IN CORE
; TAKE THE SKIP RETURN. ENTER WITH (TB) = BREAKPOINT'S ADDRESS.
; LEAVE WITH (TC) = THE SEGMENT PRIORITY FOR THIS PARAGRAPH/SECTION.
CHKBP: LDB TC, [POINT 7,2(TB),24] ;GET THE PRIORITY.
TRNE TC, -1 ;IF IT'S RESIDENT OR IT'S
CAMN TC, SEGNO.## ; PRIORITY IS THE SAME AS THE
AOS (PP) ; CURRENT SEGMENT'S, TAKE
POPJ PP, ; THE SKIP RETURN.
;PRINT NAME FOUND POINTED AT IN DT
PRNAM: HLRZ TA,0(DT) ;GET # OF WORDS
HRRZI TB,1(DT) ;GET ADDR OF FIRST
HRLI TB,(<POINT 6,,>);MAKE BP
PRNAM1: ILDB TC,TB
JUMPE TC,PRNAM2 ;DONE IF ZERO
ADDI TC,40 ;CONVER TO ASCII
CAIN TC,":"
MOVEI TC,"-"
TTCALL 1,TC
TLNE TB,770000 ;WORD FINISHED
JRST PRNAM1 ;NO: LOOP
SOJG TA,PRNAM1 ;YES: CHECK IF THAT'S ALL
PRNAM2: POPJ PP, ;ALL DONE - EXIT
;PRINT THE MODULE'S NAME. ENTRY POINT ADDR IS IN TA.
PRTMNM: MOVE TA, -1(TA)
JRST SIXSIX
;PRINT THE OCTAL NUMBER IN TA.
PROCT: PUSHJ PP, PROCTD
OUTCHR [","]
PROCTD: SETOI TB,
PROCTH: HRRI TB, 6
LSHC TB, 3
OUTCHR TB
JUMPL TB, PROCTH
POPJ PP,
;COME HERE TO EXECUTE A TRACE COMMAND. THIS CONSISTS IN SETTING
;A SWITCH WHICH CAUSES TRACING TO BE ON OR OFF. THE ACTUAL 'TRACING'
;IS DONE BY THE FOLLOWING ROUTINE, WHICH IS ENTERED EACH TIME A
;'TRACEPOINT' IS ENCOUNTERED IN FLOW OF CONTROL IN THE USER PROGRAM.
SETTRC: MOVEM W2,PTFLG. ;SAVE ON/OFF VALUE
JRST XECUTX ;AND RETURN TO COMMAND LEVEL
;ENTER COBDDT HERE FROM ALL TRACEABLE POINTS IN THE USER PROGRAM.
; PUSHJ PP,C.TRCE
; XWD ;ARGUMENT WORD
;THE ARGUMENT WORD CONTAINS:
;BITS 0-8 FLAGS
; BIT 4 EXIT PROGRAM
; BIT 5 GOBACK
; BIT 7 PROGRAM ENTRY
; BIT 8 ALTERNATE ENTRY
;BITS 9-17 ARGUMENT WORD COUNT (1 OR 2)
;BITS 18-35 POINTER TO PROTAB ENTRY FOR THIS PROCEDURE NAME.
;
;NAMES PRINTED BY THE TRACE ARE PRECEDED BY A STRING OF *'S AND !'S.
;A * INDICATES A PERFORM THAT IS ACTIVE, AND A ! INDICATES A CALL.
;TRACE KEEPS TRACK OF UP TO 35 OF THESE CHARACTERS.
;IS THIS THE FIRST TRACE CALL FOLLOWING A REENTER FROM MONITOR LEVEL?
C.TRCE: SKIPE REEBRK ;[26]REENTER BREAK?
JRST [OUTSTR [ASCIZ /
PROGRAM INTERRUPTED AT /]
SETZM STPCTR
JRST .+1] ;[26]YES
HRRZ TA,(PP) ;[26]GET ARG PTR
HRRZ TB,(TA) ;GET PROTAB LINK IF ANY
HLRZ TA,(TA) ;GET ARG COUNT AND FLAGS
LDB TE,[POINT 9,TA,35] ;GET ARG COUNT
TRNE TA,10000 ;GOBACK?
JRST TRACE0 ;YES
TRNE TA,20000 ;EXIT PROGRAM?
JRST TRACE1 ;YES
TRNE TA,3000 ;PROGRAM-ENTRY OR OTHER ENTRY?
JRST TRACE2 ;YES
SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP, HAPS ; ACCUMULATE STATISTICS.
; SAVE THIS PROTAB ADDRESS AS NAME TO BE PRINTED IF PROGRAM GETS
; AN ABORT ERROR.
ADD TB,@%PR ;MAKE REAL ADDR
MOVEM TB,L.PARA ;[26]ASSUME PARAGRAPH
MOVE TC,PRFLGS(TB) ;[26]GET PAR/SECT FLAG
TRNN TC,PRLINK ;[26]IS IT PARA?
JRST [MOVEM TB,L.SECT
SETZM L.PARA
JRST .+1] ;[26]NO, NEW SECTION
PUSHJ PP,STPCHK ;[26]ARE WE STEPPING?
SKIPE REEBRK ;[26]TIME TO BREAK?
JRST CTRCE3 ;[26]YES
SKIPN PTFLG. ;ARE WE PRINTING?
JRST CNPOPJ ;NO: JUST EXIT
; WE ARE TRACING SO WE MUST PRINT
CTRCE3: PUSHJ PP, PTDPTH ;PRINT STRING OF !/*
OUTSTR [ASCIZ /<</]
SKIPN TB,L.PARA ;[26]IS THERE A CURRENT PARAGRAPH?
JRST [SKIPN TB,L.SECT
JRST [OUTSTR [ASCIZ /(NO NAME)/]
JRST CTRCE6]
PUSHJ PP,PRTPNM
OUTSTR [ASCIZ / SECTION/]
JRST CTRCE6] ;[26]NO, PRINT SECTION NAME ONLY.
PUSHJ PP,PRTPNM ;[26]YES, PRINT PARA NAME
SKIPN TB,L.SECT ;[26]SECT NAME TOO?
JRST CTRCE6 ;[26]NO
OUTSTR [ASCIZ / IN /] ;[26]YES
PUSHJ PP,PRTPNM ;[26]PRINT SECT NAME
CTRCE6:CTRCE6: OUTSTR [ASCIZ />>
/]
SKIPN REEBRK ; [21] FROM A REENTER OR STEP?
JRST CNPOPJ ;NO, RETURN...
; [21] YES, SETUP A BREAK
DEB: MOVEM PP,REEFLG ; [21] SET FLAGS FOR OTHERS
; AND SAVE STACK POINTER.
HRRZ TA,0(PP) ; [21] FIND RETURN ADDRESS BY
ADD TA,TE ; [21] ADDING ARGUMENT COUNT
HRRM TA,0(PP) ; [21]
JSR SAVE ; [21] GO SAVE THE STATE OF ALL
SETZM REEBRK ; [21] NEVER DO THIS TWICE
;;; SETZM PTFLG. ; [26] OR THIS NUMBER OF TIMES
JRST XECUTX ; [21]
;CHECKS WHETHER STEPPING IS BEING DONE AND PRINTS IF SO.
STPCHK: SOSE STPCTR ;[26]ARE WE STEPPING?
POPJ PP, ;[26]NO
SETOM REEBRK ;[26]YES. SET TO BREAK.
OUTSTR [ASCIZ /STEP AT /] ;[26]
POPJ PP, ;[26]
;COMMON ENTRANCE TO PRNAM
PRTPNM: LDB DT,[POINT 15,0(TB),17] ;[26]GET NAMTAB ADDR
ADD DT,@%NM
JRST PRNAM
;TRACE A 'GOBACK' OR 'EXIT PROGRAM'
TRACE0: PUSHJ PP, TRAC1D
ASCIZ /<<GOBACK>>
/
TRACE1: PUSHJ PP, TRAC1D
ASCIZ /<<EXIT PROGRAM>>
/
TRAC1D: SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP,HAGBS ; ACCUMULATE STATISTICS.
PUSHJ PP,STPCHK ;[26]SEE IF WE ARE STEPPING
SKIPE REEBRK ;[26]SHOULD WE PRINT THE MESSAGE?
JRST TRAC1F ;[26]YES
SKIPN PTFLG. ;ARE WE TRACING?
JRST TRAC1H ;NO
TRAC1F: PUSHJ PP,PTDPTH ;PRINT STRING OF */!
OUTSTR @(PP) ;PRINT MESSAGE
TRAC1H: AOS DEPTH ;SHORTEN STRING
POP PP,0(PP) ;DISCARD POINTER TO TYPEOUT
POP PP,TA ;[26]SAVE TRACE EXIT
POP PP,CUREPA ;[26]UNSTACK ENTRY POINT
POP PP,TC ;[26]UNSTACK SECT AND PARA PRTAB ADDRS.
HRRZM TC,L.SECT ;[26]RESTORE SECTION NAME
HLRZM TC,L.PARA ;[26]RESTORE PARA NAME
PUSH PP,TA ;[26]RESTACK TRACE EXIT
SKIPE REEBRK ;[26]SIMULATE BREAK?
JRST DEB ;[26]YES
JRST CNPOPJ
;TRACE ENTRY OR PROGRAM-ENTRY
;CAUTION: DO NOT TAMPER WITH NEXT THREE LINES.
XWD 0,"!"
TRACE2: SOSL DEPTH
JSA TA,TPDCHR ;ADD ! TO STRING
SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP,HAEPS ; ACCUMULATE STATISTICS.
POP PP,TA ;[26]SAVE TRACE EXIT
POP PP,TB ;[26]SAVE PTR TO PREVIOUS STACK FRAME
PUSH PP,L.SECT ;[26]STACK OLD SECTION NAME
MOVE TC,L.PARA ;[26]GET OLD PARA NAME
HRLM TC,0(PP) ;[26]STACK OLD PARA NAME
PUSH PP,CUREPA ;[26]STACK OLD ENTRY POINT
PUSH PP,TB ;[26]RESTACK PREV STACK FRAME'S PTR
PUSH PP,TA ;[26]RESTACK TRACE EXIT
;HAVE TO ADJUST THE VALUE OF THE STACK POINTER THAT PUTF. (IN LIBOL)
;SAVED IN SBPSA. THIS ROUTINE JUST ADDS 2 TO IT.
PUSHJ PP,ISBPS. ;[26]
SETZM L.SECT ;[26]FORGET OLD
SETZM L.PARA ;[26] PROCED NAMES
;NOW FIND THE ENTRY POINT BY SEARCHING BACKWARDS FROM CALL ON C.TRCE.
MOVE TB,[SKIPA 0] ;[26]ENTRY PT HAS SKIPA 0
CAME TB,(TA) ;[26]THIS IT?
SOJA TA,.-1 ;[26]NO
HRRZM TA,CUREPA ;[26]YES, SAVE IT
PUSHJ PP,STPCHK ;[26]ARE WE STEPPING?
SKIPE REEBRK ;[26]SIMULATE BREAK?
JRST TRACE3 ;[26]YES, SO PRINT
SKIPE PTFLG. ;TRACING?
JRST TRACE3 ;YES
SKIPN TA,EBRKOV ;[26]BREAK ON OVERLAY?
JRST CNPOPJ ;[26]NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
CAMN TA,CUREPA ;[26]RIGHT ENTRY POINT?
JRST BROV ;[26]YES
SETZM EBRKOV ;[26]NO,FORGET IT
CNPOPJ: ADDM TE,(PP) ;NO, SKIP RETURN
CPOPJ: POPJ PP,
;PRINT THE PROGRAM OR ENTRY NAMES
TRACE3: PUSHJ PP,PTDPTH
AOS (PP) ;AIM AT NAME ARG
TTCALL 3,[ASCIZ "<<"]
TRNE TA,2000 ;PROGRAM ENTRY?
TTCALL 3,[ASCIZ "PROGRAM "]
TRNE TA,1000 ;OR OTHER ENTRY?
TTCALL 3,[ASCIZ "ENTRY "]
TRACE5: SOJLE TE,TRACE4 ;CHK COUNT OF NAME TO PRINT
AOS TA,(PP) ;BUMP ARG PTR
MOVE TA,-1(TA) ;GET ARG WORD
PUSHJ PP,SIXSIX
JRST TRACE5
TRACE4: TTCALL 3,[ASCIZ ">>
"]
SKIPN TA,EBRKOV ;[26]BREAK ON OVERLAY?
JRST TRACE6 ;[26]NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
CAMN TA,CUREPA ;[26]RIGHT ENTRY POINT?
JRST BROVA ;[26]YES
TRACE6: SETZM EBRKOV ;[26]NO,FORGET IT
SKIPE REEBRK ;[26]SIMULATE BREAK?
JRST DEB ;[26]YES
POPJ PP,
;GETS NAMTAB, DATAB AND PRTAB ADDRESSES FOR CURRENT ENTRY POINT.
;CUREPA MUST HAVE ENTRY POINT ADDRESS.
GTTABS: HRRZ TA,CUREPA ;[26]GET ENTRY ADDRESS
HRRZ TA,1(TA) ;[26]ADDR OF %FILES
HRLI TA,%%NM.(TA) ;[26]NAMTAB ADDR
HRR TA,%NM ;[26]
HRRZ TB,%NM ;[26]
BLT TA,2(TB) ;[26]GET ALL 3
POPJ PP, ;[26]
;ENTER HERE FROM KILL.
BTRAC.: SETOM DIED. ;WE ARE NOW DEAD
SETZM STPCTR ;[26]DON'T BREAK DURING PRINT
SETZM TE,REEBRK ;[26]ZERO ARG COUNT; NO BREAK
TTCALL 3,[ASCIZ "ENTERING COBDDT FROM: "]
SKIPN @%DT ;[26]ANY SYMBOLS?
JRST [OUTSTR [ASCIZ / (MODULE WITH NO SYMBOLS)/]
JRST BTRAC1] ;[26]NO...
PUSHJ PP,CTRCE3 ;[26]PRINT WHERE WE ARE.
BTRAC1: PUSHJ PP,PPOT4. ;[26]AUTOMATIC TRACE BACK
MOVEM PP,PDL. ;[26]DON'T WIPE OUT ANY STACK
JRST XECUTX ;GO...
;ROUTINES TO KEEP TRACE CORRECT FOR PERFORMS.
;IN ORDER TO REMEMBER THE LAST-SEEN SECTION AND PARAGRAPH NAMES AT
;THE PERFORM STATEMENT, WE SAVE THEM ON THE STACK, THEN RESTORE THEM
;AT THE EXIT FROM THE PERFORM RANGE.
; USE SAME REGISTERS THAT PERF. USES.
PERFTA==10 ;HOLDS ADDR OF START OF PERF RANGE.
PERFTB==11 ;HOLDS COPY OF RETURN ADDR ON STACK
;COME HERE FROM OBJECT PROGRAM DURING A PERFORM SETUP.
;SAVE PAR AND SECT NAMES AND ADD * TO STRING THAT GETS PRINTED
;IN FRONT OF ANY NAME THAT IS BEING TRACED.
;CAUTION: DO NOT TAMPER WITH THE NEXT THREE INSTRUCTIONS.
XWD 0, "*"
TRPD.: SOSL DEPTH
JSA TA, TPDCHR ;ADD A * TO THE STRING
SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP, HAPFS ; ACCUMULATE STATISTICS.
;LEAVE PERFORM EXIT ADDRESS ON TOP OF STACK, BUT SLIP SECTION AND
;PARAGRAPH NAME PRTAB ADDRESSES JUST BELOW IT.
POP PP,PERFTB ;SAVE EXIT WORD.
PUSH PP,L.SECT ;STACK SECTION
MOVE TA,L.PARA ;[26]AND PARAGRAPH
HRLM TA,0(PP) ;[26]PRTAB ADDRESSES
PUSH PP,PERFTB ;RESTACK EXIT WORD.
JRST -1(PERFTA) ;RETURN
;COME HERE FROM OBJECT PROGRAM WHEN EXITING A PERFORM RANGE.
;REMOVES A CHAR FROM STRING AND RESTORES SECT AND PAR NAMES.
TRPOP.: SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP, HAEXS ; ACCUMULATE STATISTICS.
AOS DEPTH ;SHORTEN STRING
POP PP,TA ;UNSTACK RETURN ADDR
POP PP,PERFTA ;[26]UNSTACK SECTION
HRRZM PERFTA,L.SECT ;[26]AND PARAGRAPH
HLRZM PERFTA,L.PARA ;[26]PRTAB ADDRESSES
JRST (TA) ;RETURN
IFNDEF MXDPTH,<MXDPTH==^D35> ;MAXIMUM DEPTH WE WILL KEEP TRACK OF.
;SUBROUTINE TO ADD A CHARACTER TO THE STRING. ENTERED WITH THE WORLD'S
;WORST CALLING SEQUENCE:
;
; XWD 0, "Z" ;THE CHARACTER TO BE ADDED.
; SOSL ... ;ANY RANDOM INSTRUCTION.
; JSA TA,TPDCHR
TPDCHR: Z ;CALLED VIA JSA.
PUSH PP, TB ;DON'T MESS UP ANY AC'S.
PUSH PP, TC
MOVE TB, DEPTH
SUBI TB, MXDPTH
MOVE TC, TRSPTR
AOJGE TB, TPDCHD
IBP TC
AOJL TB, .-1
TPDCHD: MOVE TB, -3(TA)
IDPB TB, TC
POP PP, TC
POP PP, TB
JRA TA, (TA)
;SUBROUTINE TO PRINT THE STRING OF *'S AND !'S.
PTDPTH: PUSH PP, TA ;DON'T MESS UP ANY AC'S.
MOVE TA, DEPTH
SUBI TA, MXDPTH
JUMPE TA, PTDPTP
CAMG TA, [EXP -MXDPTH]
HRREI TA, -MXDPTH
PUSH PP, TB
PUSH PP, TC
MOVE TB, TRSPTR
PTDPTL: ILDB TC, TB
OUTCHR TC
AOJL TA, PTDPTL
POP PP, TC
POP PP, TB
PTDPTP: POP PP, TA
POPJ PP,
TRSPTR: POINT 7,.+1
BLOCK <MXDPTH+4>/5
DEPTH: EXP MXDPTH
;COME HERE TO EXECUTE "OVERLAY" COMMAND.
;JUST SET SWITCH ON OR OFF.
SETOVR: MOVEM W2, BRKONO ;SAVE ON/OFF VALUE.
JRST XECUTX ;CONTINUE.
;ROUTINE TO DO INITIALIZATION ON THE FLY FOR LINK-10 OVERLAYS.
; CALLED BY PUTF. BEFORE IT SWAPS THE TABLES (EVERY ENTRY).
; ENTER WITH (TA) = ENTRY POINT ADDRESS.
; ALL AC'S ARE PRESERVED.
SFOV.: SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM GO
PUSHJ PP, HAOVL ; ACCUMULATE STATISTICS.
JSR SVALL ;GO SAVE THE AC'S.
MOVE TB, -2(TA) ;MAKE SURE WE ARE AT THE
TRNE TB, -1 ; MAIN ENTRY POINT.
MOVEI TA, (TB)
MOVE TB, 1(TA) ;IF WE HAVE ALREADY
SKIPGE TC, %%NM.(TB) ; INITIALIZED THIS MODULE
JRST SFOVI ; LEAVE.
;WE HAVE TO INITIALIZE ANY NEW MODULES THAT WERE BROUGHT IN.
; BUT FIRST REMOVE ANY BREAK POINTS AND ENTRY POINTS FOR MODULES THAT
; WERE OVERLAYED.
MOVE NM, ETYPTS ;GET POINTER TO THE ENTRY POINT TABLE.
SKIPN TA, (NM) ;IS THERE ONE THERE?
SFOVB: AOBJN NM, .-1 ;NO, LOOP.
JUMPGE NM, SFOVE ;IF THERE AREN'T ANY MORE, THERE
; ARE NO ENTRY POINTS TO BE REMOVED,
; GO ON.
HLRZ TA, TA ;GET PONTER TO THE OVERLAY BLOCK.
JUMPE TA, SFOVB ;IF IT'S RESIDENT, IGNORE IT.
MOVE TA, OVLKN(TA) ;GET THE MODULE'S LINK NUMBER.
SKIPE TH, OVLCHS ;GET THE ADDR OF THE ROOT'S
; CONTROL SECTION.
SFOVC: HRRZ TH, CS.PTR(TH) ;GET THE NEXT CONTROL SECTION.
JUMPE TH, SFOVD ;NO MORE CONTROL SECTIONS,
; GO REMOVE THE LINK.
HRRZ TI, CS.NUM(TH) ;GET THE LINK NUMBER.
CAIE TI, (TA) ;IS THIS THE ONE?
JRST SFOVC ;NO, GO LOOK AT THE NEXT ONE.
JRST SFOVB ;YES, DON'T REMOVE IT.
SFOVD: HLRZ TC, TA ;GET THE LOWEST ADDRESS IN THE
; LINK THAT WENT AWAY.
MOVEI TE, [ASCIZ /
[OVERLAYED /]
PUSHJ PP, SFOVS ;GO REMOVE ANY ENTRY POINTS
; AND BREAK POINTS THAT HAVE
; BEEN OVERLAYED.
SKIPE PTFLG.
OUTSTR [ASCIZ /WITH /]
JRST .+3
SFOVE: SKIPE PTFLG.
OUTSTR [ASCIZ /
[BROUGHT IN MODULES /]
;NOW GO THROUGH ALL THE CONTROL SECTIONS AND INITIALIZE ANY MODULES
; WHICH HAVEN'T BEEN INTIALIZED YET.
SETOM SUBSPR ;NOTE THAT THERE ARE SUBROUTINES
; PRESENT.
SKIPE TH, OVLCHS ;GET THE ADDR OF THE ROOT'S CS.
SFOVF: HRRZ TH, CS.PTR(TH) ;GET THE ADDR OF THE NEXT CS.
JUMPE TH, SFOVH ;IF THAT'S ALL, WE'RE DONE.
SKIPN TI, CS.INT(TH) ;GET POINTER TO THE INTERNAL
; TRANSFER TABLES.
JRST SFOVF ;IF IT DOESN'T EXIST, GO LOOK
; AT THE NEXT CS.
PUSH PP, TH ;SAVE CS PTR.
SFOVG: HRRZ TA, (TI) ;GET THE ADDR (OF AN ENTRY PT?)
PUSH PP, TI ;SAVE THE POINTER.
PUSHJ PP, SFOVK ;GO SEE IF WE HAVE TO LINK ANYTHING.
POP PP, TI ;RESTORE THE POINTER.
ADDI TI, 1 ;SKIP OVER A WORD.
AOBJN TI, SFOVG ;IF THERE ARE MORE (ENTRY PTS.), LOOP.
POP PP, TH ;RESTORE CS PTR.
JRST SFOVF ;GO LOOK FOR MORE CONTROL SECTIONS.
SFOVH: SKIPE PTFLG.
OUTSTR [ASCIZ /]
/]
MOVE TA, AC0+TA
SKIPE BRKONO ;IF HE WANT'S TO BREAK,
MOVEM TA, EBRKOV ; REMEMBER TO DO SO LATER.
SFOVI: HRLZI 17, AC0 ;RESTORE THE AC'S.
BLT 17, 17
POPJ PP, ;RETURN.
;ROUTINE TO SET UP THE OVERLAY BLOCKS AND INITIALIZE
; MODULES IN A LINK-10 OVERLAY.
; ENTER WITH (TA) = ENTRY POINT ADDRESS.
SFOVK: MOVE NM, ETYPTS ;GET THE POINTER TO THE ENTRY POINTS.
SFOVL: MOVS TB, (TA) ;GET THE INSTRUCTION AT THE EP.
CAIE TB, (<SKIPA 0,0>) ;IF IT ISN'T "SKIPA 0,0",
POPJ PP, ; LEAVE.
HRRZ TB, -2(TA) ;MAKE SURE THAT WE ARE AT
TRNE TB, -1 ; THE MAIN ENTRY POINT.
HRRZI TA, (TB)
MOVE TB, 1(TA) ;GET THE ADDR OF %FILES.
SKIPGE %%NM.(TB) ;IF THE MODULE HAS ALREADY BEEN
POPJ PP, ; INITIALIZED, LEAVE.
MOVE NM, ETYPTS ;PUT THE MODULE'S MAIN ENTRY
SKIPE (NM) ; POINT IN THE ENTRY POINT
AOBJN NM, .-1 ; TABLE.
JUMPGE NM, [CAIN NM, ETYTAB+^D100
JRST [OUTSTR [ASCIZ /
?TOO MANY SUBROUTINES FOR COBDDT TO COPE WITH. PLEASE COMBINE SOME OF
?THEM SO THAT THERE ARE LESS THAN 100 MODULES./]
CALLI 12]
MOVS TC, ETYPTS
SUBI TC, 1
MOVSM TC, ETYPTS
JRST .+1]
HRRZM TA, (NM) ;PUT THE EP ADDR IN THE TABLE.
HRRZM NM, NMSVD ;REMEMBER WHERE WE PUT IT.
HRROS %%NM.(TB) ;MARK THE MODULE.
SKIPN PTFLG. ;IF WE'RE TRACING, PRINT IT'S NAME.
JRST SFOVM
MOVE TD, -1(TA)
PUSHJ PP, SFOVU
OUTCHR [" "]
;BUILD AN OVERLAY BLOCK FOR THE MODULE.
; FIRST FIND OUT WHICH LINK IT'S IN.
SFOVM: MOVE TH, OVLCHS ;GET THE ADDR OF THE ROOT LINK'S
; CONTROL SECTION.
SFOVN: HRRZ TH, CS.PTR(TH) ;GET THE ADDR OF THE NEXT CS.
MOVE TI, CS.COR(TH) ;GET BASE ADDR AND LENGTH OF
HLRZ TJ, TI ; THE LINK.
ADDI TJ, (TI) ;LAST ADDR IN THE LINK.
CAIGE TJ, (TA) ;IF THIS ISN'T THE ONE,
JRST SFOVN ; GO LOOK AT THE NEXT ONE.
; NOW SEE IF IT WAS IN CORE BEFORE.
MOVE TE, -1(TA) ;GET THE MODULE'S NAME.
MOVE TF, CS.NUM(TH) ;AND LINK NUMBER.
SKIPA TD, OVRLHD ;GET THE POINTER TO THE OVERLAY BLOCKS.
SFOVO: SKIPN TD, OVLTN(TD) ;GET THE NEXT OVERLAY BLOCK.
JUMPE TD, SFOVP ;NO MORE OVERLAY BLOCKS, IT WAS
; NEVER IN CORE BEFORE.
HRRZ TG, OVLKN(TD) ;GET THE LINK NUMBER.
CAMN TE, OVNAM(TD) ;NAMES MATCH?
CAIE TF, (TG) ;YES, LINK NO'S MATCH?
JRST SFOVO ;NO, NOT A MATCH.
JRST SFOVQ ;MATCH, GO ON.
; DIDN'T FIND A MATCH, BUILD A BLOCK FOR IT.
SFOVP: PUSHJ PP, SFOVW ;GO FIND OUT WHERE .JBFF LIVES.
CAIGE TD, OVBKSZ(TC) ;IF THERE ISN'T ENOUGH ROOM, COMPLAIN.
JRST [OUTSTR [ASCIZ -
?NOT ENOUGH ROOM BELOW LINK'S OVERLAY AREA, RELOAD WITH LARGER "/SPACE."-]
CALLI 12]
; LINK THE BLOCK IN AS THE LAST BLOCK IN THE LIST.
SKIPN TG, OVRLHD
HRLZI TG, OVRLHD
HLRZS TG
HRRZM TC, (TG)
HRLM TC, OVRLHD
HRRI TD, OVBKSZ(TC) ;UPDATE .JBFF
HRRM TD, (TE)
HRLI TC, (TC) ;ZERO OUT THE BLOCK.
SETZM (TC)
ADDI TC, 1
BLT TC, -1(TD)
MOVEI TD, -OVBKSZ(TD) ;POINT AT THE FIRST LOCATION OF
; THE BLOCK.
MOVE TE, -1(TA) ;GET THE MODULE'S NAME
MOVEM TE, OVNAM(TD) ; AND PUT IT IN THE BLOCK.
HRL TF, CS.COR(TH) ;COMBINE THE LOWEST ADDR IN THE
; LINK WITH THE LINK NUMBER AND
MOVEM TF, OVLKN(TD) ; PUT THEM IN THE BLOCK.
; PUT THE REST OF THE JUNK IN THE BLOCK.
HLL TA, -2(TA) ;GET THE MODULE'S START ADDR.
MOVEM TA, OVEPA(TD) ;SAVE FIRST LOC,,EP ADDR.
HRRZ TC, %%NM.(TB)
MOVEM TC, OV%NM(TD)
MOVE TC, %%DT.(TB)
MOVEM TC, OV%DT(TD)
SFOVQ: HLLZ TC, OV%PR(TD)
IORB TC, %%PR.(TB)
MOVEM TC, OV%PR(TD)
HRLM TD, @NMSVD ;PUT THE OVERLAY BLOCK'S ADDR
; IN THE ENTRY POINT TABLE.
; IF THE HISTOGRAM IS ACTIVE AND WE HAVEN'T SET UP A TABLE FOR THIS
; MODULE, DO SO NOW.
SKIPE HFINIT
TLNE TC, -1
JRST SFOVR
; SET UP A HISTOGRAM TABLE.
PUSHJ PP, SFOVW ;GO FIND .JBFF.
MOVEI TA, (TB) ;GET THE SIZE OF PROTAB.
MOVE TB, %%PR.(TA)
HLRZ TC, %%DT.(TA)
SUBI TC, (TB)
HRRZ TB, (TE) ;GET THE HISTAB ADDR.
ADDI TC, (TB) ;LAST LOCATION IN HISTAB.
CAIL TC, (TD)
JRST [OUTSTR [ASCIZ -
?NOT ENOUGH SPACE FOR HISTOGRAM TABLES, RELOAD WITH LARGER "/SPACE".-]
CALLI 12]
HLRZ TD, (NM) ;GET THE OVERLAY BLOCK'S ADDR.
HRLM TB, OV%PR(TD) ;PUT THE HISTAB ADDR IN IT.
HRLM TB, %%PR.(TA) ; AND IN %PR.
ADDI TC, 1 ;UPDATE .JBFF.
MOVEM TC, (TE)
PUSHJ PP, HISIRP ;GO CLEAN THE TABLE UP.
SFOVR: HRRZ TA, @NMSVD ;GET THE ENTRY POINT ADDR BACK.
HLRZ TB, 1(TA) ;GET THE LIST OF PROGRAMS CALLED.
SFOVRH: SKIPN TA, (TB) ;IF THIS MODULE DOESN'T
POPJ PP, ; CALL ANYONE, RETURN.
PUSH PP, TB ;OTHERWISE, SAVE THE PTR.
PUSHJ PP, SFOVL ;GO DO THIS PROGRAM.
POP PP, TB ;RESTORE THE PTR.
AOJA TB, SFOVRH ;AND GO SEE IF ANYONE ELSE IS CALLED.
;ROUTINE TO REMOVE ENTRY POINTS AND BREAK POINTS FOR ROUTINES THAT
; HAVE BEEN OVERLAYED OR CANCELED. ENTER WITH (TC) = HIGHEST ADDRESS
; KNOWN TO STILL BE PRESENT.
SFOVS: CAML TC, CUREPA ;SEE IF THE CURRENT MODULE
JRST SFOVSB ; WENT AWAY.
HRRZ TD, ETYTAB ;IT DID, MAKE THE MAIN PROGRAM
MOVEM TD, CUREPA ; THE CURRENT MODULE.
HRRZ TD, 1(TD)
HRLI TD, %%NM.(TD)
HRRI TD, BNM
BLT TD, BPR
SFOVSB: MOVE NM, ETYPTS ;GET THE POINTER TO THE ENTRY POINTS.
SKIPN TD, (NM) ;IS THERE ONE THERE?
SFOVSD: AOBJN NM, .-1 ;NO, IF THERE ARE MORE, LOOP.
JUMPGE NM, SFOVSL ;IF THERE ARE NO MORE, GO ON.
CAIL TC, (TD) ;IF THE ENTRY POINT IS ABOVE
JRST SFOVSD ; THE STARTING ADDRESS, DO NOTHING.
SKIPN PTFLG. ;IF WE AREN'T TRACING, GO ON.
JRST SFOVSH
TRNE TE, -1 ;IF THERE IS SOMETHING TO TYPE,
OUTSTR (TE) ; TYPE IT.
HLRZ TD, TD ;POINT AT THE OVERLAY BLOCK.
MOVE TD, OVNAM(TD) ;GET THE NAME.
PUSHJ PP, SFOVU ;GO TYPE IT OUT.
OUTCHR [" "] ;FOLLOWED BY A SPACE.
SFOVSH: SETZB TE, (NM) ;REMOVE THE ENTRY POINT FROM THE TABLE.
JRST SFOVSD ;GO LOOK FOR MORE.
SFOVSL: MOVEI TD, B1ADR ;POINT AT THE FIRST BREAK POINT.
SFOVSP: SKIPE TG, 0(TD) ;IF THERE ISN'T ANYTHING THERE
CAIL TC, (TG) ; OR IT'S BELOW THE ADDRESS,
JRST SFOVST ; GO LOOK AT THE NEXT ONE.
SETZM (TD) ;OTHERWISE CLEAR THE BP.
SETZM 1(TD)
SETZM 2(TD)
SFOVST: ADDI TD, LBA ;MOVE UP TO THE NEXT ONE.
CAIG TG, BNADR ;IF THERE ARE MOVE,
JRST SFOVSP ; LOOP.
POPJ PP, ;OTHERWISE, RETURN.
;PRINT A SIXBIT WORD. WORD IS IN TD, USES TE.
SFOVU: SETZI TE,
LSHC TE, 6
ADDI TE, 40
OUTCHR TE
JUMPN TD, SFOVU
POPJ PP,
SFOVW: MOVEI TE, .JBFF## ;GET .JBFF'S ADDR.
MOVE TC, .JBFF## ;GET .JBFF.
SKIPE TD, HLOVL.## ;GET THE ADDR OF THE FIRST LOC
; IN THE OVERLAY AREA.
CAIG TC, (TD) ;IF .JBFF IS ABOVE THE OVERLAY
POPJ PP, ; AREA, USE THE SAVED .JBFF.
MOVEI TE, SAVEF.##
MOVE TC, SAVEF.##
;COME HERE WHEN BREAKING AFTER HAVING BROUGHT A LINK-10 OVERLAY IN.
BROV: ADDM TE,(PP) ;ADJUST THE RETURN ADDRESS.
BROVA: JSR SAVE ;GO SAVE THE WORLD.
SKIPE HFGTHR ;IF WE'RE DOING A HISTOGRAM, GO
PUSHJ PP,HAOVL ; ACCUMULATE STATISTICS.
PUSHJ PP,REMOVB ;REMOVE BREAK POINTS.
OUTSTR [ASCIZ "BREAK UPON OVERLAY LOAD "] ;[26]
HRL TA,%NM ;SAVE POINTERS
HRRI TA,PNM
BLT TA,PPR
PUSHJ PP,GTTABS ;[26]GET NEW TABLE POINTERS
PUSHJ PP,MODH ;[26]TELL WHAT MODS ARE IN MEMORY
JRST XECUTX ;[26]DIALOGUE
;COME HERE TO PROCEED FROM THE ABOVE BREAK.
PROV: SETZM EBRKOV ;DON'T BREAK AGAIN.
PUSHJ PP,INSRTB ;GO INSERT BREAK POINTS.
HRLZI 17,AC0 ;RESTORE THE AC'S.
BLT 17,17
POPJ PP, ;RETURN.
;ROUTINE TO REMOVE ANY BREAKPOINTS FROM LINK-10 OVERLAYS BEFORE THEY
; ARE CANCELED.
;CALLED BY CANCEL JUST BEFORE IT CALLS OVRLAY TO REMOVE THE LINK.
;ENTER WITH (TA) = PTR TO ARG WHCH POINTS TO LINK NUMBER OF LINK TO CANCEL.
;ALL AC'S ARE PRESERVED.
CNTRC.: JSR SVALL ;GO SAVE THE AC'S.
MOVE TA, @(TA) ;GET THE LINK NUMBER.
SKIPE TH, OVLCHS ;POINT AT THE ROOT'S CONTROL SECTION.
CNTRCB: HRRZ TH, CS.PTR(TH) ;POINT AT THE NEXT CONTROL SECTION.
JUMPE TH, CNTRCC ;IF THERE ARE NO MORE LINKS, LEAVE.
HRRZ TI, CS.NUM(TH) ;GET THE LINK'S NUMBER.
CAIE TI, (TA) ;IF THIS ISN'T THE ONE,
JRST CNTRCB ; GO LOOK AT THE NEXT ONE.
HRRZ TC, CS.COR(TH) ;GET THE LOWEST ADDRESS IN THE LINK.
MOVEI TE, [ASCIZ /
[CANCELED /]
PUSHJ PP, SFOVS ;GO REMOVE ANY BREAK POINTS AND
; ENTRY POINTS IN THE CANCELED
; ROUTINES.
SKIPE PTFLG. ;IF WE'RE TRACING,
OUTCHR ["]"] ; TERMINATE THE STRING.
SETZM SUBSPR ;ASSUME THAT THERE ARE NO
; SUBROUTINES LEFT.
MOVE NM, ETYPTS ;GET POINTER TO ENTRY POINT TABLE.
AOBJP NM, CNTRCC ;IF THE MAIN ROUTINE IS THE ONLY
; THING THERE, GO ON.
SKIPN (NM) ;LOOK FOR A NON ZERO ENTRY IN
AOBJN NM, .-1 ; THE TABLE.
JUMPGE NM, CNTRCC ;IF WE FOUND ONE, NOTE THAT
SETOM SUBSPR ; THERE ARE SUBROUTINES PRESENT.
CNTRCC: HRLZI 17, AC0 ;RESTORE THE AC'S.
BLT 17, 17
POPJ PP, ;RETURN.
;ROUTINE TO SAVE THE AC'S - JSR SVALL -
SVALL: Z
MOVEM 17, AC0+17
HRRZI 17, AC0
BLT 17, AC0+16
MOVE 17, AC0+17
JRST @SVALL
; REWRITE OF HISTOGRAM FEATURE 27-JUL-75 /ACK
;DEFINITIONS:
DV.DSK==(1B1) ;DEVCHR FLAG - DEVICE IS A DISK.
DV.CDR==(1B2) ;DEVCHR FLAG - DEVICE IS A CARD READER.
DV.LPT==(1B3) ;DEVCHR FLAG - DEVICE IS A LINE PRINTER.
DV.NUL==DV.CDR+DV.LPT ;IF THEY ARE BOTH ON, IT'S THE NULL DEVICE.
DV.DIR==(1B15) ;DEVCHR FLAG - DEVICE IS A DIRECTORY DEVICE.
EOL==12 ;END OF LINE CHARACTER.
HTTLSZ==^D70 ;MAXIMUM SIZE FOR TITLE.
IFNDEF HPSPLN,<HPSPLN==^D20> ;MAXIMUM NUMBER OF ENTRY POINTS
; AND PERFORMS TO KEEP TRACK OF.
;SOME USEFUL MACROS:
DEFINE WARN% (X)<
OUTSTR [ASCIZ \
%'X'\]
>
DEFINE WARN (X)<
OUTSTR [ASCIZ \'X'\]
>
SALL
;INITIATE A HISTOGRAM.
HISINI: PUSHJ PP, SHISCM ;GO SCAN THE REST OF THE LINE.
PUSHJ PP, HISIND
JRST XECUTX
;SET UP THE TABLES.
HISIND: SKIPE HFTBST ;IF WE HAVE ALREADY SET THEM
JRST HISIRD ; UP, GO CLEAN THEM UP.
PUSHJ PP, SFOVW ;GO FIND OUT WHERE .JBFF IS
; HIDEING.
HISINF: MOVEM TC, HSTSJF ;SAVE .JBFF IN CASE WE CAN'T
; ALLOCATE ALL THE CORE WE NEED.
MOVE NM, ETYPTS ;SET UP THE POINTER TO THE ENTRY POINTS.
SKIPN TA, (NM) ;IS THERE AN ENTRY POINT THERE?
HISINH: AOBJN NM, .-1 ;NO, IF THERE ARE MORE, LOOP.
JUMPGE NM, HISINX ;IF WE'RE DONE, GO CLEAR THE TABLES.
HRRZ TA, 1(TA) ;ADDRESS OF %FILES.
MOVE TB, %%PR.(TA) ;PROTAB ADDR.
TLNE TB, -1 ;IF THIS ONE WAS SET UP BEFORE
JRST HISINH ; GO DO THE NEXT ONE.
HLRZ TC, %%DT.(TA) ;LAST LOCATION IN PROTAB.
SUBI TC, (TB) ;SIZE OF PROTAB.
HRRZ TB, (TE) ;HISTAB ADDRESS.
ADDI TC, (TB) ;LAST LOCATION IN HISTAB.
JUMPE TD, HISINT ;IF THERE ARE NO LINK-10 OVERLAYS
; ACTIVE GO ON.
CAIG TC, (TD) ;IF THE LAST LOCATION IS BELOW
JRST HISINV ; THE OVERLAY AREA, ALL IS WELL.
OUTSTR [ASCIZ -
?NOT ENOUGH SPACE FOR HISTOGRAM TABLES, RELOAD WITH LARGER "/SPACE".-]
HISINL: MOVE TA, HSTSJF ;RESTORE ORIGIONAL .JBFF.
MOVEM TA, (TE)
JRST XECUTX
HISINT: CAMG TC, .JBREL## ;IF WE DON'T NEED TO ASK FOR
JRST HISINV ; MORE CORE, DON'T.
MOVEI TG, (TC) ;ASK FOR THE CORE.
CORE TG,
JRST [OUTSTR [ASCIZ /
?NOT ENOUGH CORE AVAILABLE FOR HISTOGRAM./]
JRST HISINL]
HISINV: HRLM TB, %%PR.(TA) ;SAVE HISTAB ADDR.
HRRI TC, 1(TC) ;FORM NEW .JBFF.
HRRM TC, (TE) ;SAVE IT.
JRST HISINH ;GO DO THE NEXT TABLE.
HISINX: HRRZ TB, %PR ;GET CURRENT PR AND GO PUT THE
PUSHJ PP, HISIT ; HISTOGRAM TABLE IN IT.
HRRZI TB, PPR ;DITTO FOR THE RUN PR.
PUSHJ PP, HISIT
HRRZI TB, BPR ;AND THE BREAK PR.
PUSHJ PP, HISIT
;NOW GO PUT THE HISTAB ADDRESSES IN ANY SAVED %PR'S.
MOVE NM, ETYPTS ;GET THE POINTER TO THE ENTRY POINTS.
SKIPN TA, (NM) ;IS THERE AN ENTRY POINT THERE?
HISIPD: AOBJN NM, .-1 ;NO, IF THERE ARE MORE LOOP.
JUMPGE NM, HISIPE ;IF THAT'S ALL GO ON.
PUSH PP, NM ;SAVE THE POINTER.
MOVE TA, 1(TA) ;ADDRESS OF %FILES.
MOVEI TB, FIXNUM+%%PR.(TA) ;ADDRESS OF SAVED PROTAB POINTER.
PUSHJ PP, HISIT ;GO CHECK IT OUT.
POP PP, NM ;RESTORE THE ENTRY POINT POINTER.
JRST HISIPD ;AND LOOP.
;NOW PUT THE HISTOGRAM TABLE ADDRESSES IN ANY LINK-10 OVERLAY BLOCKS.
HISIPE: MOVEI TD, OVRLHD ;GET THE ADDR OF THE LIST HEADER.
HISIPF: SKIPN TD, (TD) ;ARE THERE MORE?
JRST HISIPH ;NO, GO ON.
MOVEI TB, OV%PR(TD) ;POINT AT THE PROTAB WORD.
PUSHJ PP, HISIT ;GO PUT THE HISTAB ADDR IN IT.
JRST HISIPF ;GO LOOK FOR MORE.
;PUT HISTOGRAM TABLE ADDRESS IN THE LOCATION WHOSE ADDRESS IS IN TB.
HISIT: MOVE TC, (TB) ;GET THE PROTAB ADDR.
TRNE TC, -1 ;IF THERE IS NO PROTAB ADDR
TLNE TC, -1 ; OR HISTAB IS ALREADY SET UP,
POPJ PP, ; FORGET IT.
MOVE NM, ETYPTS ;SET UP THE POINTER TO THE ENTRY POINTS.
SKIPN TA, (NM) ;IS THERE AN ENTRY POINT THERE.
HISITD: AOBJN NM, .-1 ;NO, IF THERE ARE MORE LOOP.
JUMPGE NM, CPOPJ ;MUST BE A LINK-10 OVERLAY THAT
; WENT AWAY.
HRRZ TA, 1(TA) ;ADDRESS OF %FILES.
MOVE TA, %%PR.(TA) ;HISTAB ADDR,,PROTAB ADDR
CAIE TC, (TA) ;IS THIS THE ONE?
JRST HISITD ;NO, GO LOOK AT THE NEXT ONE.
HLLM TA, (TB) ;YES, STASH THE HISTAB ADDR.
POPJ PP, ;RETURN.
HISIPH: SETOM HFTBST ;REMEMBER THAT WE HAVE SET UP
; THE TABLES.
;ZERO OUT ALL OF THE TABLES.
HISIRD: MOVE NM, ETYPTS ;SET UP THE POINTER TO THE ENTRY POINTS.
SKIPN TA, (NM) ;IS THERE AN ENTRY POINT THERE?
HISIRH: AOBJN NM, .-1 ;NO, IF THERE ARE MORE LOOP.
JUMPGE NM, HISIRI ;IF WE'RE DONE, GO ON.
HRRZ TA, 1(TA) ;ADDRESS OF %FILES.
PUSHJ PP, HISIRP ;GO ZAP THE TABLE.
JRST HISIRH ;GO DO THE NEXT TABLE.
;CLEAR LINK-10 OVERLAY MODULE'S TABLES IN CASE THE MODULE ITSELF ISN'T
; CURRENTLY IN CORE.
HISIRI: SKIPN TD, OVRLHD ;IF THERE AREN'T ANY LINK-10
JRST HISIRL ; OVERLAYS GO ON.
HISIRJ: MOVEI TA, OV%PR-%%PR.(TD) ;POINT AT WHERE %FILES WOULD BE.
PUSHJ PP, HISIRP ;GO ZAP THE TABLE.
SKIPE TD, (TD) ;IF THERE ARE MORE,
JRST HISIRJ ; LOOP.
HISIRL: SETZM HOVCPU ;CLEAR THE OVERHEAD AND
MOVE TA, [XWD HOVCPU,HOVCPU+1] ;ELAPSED TIMES.
BLT TA, HUNELP
SETOM HFINIT ;REMEMBER THAT AN INITIALIZATION
; WAS DONE.
POPJ PP, ;RETURN.
;ROUTINE TO ZAP A HISTAB TABLE.
; ENTER WITH THE ADDR OF %FILES IN TA.
HISIRP: MOVE TB, %%PR.(TA) ;HISTOGRAM TABLE ADDRESS,,PROTAB ADDRESS.
TLNN TB, -1 ;IS THERE A TABLE THERE?
POPJ PP, ;NO, LEAVE.
HLRZ TA, %%DT.(TA) ;LAST LOCATION IN PROTAB.
SUBI TA, (TB) ;GET SIZE OF PROTAB.
HLR TB, TB ;FORM WORD FOR BLT.
ADDI TB, 1
SETZM -1(TB) ;ZERO THE FIRST WORD.
ADDI TA, -1(TB) ;LAST LOCATION IN HISTAB.
BLT TB, (TA) ;ZAP.
POPJ PP, ;RETURN.
;START GATHERING STATISITICS.
HISSTA: PUSHJ PP, SHISCM ;GO SCAN THE REST OF THE LINE.
SKIPL HFINIT ;IF WE HAVEN'T DONE THE
PUSHJ PP, HISIND ; INITIALIZATION YET, GO DO IT.
HISSTE: SETOM HFGTHR ;TURN ON THE GATHER FLAG.
SETOM HFGTST ;TURN ON THE INITIALIZE FLAG.
MOVE TA, [IOWD HPSPLN,HPSPLO] ;SET UP THE PDL.
MOVEM TA, HPSPDL
JRST PRCEDD ;AUTOMATICALY PROCEED.
;STOP GATHERING STATISTICS.
HISSTO: PUSHJ PP, CHSCMB ;GO MAKE SURE WE ARE AT THE
; END OF A LINE.
SETZM HFGTHR ;TURN OFF THE GATHER FLAG.
JRST XECUTX
;COME HERE WHEN THE PROGRAM TERMINATES TO PRINT THE REPORT, IF NECESSARY.
HSRPT.: AOSN HFGTST ;DO WE HAVE STATISTICS THAT
; WANT TO BE PRINTED.
POPJ PP, ;NO, RETURN.
JRST HISREB ;YES, GO PRINT THEM AND RETURN.
;PRINT THE REPORT.
HISREP: PUSHJ PP, SHISCM ;GO SCAN THE REST OF THE LINE.
SKIPN HFINIT ;IF AN INITIALIZATION OR A BEGIN
; WASN'T DONE, COMPLAIN.
JRST [OUTSTR [ASCIZ /
?HISTORY NOT INITIALIZED./]
JRST XECUTX]
PUSHJ PP, HISREB ;GO PRINT THE REPORT.
SETOM HFGTST ;NOTE THAT WE HAVE PRINTED THE
; REPORT.
JRST XECUTX ;GO SEE IF THERE ARE MORE COMMANDS.
;CALLED BY A PUSHJ SO WE CAN CALL IT IF THE PROGRAM TERMINATES WITHOUT
; PRINTING THE REPORT.
HISREB: MOVEM PP, HSTPDL ;SAVE THE PDL IN CASE WE HAVE
; AN ERROR.
PUSHJ PP, HISSIO ;GO SET UP THE I/O ROUTINES.
AOS TE, HSTRPN ;BUMP THE REPORT NUMBER.
OUTSTR [ASCIZ /
[REPORT: /] ;AND TYPE IT OUT.
PUSHJ PP, PRNUM
OUTCHR ["]"]
MOVEM 17, HSTACS+17 ;SAVE THE AC'S.
HRRZI 17, HSTACS
BLT 17, HSTACS+16
MOVE 17, HSTACS+17
MOVE NM, ETYPTS ;SET UP THE POINTER TO THE
; ENTRY POINTS.
HISRED: SKIPE TA, (NM) ;IS THERE ONE THERE?
PUSHJ PP, HISPRP ;YES, GO PRINT A PAGE.
AOBJN NM, HISRED ;IF THERE ARE MORE MODULES, LOOP.
;PRINT OUT THE OVERHEAD FOR PERFORMS AND SUBROUTINE CALLS.
SKIPN TK, HOVELP ;IF THERE WASN'T ANY FORGET IT.
JRST HISREF
MOVEI TE, [ASCIZ /
OVERHEAD: ELAPSED: /]
PUSHJ PP, HISPST
PUSHJ PP, HSPRTM
MOVEI TE, [ASCIZ / CPU: /]
PUSHJ PP, HISPST
MOVE TK, HOVCPU
PUSHJ PP, HSPRTM
;PRINT OUT THE UNACCOUNTABLE TIME.
HISREF: SKIPN TK, HUNELP ;IF THERE WASN'T ANY FORGET IT.
JRST HISREG
MOVEI TE, [ASCIZ /
UNACCOUNTED: ELAPSED: /]
PUSHJ PP, HISPST
PUSHJ PP, HSPRTM
MOVEI TE, [ASCIZ / CPU: /]
PUSHJ PP, HISPST
MOVE TK, HUNCPU
PUSHJ PP, HSPRTM
HISREG: PUSHJ PP, HISPEL
HISREH: HRLZI 17, HSTACS ;RESTORE THE AC'S.
BLT 17, 17
HISREL: PUSHJ PP, HISCLO ;GO CLOSE THE CHANNEL, RETURN IT
; AND RETURN THE CORE.
MOVE PP, HSTPDL ;RESTORE THE PDL.
POPJ PP, ;RETURN.
;ROUTINE TO PRINT THE STATISTICS FOR ONE MODULE.
HISPRP: MOVEI TE, [ASCIZ /
COBDDT HISTOGRAM FOR /]
PUSHJ PP, HISPST
MOVE TD, -1(TA) ;PRINT THE MODULE'S NAME.
HSPRPD: SETZI TE,
LSHC TE, 6
JUMPE TE, HSPRPH
MOVEI CH, 40(TE)
PUSHJ PP, HISPCH
JRST HSPRPD
HSPRPH: MOVEI CH, " "
MOVEI TE, 4
PUSHJ PP, HISPCH
SOJG TE, .-1
MOVEI TE, [ASCIZ /REPORT: /]
PUSHJ PP, HISPST
MOVE TE, HSTRPN
PUSHJ PP, HISPDC
PUSHJ PP, HISPEL
LDB TE, [POINT 7,HSTTTL,6]
JUMPE TE, HSPRPJ
MOVEI TE, HSTTTL
PUSHJ PP, HISPST
PUSHJ PP, HISPEL
HSPRPJ: MOVEI TE, [ASCIZ /
PROCEDURE ENTRIES CPU ELAPSED
/]
PUSHJ PP, HISPST
SETZI CH, ;REMEMBER THAT WE HAVE JUST
; PRINTED THE HEADING.
HRRZ TA, 1(TA) ;ADDRESS OF %FILES
MOVE TB, %%PR.(TA) ;HISTOGRAM TABLE ADDR,,PROTAB ADDR.
TRNE TB, -1 ;[26]IS PROTAB ADDRESS 0?
JRST HSPRPK ;[26]
MOVEI TE, [ASCIZ /(NO SYMBOLS FOR THIS MODULE)
/] ;[26]
PUSHJ PP, HISPST ;[26]
POPJ PP, ;[26]
HSPRPK: AOBJN TB, .+1 ;SKIP THE ZERO WORDS.
HLLZ TC, %%DT.(TA) ;LAST LOCATION IN PROTAB.
HRRZ TA, %%NM.(TA) ;NAMTAB ADDR.
ADD TA, [POINT 6,1] ;POINTER TO TEXT.
MOVSS TB ;PROTAB ADDR,,HISTOGRAM TABLE ADDR.
HSPRPL: SKIPN TE, (TB) ;IF THERE IS NO TIME FOR THIS
SKIPE 2(TB) ; PROCEDURE AND IT WAS NEVER
TRNA ; ENTERED, GO ON TO THE
JRST HSPRPX ; NEXT ONE.
MOVSS TB ;POINT AT PROTAB
LDB TG, [POINT 15,(TB),17] ;GET THE NAMTAB LINK.
ADD TG, TA ;POINT AT THE NAME.
HRREI TH, -^D32 ;SET THE POSITION COUNT.
MOVE TI, PRFLGS(TB) ;IF THIS IS A PARAGRAPH,
TRNE TI, PRLINK ; INDENT A SPACE. IF IT'S
JRST [MOVEI CH, " " ; A SECTION AND WE HAVE
JRST HSPRPR] ; NOT JUST PRINTED THE HEADING
PUSHJ PP, HISPCH ; SKIP A LINE.
HSPRPP: ILDB CH, TG ;GET A CHAR.
TRNN CH, 60 ;IS THIS THE END?
JRST HSPRPT ;YES, GO ON.
CAIN CH, ':' ;REPLACE COLONS BY HYPHENS.
MOVEI CH, '-'
CAIN CH, ';' ; AND SEMICOLONS BY PERIODS.
MOVEI CH, '.'
ADDI CH, 40 ;MAKE IT ASCII.
HSPRPR: PUSHJ PP, HISPCH ;PRINT IT.
AOJA TH, HSPRPP ;BUMP POSITION AND LOOP.
HSPRPT: MOVEI CH, " " ;PADD WITH BLANKS UNTIL
PUSHJ PP, HISPCH ; WE ARE AT COLUMN 33.
AOJL TH, .-1
HSPRTV: IDIVI TE, ^D10 ;PRINT THE NUMBER OF TIMES
PUSH PP, TD ; THIS ROUTINE WAS ENTERED
TDNE TE, TE ; RIGHT JUSTIFIED IN AN
SOJA TH, HSPRTV ; 11 CHAR FIELD.
HRREI TD, ^D10(TH)
PUSHJ PP, HISPCH
SOJG TD, .-1
HSPRTW: POP PP, CH
TRO CH, 60
PUSHJ PP, HISPCH
AOJLE TH, HSPRTW
MOVSS TB ;POINT AT THE HISTOGRAM TABLE AGAIN.
MOVE TK, 1(TB) ;GET THE CPU TIME FOR THE
PUSHJ PP, HSPRTM ; PARAGRAPH AND GO PRINT IT.
MOVE TK, 2(TB) ;GET THE ELAPSED TIME FOR THE
PUSHJ PP, HSPRTM ; PARAGRAPH AND GO PRINT IT.
PUSHJ PP, HISPEL ;PRINT A <CR><LF>
HSPRPX: ADD TB, [XWD 4,4] ;BUMP UP TO THE NEXT ENTRY.
SKIPE C74FLG ;COBOL-74?
AOBJP TB,.+1 ;YES, USE [5,,5]
CAMLE TC, TB ;ARE WE PAST THE END?
JRST HSPRPL ;NO, GO LOOK AT THIS ENTRY.
POPJ PP, ;DONE WITH THIS TABLE, RETURN.
;ROUTINE TO PRINT A TIME AS HH:MM:SS.TTT, WITH LEADING ZEROS SUPPRESSED.
HSPRTM: MOVEI CH, " " ;THROW OUT A COUPLE SPACES.
PUSHJ PP, HISPCH
PUSHJ PP, HISPCH
IDIVI TK, ^D1000 ;GET FRACTIONAL SECONDS.
PUSH PP, TJ ;SAVE THEM.
IDIVI TK, ^D60 ;GET SECONDS.
PUSH PP, TJ
IDIVI TK, ^D60 ;MINUTES AND HOURS.
PUSH PP, TJ
SETZI TI, ;SET THE NO SIGINFICANCE FLAG.
PUSHJ PP, HSPRTU ;GO PRINT HOURS.
POP PP, TK ;GET MINUTES BACK.
PUSHJ PP, HSPRTU ;GO PRINT THEM.
POP PP, TK ;GET SECONDS BACK.
IDIVI TK, ^D10
TRON TI, -1 ;TURN ON SIGNIFICANCE AND GO
TRNE TK, -1 ; PRINT A DIGIT OR A SPACE.
MOVEI CH, 60(TK)
PUSHJ PP, HISPCH
PUSHJ PP, HSPRTR ;GO PRINT DIGITS POSITION.
MOVEI CH, "." ;PRINT THE DECIMAL POINT.
PUSHJ PP, HISPCH
POP PP, TK ;GET FRACTIONAL SECONDS.
IDIVI TK, ^D100
PUSHJ PP, HSPRTT
MOVEI TK, (TJ)
HSPRTO: IDIVI TK, ^D10
PUSHJ PP, HSPRTS
HSPRTR: MOVEI TK, (TJ)
HSPRTS: TRNE TK, -1
TROA TI, -1
TRNE TI, -1
HSPRTT: MOVEI CH, 60(TK)
JRST HISPCH
HSPRTU: PUSHJ PP, HSPRTO
TRNE TI, -1
MOVEI CH, ":"
JRST HISPCH
;PRINT A <CR><LF>
HISPEL: MOVEI CH, 15
PUSHJ PP, HISPCH
MOVEI CH, 12
JRST HISPCH
;PRINT THE ASCIZ STRING WHOSE ADDRESS IS IN RH TE.
HISPST: HRLI TE, (<POINT 7,0>)
HPSTRD: ILDB CH, TE
JUMPE CH, CPOPJ
PUSHJ PP, HISPCH
JRST HPSTRD
;PRINT THE DECIMAL NUMBER IN TE.
HISPDC: IDIVI TE, 12
HRLM TD, (PP)
TDNE TE, TE
PUSHJ PP, HISPDC
HLR CH, (PP)
TRO CH, 60
JRST HISPCH
;I/O ROUTINES.
;SET UP FOR OUTPUT.
HISSIO: MOVEI TA, 4 ;CALL FUNCT. TO GET
MOVEM TA, HSTFFN ; A CHANNEL.
MOVEI TA, HSTFFB
PUSHJ PP, FUNCT.##
SKIPE HSTFST ;IF WE DIDN'T GET ONE, COMPLAIN.
JRST [OUTSTR [ASCIZ /
?CAN'T FIND A FREE CHANNEL FOR HISTORY REPORT./]
JRST XECUTX]
AOS TA, .JBREL## ;SAVE .JBREL AND .JBFF AND
MOVEM TA, HSTSJR ; SET .JBFF TO (.JBREL)+1 SO
EXCH TA, .JBFF## ; THAT WE ARE ABOVE THE
MOVEM TA, HSTSJF ; LINK-10 OVERLAY AREA.
MOVE TA, HSTFCH ;GET THE CHANNEL NUMBER.
DPB TA, [POINT 4,HSTOPN,12] ;PUT IT IN THE OPEN,
DPB TA, [POINT 4,HISETR,12] ; ENTER,
DPB TA, [POINT 4,HISOPT,12] ; OUTPUT,
DPB TA, [POINT 4,HISGST,12] ; GETSTS AND
DPB TA, [POINT 4,HISCLO,12] ; CLOSE.
MOVE TE, [XWD HSTIOB,HSTLUB] ;SET UP THE LOOKUP
BLT TE, HSTETB+3 ; AND ENTER BLOCKS.
MOVE TE, HSTDEV ;GET THE DEVICE.
DEVCHR TE, ;GET IT'S CHARACTERISTICS.
TLNN TE, DV.DSK ;IF IT'S NOT A DISK,
JRST HISSID ; DON'T TRY TO APPEND.
;DEVICE IS A DISK, TRY TO APPEND TO THE FILE.
DPB TA, [POINT 4,HISLKU,12] ;PUT THE CHANNEL NUMBER IN
DPB TA, [POINT 4,HISUSI,12] ; THE LOOKUP AND USETI.
XCT HSTOPN ;DO THE OPEN.
JRST HISER1 ;FAILED, COMPLAIN.
SETOI TA, ;ASSUME WE'RE GOING TO DO THE USETI.
HISLKU: LOOKUP HSTLUB ;DO THE LOOKUP.
SETZI TA, ;FAILED, REMEMBER NOT TO DO THE USETI.
JRST HISETR ;GO DO THE ENTER.
;COME HERE IF THE DEVICE ISN'T A DISK.
HISSID: XCT HSTOPN ;DO THE OPEN.
JRST HISER1 ;FAILED, COMPLAIN.
HISETR: ENTER HSTETB ;DO THE ENTER.
JRST HISER0 ;FAILED, COMPLAIN.
TLNE TA, -1 ;DO WE WANT TO DO THE USETI?
HISUSI: USETI -1 ;YES, DO SO.
XCT HISOPT ;DO AN OUT TO ESTABLISH THE BUFFERS.
POPJ PP, ;RETURN.
HISER0: OUTSTR [ASCIZ /
?ENTER FAILURE ON /]
PUSHJ PP, HISPFN
JRST HISREL
HISER1: OUTSTR [ASCIZ /
?OPEN FAILURE ON /]
MOVE TA, HSTDEV
PUSHJ PP, SIXSIX
JRST HISREL
;OUTPUT THE CHARACTER IN CH.
HISPCH: SOSG HSTOBF+2
JRST HISOPT
HISPCM: IDPB CH, HSTOBF+1
POPJ PP,
HISOPT: OUT
JRST HISPCM
OUTSTR [ASCIZ /
?OUTPUT ERROR ON /]
PUSHJ PP, HISPFN
OUTSTR [ASCIZ / STATUS (/]
HISGST: GETSTS TA
HRLZI TA, (TA)
PUSHJ PP, PROCTD
OUTCHR [")"]
JRST HISREH ;GO RESTORE EVERYTHING AND
; RETURN TO COMMAND INTREPRETER.
;ROUTINE TO CLEAN UP AFTER THE REPORT.
HISCLO: CLOSE ;CLOSE THE CHANNEL.
MOVEI TA, 5 ;CALL FUNCT. TO RETURN
MOVEM TA, HSTFFN ; THE CHANNEL
MOVEI TA, HSTFFB
PUSHJ PP, FUNCT.##
SOS TA, HSTSJR ;RESTORE .JBREL
CORE TA,
JFCL
MOVE TA, HSTSJF ;RESTORE .JBFF
MOVEM TA, .JBFF##
POPJ PP,
;ROUTINE TO TYPE OUT THE FILE SPEC.
HISPFN: MOVE TA, HSTDEV
PUSHJ PP, SIXSIX
SKIPN TA, HSTIOB
POPJ PP,
OUTCHR [":"]
PUSHJ PP, SIXSIX
OUTCHR ["."]
SKIPE TA, HSTIOB+1
PUSHJ PP, SIXSIX
SKIPN TA, HSTIOB+3
POPJ PP,
OUTCHR ["["]
PUSHJ PP, PROCT
OUTCHR ["]"]
POPJ PP,
;ROUTINE TO SCAN THE REST OF THE COMMAND FOR HISTOGRAM COMMANDS.
SHISCM: PUSHJ PP, HGTCOM ;GO SEE IF THERE IS A FILE
; SPEC OR A TITLE.
CHSCMB: PUSHJ PP, EOLCHK ;GO MAKE SURE WE ARE AT THE END
; OF THE LINE.
POPJ PP, ;WE ARE, RETURN.
WARN% (<GARBAGE AFTER COMMAND IGNORED>)
CHSCMF: PUSHJ PP, GETCHR ;GO GET THE NEXT CHAR.
PUSHJ PP, EOLCHK ;ARE WE AT THE END OF A LINE NOW?
POPJ PP, ;YES, RETURN.
JRST CHSCMF ;NO, SKIP THIS CHAR.
;PARAGRAPHS AND SECTIONS COME HERE.
; ENTER WITH TB CONTAINING THE PROTAB LINK.
HAPS: PUSHJ PP, HACAPS ;GO INITIALIZE.
HRLI TB, (TB) ;FORM HISTAB ADDR,, PROTAB ADDR.
ADD TB, @%PR
HLRZ TC, TB ;GET THE HISTAB ADDR.
AOS (TC) ;BUMP NUMBER OF TIMES ENTERED.
MOVE TC, PRFLGS(TB) ;GET THE PROTAB FLAGS.
TRNN TC, PRLINK ;IF IT'S A SECTION,
JRST HAPSD ; GO ON.
; IT'S A PARAGRAPH.
LDB TC, [POINT 15,1(TB),17] ;GET THE SECTION LINK.
HLR TB, @%PR ;GET HISTAB ADDR.
ADDI TB, (TC) ;FORM NEW SECTION'S HISTAB ADDR.
MOVEM TB, HCURPS ;SAVE PARAGRAPH/SECTION.
TRNA
; IT'S A SECTION.
HAPSD: HLRZM TB, HCURPS ;SAVE NEW SECTION AND CLEAR OLD PARAGRAPH.
; REINITIALIZE THE TIMES.
HARAR: MSTIME TB,
MOVEM TB, HSTELP
SETZI TA,
RUNTIM TA,
MOVEM TA, HSTCPU
; RESTORE AC'S AND RETURN.
HARAV: MOVE TA, [XWD HSTACS,TD]
BLT TA, TA
POPJ PP,
;COME HERE ON A BREAKPOINT TO UPDATE THE CURRENT PARAGRAPH/SECTION.
HABP: PUSHJ PP, HACAPS ;GO INITIALIZE.
JRST HARAV ;GO RESTORE AC'S AND RETURN.
;PERFORMS COME HERE.
HAPFS: PUSHJ PP, HACAPS ;GO INITIALIZE.
JSR HPFEP ;GO SAVE CURRENT PARAGRAPH/SECTION.
MOVEI TA, HOVRHD ;CHARGE TIME TO OVERHEAD UNTIL
MOVEM TA, HCURPS ; WE SEE A PARAGRAPH OR SECTION.
JRST HARAR ;GO RESTORE AC'S AND RETURN.
;ENTRY POINTS COME HERE.
HAEPS: PUSHJ PP, HACAPS ;GO INITIALIZE.
JSR HPFEP ;GO SAVE CURRENT PARAGRAPH/SECTION.
JRST HAEXSD ;GO CHARGE TIME TO UNACCOUNTABLE
; UNTIL WE SEE A PARAGRAPH OR
; SECTION.
HPFEP: Z
MOVE TB, HCURPS ;GET CURRENT PARAGRAPH/SECTION.
CAIN TB, HOVRHD ;IF WE'RE CHARGING THIS TIME TO
JRST HARAR ; OVERHEAD, DON'T SAVE ANYTHING.
MOVE TA, HPSPDL ;GET THE PUSH DOWN POINTER.
AOBJP TA, .+2 ;IF THERE IS ROOM FOR THIS
MOVEM TB, (TA) ; PARAGRAPH/SECTION, SAVE IT.
MOVEM TA, HPSPDL ;SAVE PUSH DOWN POINTER.
JRST @HPFEP ;RETURN.
;EXITS, EXIT PROGRAMS AND GOBACKS COME HERE.
HAGBS:
HAEXS: PUSHJ PP, HACAPS ;GO INITIALIZE.
MOVE TA, HPSPDL ;GET PUSH DOWN POINTER.
JUMPL TA, HAEXSH ;IF WE SAVED SOMETHING, GO ON.
SUB TA, [XWD 1,1] ;DECREMENT THE POINTER, BUT DON'T
HAEXSB: MOVEM TA, HPSPDL ; TRY TO RESTORE ANYTHING.
HAEXSD: MOVEI TA, HUNATD ;CHARGE TIME TO UNACCOUNTABLE
MOVEM TA, HCURPS ; UNTIL WE SEE A PARAGRAPH OR
; SECTION.
JRST HARAR ;GO RESTORE AC'S AND RETURN.
HAEXSH: CAMN TA, [IOWD HPSPLN,HPSPLO] ;IF WE HAVE NOTHING
JRST HAEXSD ; TO RESTORE GO CHARGE
; THIS TIME TO UNACCOUNTABLE.
HAEXSL: POP TA, HCURPS ;RESTORE OLD PARAGRAPH/SECTION.
MOVEM TA, HPSPDL ;SAVE THE POINTER.
JRST HARAR ;GO RESTORE THE AC'S AND RETURN.
;COME HERE BEFORE PROCESSING OVERLAYS.
HAOVL: PUSHJ PP, HACAPS ;GO INITIALIZE.
MOVEI TA, HOVRHD ; CHARGE TIME TO OVERHEAD UNTIL
MOVEM TA, HCURPS ; WE SEE A PARAGRAPH OR SECTION.
JRST HARAR ;GO RESTORE AC'S AND RETURN.
;INITIALIZATION ROUTINE.
; SAVE SOME AC'S AND IF THIS IS THE FIRST TIME WE HAVE BEEN
; CALLED SINCE THE BEGIN WAS DONE SET UP THE INITIAL TIMES OTHERWISE
; INCREMENT THE TIMES FOR THE CURRENT PARAGRAPH/SECTION.
HACAPS: MOVEM TA, HSTACS+3
SETZI TA,
RUNTIM TA,
MOVEM TB, HSTACS+2
MSTIME TB,
MOVEM TD, HSTACS
MOVEM TC, HSTACS+1
AOSN HFGTST ;IF THIS IS THE FIRST TIME WE
JRST HACAPU ; HAVE BEEN CALLED, GO SET UP
; THE INITIAL TIMES.
;INCREMENT THE CURRENT PARAGRAPH/SECTION'S TIMES.
MOVE TC, HCURPS ;GET THE HISTAB ADDRESSES.
HLRZ TD, TC ;TC HAS THE SECTION.
;TD HAS THE PARAGRAPH.
SUB TA, HSTCPU
ADDM TA, HSTCPU
ADDM TA, 1(TC)
TRNE TD, -1
ADDM TA, 1(TD)
SUB TB, HSTELP
ADDM TB, HSTELP
CAMGE TB, TA ;IF THE ELAPSED TIME IS LESS
MOVE TB, TA ; THAN THE CPU TIME, USE THE
; CPU TIME AS ELAPSED TIME.
; THIS HACK IS NECESSARY
; BECAUSE SYSTEMS WITH REAL
; TIME CLOCKS GET CPU TIME IN
; MS BUT ROUND MSTIME OFF TO
; THE NEAREST 16 MS.
ADDM TB, 2(TC)
TRNE TD, -1
ADDM TB, 2(TD)
HACAPT: MOVE TB, HSTACS+2
POPJ PP,
;THIS IS THE FIRST TIME WE HAVE BEEN CALLED SINCE THE BEGIN WAS DONE.
HACAPU: MOVEM TA, HSTCPU
MOVEM TB, HSTELP
MOVEI TA, HOVRHD ;CHARGE TIME TO OVERHEAD UNTIL
MOVEM TA, HCURPS ; WE SEE A PARAGRAPH OR SECTION.
JRST HACAPT ;GO RESTORE TB AND RETURN.
;ROUTINE TO PICK UP THE REST OF THE HISTOGRAM COMMAND.
HGTCOM: PUSHJ PP, SKPBLN ;GO SKIP LEADING BLANKS AND TABS.
CAIN CH, EOL ;IF IT'S THE END OF THE LINE,
POPJ PP, ; RETURN.
CAIN CH, "'" ;IF IT LOOKS LIKE A TITLE,
JRST HGTCOD ; SKIP THE FILE SPEC STUFF.
PUSHJ PP, GFSPEC ;GO GET A FILE SPEC.
JUMPE TC, [MOVE TE, TD ;IF THERE ISN'T A FILE
; NAME, SEE IF IT'S A
; DIRECTORY DEVICE.
DEVCHR TE, ;GET THE CHARACTERISITCS.
TLC TE, DV.NUL ;IF IT'S THE NULL DEVICE
TLCE TE, DV.NUL ; PRETEND IT'S NOT A
TLNN TE, DV.DIR ; DIRECTORY DEVICE.
JRST .+1 ;IT ISN'T ALL IS WELL.
ERR ("FILE NAME REQUIRED FOR THIS DEVICE")]
MOVEM TD, HSTDEV ;SAVE THE FILE SPEC.
MOVEM TC, HSTIOB
MOVEM TB, HSTIOB+1
MOVEM TA, HSTIOB+3
PUSHJ PP, SKPBLN ;GO SKIP OVER ANY INTERVENING BLANKS.
CAIN CH, EOL ;IF IT'S THE END OF THE LINE,
POPJ PP, ; RETURN.
HGTCOD: HRREI TE, -HTTLSZ ;SET UP FOR THE TITLE.
MOVE TF, [POINT 7,HSTTTL]
CAIN CH, "'" ;IF IT LOOKS LIKE A TITLE,
SOJA TE, HGTCOL ; GO ON.
WARN% (<TITLE SHOULD START WITH "'">)
WARN (<, BUT I'LL LET IT SLIDE.>)
HGTCOH: IDPB CH, TF ;SAVE THE CHAR.
HGTCOL: PUSHJ PP, GETCHR ;GO GET THE NEXT ONE.
CAIN CH, "'" ;IS THAT ALL?
JRST HGTCOT ;YES, GO FINISH UP.
CAIN CH, EOL ;DID HE FORGET THE TERMINATING "'"?
JRST HGTCOP ;YES, GO TELL HIM ABOUT IT.
AOJL TE, HGTCOH ;IF THERE IS ROOM FOR THIS CHAR,
; GO STASH IT.
JUMPG TE, HGTCOL ;NO ROOM, IF WE HAVE ALREADY
; COMPLAINED, DON'T NAG.
WARN% (<TITLE IS TOO LONG - BUT DON'T WORRY, I'LL TRUNCATE IT.>)
JRST HGTCOL
HGTCOP: WARN% (<YOU FORGOT TO TERMINATE THE TITLE WITH "'">)
WARN (<, BUT I'LL LET IT SLIDE.>)
TRNA
HGTCOT: MOVEI CH, " " ;PRETEND THE ' IS A BLANK.
SETZI TE, ;MARK THE END OF THE
IDPB TE, TF ; TITLE.
POPJ PP, ;RETURN.
;ROUTINE TO GET A FILE SPEC.
GFSPEC: HRLZI TD, 'DSK' ;SET UP DEFAULTS.
HRLZI TB, 'HIS'
SETZB TA, TC
PUSHJ PP, GETSIX ;GO GET, AT MOST, SIX CHARS.
CAIE CH, ":" ;IS IT A DEVICE?
JRST GFSPEG ;NO, MUST BE A FILE NAME THEN.
JUMPE TE, [JSP TA, PUTERR ;IF IT'S NULL, COMPLAIN.
ASCIZ /NULL DEVICE IS NOT PERMITTED./]
MOVE TD, TE ;SAVE DEVICE.
PUSHJ PP, BGTSIX ;GO GET THE FILE NAME.
GFSPEG: MOVE TC, TE ;SAVE IT.
CAIE CH, "." ;ARE WE GOING TO HAVE AN EXTENSION?
JRST GFSPEK ;NO, GO ON.
PUSHJ PP, BGTSIX ;GO GET IT.
HLLZ TB, TE ;SAVE IT.
GFSPEK: CAIE CH, "[" ;ARE WE GOING TO HAVE A PPN?
POPJ PP, ;NO, RETURN.
PUSHJ PP, BGHOCT ;GO GET PROJECT NO.
HRLI TA, (TE) ;SAVE IT.
CAIE CH, "," ;DID IT TERMINATE PROPERLY.
JRST [JSP TA, PUTERR ;NO, COMPLAIN.
ASCIZ /MISSING "," IN PPN./]
PUSHJ PP, BGHOCT ;GO GET PROGRAMMER NO.
HRRI TA, (TE) ;SAVE IT.
CAIN CH, "]" ;IF IT TERMINATED WITH "]",
JRST GETCHR ; IGNORE IT.
POPJ PP, ;RETURN.
;ROUTINE TO GET AT MOST SIX CHARS IN TE.
BGTSIX: MOVEI CH, " " ;MAKE THE CURRENT CHAR A BLANK.
PUSHJ PP, SKPBLN ;SKIP ANY LEADING BLANKS.
GETSIX: SETZI TE, ;INITIALIZE.
MOVE TF, [POINT 6,TE]
GETSID: CAIE CH, ":" ;CHECK FOR TERMINATING CHARS.
CAIN CH, "."
POPJ PP,
CAIE CH, "'"
CAIG CH, " "
POPJ PP,
CAIE CH, "["
CAIN CH, "]"
POPJ PP,
CAIG CH, 137 ;MAKE IT SIXBIT.
MOVEI CH, -40(CH)
TRNN TE, 77 ;DO WE HAVE ROOM FOR IT?
IDPB CH, TF ;YES, SAVE IT.
PUSHJ PP, GETCHR ;GO GET THE NEXT ONE.
JRST GETSID ; AND GO CHECK IT OUT.
;ROUTINE TO GET HALF OF AN OCTAL NUMBER RIGHT JUSTIFIED IN TE.
BGHOCT: MOVEI CH, " " ;MAKE THE CURRENT CHAR A BLANK.
PUSHJ PP, SKPBLN ;SKIP ANY LEADING BLANKS.
GHFOCT: SETZI TE,
GHFOCD: CAIL CH, 60 ;IS IT AN OCTAL DIGIT?
CAILE CH, 67
POPJ PP, ;NO, TERMINATE.
LSH TE, 3 ;MULTIPLY BY 8.
TRO TE, -60(CH) ;ADD THIS DIGIT IN.
PUSHJ PP, GETCHR ;GO GET THE NEXT ONE
JRST GHFOCD ; AND GO CHECK IT OUT.
;DATA STORAGE AREA.
HSTIOB: BLOCK 4 ;PLACE FOR NAME.EXT[PPN].
HSTLUB: BLOCK 4 ;FOR LOOKING UP THE FILE.
HSTETB: BLOCK 4 ;FOR ENTERING THE FILE.
HSTTTL: BLOCK <HTTLSZ+5>/5 ;PLACE FOR TITLE.
HFINIT: Z ;NON ZERO IF AN INITIALIZATION OR BEGIN WAS DONE.
HFGTHR: Z ;NON ZERO IF WE ARE GATHERING STATISTICS.
HFTBST: Z ;NON ZERO IF WE HAVE SET UP THE TABLES.
HFGTST: Z ;-1 ==> SET UP INITIAL ITMES.
HSTRPN: Z ;REPORT NUMBER.
HSTACS: BLOCK 20 ;PLACE TO SAVE AC'S.
HSTSJR: Z ;PLACE TO SAVE .JBREL
HSTSJF: Z ;PLACE TO SAVE .JBFF
XWD -4,0 ;ARG BLOCK FOR FUNCT. CALLS.
HSTFFB: Z 2, HSTFFN
Z 2, HSTFEC
Z 2, HSTFST
Z 2, HSTFCH
HSTFFN: Z ;FUNCTION.
HSTFEC: Z ;ERROR CODE.
HSTFST: Z ;STATUS.
HSTFCH: Z ;CHANNEL.
HSTOPN: OPEN HSTOPB ;JUNK FOR THE OPEN.
HSTOPB: Z
HSTDEV: Z
XWD HSTOBF,0
HSTOBF: BLOCK 3
HCURPS: Z ;CURRENT PARAGRAPH/SECTION.
HSTCPU: Z ;HOLDS THE RUNTIME.
HSTELP: Z ;HOLDS THE ELAPSED TIME.
HPSPDL: Z ;HOLDS THE PUSH DOWN POINTER.
HPSPLO: BLOCK HPSPLN ;PUSHDOWN LIST FOR SAVING OLD PARAGRAPH/SECTION
; WHEN WE START A PERFORM OR ENTER A SUBROUTINE.
HOVRHD=.-1 ;PLACE TO ACCUMULATE OVERHEAD TIME.
HOVCPU: Z
HOVELP: Z
HUNATD=.-1 ;PLACE TO SAVE UNACCOUNTABLE TIME.
HUNCPU: Z
HUNELP: Z
HSTPDL: Z ;PLACE TO SAVE THE PUSHDOWN POINTER.
;COME HERE ON SECOND DISPATCH FOR HISTORY COMMANDS.
;SECOND WORD HAS BEEN DECODED IN W2 AS DISPATCH INDEX.
HISDIS: MOVEI W2,0*.JBFF-HISCOM(W2) ;HACK TO MAKE MACRO 52 WORK
JRST @HISDTB(W2) ;DISPATCH
HISERR: ERR ("INITIALIZE/BEGIN/END/REPORT REQUIRED")
;HISTORY COMMANDS
HISCOM: SIXBIT /INITIA/
SIXBIT /BEGIN/
SIXBIT /END/
SIXBIT /REPORT/
HISLEN==.-HISCOM
;HISTORY COMMAND DISPATCH TABLE
HISDTB: HISINI
HISSTA
HISSTO
HISREP
;PRINT A SIXBIT WORD
;WORD IS IN TA, USES TB.
;ENTERED WITH PUSHJ PP,SIXSIX
SIXSIX: MOVEI TB,0
LSHC TB,6
ADDI TB,40
TTCALL 1,TB
JUMPN TA,SIXSIX
POPJ PP,
;COME HERE ON SECOND DISPATCH FOR DDT COMMAND.
GODDT:
IFE TOPS20,<
SKIPE .JBDDT ;IS DDT LOADED?
JRST GODDT1 ;YES
>
IFN TOPS20,<
MOVE 1,[400000,,770] ;[26]IS PAGE ACCESSIBLE?
RPACS
AND 2,[EXP RDACC!EXCACC!PGXSTS] ;[26]
CAME 2,[EXP RDACC!EXCACC!PGXSTS] ;[26]
JRST GODDT0 ;[26]NO
MOVE 1,770000 ;[26]DOES IT CONTAIN DDT?
CAME 1,[JRST 770002] ;[26]PROBABLY, IF EQUAL.
>
GODDT0: ERR "DDT NOT ACCESSIBLE" ;[26]
GODDT1: OUTSTR [ASCIZ /RETURN FROM DDT BY TYPING "POPJ 17,$X"
/] ;[26]
IFE TOPS20,<
HRRZ TA,.JBDDT ;[26]GET DDT ENTRY POINT
PUSHJ PP,(TA) ;[26]
>
IFN TOPS20,<
PUSHJ PP,770000 ;[26]
>
JRST XECUTX ;[26]
;COME HERE ON SECOND DISPATCH FOR LOCATE COMMAND
LOCTYP: TSWT PRNMFG ;[26]WERE WE GIVEN A PROC NAME?
JRST LCTYP0 ;[26]NO, DATA NAME.
HRRZ TA,1(W2) ;[26]YES, GET OBJECT ADDRESS OUT OF PROTAB.
JRST LCTYP1 ;[26]PRINT IT
LCTYP0: MOVEI W1,BASEA ;[26]SET UP 'A' OPERAND
PUSHJ PP,SETOPN ;[26]RESOLVE ADDRESSING.
HRRZ TA,BASEA ;[26]GET BASE ADDRESS
ADD TA,INCRA ;[26]ADD ANY SUBSCRIPT INCREMENT
HLRZ TB,RESA ;[26]GET BIT RESIDUE
SKIPN TB ;[26]BIT 0?
AOJA TA,LCTYP1 ;[26]YES, NEXT WORD ADDRESS
CAIN TB,^D36 ;[26]IS IT 0?
JRST LCTYP1 ;[26]YES
MOVEI TE,^D36 ;[26]CONVERT RESIDUE TO BIT NUMBER
SUB TE,TB ;[26]
OUTSTR [ASCIZ /BIT DISPLACEMENT = /]
PUSHJ PP,PRNUM ;[26]PRINT IT
OUTSTR CRLF ;[26]
LCTYP1: MOVEI TC,6 ;[26]ALWAYS 6 OCTAL DIGITS
LSH TA,^D18 ;[26]
LCTYP2: SETZM TB ;[26]
LSHC TB,3 ;[26]ISOLATE OCTAL DIGIT
ADDI TB,60 ;[26]MAKE ASCII
TTCALL 1,TB ;[26]
SOJG TC,LCTYP2 ;[26]MORE?
JRST XECUTX ;[26]
;COME HERE ON SECOND DISPATCH FOR GO COMMAND
;DESTINATION'S PROTAB ADDRESS IS IN W2.
GOXXX: SKIPE DIED. ;[26]ARE WE ALIVE?
JRST [OUTSTR [ASCIZ /?CANNOT GO!/]
JRST XECUTX] ;[26]DEAD
SKIPE REEFLG ;[26]NEED TO RESET STACK?
JRST [MOVE PP,REEFLG
POP PP,0(PP)
SETZM REEFLG
JRST GOXXX4] ;[26]YES
SKIPE EBRKOV ;[26]OVERLAY BREAK?
JRST [OUTSTR [ASCIZ /MODULE/]
JRST GOXXX2] ;[26]YES
SKIPE CUR.BP ;[26]PROGRAM STARTED?
JRST GOXXX4 ;[26]YES
OUTSTR [ASCIZ /PROGRAM/] ;[26]NO
GOXXX2: OUTSTR [ASCIZ / NOT STARTED, DO STEP, THEN GO/]
JRST XECUTX ;[26]
GOXXX4: HRRZ TA,1(W2) ;[26]GET DESTINATION
MOVE TE,0(TA) ;[26]GET INSTRUCTION
CAME TE,[PUSHJ PP,C.TRCE] ;[26]IS IT TRACE INSTRUCTION?
JRST GOXXX6 ;[26]NO
HRRZ TE,1(TA) ;[26]GET PROTAB LINK
ADD TE,@%PR ;[26]MAKE ADDRESS
CAME TE,W2 ;[26]SAME ADDRESS?
JRST GOXXX6 ;[26]NO
PUSHJ PP,INSRTB ;[26]SET ANY BREAKPOINTS THAT NEED IT.
HRRZ TA,1(W2) ;[26]REFETCH DESTINATION
JRST 0(TA) ;[26]GO
GOXXX6: OUTSTR [ASCIZ /LOCATION IS NOT RESIDENT/]
JRST XECUTX ;[26]
;THIS IS ENTRANCE TO DIALOGUE MODE
;THIS CODE READS AND PARSES THE COMMAND PORTION OF A COMMAND LINE.
;THE COMMAND IS DECODED AND PLACED IN W1 AS AN INDEX ON THE DISPATCH TABLE.
DECOD: TTCALL 3,CRLF
DECOD0: TTCALL 1,[EXP "*"] ;PROMPT USER
MOVEI SW,0 ;CLEAR SWITCHES. RH(SW)=CHAR-POSITION
PUSHJ PP,GETCHR ;CH ALWAYS HOLDS THE NEXT CHAR.
CAIN CH,12 ;SKIP LEADING LF'S
JRST .-2
PUSHJ PP,GATOM ;GET COMMAND WORD IN C(TE-TA) IN SIXBIT
JUMPN TE,DECOD1 ;ATOM FOUND?
;NOTHING WAS TYPED, IS ANYTHING THERE?
PUSHJ PP,EOLCHK ;CHECK EOL
;HERE IF LINE EMPTY, HANDLE ESC.
JRST [TSWT ALTFLG
JRST DECOD0
JRST DECOD]
AOJA SW,ERR0("LINE TERMINATION ERROR")
DECOD1: MOVE W1,[-COMLEN,,COMTAB] ;USE COMMAND TABLE
PUSHJ PP,GETCOM ;GET LOC OF ENTRY WHOSE INIT. SEG IS C(TE)
JUMPG W1,ERR0('ILLEGAL COMMAND') ;FOUND?
;GET INDEX ONLY
MOVEI W1,0*.JBFF-COMTAB(W1) ;HACK TO MAKE MACRO 52 WORK
;NOW DISPATCH TO HANDLE THE REST OF THE COMMAND DECODING.
;IF THERE IS MORE ON THE COMMAND LINE, IT IS ENCODED IN W2. A REFERENCE
;TO A DATA ITEM (ACCEPT, DISPLAY ...) IS SCANNED, PARSED, AND A LOOK-UP
;IS DONE IN THE CURRENT NAMTAB TO FIND THE CORRECT DATAB ENTRY. THE
;DATAB ADDRESS IS PLACED IN W2. A REFERENCE TO A PROCEDURE NAME
;(BREAK, CLEAR ...) IS SCANNED, PARSED, AND A LOOK-UP IN THE CURRENT
;NAMTAB IS DONE TO FIND THE CORRECT PROTAB ENTRY. THE PROTAB ADDRESS
;IS PLACED IN W2.
;THE KEYWORD 'ON' IS ENCODED IN W2 AS -1, THE KEYWORD 'OFF' AS 0.
;A PROCEED COUNT OR STEP COUNT IS PLACED IN W2.
;A SECOND DISPATCH WILL BE DONE TO HANDLE THE COMMAND EXECUTION.
HRRZ TA,COMDIS(W1)
JRST 0(TA) ;DISPATCH
;RETURN FROM FIRST DISPATCH COMES HERE (UNLESS ERROR).
DECODX: PUSHJ PP,EOLCHK ;DID WE GET ALL OF THE COMMAND?
XECUT: SKIPA PP,PDL. ;HERE IF LINE EMPTY
AOJA SW,ERR0("LINE TERMINATION ERROR")
;COMMAND EXECUTION SECTION.
;ENTERED WITH W1 POINTING AT DISPATCH TABLE ENTRY, AND W2 HOLDING
;A DATAB OR PROTAB ADDRESS, OR SWITCH VALUE, OR DISPATCH CODE, ETC.
MOVE DT,W2
HLRZ W1,COMDIS(W1) ;GET SECOND DISPATCH ADDRESS
CAIE W1,ACCGEN ;CHECK FOR CODE GENERATORS
CAIN W1,DISPGN
SKIPA TE,[XWD CODFST,CODFST+1] ;YES,
JRST 0(W1) ;NO, DISPATCH FOR ALL BUT ACCEPT/DISPLAY
;ACCEPT/DISPLAY CODE INIT AND EXECUTION
SETZM TEMPC
SETZM EAC
SETZM TEMROL
BLT TE,CODLST
MOVE LIT,[IOWD N.LIT,LITROL]
MOVE COD,[IOWD N.COD,CODROL]
;IF DT = 0, NO NAME WAS GIVEN WITH COMMAND, USE SAVED NAME.
JUMPE DT,[MOVE DT,LAST. ;GET LAST NAME
JUMPE DT,NOLAST ;WAS THERE ONE?
MOVE TE,[XWD SAVSUB,NSUBS] ;YES, GET SUBS TOO
BLT TE,NSUBS+3
JRST .+1]
MOVEM DT,LAST. ;SAVE FOR NEXT TIME
MOVS TE,[XWD SAVSUB,NSUBS] ;SAVE SUBS TOO
BLT TE,SAVSUB+3
PUSHJ PP,0(W1) ;DISPATCH TO ACCEPT OR DISPLAY
;THE ACCEPT OR DISPLAY CODE GENERATORS LOAD EXECUTABLE INSRUCTIONS
;INTO THE CODROL BLOCK AND THEN RETURN HERE.
PUSH COD,CPOPJ ;ADD A POPJ RETURN TO THE EXECUTABLE INSTRUCS
PUSHJ PP,CODROL ;CALL CODE
;RETURN FROM THE SECOND DISPATCH COMES HERE.
XECUTX: SETZB SW,NSUBS ;CLEAR FLAGS & INIT PARSE
MOVE PP,PDL. ;RESTORE PUSH-DOWN-LIST
JRST DECOD ;*** PARSE
;ROUTINES ENTERED BY FIRST DISPATCH FROM COMMAND TABLE.
;THESE ROUTINES COMPLETE THE DECODING OF THE COMMAND (GENERALLY).
;COME HERE ON FIRST DISPATCH FOR LOCATE COMMAND.
;SET SWITCH, THEN SHARE CODE FOR ACCEPT/DISPLAY.
LOC.: SWON LOCFLG ;[26]
SWOFF CLRFLG!PRNMFG!GOFLG ;[26]CLEAR OTHER FLAGS
JRST ACC1 ;[26]
;COME HERE ON FIRST DISPATCH FOR GO COMMAND.
;SET SWITCHES, THEN SHARE CODE FOR BREAK/CLEAR.
GO.: SWON GOFLG!PRNMFG ;[26]SET SWITCHES
SWOFF CLRFLG!LOCFLG ;[26]CLEAR SWITCHES
JRST ACC1 ;[26]
;COME HERE ON FIRST DISPATCH FOR CLEAR AND BREAK COMMANDS.
;SET SWITCHES, THEN SHARE CODE WITH ACCEPT/DISPLAY.
CLR.: SWON CLRFLG ;CLEAR COMMAND
BRK.: SWON PRNMFG ;[26]LOOKING FOR PROCEDURE NAME
SWOFF LOCFLG!GOFLG ;[26]NOT LOCATE OR GO
JRST ACC1 ;[26]
;COME HERE ON FIRST DISPATCH FOR ACCEPT AND DISPLAY COMMANDS.
DIS.:
ACC.: SWOFF LOCFLG!GOFLG!CLRFLG!PRNMFG ;[26]RESET FLAGS
ACC1: SKIPN @%NM ;[26]DO WE HAVE A NAMTAB?
ERR "NO SYMBOLS FOR THIS MODULE" ;[26]NO
PUSHJ PP,GATOM ;[26]GET NAME
;HAVE TO TREAT 'TALLY' SPECIAL IF COBOL-68.
SKIPE C74FLG ;COBOL-74?
JRST ACC.0 ;YES, NOTHING SPECIAL
CAMN TE,[SIXBIT 'TALLY']
JRST DOTAL ;TREAT TALLY SPECIALLY
; SEE IF CAN FIND NAME IN NAMTAB.
;IF THE NAME CAN BE FOUND IN NAMTAB, WE WILL BUILD A STACK OF
;NAMTAB ADDRESSES FOR THE NAME AND ITS QUALIFIERS. TOP-OF-STACK WILL
;HAVE HIGHEST LEVEL QUALIFIER. A PARANTHESIZED SUBSCRIPT EXPRESSION
;IS ACCEPTED ANYWHERE IN THE LIST OF QUALIFIERS.
;THE SUBSCRIPTS ARE RESTRICTED TO INTEGER VALUES, AND ARE STORED
;AWAY, UP TO 3 OF THEM, IN THEIR OWN LIST.
;THIS IS A SYNTAX SCAN ONLY. THE LOOK UP IN DATAB OR PROTAB COMES LATER.
;AND THE ACTUAL CALCULATON OF OBJECT ADDRESS COMES MUCH LATER.
ACC.0: JUMPE TE,CKCLR ;JUMP IF THERE WAS NO NAME AT ALL
PUSHJ PP,GETNAM ;RETURNS WITH NAMTAB ADDR IN TF
JUMPE TF,ACCEP2 ;SYMBOL NOT IN TABLE?
PUSH PP,[OCT -1] ;MARK BOTTOM OF STACK WITH -1
PUSH PP,TF ;PUSH NAMTAB ADDRESS ON STACK
;LOCATE COMMAND SETS PRNMFG IF FIRST NAME IS A PROCEDURE NAME.
TSWT LOCFLG ;[26]LOCATE COMMAND?
JRST DIS2 ;[26]NO
;[26]SEE WHICH TABLE (DATAB/PROTAB)
HRRZ TF,(TF) ;[26]GET LINK TO TABLE
TRC TF,DTTYPE ;[26]TEST TABLE TYPE BITS
TRNE TF,TYPMSK ;[26]
SWON PRNMFG ;[26]THIS IS LOCATE OF PROC NAME
DIS2: PUSHJ PP,SKPBLN ;GET NEXT NON-BLANK CHAR
CAIE CH,"(" ;LOOK FOR SUBSCRIPTS
JRST MOREDN ;NO SUBSCRIPTS
SKIPE NSUBS ;SKIP IF FIRST OCCURANCE OF SUBSCRIPTS
AOJA SW,ERR0("SUBSCRIPT ERROR")
;LOOP FOR THE SUBSCRIPTS.
DIS3: PUSHJ PP,GETCHR ;SKIP PAST "(" OR ","
PUSHJ PP,GETNUM ;GET A NUMBER
;;; JUMPLE W2,ERR0("SUBSCRIPT ERROR") ;[24](DELETED)
AOS TA,NSUBS
CAILE TA,3 ;CHECK MAX ALLOWABLE
ERR "ONLY 3 SUBSCRIPTS ALLOWED"
MOVEM W2,SUB0.-1(TA) ;STASH AWAY
PUSHJ PP,SKPBLN ;GET NEXT NON-BLANK
CAIN CH,"," ;MORE?
JRST DIS3 ;YES: CONTINUE
CAIE CH,")" ;NO: CHECK PROPER DELIM.
AOJA SW,ERR0("IMPROPER SUBSCRIPT DELIMITER")
PUSHJ PP,GETCHR ;OK: SKIP PAST IT
;REVERSE THE ORDER OF THE SUBSCRIPTS
MOVE TB,SUB0. ;GET FIRST SUBSCRIPT
EXCH TB,SUB0.-1(TA) ;EXCHANGE WITH LAST SUBSCRIPT
MOVEM TB,SUB0. ;STORE LAST AS FIRST
;LOOK FOR QUALIFIERS.
MOREDN: PUSHJ PP,GATOM
JUMPE TE,QUAL ;NO MORE QUALIFIERS IF 0
CAME TE,[SIXBIT /IN/]
CAMN TE,[SIXBIT /OF/]
JRST INOF
AOJA SW,ERR0("IN/OF MISSING")
INOF: PUSHJ PP,GATOM ;GET NAME
JUMPE TE,ERR0("MISSING QUALIFIER")
PUSHJ PP,GETNAM
JUMPE TF,ACCEP2 ;SYMBOL NOT IN TABLE
PUSH PP,TF ;PUSH PTR TO SYMBOL TABLE HDR FOR DATA-NAME
JRST DIS2 ;YES. CHECK FOR MORE DATA-NAMES
;NO NAME GIVEN AFTER COMMAND. THAT'S OK, UNLESS
;IT'S A BREAK, GO, OR LOCATE COMMAND.
CKCLR: TSWT GOFLG ;[26]GO COMMAND?
TSWF LOCFLG ;[26]LOCATE COMMAND?
ERR "MISSING NAME" ;[26]
TSWT CLRFLG ;SKIP IF CLEAR COMMAND
TSWT PRNMFG ;SKIP IF BREAK
TDZA W2,W2 ;ZERO W2 AND SKIP
ERR "MISSING PROCEDURE-NAME"
SWOFF CLRFLG!PRNMFG
JRST DECODX
ACCEP2: ERR "UNDEFINED NAME" ;[26]
;SEARCH FOR (QUALIFIED) NAME.
;PP LOCATES STACK OF POINTERS TO NAMES IN NAMTAB,
;WITH HIGHEST LEVEL QUALIFIER ON TOP OF STACK, AND -1 MARKING BOTTOM.
QUAL: SWOFF NUQFLG ;CLEAR NON-UNIQUE FLAG
SETZI W2, ;CLEAR W2 INDICATING NO SUCCES YET
;GO DOWN THE STACK TO LOWEST LEVEL ENTRY.
HRRZ TB,PP
SKIPL -1(TB)
SOJA TB,.-1
;RH(TB) POINTS AT FIRST NAMPTR ON STACK
HRRZ TA,(TB) ;GET NAMTAB ADDRESS
;USE RH OF TB TO POINT TO THE STACK OF PNTRS TO THE NAMTAB.
;USE TA AS A WORKING REGISTER TO SEARCH THE LINKED LIST OF
;DATAB OR PROTAB ENTRIES THAT HAVE THE SAME NAME.
;MAKE LH OF TB POINT AT DATAB ENTRY FOR FIRST SPECIFIED NAME
QUAL2: SWON FQFLAG ;SET CURRENT SEARCH IS FULLY-QUAL. FLAG
HRRZ TA,(TA) ;LOAD LINK TO NEXT DATAB OR PROTAB
; ENTRY OF SAME NAME
TRC TA,DTTYPE ;WHICH TABLE DOES IT POINT AT?
TRNE TA,TYPMSK
JRST QUAL21 ;PRTAB
ADD TA,@%DT ;DATAB. ADD BASE ADDRESS
TSWF PRNMFG ;LOOKING FOR DATAB ENTRY?
JRST QUAL2 ;NO. KEEP SEARCHING
JRST QUAL22 ;YES. CARRY ON
;NOT A DATAB ENTRY
QUAL21: TRC TA,DTTYPE+PRTYPE
TRNE TA,TYPMSK ;CHECK FOR PRTAB
JRST QUAL6 ;NO MORE ENTRIES
ADD TA,@%PR ;ADD OFFSET
;GOT THE TABLE ADDRESS, SAVE IN LH OF TB
QUAL22: HRL TB,TA ;SAVE DATAB ADDRESS
HRRZ TA,TB ;TA POINTS AT NAM PTRS IN STACK
HLRZ TD,TB ;TD POINTS AT DATAB
;WE HAVE A DATAB ENTRY (MAYBE NOT THE ONLY ONE) THAT HAS THE
;RIGHT NAME. ARE THERE MORE QUALIFIERS OF THIS ENTRY?
QUAL3: CAIGE TA,(PP) ;THROUGH NAME PTRS IN STACK?
AOJA TA,QUAL5 ;NO. MAKE TA POINT AT NEXT NAME PTR
HRRZ TE,PRFLGS(TD) ;SUCCESSFUL MATCH. FULLY QUALIFIED?
;WE CAN TELL BY LOOKING AT THE FATHER LINK
;OF DATAB ENTRY OR PAR/SECT FLAG OF
;PROTAB ENTRY.
ANDI TE,PRLINK ;[26](TE)=0 IF SECTION-NAME
TSWT PRNMFG ;IS THIS PROTAB ENTRY?
HLRZ TE,DTSON(TD) ;DATAB ENTRY. LOAD FATHER LINK
TSWF FQFLAG
JUMPE TE,[HLRZ W2,TB ;JUMP IF AT LEVEL 01 OR SECT NAME
JRST DECODX]
SKIPE W2 ;NOT FULLY QUALIFIED
SWON NUQFLG ;NOT UNIQUE. SET FLAG
HLRZ W2,TB ;SAVE PTR TO FIRST MATCH
QUAL4: HLRZ TA,TB ;GET READY TO UPDATE LH(TB)
JRST QUAL2 ;GET LINK TO PROPER TYPE ENTRY
QUAL5: TSWF PRNMFG
JRST [LDB TD,SECNAM ;LOOK TO SEE IF SECT. NAM. MATCHES ((TA))
ADD TD,@%PR
JRST QUAL52 ]
QUAL51: MOVE TE,DTFLAG(TD) ;LOAD FLAG WORD
HLRZ TD,DTSON(TD) ;GET FATHER/BROTHER LINK
JUMPE TD,QUAL4 ;JUMP IF NO FATHER
TRZ TD,TYPMSK ;CLEAR TYPE BIT
ADD TD,@%DT ;ADD OFFSET
TLNN TE,DTLINK ;IS THIS ENTRY LINKED TO FATHER
JRST QUAL51 ;NO. GO TO BROTHER
QUAL52: LDB TE,NMLINK ;DOES ANTECEDENT HAVE SAME NAME AS ((TA))?
ADD TE,@%NM ;ADD NAMTAB OFFSET
HRRZ TF,(TA) ;GET NAMTAB PTR OUT OF PDL
CAIN TF,(TE)
JRST QUAL3 ;NAME MATCHES. LOOK FOR FURTHER QUALIFIER
SWOFF FQFLAG ;NAME DIFFERS. CLEAR NOT FULLY QUAL. FLAG
TSWF PRNMFG ;DATAB OR PROTAB?
JRST QUAL4 ;PROTAB - CAN'T HAVE A FATHER.
LDB TE,[POINT 6,DTLVL(TD),5] ;[17] GET THE LEVEL NUMBER
SOJE TE,QUAL4 ;IF IT'S "1", THIS ISN'T THE ONE WE WANT.
JRST QUAL51 ;GO LOOK AT HIGHER LEVEL QUALIFIERS.
;THERE WERE NO MORE TABLE ENTRIES THAT SHARED THE SAME NAME.
;WAS ONLY ONE FOUND?
QUAL6: TSWF NUQFLG
ERR "NOT UNIQUELY QUALIFIED"
JUMPN W2,DECODX ;OK IF EXACTLY ONE FOUND
ERR "NOT DEFINED"
;COME HERE ON FIRST DISPATCH FOR PROCEED OR STEP COMMANDS
;GET THE PROCEED COUNT OR DEFAULT IT TO 1.
STP.:
PRO.: MOVEI W2,1
PUSHJ PP,EOLCHK
JRST XECUT ;HERE IF LINE EMPTY
PUSHJ PP,GETNUM ;GET PROCEED COUNT
JUMPLE W2,ERR0("ERROR IN COUNT")
JRST DECODX
;COME HERE ON FIRST DISPATCH FOR OVERLAY AND TRACE COMMANDS
;DECODE THE NEXT WORD: 'ON'=-1, 'OFF'=0. STORE IN W2.
;IF NEXT WORD IS 'BACK', USE LIBOL'S PRINT ROUTINE, THEN
;RETURN DIRECTLY TO XECUTX, BYPASSING THE SECOND DISPATCH FOR TRACE.
OVR.: PUSHJ PP,ONOFF ;[26]TEST NEXT WORD
JUMPLE W2,DECODX ;[26]
ERR ("ON/OFF REQUIRED") ;[26]
TRC.: PUSHJ PP,ONOFF ;[26]TEST NEXT WORD
JUMPLE W2,DECODX ;[26]OK
CAME TE,[SIXBIT /BACK/] ;[26]
ERR ("ON/OFF/BACK REQUIRED") ;[26]
PUSHJ PP,PPOT4. ;[26]USE LIBOL'S ROUTINE
JRST XECUTX ;[26]SKIP 2ND DISPATCH
;ONOFF ROUTINE RETURNS -1 OR 0 FOR "ON" AND "OFF",RESPECTIVELY.
;RETURNS +1 FOR ANYTHING ELSE.
ONOFF: PUSHJ PP,GATOM ;[26]GET WORD
SETZ W2,
CAMN TE,[SIXBIT /ON/]
SOJA W2,ONOFF9
CAME TE,[SIXBIT /OFF/]
AOJ W2, ;[26]NOT FOUND
ONOFF9: POPJ PP, ;[26]
;COME HERE ON FIRST DISPATCH FOR 'NEXT' COMMAND.
;GET A COUNT OR DEFAULT IT TO 1.
;SUM THE COUNT INTO THE LEAST SUBSCRIPT VALUE.
NEX.: MOVEI W2,1 ;[24]DEFAULT
PUSHJ PP,EOLCHK ;[24]CHECK FOR END OF LINE
JRST NEXT1 ;[24]HERE IF LINE EMPTY
PUSHJ PP,GETNUM ;[24]GET THE NUMBER IN W2
NEXT1: SKIPN SAVSUB ;[24]ANY SUBSCRIPTS ON LAST REFERENCE?
ERR ("PREVIOUS NAME NOT SUBSCRIPTED") ;[24]
;CAREFUL!! SUBSCRIPTS HAVE BEEN
;STORED IN REVERSE ORDER
SKIPN @%NM ;[26]DO WE HAVE A NAMTAB?
ERR "NO SYMBOLS FOR THIS MODULE" ;[26]NO
ADDM W2,SAVSUB+1 ;[24]INCR/DECR LEAST SUBSCRIPT
SETZM W2 ;[24]SHOW NO NEW NAME TO DISPLAY.
JRST DECODX ;[24]
;COME HERE ON FIRST DISPATCH FOR MODULE COMMAND
;IF A PROGRAM NAME IS SUPPLIED, SWITCH DATAB,PROTAB,NAMTAB TO THAT
;MODULE'S TABLES. IF NO PROGRAM NAME IS SUPPLIED, TELL THE USER
;WHAT THE CURRENT MODULE IS AND WHAT MODULES ARE IN MEMORY.
MOD.: PUSHJ PP,GATOM ;GET PROGRAM NAME.
MOVE NM,ETYPTS ;GET POINTER TO TABLE OF MAIN
; ENTRY POINT ADDRESSES.
JUMPE TE,MODG ;[26]IF HE WANTS TO SEE WHAT MODULES
; ARE IN CORE, GO TELL HIM.
MODD: SKIPE TG,(NM) ;IS THERE ONE THERE? (THEY MAY
; DISAPPEAR, IF THEY ARE IN
; LINK-10 OVERLAYS.)
CAME TE,-1(TG) ;YES, IS THIS THE ONE?
AOBJN NM,MODD ;NO, IF THERE ARE MORE, GO LOOK AT THEM.
JUMPGE NM,ERR0 ("PROGRAM NOT LOADED")
HRRZM TG,CUREPA ;[26]SAVE AS CURRENT ENTRY PT
HRRZ TF,1(TG) ;GET ADDRESS OF %FILES FOR THE
; SPECIFIED MODULE.
HRRZ TA,%%NM.(TF) ;[26]GET ADDR OF SYMBOL TABLE ADDRESSES
JUMPE TA,MODF ;[26]CHECK IT
PUSHJ PP,GTTABS ;[26]GET TABLE ADDRESSES
JRST DECODX ;RETURN.
MODF: OUTSTR [ASCIZ /NO SYMBOLS FOR THAT MODULE/] ;[26]
MODG: PUSHJ PP,MODH ;[26]
JRST DECODX ;[26]
;SUBROUTINE TO SHOW WHAT MODULES ARE IN MEMORY
MODH: OUTSTR [ASCIZ /
CURRENT MODULE: /]
MOVE TA,CUREPA ;GET ENTRY POINT ADDRESS
PUSHJ PP,PRTMNM
SKIPE SUBSPR ;[26]ANY OTHERS?
JRST MODJ ;[26]NO
HRRZ TA,1(TA) ;[26]GET ADDR OF %FILES
HRRZ TA,%%NM.(TA) ;[26]GET NAMTAB BASE
JUMPN TA,MODX ;[26]DO WE HAVE ONE?
OUTSTR [ASCIZ / (NO SYMBOLS)/] ;[26]NO
JRST MODX ;[26]
MODJ: OUTSTR [ASCIZ /
MODULES CURRENTLY IN CORE:/]
MOVE NM,ETYPTS ;[26]GET ENTRY PTS TABLE
MODL: SKIPN TA,(NM) ;IS IT THERE?
AOBJN NM,MODL ;NO, ARE THERE MORE?
JUMPGE NM,MODX ;[26]ALL DONE?
OUTSTR CRLF
PUSHJ PP,PRTMNM
HRRZ TA,(NM) ;[26]GET ENTRY PT AGAIN
HRRZ TA,1(TA) ;[26]GET ADDR OF %FILES
HRRZ TA,%%NM.(TA) ;[26]GET ADDR OF NAMTAB
JUMPN TA,MODM ;[26]IS IT THERE?
OUTSTR [ASCIZ / (NO SYMBOLS)/] ;[26]
MODM: AOBJN NM,MODL ;ANY MORE?
MODX: POPJ PP, ;[26]NO
;COME HERE ON FIRST DISPATCH FOR HISTORY COMMAND
;DECODE SECOND WORD OF COMMAND INTO W2.
HIS.: PUSHJ PP,GATOM ;GET SECOND WORD OF COMMAND
JUMPE TE,ERR0("HISTORY COMMAND REQUIRES AN ARGUMENT")
MOVE W2,W1 ;SAVE W1
MOVE W1,[-HISLEN,,HISCOM] ;LOOK UP SECOND WORD
PUSHJ PP,GETCOM
JUMPE W1,ERR0("INIT/BEGIN/END/REPORT REQUIRED")
EXCH W1,W2 ;RESTORE W1
JRST XECUT ;[26]COULD STILL BE A FILE SPEC
;ON THE COMMAND LINE. DON'T
;GO BACK TO DECODX
ERR ("HISTORY COMMAND REQUIRES AN ARGUMENT")
;COMMAND DEFINITIONS.
;TWO PARALLEL TABLES ARE BUILT, COMTAB CONTAINS THE COMMANDS, COMDIS
;CONTAINS A PAIR OF DISPATCH ADDRESSES. THE FIRST DISPATCH GOES TO
;CODE THAT COMPLETES THE SYNTAX SCAN OF THE COMMAND LINE. THE SECOND
;DISPATCH GOES TO CODE THAT EXECUTES THE COMMAND. THE TABLES ARE
;IN APPROXIMATE ALPHABETICAL ORDER, BUT THIS IS FOR CONVENIENCE ONLY,
;SINCE A LINEAR SEARCH IS DONE ON THE COMMAND AS TYPED. THE COMMANDS
;CAN BE ABBREVIATED. NEW COMMANDS
;THAT HAVE THE SAME STARTING CHARACTERS MUST BE PLACED AFTER THE
;EXISTING COMMANDS, AND THEIR SHORTEST ALLOWABLE ABBREVIATION
;MUST BE LONG ENOUGH TO FAIL THE COMPARISON WITH THE PREVIOUS
;COMMAND. (EXAMPLE: 'D' IS AN ACCEPTABLE ABBREVIATION FOR 'DISPLAY'.
;'DD' WOULD BE AN ACCEPTABLE ABBREVIATION FOR 'DDT'.
XALL
DEFINE COMMANDS<
XX ACCEPT,ACC.,ACCGEN
XX BREAK,BRK.,SETBRK
XX CLEAR,CLR.,CLRBRK
XX DISPLAY,DIS.,DISPGN
XX DDT,DECODX,GODDT
XX GO,GO.,GOXXX
XX HISTORY,HIS.,HISDIS
XX LOCATE,LOC.,LOCTYP
XX MODULE,MOD.,XECUTX
XX NEXT,NEX.,DISPGN
XX OVERLAY,OVR.,SETOVR
XX PROCEED,PRO.,PROCED
XX STEP,STP.,STEP
XX STOP,DECODX,STOPR
XX TRACE,TRC.,SETTRC
XX WHERE,DECODX,WHERE
>
;COMMAND TABLE, ONE WORD ENTRIES, CONTAINING THE FIRST SIX
;CHARACTERS OF THE COMMAND.
DEFINE XX(A,B,C)< <SIXBIT /A/>>
COMTAB: COMMANDS
COMLEN==.-COMTAB
;COMMAND DISPATCH TABLE, ONE WORD ENTRIES, CONTAINING TWO ADDRESSES.
;RIGHT HALF IS FIRST DISPATCH ADDRESS, LEFT HALF IS SECOND DISPATCH ADDRESS.
DEFINE XX(A,B,C)< C,,B>
COMDIS: COMMANDS
SALL
;GETCOM RETURNS THE LOCATION IN W1 OF THE SIXBIT WORD,
; WHOSE (UNIQUE) INITIAL SEGMENT IS IN C(TE), FROM THE
; TABLE OF SIXBIT WORDS POINTED AT BY (W1).
; RETURNS W1 POSITIVE IF NOT FOUND.
GETCOM: SETOI TD, ;FIND MASK FOR TRAILING BLANKS
LSH TD,-6
TDNE TE,TD
JRST .-2
GETCM2: MOVE TB,(W1) ;GET TABLE ENTRY
ANDCM TB,TD ;AND MASK IT TO SAME LENGTH
CAMN TB,TE
POPJ PP, ;FOUND IT
AOBJN W1,GETCM2 ;LOOP
POPJ PP, ;NOT IN TABLE
;SKPBLN SKIPS THE BLANKS AND TABS AND PUTS THE NEXT NON-BLANK/TAB
; CHARACTER IN CH. SETS BLNFLG SWITCH IF AT LEAST ONE BLANK
; OR TAB IS FOUND
SKPBL2: SWONS BLNFLG ;BLANK/TAB SEEN. SET FLAG
SKPBLN: SWOFFS BLNFLG ;CLEAR BLANK/TAB SEEN FLAG
PUSHJ PP,GETCHR ;GET NEXT CHAR. FROM BUFFER
CAIE CH," "
CAIN CH," "
JRST SKPBL2
POPJ PP, ;RETURN N0N-BLANK/TAB CHAR. IN CH.
;GETCHR PUTS NEXT CHAR. IN CH. INCREMENTS CHAR
;POSITION COUNTER. NULLS AND CR'S ARE BYPASSED.
;LOWER CASE ALPHABETICS ARE CONVERTED TO UPPERCASE.
;VT AND FF ARE CONVERTED TO LF
GETCHR: TTCALL 4,CH ;GET NEXT CHARACTER INTO CH
JUMPE CH,GETCHR ;SKIP NULLS
CAIN CH,15 ;SKIP CARR RET'S
JRST GETCHR
CAIL CH,141 ;[20] LOWER CASE "A"
CAILE CH,202 ;[20] LOWER CASE "Z"
CAIA ;[20] NOT LOWER CASE
SUBI CH,40 ;[20] LOWER CASE, CONVERT TO UPPER CASE
CAIE CH,13 ;CONVRT VT & FF TO LF
CAIN CH,14
MOVEI CH,12
CAIE CH,12 ;LF ?
AOSA SW ;NO, SO INCREMENT CHAR COUNT
POPJ PP,
CAIN CH," " ;CHECK FOR TAB
ORI SW,7 ;TAB SEEN. FIX UP POSITION CTR
POPJ PP,
;EOLCHK SKIPS INITIAL BLANKS/TABS AND GIVES SKIP RETURN
; IF NEXT CHAR. IS NOT A LF OR AN ALTMODE (33,175,176).
; SETS ALTFLG AND ECHOS 3 BLANKS IF ALTMODE FOUND.
EOLCHK: PUSHJ PP,SKPBLN ;SKIP BLANKS ETC.
CAIN CH,12 ;LF ?
POPJ PP,
CAIE CH,33 ;ESC?
CAIN CH,175 ;ANY FLAVOR OF ESC WILL DO
JRST EOLCH2
CAIN CH,176
JRST EOLCH2
AOS 0(PP) ;SKIP RETURN
POPJ PP,
EOLCH2: SWON ALTFLG ;SET ALT-MODE SEEN
TTCALL 3,[ASCIZ " "]
POPJ PP,
;GATOM GETS A STRING OF COBOL CHARACTERS THROUGH
;THE NEXT NON-ALPHA-NUMERIC-(- AND .) AND RETURNS THEM
;PACKED INTO SIXBIT IN (TE-TA). DASHES ARE
;CONVERTED TO COLONS. SCAN OFF, BUT IGNORE CHARACTERS
;IN EXCESS OF 30.
;C(TE) CAN BE TESTED (=0 ?) TO SEE IF STRING IS EMPTY.
GATOM: PUSHJ PP,SKPBLN ;SCAN TO NON-BLANK
SETZB TA,TB ;ZERO THE RETURN VALUES
SETZB TC,TD
SETZI TE,
MOVE TF,[POINT 6,TE]
;LOOP FOR EACH CHARACTER
GATOM3: CAIN CH,"-"
MOVEI CH,":"
CAIL CH,"0" ;TEST FOR ALPH-NUMERICS
CAILE CH,"Z"
POPJ PP, ;OUT OF SIGHT
CAILE CH,":"
CAIL CH,"A"
JRST GATOM4 ;LEGAL CHAR.
POPJ PP, ;NOT LEGAL CHAR.
GATOM4: ADDI CH,40 ;CONVERT ASCII TO SIXBIT
CAME TF,[POINT 6,TA,35] ;IGNORE CHARS. IN EXCEES OF 30
IDPB CH,TF ;DEPOSIT CHAR. IN C(TE-TA)
PUSHJ PP,GETCHR
JRST GATOM3
;GETNUM INTERPRETS THE NEXT NON-BLANK CHARS. AS
;A (POSSIBLY) SIGNED INTEGER AND RETURNS ITS VALUE IN W2.
GETNUM: SETZB W2,SIGNSW ;[24]
PUSHJ PP,SKPBLN ;SKIP INITIAL BLANK/TABS IF ANY
CAIE CH,"-" ;[24]NEGATIVE?
JRST GETNU1 ;[24]NO
SETOM SIGNSW ;[24]REMEMBER NEGATIVE SIGN
JRST GETNU2 ;[24]
GETNU1: CAIN CH,"+" ;[24]POSITIVE?
GETNU2: PUSHJ PP,GETCHR ;[24]YES, GET NEXT CHAR.
CAIL CH,"0"
CAILE CH,"9"
JRST GETNU4 ;[24]NON-NUMERIC. DONE.
IMULI W2,^D10
ADDI W2,-60(CH) ;CONVERT ASCII TO AN INTEGER AND ADD
JRST GETNU2
GETNU4: SKIPE SIGNSW ;[24]DID WE SEE "-"?
MOVN W2,W2 ;[24]YEP
POPJ PP, ;[24]RETURN
;GETNAM SEARCHES NAMTAB FOR AN ENTRY THE SAME AS C(TE-TA).
;RETURNS POINTER TO ENTRY IN TF. OTHERWISE RETURN
;PTR TO ENTRY IF C(TE-TA) IS INITIAL SEGMENT OF ONLY
;THAT ENTRY (PRINTS ERROR MESSAGE IF TWO SUCH ENTRIES).
;FAILING ALL THAT RETURN 0.
GETNAM: SKIPN @%DT ;[26]ARE SYMBOLS AVAILABLE?
ERR "NO SYMBOLS"
SWOFF NUIFLG ;CLEAR NOT UNIQUE INITIAL SEGMENT FLAG
MOVEI W2,5 ;MAKE (TH)=# FULL WORDS IN (TE-TA)
SETOI TI,
SKIPN TJ,TE-1(W2)
SOJA W2,.-1
LSH TI,-6 ;W2 HAS LENGTH OF SYMBOL TYPED
TDNE TJ,TI ;MAKE TI A MASK FOR TRAILING BLANKS OF PARTIAL WORD
JRST .-2
HRRZ TF,@%NM ;MAKE TF POINT AT HDR OF NAMTAB ENTRIES
AOSA TF ;LH(TF) IS PTR TO FIRST MATCHING PROPER INT. SEG
;(=0, IF NONE YET)
GETNM2: ADDI TF,1(TG) ;GET NEXT ENTRY
HLRZ TG,(TF) ;TG=LH(HDR)
JUMPE TG,GETNM5 ;JUMP IF THRU TABLE
CAMLE W2,TG ;DON'T BOTHER IFUSER SYMBOL LARGER
JRST GETNM2
HRRZI TK,(TF) ;INITIALIZE LOOP TO COMPARE (TE-TA) WITH ENTRY
SETZI TH,
GETNM3: ADDI TK,1
MOVE TJ,(TK) ;GET NEXT SIXBIT WORD FROM ENTRY
CAME TJ,TE(TH)
JRST GETNM4 ;SYMBOL DOESN'T MATCH
CAIGE TH,-1(TG)
AOJA TH,GETNM3
CAIE TG,5
SKIPN TE+1(TH)
POPJ PP, ;SUCCESS
JRST GETNM2 ;C(TE-TA) LONGER THAN CURRENT ENTRY
GETNM4: MOVE TK,TE(TH) ;TRY MASK ONLY IF C(TE(TH)) IS PARTIAL WORD
JUMPE TK,GETNM6
TRNE TK,77
JRST GETNM2 ;FAILED ON FULL WORD FROM TE-TA
ANDCM TJ,TI ;MASK OUT TRAILING CHARS.
CAME TJ,TE(TH)
JRST GETNM2 ;NOT INITIAL SEGMENT
GETNM6: TLNE TF,-1 ;YES
SWONS NUIFLG ;WE HAVE SEEN AT LEAST 2 INIT. SEG.
HRLS TF ;SAVE PTR TO MATCHING INITIAL SEGMENT
JRST GETNM2
GETNM5: TSWF NUIFLG ;THRU TABLE
ERR "MATCHES INITIAL SEGMENTS OF 2 SYMBOLS"
HLRZS TF
POPJ PP,
;PUTERR OUTPUTS ^ PRECEDED (OR FOLLOWED BY) AN ERROR
; MESSAGE TO POINT AT A SYNTAX ERROR ON USERS LINE ABOVE
;CALL: JSP TA,PUTERR
; ASCIZ /ERROR MESSAGE OF YOUR CHOICE/
;RETURNS TO XECUTX TO RESTART DEBUGGER
PUTERR: HRRZ TB,SW ;LOAD CHAR. POSITION FO LAST USED CHAR.
PUT1A: PUSHJ PP,EOLCHK
JRST PUT1B
PUSHJ PP,GETCHR
JRST PUT1A
PUT1B: TSWF ALTFLG
TTCALL 3,CRLF ;NEED CRLF IF ALTMODE TYPED.
HRRZ TC,TA ;TC WILL CONTAIN BPTR TO MESSAGE
HRLI TC,(POINT 7,0)
MOVEI TD,2
ILDB TE,TC
SKIPE TE
AOJA TD,.-2
CAMLE TD,TB ;COMPARE MESSAGE LENGTH WITH CHAR. POSITION
SOJA TB,PUTER2 ;JUMP IF MESSAGE TOO LONG TO GO IN FRONT OF ^ .
SUB TB,TD ;MESSAGE SHORT ENOUGH TO GO IN FRONT OF ^
JUMPE TB,PUT2
PUT1: TTCALL 1,[EXP "?"] ;PRINT "?" AT FRONT OF LINE
SOJLE TB,PUT2
PUT0: TTCALL 1,[EXP " "] ;PRINT ENOUGH BLANKS IN FRONT OF MESSAGE
SOJG TB,PUT0
PUT2: TTCALL 3,(TA) ;PRINT MESSAGE
TTCALL 3,[ASCIZ " ^"]
JRST XECUTX ;RETURN TO MAIN LOOP
PUTER2: TTCALL 1,[EXP "?"] ;"?" BEFORE ERROR MESSAGE
SOJLE TB,PUTER4
PUTER3: TTCALL 1,[EXP " "] ;MESSAGE TOO LONG. HAS TO GO AFTER ^
SOJG TB,PUTER3 ;PRINT BLANKS BEFORE ^
PUTER4: TTCALL 3,[ASCIZ "^ "]
TTCALL 3,(TA) ;PRINT MESSAGE
JRST XECUTX
;SPECIAL TREATMENT FOR "TALLY" IN COBOL-68
;BYPASSES THE ENTIRE DISPATCH FUNCTION (BOTH OF THEM).
;EXECUTES THE ACCEPT OR DISPLAY AND GOES BACK FOR THE NEXT COMMAND
DOTAL: MOVE W1,COMTAB(W1) ;[26]GET COMMAND
CAMN W1,[SIXBIT /ACCEPT/] ;[26]
JRST DOTAL1
CAME W1,[SIXBIT /DISPLAY/]
ERR ("ILLEGAL COMMAND")
;DISPLAY TALLY
MOVE TE,TALLY.## ;GET CONTENTS OF TALLY
JUMPGE TE,DOTAL0 ;NEGATIVE?
MOVEI CH,"-" ;PRINT MINUS SIGN
TTCALL 1,CH
MOVM TE,TE ;MAGNITUDE
DOTAL0: PUSHJ PP,PRNUM ;PRINT NUMBER
JRST DECOD
;ACCEPT TALLY
DOTAL1: MOVSI TE,6005 ;PARAMETERS FOR LIBOL ACCEPT
MOVEI 16,TE ;GET VALUE FROM USER
PUSHJ PP,ACEPT.
MOVEM 1,TALLY.## ;PUT LOW ORDER 5 DIGITS IN TALLY
JRST DECOD0
;MESSAGE TYPED UPON STARTING COBDDT
STRTUP: ASCIZ "
STARTING COBOL DDT
"
;IMPURE AREA
INTERNAL PTFLG.
PTFLG.: BLOCK 1 ;NON-ZERO IF WE ARE TRACING
BRKONO: BLOCK 1 ;IF NON ZERO BREAK WHEN WE BRING AN OVERLAY IN.
EBRKOV: BLOCK 1 ;ENTRY POINT ADDRESS OF THE OVERLAY WE ARE
; BREAKING ON.
SUBSPR: BLOCK 1 ;IF NON ZERO THERE ARE SUBROUTINES PRESENT.
CUREPA: BLOCK 1 ;CURRENT ENTRY POINT'S ADDRESS.
CBLIO.: BLOCK 1 ;ADDRESS OF 'RESET.' ROUTINE
PROGST: BLOCK 1 ;STARTING ADDRESS OF COBOL PROGRAM
NSUBS: BLOCK 1 ;NUMBER OF SUBSCRIPTS TYPED
SUB0.: BLOCK 3 ;PLACE FOR SUBS
SAV.TA: ;PLACE TO SAVE "TA" IN BCOM
SAVDT: BLOCK 1 ;PLACE TO SAVE "DT"
FLGS.: BLOCK 1 ;PLACE TO SAVE PROCESSOR FLAGS
TEMP1: ;TEMP STORAGE FOR BP CODE
EAC: BLOCK 1 ;AC NUMBER FOR ASSEMBLY
TEMP2: ;TEMP STORAGE FOR BP CODE
REMAN: BLOCK 1 ;TEMP STORAGE USED IN SUBSCR CALC
SIGNSW: Z ;[24]REMEMBERS LEADING SIGN ON INTEGER
BASEA: BLOCK 1 ;ADDR OF "A" OPERAND (RH)
RESA==BASEA ;BYTE RESIDUE FOR "A" (LH)
INCRA: BLOCK 1 ;OFFSET FOR "A"
SIZEA: BLOCK 1 ;SIZE OF "A"
MODEA: BLOCK 1 ;USAGE OF "A"
DPLA: BLOCK 1 ;DECIMAL PLACES IN "A"
BASEB: BLOCK 1 ;ADDR OF "B" OPERAND (RH)
RESB==BASEB ;BYTE RESIDUE FOR "B" (LH)
INCRB: BLOCK 1 ;OFFSET FOR "B"
SIZEB: BLOCK 1 ;SIZE OF "B"
MODEB: BLOCK 1 ;USAGE OF "B"
DPLB: BLOCK 1 ;DECIMAL PLACES IN "B"
BASEX==0 ;OFFSET OF BASE
RESX==0 ;OFFSET OF RESIDUE
INCRX==1 ;OFFSET OF OFFSET
SIZEX==2 ;OFFSET OF SIZE
MODEX==3 ;OFFSET OF USAGE
DPLX==4 ;OFFSET OF DECIMAL PLACES
SAVEA: BLOCK DPLX+1 ;PLACE TO SAVE "A" PARAMETERS
SAVEB: BLOCK DPLX+1 ;PLACE TO SAVE "B" PARAMETERS
SAVMA: BLOCK 2*DPLX+2 ;PLACE TO SAVE PARAMETERS DURING MOVES
SAVMB=SAVMA+DPLX+1
SAVAX==SAVEA+DPLX
SAVBX==SAVEB+DPLX
BASAX==BASEA+DPLX
BASBX==BASEB+DPLX
SVMAX==SAVMA+DPLX
SVMBX==SAVMB+DPLX
;BREAK POINT IMPURE AREA
BCOM2: BLOCK 1 ;USED INDIRECT FOR PROCEED CNTR
BCOM3: BLOCK 1 ;USED INDIRECT FOR SECTION NAME
LEAV1: XWD Z,LEAV ;USED JRST @ TO DISMISS
LEAV: Z ;HOLDS USER OR OTHER DISMISS INSTR
JRST @BCOM ;IF INSTR HOPS
AOS BCOM ;IF INSTR SKIPS
JRST @BCOM
CUR.BP: BLOCK 1 ;HOLDS CURRENT BP (0 IF VIRGIN)
LAST.: BLOCK 1 ;HOLDS LAST DATA ITEM IN ACCEPT ETC.
SAVSUB: BLOCK 4 ;HOLDS SUBSCRIPT INFO AS ABOVE
DEFINE BP (D) <
IRP (D),<
BP'D: Z ; JSR ENTRY FOR BREAKPOINT D
JSA TA,BCOM ; INVOKE BP LOGIC
B'D'INS: Z ; ORIGINAL INSTR AT BP D
>>
DEFINE BA (D) <
IRP (D),<
B'D'ADR: Z ; PNTR TOP PROTAB FOR BP'D
B'D'SEC: Z ; CURRENT ENTRY POINT ADDRESS (LH) AND
; SECTION NAME PNTR (RH) FOR BP'D
B'D'CNT: Z ; PROCEED COUNT FOR BP'D
>>
;BREAK POIN CONSTANTS
LBP==3
LBA==3
NBP==^D20
BP (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BPN==.-LBP ;ADDR OF LAST BP ENTRY
PAGE
BA (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BNADR==.-LBA
CBPADS: BLOCK 2 ;PNTR TOP PROTAB AND SECTION NAME FOR CURRENT BP.
CBREE.: PUSH PP,TA ; [21] GET AN ACC
CBREEA: OUTSTR [ASCIZ /Do you want to enter COBDDT? (Y or N) /]
INCHRW TA ; [21] GET RESPONCE
CAIE TA,"Y" ; [21] LOOK FOR Y
CAIN TA,"y" ; [21] ALLOW LOWER CASE ALSO
JRST CBREEC ; [21] MATCH
CAIE TA,"N" ; [21] LOOK FOR N
CAIN TA,"n" ; [25] ALLOW LOWER CASE ALSO
JRST CBREED ; [21] MATCH
OUTSTR CRLF ; [21] NEITHER
JRST CBREEA ; [21] TRY AGAIN
CBREEC: POP PP,TA ; [21]
SETZM STPCTR ;[26]CLEAR STEP COUNTER ON REENTER
SETOM REEBRK ; [21] SAY WE WANT TO BREAK ON NEXT ENTER
JRST @.JBOPC## ; [21] AND CONTINUE AS PLANNED
CBREED: POP PP,TA ; [21] NO
JRST @RRDMP ; [21] ASSUME USER WANTED RERUN DUMP
;CODE GENERATION IMPURE AREAS
TEMPC: BLOCK 1 ;OFFSET IN TEMP
CODFST==. ;FIRST LOC TO CLEAR
TEMROL: ;TEMP STORAGE
CBDDT.: ;START ADDR OF COBDDT, FOR USER PROGRAM
INIT.: ;;; ONCE-ONLY INITIALIZATION
MOVEM TA,PROGST ; SAVE ADDR OF BEGINNING OF USER PROG
AOS PROGST ;SKIP XWD PARAMETER
HRRZ TA,(TA) ;GET ADDR OF MAIN PROGRAM
PUSHJ PP,SETETY ;SET UP TABLE OF ENTRY POINT ADDRESSES.
SUBI NM, ETYTAB ;FORM AN AOBJN TYPE POINTER FOR
MOVNI NM, (NM) ; THE TABLE.
HRLI NM, ETYTAB
MOVSM NM, ETYPTS ;SAVE IT.
SETZM SUBSPR
CAME NM, [XWD ETYTAB,-1]
SETOM SUBSPR
MOVEI 16,%NM ;GET ADDRESSES OF %NM., %DT., %PR.
PUSHJ PP,GETNM.
MOVE TA,%NM ;GET ADDRESS ON %NM
PUSH PP,%COBVR-%%NM.(TA)
POP PP,COBVR ;COPY VERSION NUMBER
MOVE TA,%COBSW-%%NM.(TA)
MOVEM TA,COBSW ;COPY COMPILER SWITCHES
TRNE TA,1 ;COBOL-74?
SETOM C74FLG ;YES
MOVEM PP,PDL.
SETZM LAST.
SETZM CUR.BP
SETZM DIED.
SETZM L.SECT
SETZM PTFLG.
SETZM BRKONO
MOVE TA, ETYTAB
MOVEM TA, CUREPA
HRLZI TA, 'TTY'
MOVEM TA, HSTDEV
SETZM HFTBST
SETZM HFINIT
SETZM HFGTHR
SETOM HFGTST
MOVE TA,.JBREN## ; [21] GET RERUN DUMP ADDRESS
MOVEM TA,RRDMP ; [21] SAVE IT
MOVEI TA,CBREE. ; [21] REENTER ADDRESS
MOVEM TA,.JBREN ; [21] ESTABLISH IT
MOVE TA,INIT.9 ;ZERO THE BREAKPOINTS
SETZM B1ADR
BLT TA,BNADR+LBA-1
TTCALL 3,STRTUP
;PREVENT DOING A START AGAIN, EXCEPT TO GET INTO COBDDT.
MOVEI TA,[ SETOM DIED.
TTCALL 3,STRTUP
JRST XECUTX]
HRRM TA,.JBSA
MOVE TA,@%NM ; [13] ADDR OF %NM
MOVEM TA,PNM ; [13] STORE INTO PROCEED
MOVEM TA,BNM ; [13] STORE INTO BREAK
MOVE TA,@%DT ; [13] ADDR OF %DT
MOVEM TA,PDT ; [13] STORE INTO PROCEED
MOVEM TA,BDT ; [13] STORE INTO BREAK
MOVE TA,@%PR ; [13] ADDR OF %PR
MOVEM TA,PPR ; [13] STORE INTO PROCEED
MOVEM TA,BPR ; [13] STORE INTO BREAK
JRST XECUTX
INIT.9: XWD B1ADR,B1ADR+1
;SET UP TABLE OF MAIN ENTRY POINT ADDRESSES FOR ALL RESIDENT SUBROUTINES.
; ENTER WITH ADDRESS OF MAIN PROGRAM'S ENTRY POINT IN TA.
SETETY: MOVEI NM, ETYTAB ;POINT AT THE TABLE.
SETETD: HRRZ TB, (TA) ;IF THE INSTRUCTION AT THE
JUMPE TB, SETETH ; ENTRY POINT ISN'T "SKIPA 0,0",
SKIPE OVLCHS ; THE MODULE IS PROBABLY IN A
POPJ PP, ; LINK-10 OVERLAY.
ADDI TA, 1 ;IF WE ALREADY HAVE THE ADDRESS
MOVE TB, JT.FLG(TA) ; OF THE CONTROL HEADER SECTION
TLNE TB, F.MDL ; FOR THE ROOT SEGMENT, LEAVE.
HRRZ TA, JT.MDL(TA) ;OTHERWISE PICK IT UP.
HRRZ TA, JT.CST(TA)
MOVEM TA, OVLCHS
POPJ PP,
SETETH: HRRZ TB, -2(TA) ;GET LINK TO MAIN ENTRY POINT.
TRNE TB, -1 ;WERE WE AT THE MAIN ENTRY POINT?
HRRZI TA, (TB) ;NO, BUT WE ARE NOW.
MOVE TB, 1(TA) ;GET THE ADDR OF %FILES.
SKIPGE %%NM.(TB) ;IF WE HAVE ALREADY DONE THIS
POPJ PP, ; MODULE LEAVE.
CAILE NM, ETYTAB+^D100 ;IF THERE ISN'T ANY MORE ROOM, COMPLAIN.
JRST [OUTSTR [ASCIZ /
?TOO MANY SUBROUTINES FOR COBDDT TO COPE WITH. PLEASE COMBINE SOME OF
?THEM SO THAT THERE ARE LESS THAN 100 MODULES./]
CALLI 12]
HRROS %%NM.(TB) ;MARK THIS MODULE AS DONE.
HRRZM TA, (NM) ;STASH THE ENTRY POINT'S ADDRESS.
ADDI NM, 1 ;MOVE UP TO NEXT LOC IN THE TABLE.
HLRZ TB, 1(TA) ;GET THE ADDRESS OF THE LIST
; OF PROGRAMS CALLED BY THIS MODULE.
SETETP: SKIPN TA, (TB) ;DOES THIS MODULE CALL ANYONE?
POPJ PP, ;NO, RETURN.
PUSH PP, TB ;SAVE POINTER TO LIST.
PUSHJ PP, SETETD ;CURSE AND RECURSE.
POP PP, TB ;GET THE POINTER BACK.
AOJA TB, SETETP ;GO SEE IF THERE ARE MORE.
IFL <N.TMP-.+TEMROL>,<PRINTX DRYROT!!!>
IFGE <N.TMP-.+TEMROL>,<BLOCK <N.TMP-.+TEMROL>>
CODROL: BLOCK N.COD ;CODE ROLL
LITROL: BLOCK N.LIT ;LITERAL POOL
CODLST==.-1 ;LAST LOC TO CLEAR
C74FLG: Z ;-1 IF COBOL-74 MAIN PROGRAM
REEBRK: Z ; [21] -1 SAYS BREAK TO C.TRCE
;USED BY ^C/REENTER AND STEP CODE.
REEFLG: BLOCK 1 ; [21] STACK ADDRESS FOR PROCEED
STPCTR: BLOCK 1 ;[26]NO. OF STEPS TO BYPASS
;BEFORE NEXT BREAK, WHEN STEPPING.
RRDMP: BLOCK 1 ; [21] SAVE RERUN DUMP REENTER ADDRESS
AC0: BLOCK 20
PDL.: BLOCK 1 ;PUSH DOWN POINTER
DIED.: BLOCK 1 ;FLAG FOR EX DEATH
L.PARA: BLOCK 1 ;PLACE TO SAVE LAST PARA
L.SECT: BLOCK 1 ;PLACE TO SAVE LAST SECTION
ETYPTS: BLOCK 1 ;POINTER INTO THE TABLE BELOW.
ETYTAB: BLOCK ^D100 ;ADDRESSES OF MAIN ENTRY POINTS FOR ALL MODULES.
NMSVD: Z ;PLACE TO SAVE THE ADDRESS OF AN ENTRY POINT IN ETYTAB.
OVRLHD: Z ;POINTER TO LIST OF OVERLAY BLOCKS.
OVLCHS: Z ;ADDRESS OF CONTROL HEADER SECTION FOR
; THE ROOT LINK.
;THE FOLLOWING THREE ITEMS CONTAIN THE ADDRESSES OF %NM., %DT., %PR.
; IN THAT ORDER
%NM: BLOCK 1 ;ADDR OF %NM.
%DT: BLOCK 1 ;ADDR OF %DT.
%PR: BLOCK 1 ;ADDR OF %PR.
COBVR: BLOCK 1 ;COBOL VERSION
COBSW: BLOCK 1 ;COMPILER ASSEMBLY SWITCHES
PNM: BLOCK 1 ; [13] RUN-TIME NM
PDT: BLOCK 1 ; [13] RUN-TIME DT
PPR: BLOCK 1 ; [13] RUN-TIME PR
BNM: BLOCK 1 ; [13] BREAK NM
BDT: BLOCK 1 ; [13] BREAK DT
BPR: BLOCK 1 ; [13] BREAK PR
END