Trailing-Edge
-
PDP-10 Archives
-
decuslib10-03
-
43,50312/mants.mac
There are no other files named mants.mac in the archive.
TITLE MANTIS UNIVERSITY OF OREGON FORTRAN DEBUGGER V5
SUBTTL L.SALMONSON, DEC 74
;***COPYRIGHT 1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
IFNDEF REENT,<REENT==0> ;REENT=1 GIVES HIGH SEGMENT
DEPTH=^D100 ;DEPTH OF HISTORY KEPT
USECHAN=^D24 ;RESERVED LOGICAL DISK CHANNEL
RBUFFS==3 ;NUMBER OF DISK BUFFERS RESERVED IN IMPURE PART,
; VARIABLE 'RSPACE' IS SIZE OF ROLL AREA LEFT.
SEARCH FORPRM ;LOAD GLOBAL SYMBOLS FROM FOROTS SYMBOL TABLE
;AC'S
T==0 ;TEMP ;HOLDS CHAR
U==1 ;TABLE INDEX
W==2 ;HOLDS SQUOZE ;TEMP
V==3 ;HOLDS CHAR ;SYMBOL-TABLE POINTER
A==4 ;UTILITY AC'S ;SYMBOL VALUE
B==5 ;PROGRAM SYMTAB POINTER
C==6
D==7
E==10
F==11 ;FLAG
G==12 ;DATA. AC'S ;BETWEEN LIMIT AC'S
H==13 ;STOP FLAG
X==14 ;MORE PERMANENT ;ROLL INSERTION POINT
Y==15 ;TOP OF TEMP NODE
J==16 ;F4 JSA AC ;SIZE OF NODE BEING REPLACED
P==17 ;PUSHDOWN POINTER AC
;UUO'S
OPDEF JUMP. [ 0B8] ; 7 EXCEPTION TRACE BREAKS
OPDEF AT. [10B8] ;AT BREAK
OPDEF ATSUB. [11B8] ;AT SUB BREAK
OPDEF SUB. [12B8] ;SUBCHECK BREAK
OPDEF ON. [13B8] ;ON (STORE) BREAK
OPDEF CALL. [14B8] ;ONCALL BREAK
;TYPE, MASK & BIT DEFS
INTEGER==0
REAL==2
LOGICAL==3
OCTAL==4
HOLLER==5
DOUBLE==6 ;DOUBLE-WORD
COMPLEX==7
SUBMSK==7777 ;MASKS INDEX TO SUBSCRIPT DATA
STAMSK==SUBMSK ;MASKS INDEX TO STMT LENGTH TABLE
BRKMSK==37777 ;MASKS RELATIVE BROKEN ADR
ARRFLG==40000 ;FIXED DIMENSION ARRAY FLAG
DMYFLG==20000 ;DUMMY ARRAY FLAG
LBLFLG==10000 ;LABEL FLAG
SUBTTL IMPURE PART
ENTRY TOPFF$,BROKE$,BRIST$
IFE REENT,< EXTERN FORSE.,END.,RESET.,ADJ.>
IF2,<IFN REENT,<REENT==-1>> ;WE MAY NOT WANT LOWSEG
IFGE REENT,< ;COMPILE LOWSEG EXCEPT ON SECOND PASS FOR HISEG
IFN REENT,< HISEG ;WE'RE COMPILING HISEG
FORSE.==<END.==<RESET.==<ADJ.==0>>>>
LOC 124 ;DEFINE INITIAL REENTRY
.JBREN::EXP SETSYM
IFN REENT,<LOC 140>
IFE REENT,<RELOC> ;LOADER CAN'T HANDLE ABSOLUTE CODE!!
TOPFF$: Z ;POINT TO BOTTOM OF BROKEN AREA
BROKE$: Z (U) ;POINT TO BROKEN AREA
BRIST$: Z ;HAAD OF AVAILABLE LIST
FINMAN: Z (L) ;FOROTS IS SETUP TO 'JRA L,@FINMAN' WHEN IT RETURNS TO F4 CODE
MANSYM: Z ;POINTER TO MANTIS SYMBOL TABLE PROPER
CURRENT:Z ;POINTER TO SYMBOLS FOR CURRENT PROG
GLOBAL: Z ;TEMP POINT TO CURRENT SYMBOLS
F4PC: Z ;F4 PC
ACSAVE: BLOCK 20 ;F4 AC'S
CALL: XWD SETMV,0 ;POINT TO ONCALL BREAK ROLL
ON: XWD 0,0 ;POINT TO ON BREAK ROLL
AT: XWD HISORG,HISORG ;POINT TO AT BREAK ROLL
HISTORY:XWD HISORG,HISORG ;POINT TO HISTORY ROLL
HISTOP: Z COMNOD ;TOP OF HISTORY ROLL (COMMAND NODE TEMP)
TROUT: Z ;TRACE OUTPUT FLAG
PAUSE: Z ;TRACE OUTPUT PAUSE FLAG
DRAIN: Z ;LAST REFERENCE WHEN DRAINING I/O
SUBINS: Z ;HOLD INSTR TEMP IN SUBCHECK
SUBSYM: Z ;HOLD SYMBOL POINTER TEMP IN SUBCHECK
SCRIPT: Z (U) ;POINT TO SUBSCRIPT DATA AREA
STATAB: Z ;STATEMENT LENGTHS BYTE TABLE
CHAN: Z -1 ;USE TTY FOR OUTPUT INITIALLY
USENAME:Z ;NAME OF OUTPUT FILE
Z
PROJMP: Z ;JUMP ADR FOR PROFILE
PRONAME:Z ;PROFILE LISTING FILENAME
PROBUF: Z ;PROFILE BUFFER HEADER
PROPNT: Z
PROCNT: Z
ONA: Z ;HOLDS ON BREAK ADR
ONTEMP: Z ; ON BROKEN TEMP
POPJ P, ; (RETURN TO ON BREAK PROCESSING
JSAADJ: JSA 16,ADJ. ;ADR OF ADJ. MAY BE PUT HERE IF LOADED
START: Z ;HOLDS INITIAL .JBSA
TINUE:REESTOP:TRN ;REENTER STOP TRAP
MOVSI 17,ACSAVE ;RESTORE AC'S
BLT 17,17
INSTR: JFCL ;BROKEN INSTR PUT HERE
JRSTF @F4PC ; AND CONTINUE F4 PROG
AOS F4PC ;SKIP AND CONTINUE
JRSTF @F4PC
MANUUO: EXCH T,.JBUUO## ;MANTIS UUO HANDLER
CAMG T,MANUUR ;MANTIS OP?
MANJMP: JRST .-. ;YES
EXCH T,.JBUUO ;NO
UUOPC: POP P,FORSE. ;SIMULATE JSR TO FORSE
MANUUF: JRST FORSE.+1
MANUUE: END. ;END OF FORJAK CODE
FORSE: Z ;WILL POINT TO INSTR IN FORJAK = UUORT.: JRSTF @UUO.
MANUUR: RESET.
SETMV: ASCIZ" MANTIS V5
"
SETNLD: OUTSTR .+2
CALLI 1,12
ASCIZ"MANTIS MUST BE LOADED FIRST
"
SETSYM: SKIPA 1,GETIME ;NORMAL ENTRY POINT
MOVE 1,SETSAV ;ENTRY TO ENABLE SAVE OF JOB AFTER SETUP
MOVEM 1,GETIME ;NEGATIVE MEANS NO SAVE POSSIBLE
MOVEI TOPFF$ ;MAKE SURE WE'RE LOADED AT 140
CAIE .JBDA##
JRST SETNLD
HRRZ 1,.JBDDT ;JUMP TO DDT IF IT'S THERE
MOVEI .+3
MOVEM .JBREN
JUMPN 1,(1)
OUTSTR SETMV ;REASSURE USER
SETZB .JBREN ;PREVENT REENTRY FOR NOW
RUNTIME ;HOLD INITIAL RUN TIME
MOVEM ACSAVE+X
MSTIME ; AND CLOCK TIME
MOVEM ACSAVE+Y
MOVE P,PDLST ;SETUP PUSHDOWN POINTER
COMMENT_ THE SYMBOL TABLE IS RE-ORGANIZED AS FOLLOWS
EACH FORTRAN PROGRAM LOADED WITH LOCAL SYMBOLS IS
REPRESENTED AS FOLLOWS:
1ST WORD: PROGRAM NAME
2ND LH: NEGATIVE NUMBER OF WORDS TO NEXT PROGRAM NAME
RH: BASE ADR OF PROGRAM LOGIC
3RD LH: ADR PROLOGUE (WORD ZERO IF MAIN)
RH: ADR EPILOGUE
4TH LH: RESERVED FOR BYTE POINTER INTO STATAB
RH: ADR END OF TEMP AREA
PROGRAMMER LABEL SYMBOL PAIRS WITH TRAILING 'P' IN NAME
DIVIDED OFF AND LABEL FLAG SET IN VALUE WORD
VARIABLES REFERENCED IN PROGRAM _
INIT 16
SIXBIT/DSK/
ZEROL: Z
JSP SVSYM2
PJOB B, ;MAKE TEMP FILENAME
MOVEI A,3
IDIVI B,^D10 ;USING JOB#
LSHC C,-6
SOJG A,.-2
TLO D,'000' ;NAME IS '000MAN.TMP'
HRRI D,'MAN'
MOVSI E,'TMP'
HRRZ C,.JBSYM## ;LIMITS OF OLD SYMBOL TABLE
HLRE B,.JBSYM
SUBM C,B
SKIPA U,.+1 ;SYMBOLS LOADED FOR MANTIS ITSELF??
SQUOZE 50,A
CAMN U,-6(B)
EXIT 1, ;YES, CONTINUE BY JRST @JOBOPC$X
MOVE J,B ;LOADED BY LINK-10??
CAMG B,.JBREL
SKIPN (B)
SKIPA
JRST SVSYM0
SETZB C,F
MOVEI B,5
LOOKUP B
JSP SVSYM2
HRRZ C,.JBSYM
MOVE B,J
MOVE T,G ;EXPAND CORE TO READ IN SPECIAL DATA
ADDI T,2K(B)
CAMLE T,.JBREL
CORE T,
JFCL
MOVNS J,G
ADD J,.JBREL
HRL J,G
MOVEI T,-1(J)
MOVEM T,ACSAVE+J
IN ACSAVE+J
RENAME ZEROL
JSP SVSYM2
SVSYM0: MOVE A,.JBREL
MOVEM A,AUXSYM
HRRZM J,RDPNT
SUBI J,1
HRRZM J,RFLINK
HRRZM J,STATAB
MOVE T,0(C) ;WHERE TO PUT NEW SYMBOL TABLE
CAMN T,SVSYMP
SKIPA A,1(C)
HLRZ A,.JBSA##
ADDI C,200
SKIPN .JBDDT##
JRST SVSYM1
HLLZS E ;SAVE OLD SYMBOL TABLE
SETZB F,G
SOS J,.JBSYM
MOVEM J,ACSAVE+J
ENTER D
JSP SVSYM2
OUT ACSAVE+J
SKIPA
JSP SVSYM2
CLOSE
LOOKUP D ;SETUP TO BRING IT BACK IN!
JSP SVSYM2
SVSYM1: CLEAR D, ;ZERO F4 SYMBOL-BLOCK AC
MOVEI G,SETMV ;SETUP FOR ONCALL BREAKS
MOVEI E,1
JRST SET0 ;BEGIN RE-ORGANIZATION
SVSYMP: SQUOZE 4,PAT.. ;NAME OF PATCH SPACE BELOW SYMBOL TABLE
SET0: SUBI B,2 ;PICK UP SQUOZE
MOVE W,(B)
TLNE W,(4B5) ;IGNORE INTERNAL SYMBOLS
JRST SET1
TLNN W,(10B5) ;LOCAL SYMBOL?
JRST SET2 ;NO, MAYBE NAME OF F4 PROG
JUMPE D,SET1 ;YES, F4 LOCAL?
MOVE V,1(B) ;YES, ZERO SUBSCRIPT INDEX
TLZ V,SUBMSK ; & PUT PAIR IN SYMBOL TABLE
JSP J,PUT
CAIG X,(V) ;IS THIS LOWEST NON-COMMON ?
CAIG Y,(V)
CAIA ;NO
MOVEI Y,(V) ;YES, NOTE IT
SET1: CAIE B,(C) ;MORE SYMBOLS?
JRST SET0 ;YES
JUMPE D,.+6 ;WERE WE PROCESSING F4 LOCALS?
MOVEI (D) ;YES, DEPOSIT LENGTH OF LOCAL BLOCK
SUBI (A) ; IN LH OF GLOBAL VALUE
HRLM -3(D)
TRNN Y,1B18 ;WAS THERE A NON-COMMON LOCAL?
HRRM Y,-1(D) ;YES, LOWEST OPPOSITE CONST.
; GIVES TOP OF TEMP AREA
MOVS U,.JBSA ;HOLD OLD .JBSA
MOVSM U,START
HRRM U,MANSYM ;SETUP NEW SYMBOL TABLE POINTER
MOVE (U) ; (DO WE HAVE SYMBOLS FOR MAIN?)
CAME SETQMA
JRST SET7 ; (NO)
OUTSTR SETMMP
HLLZ 1(U)
ADDI 4(U)
MOVEM CURRENT
MOVE SETQMN
MOVEM (U)
SET7: SUBI U,(A)
JUMPE U,SETNON
HRLM U,MANSYM
HRRM G,CALL ;SET ROLL POINTERS
HRLS G
MOVEM G,ON
JRST RDSUB ;PROCESS SUBSCRIPT DATA
SETMMP: ASCIZ"CURRENT PROGRAM IS MAIN
"
SETNON: OUTSTR .+2
EXIT 1,
ASCIZ"NO SUBPROGRAM HAS SYMBOLS!"
SET2: JUMPE D,.+7 ;WERE WE BUILDING LOCAL SYMBOL BLOCK?
MOVEI (D) ;YES, DEPOSIT LENGTH OF LOCAL BLOCK
SUBI (A) ; IN LH OF GLOBAL VALUE
HRLM -3(D)
TRNN Y,1B18 ;WAS THERE A NON-COMMON LOCAL?
HRRM Y,-1(D) ;YES, LOWEST
CLEAR D, ;ZERO IT
JUMPE W,SET1
CAMN W,SET2D ;IS THIS BLOCK DATA PROG?
JRST SET1 ;YES, FORGET SYMBOLS
MOVE V,-1(B) ;IS IT MULTIPLIER ADJUSTMENT PROG?
MOVE SETQ1M ;IS THIS F4 PROGRAM? ;"SQUOZE 10,1M"
CAME -2(B)
CAMN -4(B)
CAIL G,SET0 ;THERE'S A LIMIT ON # SUBPROGRAMS
JRST SET1 ;NO, TRY NEXT PAIR
JSP J,PUT ;YES, PUT GLOBAL PAIR IN SYMBOL TABLE
SETZB W,V ;RESERVE TWO WORDS
JSP J,PUT ; FOR PROLOGUE,,EPILOGUE & POINTER,,TEMP
MOVEI D,(A) ;SET LOCAL BLOCK POINTER
SET3: MOVE W,-2(B) ;ANOTHER LABEL?
TLZN W,(10B5)
JRST SET4 ;NO MORE LABELS
IDIVI W,50 ;DIVIDE OFF LAST CHAR
CAIE V,"P"-66 ;PROGRAMMER LABEL?
SOJA B,SET3A ;NO, MADE LABEL
TLO W,(10B5) ;LOCAL CODE
HRRZ V,-1(B) ;GET LABEL VALUE
HLRZ T,(V)
CAIE T,(JRST)
JRST SET3J
LDB T,SETFMT ;MAY NOT WANT LABEL IF REFERS TO FORMAT STMT
CAIN T,"("
CAMN V,-3(B)
SET3J: JSP J,PUTL ;PUT LABEL PAIR IN SYMBOL TABLE
SOJA B,SET3A ;NEXT PAIR
SET3A: SOJA B,SET3
SET2D: SQUOZE 0,DAT.
SETFMT: POINT 7,1(V),6
SETQ1M: 2*50+"M"-66+10B5
SET4: SUBI B,6 ;ADJUST TO START OF LOCAL SYMBOLS
HRRZ X,-3(D) ;SETUP WATCH FOR LOWEST NON-COMMON
MOVEI Y,1B18 ; LOCAL SYMBOL
SET5: MOVE (B) ;GET SPECIAL SYMBOL
CAMN SETQ%T ;END OF SPECIALS?
JRST SET8 ;YES
SUBI B,2 ;ADJUST TO NEXT PAIR
CAMN SETQCN ; TEMP. DEFINITION?
JRST SET6 ;YES, PUT AT BEGINNING OF BLOCK
HRL U,5(B) ;NO, PUT PROLOGUE,EPILOGUE DEFS
HRR U,3(B) ; AT BEGINNING OF BLOCK
SETZM @5(B) ;FLAG ROUTINE AS NOT YET CALLED
MOVEM U,-2(D)
HRLI D,(CALL.)
MOVEM D,-1(U) ;SET ONCALL BREAKS
HLRZ (U) ;LOOK FOR RETURN JRA
CAIE (JRA 16,(16))
AOJA U,.-2
MOVSI T,(CALL. 16,(16))
HLLM T,(U)
HLRZ -1(U)
MOVSI W,(CALL. 16,@(16))
CAIN (SKIPG)
HLLM W,2(U)
HRRM D,(G) ;BUILD ONCALL ROLL
HRLM E,(G)
MOVE T,(B)
CAMN T,SETQ2M ; "SQUOZE 10,2M" ???
SUBI B,2 ;YES, ADJUST DOWN AGAIN
AOJA G,SET5 ;LOOP
SET6: HRRZ 1(B) ;PUT TEMP. DEF AT BEGINNING OF BLOCK
MOVEM -1(D)
SET8: MOVE -2(B) ;SKIP ANOTHER PAIR?
CAMN SETQT
SUBI B,2 ;YES
JRST SET1 ;GET FIRST LOCAL VARIABLE
SETQCN: SQUOZE 10,CONST.
SETQ%T: SQUOZE 10,%TEMP.
SETQT: SQUOZE 10,TEMP.
SETQ2M: 3*50+"M"-66+10B5
PUTL: TLO V,LBLFLG
PUT: ADDI A,2 ;ROOM FOR ANOTHER PAIR?
CAIGE A,(C)
JRST PUTSQZ
MOVEI T,(C) ;NO, SO MOVE REMAINING PORTION
HRROI U,-1(B) ; OF SYMBOL TABLE UP
MOVE B,RDPNT
MOVEI C,-1(B)
POP U,(C)
CAIG T,(U)
SOJA C,.-2
PUTSQZ: MOVEM W,-2(A) ;DEPOSIT SQUOZE
MOVEM V,-1(A) ; & VALUE
JRST (J) ;RETURN
COMMENT_ THE SUBSCRIPT DATA IS SET UP AS FOLLOWS:
IN THE VALUE WORD OF ARRAY SYMBOL TABLE PAIRS THE FIXED-DIMENSIONED
AND DUMMY FLAGS ARE SET AS IS THE 12-BIT INDEX INTO THE
SUBSCRIPT DATA AREA.
EACH ENTRY IN SCRIPT AREA IS AS FOLLOWS:
1ST WORD LH: RELATIVE ADR TOP OF ARRAY OR
POINTER TO ADR TOP OF ARRAY
RH: DIMENSIONALITY N OR
POINTER TO ADRS BOUNDS IN ADJUSTMENT CALL
N LOWER AND UPPER BOUNDS WORDS
ARRAY REFERENCE OFFSETS PACKED 2 OR 4 TO A WORD WITH ZERO DELIMITER_
REMARK THAT THE VALUE WORD OF EACH LABEL SYMBOL IS SET TO POINT INTO STATAB
;REFERENCE TEMPORARIES
RFLINK=ACSAVE+1
RFSLAB=ACSAVE+2
RDPNT=ACSAVE+3
DUMMYH=ACSAVE+5
RFBASE=ACSAVE+6
RFSKA=ACSAVE+7
RFSKP=ACSAVE+10
RFDBL=ACSAVE+11
RFSTA=ACSAVE+12
AUXSYM=ACSAVE+13
GETHGH: MOVE U,STATAB ;SEE IF TABLES TOO BIG
SUB U,RFLINK
AOS E
SUB E,SCRIPT
TRNN U,10000
TRNE E,10000
JRST HAAHHH
ADD E,SCRIPT ;THEY'RE OK
HRRZM E,STATAB ;SETUP PERMANENT STMT LENGTHS BASE
ADDI U,(E) ;MOVE THE TABLE DOWN
AOS RFLINK
HRL E,RFLINK
BLT E,(U)
SKIPN .JBDDT
AOJA U,SVSYM3
HRRM U,ACSAVE+J
HLRE T,ACSAVE+J
SUBM U,T
CORE T,
JRST HAAHHH
IN ACSAVE+J
RENAME FORSE
JSP SVSYM2
AOS U,ACSAVE+J
MOVEM U,.JBSYM
HLRE T,U
SUBM U,T
HRRZ U,T
SVSYM3: HRLZM U,.JBSA
HRRZM U,.JBFF
HRLM U,.JBCOR##
MOVEI A,LOW.SZ+DDB.SZ(U) ;SHRINK LOWSEG
CORE A,
JRST HAAHHH
SKIPG GETIME
JRST GETJAK
SUB U,MANSYM
MOVEI T,(U)
PUSHJ P,SDECOU
OUTSTR GETSYM
GETJAK: MOVEI U,FORSE.+207 ;LOOK FOR PLACE CALLED 'UUORT.' IN FORJAK
SKIPA W,.+1
JRSTF @FORSE.
CAME W,(U)
AOJA U,.-1
HRRZM U,FORSE ;SAVE POINTER TO THAT LAST INSTR
TLNE F,(1B1)
OUTSTR SETUND
LSH A,12 ;SEE IF WE'VE ENOUGH CORE FOR HISEG
SUB A,.JBREL
CAIL A,24K ;ASSUME 10K HISEG
JRST GETSAV ;YES ENOUGH
SKIPA U,SETSAV ;NO, ALLOW SAVE OF LOAD
SETSAV: JRST GETACP ;CONSTANT TO ENABLE SAVE OF JOB
MOVEM U,GETIME
OUTSTR SETRUN
GETSAV: SKIPG GETIME ;STOP TO ALLOW USER TO SAVE JOB???
JRST GETGO ;NO, GO
MOVEI T,GETSA ;YES, ENABLE START
HRRM T,.JBSA##
EXIT 1, ;OR CONTINUE AFTER EXIT
GETSA: HLLZS .JBSA##
GETGO: MOVEI W,GETOTS ;PRELOAD HIGHSEG
GETSEG W,
HALT . ;HELP!!, MANTIS NOT AROUND
SETZM .JBOPS## ;DONT TOUCH ACS 0,7,11 UNTIL RESET.
MOVE U,START ;SETUP F4 PC BUT DONT LET STARTING RESET.
HLRZ W,1(U)
CAIE W,046040 ;F4STAT 1, FOR F4 SUBR USAGE STATS?
CAIN W,(15B8) ;(RESET. OPCODE)
JRST GETF4S
HRRZM U,F4PC
JSP L,RESET. ;GET SHARABLE HIGH SEGMENT
Z
JRST GETRES
GETF4S: MOVE W,2(U)
HRRZM W,F4PC
MOVEI W,GETF4R
HRRM W,2(U)
JRST (U)
GETF4R: MOVE U,START
MOVE T,F4PC
HRRM T,2(U)
GETRES: MOVE P4,.JBOPS
GETIME: HRROI ACSAVE+Y ;CORRECT FOROTS START TIMES
POP DAY.TM(P4) ; TO REFLECT MANTIS INITIALIZATION
POP RUN.TM(P4)
GETACP: MOVEM P,ACSAVE+P ;SAVE PUSHDOWN POINTER
MOVSI (PUSHJ P,) ;SETUP MANTIS UUO HANDLER
HRRI MANUUO
MOVEM .JB41##
MOVE .JBHGH##+0 ;AND ADR OF MANTIS CODE LOGIC
HRRM MANJMP
HRLZI LOWEND-TTBUFS ;FREE UP SOME CORE
MOVEM TTBUFS
JSP 16,.+3
ARG .+1
EXP TTBUFS+1
PUSHJ P,DECOR.##
SETZB T,.JBUUO ;ENTER DEBUGGER INITIAL POINT
JRST MANJMP
GETOTS: SIXBIT /SYS/ ;GET SEG ARG BLOCK
SIXBIT /MANOTS/
BLOCK 4
SETUND: ASCIZ"ONE OR MORE ARRAYS SPECIFIED AS ONLY ONE ELEMENT.
IF ANY DUMMY ARRAYS ARE GREATER IN SIZE THAN SPECIFIED IN THE SOURCE
PROGRAM, THE SUBCHECK OR ON COMMANDS CANNOT WORK PROPERLY WITH ANY OF
THE ARRAYS. AN ARRAY CAN BE REFERENCED PROPERLY ONLY IN SUBPROGRAMS
WHERE THE TRUE SIZE WAS SPECIFIED IN THE SOURCE.
"
SVSYM2: OUTSTR .+2
CALLI 1,12
ASCIZ"?DISK I/O ERROR"
SETRUN: ASCIZ"SAVE LOAD AND RUN WITH MORE CORE"
GETSYM:ASCIZ" WORDS OF DEBUGGER SYMBOLS
"
RDSUB: MOVSI F,(1B0) ;INITIALIZE FLAG
MOVEI E,-1(A) ;POINT TO SUBSCRIPT AREA
HRRM E,SCRIPT
RSUB1: SETZB X,J ;ZERO ARRAY LIST HEAD & PROGRAM NAME
JRST RSUB2
RSUB2S: HRREM W,RFSTA ;HOLD COUNT OF LENGTHS WORDS
RSUB2: JSP H,REFWRD ;GET A WORD
AOSGE RFSTA ;ANOTHER STMT LENGTHS WORD?
JRST RFSCHK ;YES, DEPOSIT WORD AND SPECIAL CHECKING
JUMPG W,RSUB3 ;JUMP IF OBJECT ARRAY REF NAME
TLNE W,(20B5) ;COUNT OF LENGTHS WORDS?
JRST RSUB2S ;YES
JUMPE W,DSUB2 ;IF WORD ZERO ASSUME EOF!!
RSUB2P: TLZ W,(40B5)
TLNE W,(10B5) ;ARRAY NAME?
JRST DSUB1 ;YES
SKIPE W ;ZERO ACCEPTABLE AS NAME OF MAIN
CAMN W,SETQMA ; AS IS 'MAIN.'
MOVE W,SETQMN
JRST DSUB2 ;YES
SETQMA: SQUOZE 0,MAIN.
SETQMN: SQUOZE 0,MAIN
DSUB1: TLZE W,(4B5) ;ARRAY NAME, DUMMY?
JRST DSUB6
JSP H,RFLOOK ;NO, LOOKUP NAME
HRRZI W,(X) ;PUT ARRAY NODE
PUSHJ P,REFPUT ; ON FRONT OF LIST
HRREI X,(U)
HRLZI A,(V) ;LINK TO SYMBOL IN LH OF 2ND WORD
PUSHJ P,REFPUT ; AND BOUNDS FOLLOW
JSP H,REFWRD
SKIPE W ;ANOTHER BOUNDS PAIR?
AOJA A,.-3 ;YES, COUNT DIMENSIONS
HRREI W,(X) ;DEPOSIT DIMENSIONALITY
ADD W,RFLINK
MOVEM A,(W)
DPB X,DSUB1P ;PUT POINT IN SYMBOL TABLE
JRST RSUB2 ;CONTINUE READING
DSUB1P: POINT 12,1(V),17
RSUB0: JUMPE W,DSUB2 ;IF WORD ZERO, ASSUME OK!
OUTSTR .+2
CALLI 1,12
ASCIZ"
?BAD AUXILARY DATA
"
RSUB3: JUMPE J,RSUB0 ;GOOD DATA?
JUMPG F,RSUB2 ;DOES USER WANT SUBCHECK?
AOSG RFDBL ;DOUBLE REFERENCE SEEN?
JRST RSUB2 ;YES, SO IGNORE NAME
RSUB4: HLRZ T,(Y) ;LOOK FOR INDEXED REFERENCE
TRNE T,16
JRST RSUB4X ;JUMP FOUND
CAIE T,(JRST) ;SKIP OVER FORMATS
RSUB4A: AOBJN Y,RSUB4
JUMPG Y,RSUB0 ;GOOD DATA?
LDB T,RSUB4F
CAIE T,"("
JRST RSUB4A ;NOT A FORMAT
HRRZ T,(Y) ;PUSH AOBJN POINTER OVER FORMAT
SUBI T,(Y)
HRLS T
ADDM T,Y
JRST RSUB4A+1
RSUB4F: POINT 7,1(Y),6
RSUB4V: POINT 4,(V),12
RSUB4X: SKIPN DUMMYH
JRST RSUB4L
ANDI T,17 ;DUMMY REF?
MOVEI V,-1(Y)
RSUB4D: LDB U,RSUB4V
CAIE T,(U)
SOJA V,RSUB4D
HRRZ T,(V)
CAIG T,17
HRRZ T,-1(V)
CAIL T,(V)
CAMLE T,DUMMYH
JRST RSUB4L
SKIPE @T
AOBJN Y,RSUB4 ;YES
RSUB4L: TLO W,(10B5) ;LOOKUP REFERENCE NAME
SKIPA V,GLOBAL
AOBJP V,RSUB0
CAME W,(V)
AOBJN V,.-2
HLRZ B,1(V) ;FOUND NATURALLY
TRNN B,SUBMSK ;GOOD DATA?
JRST RSUB0
MOVEI W,(Y) ;ADR OF REFERENCE
MOVE T,(W) ;DOUBLE REFERENCE
ADDI T,1
XOR T,1(W)
TLZ T,777740
AOBJP Y,RSUB0
JUMPN T,RSUB4R
SETOM RFDBL ;YES, MAYBE TRIPLE IF COMPARE
AOBJP Y,RSUB0
HLRZ T,1(W)
CAIL T,(CAMLE) ;TRIPLE REFERENCE?
CAIL T,(CAMGE 17,)
JRST RSUB4R ;NO
SOS RFDBL ;YES
AOBJP Y,RSUB0
RSUB4R: PUSHJ P,REFPUT ;RESERVE WORD FOR REFERENCE
ORCMI B,SUBMSK ;HEAD IN LH OF ARRAY NODE
ADD B,RFLINK
HLL W,1(B) ;PUT ON FRONT OF LIST
HRLM U,1(B)
MOVEM W,1(G)
JRST RSUB2
REFPUT: PUSHJ P,REFUP ;MAKE ROOM FOR ONE WORD
SOS U,G ;DECREMENT AVAILABLE
MOVEM W,1(G) ;DEPOSIT AC W
SUB U,RFLINK ;MAKE ADR RELATIVE
POPJ P, ;RETURN
REFWRD: AOS U,RDPNT ;COUNT DATA WORD
MOVE W,-1(U) ;PICKUP WORD
CAMLE U,AUXSYM ;EOF? .JBCN6 IS ZEROD
TDZA W,W ;YES, ZERO AC W AS EOF FLAG
JRST (H) ;NO, RETURN WORD IN AC W
DSUB2: EXCH W,J ;HOLD NEW PROGRAM
MOVEM W,GLOBAL ;HOLD OLD PROGRAM
JUMPE X,RFSTAL ;JUMP IF ARRAY LIST EMPTY
DSUB3: SOS D,X ;HOLD HEAD -1
ADD X,RFLINK ;MAKE ADR ABSOLUTE
HLRE H,2(X) ;REFERENCE LINK
HLRE A,1(X) ;SYMBOL ADR
HRRZ B,1(X) ;DIMENSIONALITY
HRRE X,2(X) ;NEXT ARRAY NODE
AOS W,E ;LINK SYMBOL TO SCRIPT
SUB W,SCRIPT
DPB W,DSUB3P
MOVEI C,(E) ;HOLD THAT ADR
HRRZM B,(C) ;DEPOSIT DIMENSIONALITY
MOVEI V,1 ;INITIAL FACTOR
DSUB4: PUSHJ P,REFUP ;INSURE ROOM
SOS W,D ;ADR OF BOUNDS PAIR
ADD W,RFLINK
PUSH E,1(W) ;MOVE IT
HRRE W,(E) ;COMPUTE NEW FACTOR
HLRE T,(E)
SUB W,T
IMULI V,1(W)
SOJG B,DSUB4 ;COUNT DIMENSIONS
LDB T,DSUB4P ;MAYBE DOUBLE RELATIVE TOP
CAIL T,DOUBLE
LSH V,1
HRLM V,(C) ; & PUT TOP OPPOSITE DIMENSIONALITY
HRLI E,(POINT 18,,35) ;POINT TO REFERENCE BYTES
JUMPE H,RSUB7 ;JUMP NO REFERENCES
RSUB6: CAIG G,(E) ;ROOM?
PUSHJ P,REFUP+2 ;NO, MAKE IT
ADD H,RFLINK ;GET REF ADR
HRRZ T,1(H)
SUB T,RFBASE ;MAKE ADR RELATIVE
IDPB T,E ;DEPOSIT IT
HLRE H,1(H) ;LINK TO NEXT REF
TLNN E,100
TRNE T,777000
JUMPN H,RSUB6 ;ANOTHER REF?
TLC E,3300 ;SWITCH TO 9-BIT REF BYTES
JUMPN H,RSUB6 ;ANOTHER REF?
TLC E,3300 ;RESTORE BYTE SIZE
RSUB7: IDPB H,E ;NO, DELIMIT REFS
JUMPN X,DSUB3 ;ANOTHER ARRAY?
RFSTAL: SKIPN GLOBAL ;FIRST PROGRAM OF FILE?
JRST DSUB5 ;YES, GO LOOKUP PROGRAM NAME
SETZ W, ;ZERO DELIMITER MAY BE NECESSARY
PUSHJ P,RFSCHA
MOVE V,RFSKP ;PICK UP LENGTH BYTE POINTER
MOVE A,RFSLAB ; & LABEL SYMBOL POINTER
MOVE B,RFSKA ; & STARTING PROGRAM ADR
TLNN F,4 ;SPECIAL FLAG IN 4TH WORD OF HEADER
TLO W,LBLFLG ; INDIACTING NO INITIALIZATION CODE
RFSTA1: MOVEI T,-1(V) ;PACK POINTER INTO LEFT HALF OF VALUE
SUB T,RFLINK
DPB T,RFSTA3
LDB T,RFSTA4
DPB T,RFSTA5
IORB W,-1(A)
ADDI A,2 ;NEXT LABEL SYMBOL PAIR
MOVE W,-1(A)
RFSTA2: CAIN B,(W) ;CORRESPONDS TO CODE LOCATION?
JRST RFSTA1 ;YES
ILDB T,V
JUMPN T,.+5
ILDB T,V
LSHC T,-4
ILDB T,V
LSHC T,4
ADD B,T
JUMPN T,RFSTA2
SOS U,STATAB ;FINISHED, NEED ZERO WORD
CAIE U,(V) ; FOR DELIMITER?
AOS STATAB ;YES
TLZ F,6 ;ZERO SPECIAL FLAGS
JRST DSUB5 ;GO LOOKUP PROGRAM NAME
RFSTA3: POINT 12,W,17
RFSTA4: POINT 4,V,3
RFSTA5: POINT 4,W,3
DSUB5: JUMPE J,GETHGH ;ANOTHER PROGRAM THIS FILE?
SKIPA V,MANSYM ;YES, LOOKUP PROGRAM NAME
AOBJP V,GETHGH ;JUMP IF NOT FOUND
CAME J,(V)
AOBJN V,.-2
HLLZ W,3(V) ;THIS PROG ALREADY DONE?
JUMPN W,DSUB5A
ADDI V,4 ;FIX POINTER TO BEYOND HEADER
HLL V,-3(V)
MOVEM V,RFSLAB ;SAVE LABEL SYMBOL POINTER
HRLO Y,-3(V) ;HOLD PROGRAM BASE
SKIPN W,-2(V) ; (MAKE AOBJN POINTER FOR CODE)
MOVS W,START
SUB Y,W
HRR Y,-3(V)
MOVEM Y,RFBASE ;AOBJN POINTER IN AC Y
MOVSI T,LBLFLG ;SKIP LABELS TO MAKE LOOKUP FASTER LATER
JUMPG V,.+3
DSUB5L: TDNE T,1(V)
AOBJN V,DSUB5J
MOVEM V,GLOBAL ;HOLD PROGRAM SYMBOL POINTER
MOVE G,RFLINK ;INITIAL BOTTOM OF LINKED-LIST AREA
SETZM DUMMYH
SKIPG GETIME ;DOING LOAD ONLY?
JRST RSUB2 ;GO GET ARRAY,V
TLON F,(1B2) ;YES, TELL PROGS THAT CAN BE DEBUGGED
OUTSTR DSUB5N
MOVE W,J
PUSHJ P,RX5OUT
OUTSTR DSCRLF
JRST RSUB2
DSUB5N: ASCIZ"ROUTINES UNDER MANTIS CONTROL:
"
DSCRLF: ASCIZ"
"
DSUB3P: POINT 12,1(A),17
DSUB4P: POINT 3,1(A),2
DSUB5J: AOBJN V,DSUB5L
DSUB5S: HRREM W,RFSTA
DSUB5A: SETZB J,GLOBAL ;SKIP OVER ARRAY DEFS FOR THIS PROG
JSP H,REFWRD ; WHICH MAY BE 'BLOCKDATA'
AOSGE RFSTA ;THIS KLUDGE WONT WORK IF
JRST DSUB5A ; 'BLOCKDATA' OCCURS BEFORE MAIN PROG
JUMPGE W,RSUB0
TLNE W,(20B5)
JRST DSUB5S
TLNN W,(10B5)
JRST RSUB2P ;HAVE PROG NAME
JSP H,REFWRD
JUMPE W,DSUB5A
AOJE W,DSUB5A
JRST REFWRD
DSUB6A: IMULI A,1(W) ;RANGE NOT ZERO, NEW FACTOR
AOJA B,REFWRD ; & COUNT DIMENSIONS & LOOP
DSUB6P: POINT 3,1(V),2
RSUB88: POINT 4,(V),12
RSUB89: POINT 4,2(V),12
DSUB6: JSP H,RFLOOK ;LOOKUP NAME
AOS D,E ;HOLD SCRIPT ADR
MOVEI U,(D) ;MAKE IT RELATIVE
SUB U,SCRIPT
MOVSI C,DMYFLG(U) ;HOLD IT & DUMMY FLAG IN LH
MOVEI B,0 ;ZERO DIMENSIONALITY
MOVEI A,1 ;INITIAL FACTOR
JSP H,REFWRD ;GET A WORD
JUMPE W,DSUB7 ;END OF DUMMY BOUNDS?
PUSHJ P,REFUP ;MAYBE NOT, INSURE ROOM
MOVEM W,1(E) ;DEPOSIT BOUNDS PAIR
HLRE T,W ;COMPUTE RANGE
SUB W,T
TRNN W,-1 ;RANGE ZERO?
SKIPL 1(E) ;DIMENSION OF FORM ARRAY(1) ALLOWED
AOJA E,DSUB6A ;NO
SETZB A,H ;WE HAVE VARIABLE DIMENSIONS
MOVE W,V ;HOLD SYMBOL POINTER IN CASE
MOVEI E,(D) ;RESTORE SCRIPT ADR
TLO C,ARRFLG ;WE WANT TO ZERO ARRFLG
DSUB7: CAIN A,1 ;CHECK FOR ONLY ONE ELEMENT
TLO F,(1B1)
LDB U,DSUB6P ;MAYBE DOUBLE TOP
CAIL U,DOUBLE
LSH A,1
XORB C,1(V) ;SET POINTER INTO SYMBOL TABLE
MOVE V,RFBASE ;LOOK FOR REFERENCE
DSUB7A: MOVE T,(V) ;PICK UP INSTR
TLZ T,777740 ;MASK OFF EFFECTIVE ADR
CAIE T,(C) ;THIS IT?
AOBJN V,DSUB7A ;NO
HLRZ T,(V) ;SUBROUTINE ARG?
HLRZ U,1(V)
CAIGE T,(JUMP)
CAIL U,(HLL)
AOBJN V,DSUB7A ;YES SO THIS NOT IT
JUMPN A,DSUB8 ;VARIABLE DIMENSIONS?
JUMPL V,DSUB8V ;ONE REF FOUND?
DPB A,DSUB8P ;NO, ZERO SCRIPT POINTER
MOVEI E,-1(D) ;RESET SCRIPT ADR
JRST RSUB2 ;FINISHED
DSUB8P: POINT 12,1(W),17
DSUB8V: HRRZ A,2(V) ;YES, LOCATE MULTIPLIER ADJ CALL
ADDI A,1
HRRZ B,RFBASE
ADDI B,3
MOVE T,JSAADJ
CAMN T,-3(B)
CAIE A,@-1(B)
AOJA B,.-2
DSUB8: HRRZM B,(D) ;DEPOSIT DIMENSIONALITY OR ADR
HRLM A,(D) ;TOP OF ARRAY OPPOSITE
HRLI E,(POINT 18,,35) ;POINT TO REFERENCE BYTES
JUMPG V,RSUB9+2 ;FINISHED IF NO REFS FOUND
JUMPG F,RSUB9+2 ;READ MORE IF NOT SUBCHECK
MOVSI D,013000 ;SETUP FOR FIXED DIMENSIONS
MOVEI U,(C)
JUMPN H,DSUB81
MOVN D,-2(B) ;SETUP FOR VARIABLE DIMENSIONED
HRLI D,-1(D) ; RECOGNITION OF COMPUTED REF
TLC C,(6B2)
TLNE C,(6B2)
ADDI D,1 ;NOT DOUBLEWORD TYPE
HRRZ U,2(V)
DSUB81: CAMLE U,DUMMYH
MOVEM U,DUMMYH
HRLZM U,(U)
RSUB8: JUMPN H,RSUB8X ;JUMP IF FIXED DIMENSIONS
ADD V,RSUB8A ;SKIP PAST REF CALC
MOVEI A,(V)
ADD A,D
RSUB82: LDB U,RSUB8U ; 'MOVEI' ?
CAIN U,201
JRST RSUB83 ;YES, SO THIS DIMENSION SPECIFIC
LDB T,RSUB8T ; 'IMUL' ?
CAIN T,220
JRST RSUB84 ;YES, SO THIS REF COOMPUTED
RSUB83: SUBI A,3 ;LOOK AT NEXT DIMENSION CALCULATION
AOBJN A,RSUB82
JRST RSUB9A ;REF SPECIFIC
RSUB84: LDB B,RSUB89 ;LOAD AC TO BE LOOKED FOR
PUSH P,V
RSUB81: MOVS T,(V) ;LOOK FOR RIGHT INDEXED INSTR
ANDI T,17
CAIE T,(B)
AOBJN V,RSUB81
CAIG G,(E) ;ROOM?
PUSHJ P,REFUP+2 ;NO, MAKE SOME
MOVEI T,(V) ;COMPUTE RELATIVE REF ADR
SUB T,RFBASE
IDPB T,E ;DEPOSIT BYTE
TLNN E,100
TRNE T,777000
TRNA
TLC E,3300 ;SWITCH TO 9-BIT REF BYTES
RSUB90: POP P,V
RSUB9A: MOVE T,(V) ;LOOK FOR ANOTHER REF
TLZ T,777740
CAIE T,(C)
AOBJN V,RSUB9A
HLRZ T,(V)
HLRZ U,1(V)
CAIGE T,(JUMP)
CAIL U,(HLL)
RSUB9: AOBJN V,RSUB9A
JUMPL V,RSUB8 ;MORE?
SETZ T,
IDPB T,E
JRST RSUB2 ;FINISHED
RSUB8A: XWD 4,4
RSUB8X: TDNE D,(V) ;IS THIS REFERENCE?
JRST RSUB8Y ;YES
HLRZ T,1(V) ;NO UNLESS NEXT INSTR 'ADD'
HLRZ B,(V)
CAIE T,070000(B) ; ('ADD'-'MOVE')
AOBJN V,RSUB9A ;SPECIFIC REF
RSUB8Y: LDB B,RSUB88 ;LOAD AC TO BE LOOKED FOR
AOBJN V,RSUB81-1 ;GO SAVE PLACE IN PROG
RSUB8T: POINT 9,-1(A),8
RSUB8U: POINT 9,-2(A),8
RFLOOK: TLO W,(10B5) ;SET LOCAL CODE
SKIPA V,GLOBAL ;LOOKUP ARRAY NAME
AOBJP V,.+3
CAME W,(V)
AOBJN V,.-2
MOVE A,1(V) ;PICK UP VALUE WORD
TLNN A,SUBMSK ;GOOD DATA?
TLNN A,ARRFLG
JUMPL V,RSUB0 ;JUMP NO
JUMPL V,(H) ;RETURN FOUND
JSP H,REFWRD ;NOT FOUND, SKIP OVER BOUNDS
JUMPE W,RSUB2
AOJN W,REFWRD
JRST RSUB2
RFSCHK: PUSH P,RFSK6J ;PUSH RETURN TO RSUB2
RFSCHA: AOS V,STATAB ;ROOM FOR ANOTHER WORD
RFSK1: MOVEM W,(V) ;DEPOSIT WORD
TLOE F,2 ;SPECIAL CHECK?
POPJ P, ;NO
TLNE F,4 ;FIRST TIME THIS PROGRAM?
JRST RFSK7 ;NO
MOVE A,RFBASE ;GET STARTOF CODE
HLRZ T,(A)
CAIN T,(JSA 16,) ;CALL INSTR?
JRST RFSK4
CAIN T,(JRST) ;JRST?
JRST RFSK2
CAIE T,(SETZM) ;ONE-WORD FORTRAN STMT
CAIN T,(SETCMM)
JRST RFSK3
CAIE T,(AOS)
CAIN T,(SOS)
JRST RFSK3
CAIE T,(MOVNS)
CAIN T,(MOVMS)
JRST RFSK3
JRST RFSK6P ;NO, DEFAULT POINTER
RFSK2P: POINT 7,1(A),6
RFSK2: LDB T,RFSK2P ;AROUND FORMAT OR STMT FUNCTION?
CAIN T,64
JRST RFSK5 ;SPECIAL WHEN AROUND STMT FUNCTION
CAIN T,"("
JRST RFSK6P ;DEFAULT POINTER WHEN AROUND FORMAT
RFSK3: HRLI V,(POINT 4,,3) ;PUT 1 IN FIRST BYTE
MOVEI U,1
DPB U,V
HRLI V,440400 ;POINT TO VERY FIRST BYTE
JRST RFSK6
RFSK4: LDB T,RFSK2P ;IS THIS CALL WITH NO ARGS?
CAIE T,64
JRST RFSK3 ;YES, ONE-WORD STMT
MOVE T,(A) ;CALL TO MULTIPLIER ADJUSTMENT?
CAME T,JSAADJ
JRST RFSK6P ;NO, DEFAULT POINTER
RFSK5: TLC F,6 ;SET FLAG FOR SPECIAL CHECKING
AOS V,STATAB ;LEAVE ROOM FOR INITIAL CODE ADR
MOVEM W,(V)
RFSK6P: HRLI V,(POINT 4,,3) ;POINT TO SECOND BYTE BY DEFAULT
RFSK6: MOVEM V,RFSKP ;DEPOSIT BYTE POINTER TO STMT LENGTHS
HRRZM A,RFSKA ; AND CODE ADR
RFSK6J: POPJ P, RSUB2 ;RETURN
RFSK7: MOVE A,RFSKP ;PICK UP POINTER
ILDB U,A ;GET LENGTH
JUMPN U,.+5
ILDB U,A
LSHC U,-4
ILDB U,A
LSHC U,4
ADDB U,RFSKA ;UPDATE CODE ADR
MOVE T,(U) ;MORE SPECIAL CODE?
CAMN T,JSAADJ
JRST RFSK8 ;YES
HLRZS T
CAIE T,(JRST)
JRST RFSK9 ;NO
LDB T,RFSK8P ;MAYBE JRST AROUND FORMAT OR STMT FUNCTION
CAIE T,"("
CAIN T,64
JRST RFSK8 ;YES
RFSK9: HRRZM U,-1(A) ;FINISHED SPECIAL PROCESSING,
MOVEM A,RFSKP ; DEPOSIT CODE ADR OF FIRST F4 STMT
POPJ P, ; & RETURN
RFSK8P: POINT 7,1(U),6
RFSK8: CAIE V,(A) ;BYTE IN CURRENT WORD?
JRST RFSK7+1 ;NO, PICK UP ANOTHER LENGTH
SUBI A,1 ;YES, RETURN MORE SPECIAL PROCESSING
HRRZM A,STATAB ; TO DO AND FORGET PRIOR WORD
MOVEM A,RFSKP
MOVE W,1(A)
MOVEM W,(A)
TLZ F,2
POPJ P,
REFUP: CAILE G,(E) ;ROOM FOR A COUPLE OF WORDS?
POPJ P, ;YES, RETURN
MOVEI U,2000 ;UPDATE TOP OF LINKED-LIST AREA
ADDM U,RFLINK
ADDB U,STATAB ;AND TOP OF STMT LENGTHS WORD AREA
CAMG U,RDPNT ;MUST WE EXPAND CORE?
JRST REFUP1 ;NO
AOS U,.JBREL## ;YES
CORE U,
JRST HAAHHH
MOVEI U,2000
ADDM U,RDPNT
ADDB U,AUXSYM
REFUP1: HRRM U,REFUP2 ;LAST DATA LOCATION
TRZ U,1777 ;MOVE THAT TOP UP
MOVSI T,-2000(U)
HRRI T,(U)
REFUP2: BLT T, ; ...INSTR MODIFIED...
SOJA U,MOVUP ;GO MOVE REST UP
MOVUP1: MOVSI T,-3777(U) ;BLOCK MOVE 1K
HRRI T,-1777(U)
BLT T,(U)
SUBI U,2000
MOVUP: CAIG G,-4000(U) ; 1K OR LESS TO MOVE?
JRST MOVUP1 ;NO, MORE
MOVSI T,(G) ;YES, MOVE REST
HRRI T,2000(G)
BLT T,(U)
ADDI G,2000 ;UPDATE BOTTOM ADR IN AC G
POPJ P, ;RETURN SUCCESSFUL
RX5OUT: IDIVI W,50
JUMPE W,.+4
HRLM V,(P)
PUSHJ P,RX5OUT
HLRZ V,(P)
ADDI V,60-1
CAILE V,71
ADDI V,101-72
CAILE V,132
SUBI V,134-44
CAIN V,43
MOVEI V,56
OUTCHR V
POPJ P,
SDECOU: IDIVI T,^D10
JUMPE T,.+4
HRLM U,(P)
PUSHJ P,SDECOU
HLRZ U,(P)
ADDI U,"0"
OUTCHR U
POPJ P,
HAAHHH: OUTSTR .+2
CALLI 1,12
ASCIZ "?THIS CORE LOAD IS IMPOSSIBLY LARGE!
"
PDLST: -10,,.
BLOCK 10
LOWEND:
TTBUFS=LOWEND-RBUFFS*204-<2*<DDB.SZ+1>> ;TAKE SPACE FOR I/O BUFFERS
COMNOD=TTBUFS-100 ; & HOLDS COMMAND NODE BEFORE INSERTION IN ROLL
HISORG=COMNOD-DEPTH ; & SPACE FOR HISTORY
RSPACE=HISORG-SETMV ; & WHAT'S LEFT FOR ROLL STORAGE
IFE REENT,<END> >;END OF CONDITIONAL LOW SEGMENT
;PURGE DUMMY EXTERNALS
IF1,<PURGE FORSE.,END.,RESET.,ADJ.
PURGE LOWEND,TTBUFS,COMNOD,HISORG,SETSYM> ;AND SIZE DEPENDENTS TOO
RELOC 0
SETHGH: SETZ T,
SETUWP T,
JFCL
MOVEI U,SAVE.## ;INITIALIZE FOROTS DYNAMICALLY
MOVSI W,(JRA L,(L)) ;CHANGE THE RETURN TO F4 CODE
CAME W,(U)
AOJA U,.-1
SKIPA W,.+1
JRA L,@FINMAN
MOVEM W,(U)
SKIPA W,.+1 ;CHANGE THE FIRST INSTR FOR EXITING JOB
JRST MANXIT
MOVEM W,EXIT%##
MOVEI U,FORER%##+34 ;CHANGE EXIT RETURN IN ERROR MODULE
SKIPA W,.+1
MOVEI T3,EXIT%##
CAME W,-2(U)
AOJA U,.-1
SKIPA W,.+1 ;SO THAT ABORT MESSAGE IS ELIMINATED
JSP T1,MANEXT ;AND USER PC REMEMBERED BY DEBUGGER
MOVEM W,-1(U)
HRRM U,MANEXJ
MOVEI U,FORER%##+542 ;CHANGE RETURN FROM APR FAULT PROC
MOVE W,POPJ
CAME W,(U)
AOJA U,.-1
SKIPA W,.+1
JRST MANEXA
MOVEM W,(U)
MOVEI MANTS. ;SETUP HIGH SEG START ADR TO POINT TO
MOVEM .JBSA ; MANTIS UUO ENTRY POINT
SETZM .JBCOR
CALLI 12 ;HIGHSEG CAN NOW BE SSAVED
SUBTTL HIGH SEGMENT TABLE OF CONTENTS
COMMENT/
UUO DISPATCH PAGE 26
COMMAND DISPATCH 27
COMMAND DISPATCH TABLE 28
AT COMMAND DECODE 29
AT BREAK HANDLE 30
ON COMMAND DECODE 32
ON COMMAND STORE 33
ON BREAK SETUP 34
ON BREAK HANDLE 41
SUBCHECK COMMAND DECODE 45
SUBCHECK BREAK HANDLE 48
ONCALL COMMAND DECODE 52
ONCALL BREAK HANDLE 53
KILL COMMAND DECODE 54
KILL STORED COMMAND 56
KILL INTERSECTING ON COMMANDS 57
CLEAR AWAY STORED COMMANDS 58
GO COMMAND DECODE 59
OUTPUT COMMAND DECODE 60
ASSIGNMENT COMMAND DECODE 62
ASSIGNMENT INPUT SUBROUTINE 64
EXERCISE ATTACHMENTS 65
EXERCISE GO ATTACHMENT 66
EXERCISE OUTPUT ATTACHMENT 67
EXERCISE KILL ATTACHMENT 69
TRACE COMMAND 70
TRACE BREAK HANDLE 75
HISTORY COMMAND 76
USE AND MTOP COMMANDS 77
EXIT COMMAND 78
RESTART COMMAND 79
ERROR HANDLE 80
REENTRY HANDLE 84
PINPOINT ELEMENT ROUTINE 86
IDENTIFY SYMBOL ROUTINE 88
IDENTIFY LOCATION ROUTINES 90
BASIC INPUT SUBROUTINES 94
IDENTIFY AND OUTPUT POSITION SUBR 95
INTERNAL AND SQUOZE OUTPUT SUBRS 98
INSERT NODE IN ROLL 99
CANNED ERROR HANDLE 102
/
SUBTTL HIGH SEGMENT UUO DISPATCH
MANTS.:: ; MANTIS UUO DISPATCH
;RETURN IS ON STACK & AC T HOLDS LUUO INSTR
; AC T WAS SAVED IN JOBUUO
MOVEM U,ACSAVE+U ;SAVE AC'S T AND U
MOVE U,.JBUUO## ;(AC T LEFT THERE BY EXCH)
MOVEM U,ACSAVE+T
LDB U,[POINT 9,T,8] ;DISPATCH TO APPROPRIATE HANDLER
JRST @.+1(U)
Z MANINI ;INITIAL ENTRY
Z $TRACE
Z $TRACE
Z $TRACE
Z $TRACE
Z $TRACE
Z $TRACE
Z $TRACE
Z $AT
Z $SUB
Z $SUB
Z $ON
Z $CALL
Z RESER. ;RESET. NOT ALLOWED
MANINI: MOVEI REENTR ;SETUP REENTER ADR
MOVEM .JBREN
AOS U,HISTORY ;ZERO HISTORY
CLEARM -1(U)
BLT U,@HISTOP
SUBTTL COMMAND DISPATCH
POFFO: SKPINC ;TURN OFF CONTROL O
.JFCL: JFCL
PROMPT: SETOB F,V ;SET COMMAND COUNT
SETZB H,J ;ZERO STOP FLAG & DELETE LENGTH
MOVE P,ACSAVE+P ;RESET PUSHJDOWN POINTER
MOVE T,CURRENT ;SETUP DEFAULT GLOBAL PROGRAM
MOVEM T,GLOBAL
MOVE Y,HISTOP ;POINT TO TEMP NODE AREA
MAYGET: TLOE F,1 ;EXTRA CR SHOULD TERMINATE MULTILINE
JRST WHERES ; STORED COMMAND
DOGET: FIN. ;PROMPT FOR INPUT
OUTSTR [BYTE(7) 15,12,52,40]
PUSHJ P,ACCEPT
GET: PUSHJ P,SKIP
JUMPE V,MAYGET
CAIN V,";" ;COMMENT?
JRST MAYGET ;YES
GETSQZ: PUSHJ P,SQZINS ;PICK UP NAME OR COMMAND
MOVEI F,1(F) ;COUNT COMMAND
CAIE V,"=" ;ASSIGNMENT?
CAIN V,"("
PUSHJ P,STORE ; (WE NEVER RETURN)
CAIE V,":"
CAIN V,"/"
PUSHJ P,STORE ;YES, MUST BE
MOVSI U,SQZTAB-SQZDIS ;IDENTIFY COMMAND
CAME W,SQZTAB(U)
AOBJN U,.-1
JUMPG U,NCERR ;NOT IDENTIFIED?
HRRZS W,U ;OK, GET DISPATCH
ROT U,-1
HRRZ T,SQZDIS(U)
SKIPL U
HLRZ T,SQZDIS(U)
CAIGE W,STOP%-SQZTAB ;VALID ATTACHED?
JUMPN F,NAERR
PUSHJ P,@T ;DISPATCH COMMAND FINALLY
JRST PROMPT
WHERES: JUMPG F,INSERT ;INSERT STORED COMMAND IN ROLL
JUMPN V,DOGET ;IGNORE COMMENT
WHERE: FIN. ;DISPLAY POSITION ON TTY
MOVE A,[5,,[ASCII"(' PROGRAM AT '2A7,A1,I4)"]]
OUT. A,-1
MOVEI J,1 ;INCLUDING PROGRAM NAME
MOVE A,F4PC
PUSHJ P,IDLOCA
JRST PROMPT
SUBTTL COMMAND DISPATCH TABLE
SQZTAB:
ONCAL%: SQUOZE 0,ONCALL
ON%: SQUOZE 0,ON
AT%: SQUOZE 0,AT
BEFOR%: SQUOZE 0,BEFORE
SQUOZE 0,RESTART
SUBCK%: SQUOZE 0,SUBCHECK
MTOP%: SQUOZE 0,REWIND
SQUOZE 0,UNLOAD
SQUOZE 0,BACKSPACE
SQUOZE 0,QUIT
SQUOZE 0,ENDFILE
SQUOZE 0,SKIPRECORD
SQUOZE 0,PROFILE
RELE%: SQUOZE 0,RELEASE
TRACE%: SQUOZE 0,TRACE
HISTR%: SQUOZE 0,HISTORY
SQUOZE 0,RETRY
SQUOZE 0,EXIT
SQUOZE 0,TYPE
SQUOZE 0,TY
USE%: SQUOZE 0,USE
STOP%: SQUOZE 0,STOP
KILL%: SQUOZE 0,KILL
OUTPT%: SQUOZE 0,OUTPUT
SQUOZE 0,OU
GO%: SQUOZE 0,GO
SQZDIS:
CALL$,,ON$
AT$,,AT$0
RESTART,,SUBCHK
MTOP,,MTOP
MTOP,,QUIT
MTOP,,MTOP
PROFILE,,MTOP
TRACE,,HISTRY
NOTIMP,,SYSEXIT
TYPE,,TYPE
USE,,STOP$
KILL,,OUTPT
OUTPT,,GO
STOP$: MOVSI H,(1B0) ;SET STOP FLAG
JUMPN F,.+3 ;ATTACHED?
JUMPE V,WHERE ;NO, JUST PROMPT IF NOTHING FOLLOWS
SOJA F,GETSQZ ;STORED COMMAND SHOULD FOLLOW
IORM H,@HISTOP ;SET STOP BIT TEMP NODE
JRST SEMIV ;MAYBE ATTACHMENTS FOLLOWING
SUBTTL AT COMMAND DECODE
AT$0: PUSHJ P,SQZINS ; 'BEFORE RETURN FROM' ?
CAME W,[SQUOZE 0,RETURN]
JRST AT$0L
PUSHJ P,SQZINS
CAMN W,[SQUOZE 0,FROM]
PUSHJ P,SQZINS
AT$0L: MOVE T,V
PUSHJ P,GLOOK
SKIPL B,V ;PROGRAM NOT THERE?
JRST DEFERR
SKIPA A,-2(V) ;SKIP PICKUP EPILOGUE ADR
AT$: PUSHJ P,ATLOC ;GET BREAK ADR
AT$1: MOVEI G,1 ;DEFAULT COUNT
CAIE T,","
JRST AT$2
PUSHJ P,FIRSCH ;READ NUMBER
JRST TAXERR ;NOTHING THERE
DATA. INTEGER,G
JUMPLE G,GTZERR
AT$2: MOVEM B,GLOBAL ;HOLD AT PROGRAM FOR ATTACHMENTS
HRRM A,H ;HOLD BREAK ADR OPPOSITE STOP FLAG
PUSHJ P,STOP ;LOOK FOR STOP PHRASE
MOVEM H,0(Y) ;HOLD NODE TEMP
HRLS G
MOVEM G,1(Y)
MOVE V,T ;HOLD DELIMITING CHAR
HLRZ X,AT ;SEARCH ROLL FOR SAME BREAK ADR
SKIPA C,AT
AT$3: ADD X,T
CAIL X,(C)
JRST AT$4
LDB T,[POINT 6,0(X),17] ; (PICK UP NODE LENGTH)
HRRZ U,(X)
CAIE U,(A)
JRST AT$3
MOVE J,T ;FOUND SAME, HOLD DELETE LENGTH
AT$4: TLO J,2 ;INDICATE THIS ROLL
ADDI Y,2 ;BUMP TEMP NODE POINTER
JRST SEMIV ;THERE MAY BE ATTACHMENTS
SUBTTL AT BREAK HANDLE
$AT: POP P,F4PC ;SAVE PC
MOVE U,[W,,ACSAVE+W] ; & AC'S
BLT U,ACSAVE+P
MOVE F,T
$AT0: HLRZ Y,AT ;IDENTIFY NODE
SKIPA E,F4PC
$AT1: ADDI Y,(X)
LDB X,[POINT 6,0(Y),17]
HRRZ A,(Y)
CAIE A,-1(E)
JRST $AT1
MOVE U,F
ORCMI U,BRKMSK
MOVE U,@BROKE$ ;GET BROKEN INSTR
HLRZ T,U ;SIMULATE JSA?
CAIN T,(JSA J,)
JRST [HRL U,F4PC ;YES, SETUP TO DO IT ON CONTINUE
MOVSM U,ACSAVE+T
MOVSI J,ACSAVE+T
MOVEM J,ACSAVE+J
HRLI U,(JRA J,)
AOJA U,.+1]
MOVEM U,INSTR ;HOLD INSTR
SOS U,1(Y) ;COUNT !
TRNN U,-1 ;ZERO?
JRST .+3 ;YES
FTINUE: JUMPG F,TINUE ;CONTINUE F4 PROG UNLESS SUBCHECKED
JRST PROMPT
HLRM U,1(Y) ;EXECUTION COUNT HAS REACHED ZERO, RESET COUNT
JUMPL F,$AT4 ;IF ATSUB FLAG THEN ALREADY LOCATED
AOSE GLOBAL ;SHOULD WE TELL USER PROGRAM NAME?
JRST $AT2 ;NO
MOVE T,[3,,[ASCII"(' 'A6,'/')"]] ;YES
OUT. T,@CHAN
MOVE W,CURRENT
MOVE W,-4(W)
PUSHJ P,SQZOUT
FIN.
$AT2: HLRZ U,-2(E) ;IS THIS BEFORE RETURN?
CAIN U,(CALL.)
JRST [MOVE T,[4,,[ASCII"(' BEFORE RETURN'I3)"]]
OUT. T,@CHAN
MOVE U,ACSAVE+01
JUMPE U,$AT3
HLRZ T,INSTR
CAIN T,(MOVEM 01,)
DATA. INTEGER,U
JRST $AT3]
MOVE T,[4,,[ASCII"(' <'A5,'>'A1,I4)"]]
OUT. T,@CHAN
SETZ J, ;INDICATE DON'T OUTPUT PROGRAM NAME
PUSHJ P,IDLOCA
$AT3: FIN.
MOVE F,(Y) ;GET STOP FLAG
$AT4: HRRI F,2 ;NOTE THAT THIS IS AT
MOVEI G,2 ; FOR BENEFIT OF EXERCISE
JRST EXERCISE ;ANY ATTACHMENTS
SUBTTL ON COMMAND DECODE
ON$0: MOVEM H,(Y) ;HOLD STOP FLAG
PUSHJ P,IDENTL ;IDENTIFY NAME OR ELEMENT
JUMPL F,SECERR ;SECTION NOTATION NOT ALLOWED
MOVEM B,GLOBAL ;HOLD PROG FOR ATTACHMENTS
TLNE A,DMYFLG ;RELATIVE ADR +1 IF DUMMY
HRRI A,1(E)
HRRM A,(Y) ;ELEMENT ADR OPPOSITE STOP FLAG
MOVEM V,1(Y) ;HOLD SYMBOL TABLE ADR
ADDI Y,4 ;STEP NODE POINTER ASSUMING WORD RELATION
CAIE T,"." ;RELATION FOLLOWS?
SOJA Y,ON$3 ;NO
PUSH P,W ;HOLD VARIABLE TYPE
PUSHJ P,SQZINK ;YES
CAIE V,"."
JRST TAXERR
MOVSI U,-6 ;LOOK RELATION UP
CAIE W,@ON$1(U)
AOBJN U,.-1
POP P,W ;GET VARIABLE TYPE
CAIN W,COMPLEX ;COMPLEX RELATION MAY
TRNN U,-2 ; ONLY BE EQ OR NE
AOJL U,ON$2 ;FIX RELATION CODE IN AC U
JRST RELERR
ON$1: CAME SQUOZE 0,EQ ;RELATION TABLE
CAMN SQUOZE 0,NE
CAML SQUOZE 0,LT
CAMLE SQUOZE 0,LE
CAMGE SQUOZE 0,GE
CAMG SQUOZE 0,GT
ON$2: DPB U,[POINT 3,@HISTOP,11] ;HOLD RELATION CODE
MOVEI A,-1(Y) ;WHERE TO PUT CONSTANT
CAIL W,DOUBLE ;BUMP NODE POINTER IF DOUBLEWORD
AOJ Y,
PUSHJ P,INPUT ;INPUT CONSTANT
ON$3: PUSHJ P,BETWEEN ;GET CODE LIMITS
MOVE U,HISTOP ;HOLD LIMITS IN NODE
HRLM G,H
MOVEM H,2(U)
MOVEM C,(P) ;HOLD BYTE POINTER ON STACK
SUBTTL ON COMMAND STORE
SKIPA J,ON$4 ;INDICATE ON
SEMIV: POP P, ;FORGET DISPATCH RETURN
CAIN V,";" ;ARE THERE ATTACHMENTS?
JRST GET ;YES
JUMPN V,TAXERR ;MUST BE END OF INPUT
INSERT: SUB Y,HISTOP ;LENGTH OF NODE
DPB Y,[POINT 6,@HISTOP,17] ;DEPOSIT IT TEMP
JUMPG J,INSERJ ;JUMP IF NOT ON BREAK
MOVE U,HISTOP ;SETUP ON PARMS (PRESERVED THROUGH INSERTION)
MOVE F,1(U)
HLRZ G,2(U)
HRRZ H,2(U)
ON$4: SETZ D,1 ;KILL INTERSECTING ONS
HRRZS E,1(U) ; (ZERO LH OF STORED SYMBOL ADR)
SUB E,MANSYM
HRL E,(U)
PUSH P,ON
PUSHJ P,KILLON
XORM C,(P) ;SAVE INDICATION OF SUCCESS
MOVEI U,^D255 ;LIMIT OF 256 ON BREAKS
ON$5: HLRZ W,C ;LOOK FOR UNUSED ID
ON$6: CAIL W,(C)
JRST ON$7 ;FOUND
LDB T,[POINT 8,(W),8]
CAIN T,(U)
SOJGE U,ON$5
LDB T,[POINT 6,(W),17]
ADD W,T
JUMPGE U,ON$6
OUTSTR @TOOMANY ;LIMIT REACHED
JRST PROMPT
ON$7: DPB U,[POINT 8,@HISTOP,8] ;DEPOSIT ON ID IN NODE TEMP
HRRZ X,C ;GO MAKE INSERTION
MOVEI C,(Y)
JRST INSERC
SUBTTL ON BREAK SETUP
ON.1: HRRZ E,@HISTOP ;HOLD ELEMENT ADR OR ZERO IF WHOLE ARRAY
MOVE A,1(F) ;SETUP SYMBOL VALUE
JUMPE E,.+3 ;MAKE ELEMENT ADR RELATIVE IF DUMMY ARRAY
TLNE A,DMYFLG
SUBI E,@(A)
MOVEI B,2 ;WILL HOLD TOP ADR OF VARIABLE
TLC A,(6B2) ;SET SIGN IF DOUBLEWORD TYPE
TLZN A,(6B2)
TLOA A,(1B0)
SUBI B,1
LDB J,[POINT 12,A,17] ;SETUP FIXED TOP (UNUSED IF DUMMY)
SKIPE U,J
HLRZ B,@SCRIPT
ADDI B,(A)
MOVSI D,(ON. 1,) ;MAKE UUO TEMPLATE
LDB T,[POINT 8,@HISTOP,8]
DPB T,[POINT 8,D,21]
EXCH H,-1(P) ;SETUP SMT LENGTHS BYTE POINTER
MOVEM G,(P) ; & CODE ADR
ON.2: CAML G,-1(P) ;TOP ADR?
JRST ON.3 ;YES
ILDB T,H ;GET LENGTH OF STMT
JUMPN T,.+6
ILDB T,H
LSHC T,-4
ILDB T,H
LSHC T,4
JUMPE T,ON.3
HLRZ W,(G) ;INSTR AT STMT START
ADD G,T ;STEP TO STMT END
CAIN W,(JRST) ;IGNORE POSSIBLE FORMAT
JRST ON.2
MOVEI C,-1(G) ;SETUP REFERENCE CODE ADR
PUSH P,.-2 ;PUSH PLACE-ROUTINE RETURN
ANDI W,(17,)
CAIN W,(15,)
JRST ON.29
MOVEI W,@(C) ; I/O STMT?
JUMPE W,ONS19
ON.21: HLRZ W,-2(C) ;IGNORE DO CONTINUE SUBSTMT
CAIN W,(SKIPGE 00,)
JRST ON.22
HLRZ W,-1(C)
ANDI W,(17,)
TRNE T,-2 ;CANT BE IF SHORT STMT
CAIE W,(15,)
JRST ON.29
ADDI C,4
ON.22: SUBI C,6
ON.23: HLRZ W,(C)
TRZ W,(1B8)
CAIE W,(ADD 15,)
CAIN W,(MOVE 15,)
SOJA C,ON.23
JRST ON.21
ON.29: HLRZ T,(C)
CAIL T,(UFA)
JUMPL A,[SOJE T,POPJ ;NO, CORRECT CODE ADR IF DOUBLEWORD
SOJA C,.+1]
ONSET: MOVEI V,(C) ;ADR OF INSTR IN AC V
MOVE U,(V) ;GET INSTR
HLRZ W,U
CAIGE W,(40B8) ;UUO?
JRST ONS16 ;YES, MAY GET BROKEN
CAIGE W,(FAD) ;HARDWARE DOUBLE MOVE TO MEMORY?
JRST [CAIL W,(124B8) ;(DMOVEM)
CAIL W,(FIXR)
POPJ P, ;NO
JRST ONS11] ;YES
TRC W,(16,) ;SOFTWARE DOUBLEWORD OPERATION TO MEMORY?
TRZN W,(17,)
JRST [CAIN W,(JSA) ;MAYBE, SUBROUTINE CALL?
POPJ P, ;YES
HRRZ T,1(C) ;OPERATION TO MEMORY?
SUBI T,1
LDB T,[POINT 6,@T,23]
CAIE T,'M'
POPJ P,
JRST ONS11] ;YES
CAIL W,(ASH) ;STORE-TYPE INSTR?
CAIL W,(SETZ)
JRST ONS10 ;MAYBE
CAIL W,(SOS)
JRST ONS11 ;YES
CAIL W,(ADD)
CAIL W,(SOJ)
POPJ P, ;NO
CAIL W,(AOS)
JRST ONS11 ;YES
CAIGE W,(CAI)
ONS10: TRNN W,(2B8)
POPJ P, ;NO
ONS11: ANDI W,17 ;MASK INDEX FIELD OF STORE-TYPE INSTR
TLNE A,DMYFLG ;DUMMY ARRAY?
SOJA C,ONS12 ;YES
JUMPN W,[JUMPL E,ONS13 ;WE WANT INDEXED ONLY IF DOING
POPJ P,] ; FIXED COMPUTED REFERENCES
MOVEI T,(U) ;WITHIN RANGE?
CAIGE T,(B)
CAIGE T,(A)
POPJ P, ;NO
CAIE E,(U) ;MUST ELEMENT MATCH
JUMPG E,POPJ ;RETURN IF MUST BUT DOESN'T
TLZ D,(2,) ;NO ADR CHECK IF SPECIFIC DEPOSIT
ONS13: PUSHJ P,TOPGET ;PLACE BREAK FINALLY
ANDI U,BRKMSK
IOR U,D
EXCH U,(V)
MOVEM U,(W)
POPJ P,
ONS12: JUMPE W,POPJ ;DUMMY ARRAY, IGNORE IF UNINDEXED
LSH W,5 ;INDEX TO AC FIELD
MOVS U,(C) ;PICK UP INSTR
TRNE U,(760B8) ;AT. UUO?
JRST .+4
MOVSS U ;YES, GET BROKEN
ORCMI U,BRKMSK
MOVS U,@BROKE$
TRC U,(ARG) ;IGNORE ARG INSTR
TRZE U,(777B8)
CAIE W,(U) ;AC MATCHES?
ONS12A: SOJA C,ONS12+2 ;NO, STEP BACK
TLNN A,ARRFLG ;FIXED DIMENSIONS?
JRST ONS14 ;NO, VARIABLE
HLRZ T,U ;SAME ARRAY FINALLY!?
JUMPE T,ONS12A
CAIE T,(A)
POPJ P, ;ALAS NO
HLRZ T,(C) ;YES, SPECIFIC ELEMENT?
HRRZ U,(V)
CAIN V,1(C)
CAIE T,<MOVE>_-22(W)
JRST ONS15 ;NO
JUMPLE E,ONS15 ;YES, MUST TO MATCH SPECIFIC ELEMENT?
AOJA U,ONS13-3 ;YES, GO SEE IF MATCH
ONS14: HRRZ T,-3(C) ;SAME ARRAY FINALLY?
CAIE T,(A)
POPJ P, ;ALAS NO
ONS15: TLO D,(2,) ;SET CHECK ADDR FLAG
JRST ONS13 ; & GO PLACE BREAK
ONS16: CAIGE W,(AT.) ;TRACE BREAK ?
POPJ P,
CAIL W,(CALL.) ;NO, STORED BREAK?
JRST ONS18 ;NO, FORTRAN I/O - SEE IF IT'S INPUT
ORCMI U,BRKMSK ;YES, GET BROKEN
MOVEI V,@BROKE$
JRST ONSET+1
ONS19: TLO C,(1B0) ;FLAG DOING WHOLE I/O STMT
SOSA X,C ; & REMEMBER WHERE WE ARE
ONS18: JUMPL C,ONS11 ;IF DOING WHOLE WE WANT DATA. UUO
ONS20: MOVEI U,(C) ;LOOK FOR START OF I/O SEQUENCE
HLRZ T,(U)
CAIGE T,(IN.) ;BREAK?
JRST [MOVE U,(U)
ORCMI U,BRKMSK
MOVEI U,@BROKE$
JRST ONS20+1]
CAIGE T,(DATA.)
JRST ONS21 ;WE'VE IN. OR OUT.
CAIGE T,(40B8)
CAIGE T,(RTB.)
SOJA C,ONS20
CAIGE T,(MTOP.)
JRST ONS21 ;WE'VE RTB. OR WTB.
CAIGE T,(NLI.)
SOJA C,ONS20 ;DON'T WANT SLIST.
CAIL T,(34B8) ;'ENC.'
JUMPL C,ONS28 ;JUMP IF ENCODE
CAIGE T,(33B8) ;IGNORE NAMELIST INPUT
POPJ P,
SUBI T,(1B8) ;WE'VE DECODE, ADJUST OPCODE FOR FOLLOWING TEST
ONS21: TRNE T,(1B8) ;FORTRAN INPUT-TYPE UUO?
POPJ P,
JUMPG C,ONS11 ;YES, PLACE BREAK NOW IF NOT DOING WHOLE
EXCH C,X ;SCAN DOWN WHOLE I/O STMT
MOVEI Y,(U) ;REMEMBER WHERE WHOLE-TYPE BREAK GOES
ONS22: CAMG C,X ;FINISHED STMT?
JRST ONS29 ;YES
HLRZ T,(C) ;GET OPCODE
CAIL T,(INF.) ;IGNORE MACHINE OPS
SOJA C,ONS22
CAIL T,(SLIST.) ;INPUT OF ENTIRE ARRAY?
JRST ONS23 ;YES
PUSHJ P,ONSET ;DATA. UUO, PLACE BREAK
SOJA C,ONS22 ; IF WE WANT IT
ONS23: HRRZ W,1(C) ;PICK UP # ELEMENTS IN ARRAY
TLC T,(6,) ;MAYBE DOUBLEWORD
TLCN T,(6,)
LSH W,1
ONS24: MOVE U,(C) ;GET ARRAY ADR
TLNN U,(764B8)
JRST [ORCMI U,BRKMSK
MOVE U,@BROKE$
JRST .-1]
MOVEI V,(U)
TLNE A,DMYFLG ;DUMMY ARRAY?
JRST ONS26 ;YES, JUST SEE IF SAME
ADDI W,(V) ;NO, MAKE TOP OF ARRAY
JUMPE E,ONS25 ;SPECIFIC ELEMENT?
CAIL E,(V) ;YES, IN RANGE?
CAIL E,(W)
SOJA C,ONS22 ;NO
JRST ONS27 ;YES, GO SET BREAK FLAG
ONS25: CAILE W,(A) ;DO AREAS OVERLAP?
CAIL V,(B)
SOJA C,ONS22 ;NO
JRST ONS27 ;YES, SET BREAK FLAG
ONS26: CAIN V,(A) ;SAME DUMMY ARRAY?
ONS27: TLO D,(4,) ;SET BREAK FLAG
SOJA C,ONS22
ONS28: MOVEI Y,(U) ;REMEMBER WHERE ENCODE BREAK GOES
HRRZ W,(Y) ;COMPUTE # WORDS
ADDI W,4 ;THAT MAY BE MODIFIED BY ENCODE
IDIVI W,5
SUBI C,3 ;POINT TO ARRAY ADR
HLRZ T,1(C)
CAIE T,(HRRM 00,)
SUBI C,1
JRST ONS24 ; & SEE IF WE BREAK
ONS29: MOVEI V,(Y) ;WHERE WHOLE BREAK WILL GO
TLNE D,(4,)
PUSHJ P,ONS13 ;PLACE WHOLE I/O STMT BREAK
TLZ D,(6,)
POPJ P, ; RETURN FINALLY!
ON.3: TLNE A,DMYFLG ;DUMMY ASSUMED NOT OVERLAPPED WITH ANYTHING
JRST INSURE
TLZ D,(1,) ;RESET UUO TEMPLATE
TLO D,(2,)
HRRZ G,GLOBAL ;HOLD LOWEST LOCAL SYMBOL POINTER
HRRO E,-3(G) ; & PROGRAM BASE WITH FLAG
HRRZM F,H ; & GIVEN SYMBOL POINTER
EXCH G,(P) ; & CODE LIMITS
EXCH H,-1(P)
MOVEI X,(A) ; & AREA LIMITS
MOVEI Y,(B)
ON.4: TLNN A,DMYFLG ;SKIP THIS SYMBOL IF DUMMY ARRAY
SKIPN U,J
JRST ON.7
HLRZ B,@SCRIPT ;GET FIXED TOP
ADDI B,(A)
CAILE Y,(A) ;OVERLAP?
CAIL X,(B)
JRST ON.7 ;NO
ADD J,SCRIPT ;YES, POINT TO REFERENCE BYTES
ADD J,(J)
HRLI J,(POINT 18,,35)
JRST ON.6 ; & ENTER BREAK LOOP
ON.5: ADDI C,(E) ;REF ADR
CAIGE C,(G) ;TOO LOW?
JRST ON.7
CAIGE C,(H) ;TOO HIGH?
PUSHJ P,ONSET ;PLACE BREAK
ON.6: ILDB C,J ;NEXT ARRAY REFERENCE
TLNN J,100
CAIL C,1000
JUMPN C,ON.5
TLC J,3300 ;SWITCH TO 9-BIT REF BYTES
JUMPN C,ON.5
ON.7: AOBJP F,.+3 ;NEXT SYMBOL
AOBJN F,.+3
AOS F,-1(P)
SUBI F,3
MOVE A,1(F)
TLNN A,LBLFLG ;FINISHED?
CAMGE F,(P)
JUMPG F,INSURE ;JUMP YES FINALLY
LDB J,[POINT 12,A,17] ;NO, SEE IF THIS SYMBOL
JRST ON.4 ; IS FIXED DIMENSIONED ARRAY
SUBTTL ON BREAK HANDLE
$ON: POP P,J ;GET PC (DESTROY AC J)
HRLI J,0 ;BREAK IS FROM PROG?
CAIE J,INSTR+1
MOVEM J,F4PC ;YES, DEPOSIT PC
MOVE U,-1(J) ;PICK UP INSTR
LDB J,[POINT 8,U,21] ;GET ON ID
HRRI T,(J) ; OPPOSITE CHECK FLAGS
ORCMI U,BRKMSK ;GET BROKEN INSTR
MOVE J,@BROKE$
TLNE J,(764B8) ;NOP IT IF NOT ANOTHER ON BREAK
MOVE J,ZERON ; & MAKE SURE FLAGED ZERO
MOVEM J,INSTR ;DEPOSIT BROKEN INSTR
MOVEM Y,ACSAVE+Y ;IDENTIFY NODE IN AC Y
HLRZ Y,ON
JRST .+3
LDB J,[POINT 6,(Y),17]
ADDI Y,(J)
LDB J,[POINT 8,(Y),8]
CAIE J,@T
JRST .-4
MOVE J,1(Y) ;GET SYMBOL VALUE
MOVE J,1(J)
TLC J,(6B2) ;SETUP TEST FOR DOUBLEWORD
SKIPE ONA ;HAS DEPOSIT BEEN PERFORMED?
JRST $ON1 ;YES
ORCMI U,BRKMSK ;NO, GET MACHNE INSTR
MOVE U,@BROKE$
TLNN U,(764B8)
JRST .-3
MOVEM U,ONTEMP ;HOLD IT TEMP
TLNE U,(757B8) ;I/O INSTR?
TLNE T,(4,)
TLO Y,(1B0) ;YES, SET ON I/O FLAG
TLNN J,(6B2) ;DOUBLEWORD DEPOSIT?
TLNN U,(640B8)
JRST .+4 ;NO
JUMPL Y,.+3
MOVE U,@F4PC ;YES
AOSA F4PC
MOVSI U,(JFCL) ;NO
MOVEM J,ACSAVE+J ;EXECUTE DEPOSIT
EXCH Y,ACSAVE+Y
EXCH U,ACSAVE+U
EXCH T,ACSAVE+T
PUSHJ P,ONTEMP
MOVEI J,@ONTEMP ; (SETUP DATA ADR IN ONA & I/O FLAGS
HLL J,ACSAVE+Y
MOVEM J,ONA
XCT ACSAVE+U
EXCH T,ACSAVE+T ;RESTORE AC'S
MOVEM U,ACSAVE+U
EXCH Y,ACSAVE+Y
MOVE J,ACSAVE+J
$ON1: TLNE T,(4,) ;BREAK ON WHOLE I/O STMT ALWAYS HAPPENS
JRST $ON4+3
TLNE J,DMYFLG ;GET BOTTOM OF DUMMY ARRAY
HRR J,(J)
TLNN T,(2,) ;ARE WE CHECKING DEPOSIT ADR?
JRST $ON3 ;NO
HRRZ T,(Y) ;YES, ON WHOLE ARRAY?
JUMPE T,$ON2
TLNE J,DMYFLG ;NO, COMPUTE DUMMY ELEMENT ADR
ADDI T,-1(J)
CAIE T,@ONA ;MATCH?
JRST $ON51 ;NO BREAK
JRST $ON3 ;YES
$ON2: MOVEI T,@ONA ;GET ADR ARRAY ELEMENT
CAIGE T,(J) ;BELOW BOTTOM?
JRST $ON51 ;YES, NO BREAK
LDB U,[POINT 12,J,17] ;NO, GET ARRAY TOP
MOVS U,@SCRIPT
TLNE U,-200 ;VARIABLE DIMENSIONS?
MOVE U,(U) ;YES
ADDI U,(J) ;NO
CAIL T,(U) ;ADR ABOVE TOP?
JRST $ON51 ;YES, NO BREAK
$ON3: LDB U,[POINT 3,(Y),11] ;PICK UP RELATION CODE
SOJL U,$ON4 ;JUMP IF ALWAYS BREAK
MOVE T,@ONA ;GET DATA WORD
TLNN J,(6B2) ;DOUBLEWORD?
JRST [MOVE J,ONA ;YES
MOVE J,1(J)
CAIL U,2 ;DOUBLE COMPARE
CAMN T,3(Y)
XCT [CAMN T,3(Y)
CAME T,3(Y)
CAMG J,4(Y)
CAMGE J,4(Y)
CAMLE J,4(Y)
CAML J,4(Y)](U)
XCT [CAME J,4(Y)
CAMN J,4(Y)
CAMLE T,3(Y)
CAMLE T,3(Y)
CAMGE T,3(Y)
CAMGE T,3(Y)](U)
JRST $ON51 ;NO BREAK
JRST $ON4] ;BREAK
XCT [CAME T,3(Y) ;SINGLE COMPARE
CAMN T,3(Y)
CAML T,3(Y)
CAMLE T,3(Y)
CAMGE T,3(Y)
CAMG T,3(Y)](U)
JRST $ON51 ;NO BREAK
$ON4: SKIPL U,ONA ;JUMP IF CAN BREAK BECAUSE NOT I/O
JRST $ON6
TRZA U,-1 ;SET CHANGED BY I/O FLAG IN NODE
MOVSI U,(3B1) ; & ENTIRE ARRAY FLAG
IORM U,1(Y)
SKIPE DRAIN ;BREAK ON FIN. ALREADY?
JRST $ON5
MOVEI T,REEFIN
MOVEM T,FINMAN
HRROS DRAIN ;SET FLAG
$ON51:
$ON5: MOVE Y,ACSAVE+Y ;RETURN TO PROGRAM (OR BREAK AGAIN)
MOVE U,ACSAVE+U
MOVE T,ACSAVE+T
SKIPG INSTR ;REENTER STOP?
SKIPG REESTOP
JRST INSTR
JRST REEYES
$ON6: MOVE U,[W,,ACSAVE+W] ;SAVE AC'S & TELL USER ABOUT BREAK
BLT U,ACSAVE+X
MOVEM P,ACSAVE+P
MOVE T,[4,,[ASCII"(' AT '2A7,A1,I4)"]]
OUT. T,@CHAN
HRRZ T,F4PC
PUSHJ P,IDLOCS
FIN.
$ON61: MOVE C,1(Y) ;SETUP SYMBOL POINTER,
MOVE A,1(C)
LDB B,[POINT 3,A,2] ; VARIABLE TYPE,
LDB D,[POINT 12,A,17] ; SCRIPT INDEX,
JUMPE D,.+5
TLNE A,DMYFLG
HRR A,(A)
MOVEI J,@ONA ; RELATIVE ELEMENT ADR,
SUBI J,(A)
MOVEI A,@ONA ; ABSOLUTE ADR,
MOVE F,(Y) ; STOP FLAG,
HRRI F,1 ; ON INDICATOR,
LDB X,[POINT 6,(Y),17] ; END OF NODE,
ADD X,Y
PUSH P,Y ; START OF NODE,
ADDI Y,2 ; ADR OF ATTACHMENTS,
TLNN F,(7B11) ; & GO TELL VARIABLE CHANGE
JRST $OUT6 ; & EXERCISE ATTACHMENTS
CAIL B,DOUBLE
AOJ Y,
AOJA Y,$OUT6
$ON7: MOVE Y,ON ;SETUP SCAN OF ON NODES
HLRZ X,Y ; FOR ONS TRIGGERED BY I/O
AOJA F,$ON70 ;STOP YES OR IF ILLEGAL REFERENCE
$ON71: LDB J,[POINT 6,(X),17] ;NEXT NODE
ADDI X,(J)
$ON70: CAIL X,(Y) ;IF FINISHED GO STOP OR CONTINUE
JRST FTINUE
SKIPL C,1(X) ;FLAGGED?
JRST $ON71
HRRZM C,1(X) ;YES, CLEAR LEFT HALF FLAGS
MOVE A,1(C) ;SETUP ABSOLUTE ADR,
LDB B,[POINT 3,A,2] ; VARIABLE TYPE,
TLZ A,(7B2)
LDB D,[POINT 12,A,17] ; SCRIPT INDEX,
HRRZ J,(X) ; RELATIVE ELEMENT ADR,
JUMPE D,$ON9
JUMPE J,$ON90 ;JUMP IF WE WERE WATCHING WHOLE ARRAY
TLNE A,DMYFLG
SKIPA A,(A) ;DUMMY ARRAY
SUBI J,-1(A) ;NON-DUMMY
SUBI J,1
ADDI A,(J) ;SETUP ABSOLUTE ELEMENT ADR
TLNE C,(1B1) ;I/O MODIFIED WHOLE ARRAY?
$ON90: SETZB A,D ;YES, JUST OUTPUT ARRAY NAME
$ON9: PUSHJ P,$OUT60 ;TELL ABOUT THAT ON BREAK
JRST $ON71 ; & LOOK AT NEXT NODE
SUBTTL SUBCHECK COMMAND DECODE
SUBCHK: MOVE X,H ;HOLD STOP FLAG IN AC X
MOVEI G,0 ;DEFAULT LIMITS IN AC'S G & H
MOVEI H,200000
MOVE E,MANSYM ; & SYMBOLS IN AC E
JUMPE V,SUBCH2 ;JUMP IF DOING ALL
MOVE F,GLOBAL ;DEFAULT PROGRAM
SUBCH0: PUSHJ P,SQZINS ;GET NAME
CAIE V,"/" ;PROGRAM?
JRST [MOVE B,F ;NO, LOOKUP ARRAY NAME
PUSHJ P,IDENT2
MOVEI E,(V) ;SYMBOL IN AC E
JUMPL V,SUBCH1
JRST DEFERR]
PUSHJ P,GLOOK ;LOOKUP PROGRAM NAME
SKIPL F,V ;HOLD IN AC F
JRST DEFERR
MOVEM F,GLOBAL ;UPDATE DEFAULT PROGRAM
PUSHJ P,SKIP ;ARRAY NAME FOLLOWS
CAIE V,","
JUMPN V,SUBCH0 ;YES
MOVE E,F ;SYMBOL IN AC E
SKIPN V
TDZA T,T
PUSHJ P,TSKIP
SUBCH1: PUSHJ P,BETWEEN ;LIMITS PHRASE FOLLOWS?
JUMPN V,TAXERR
HRRZ F,-3(F) ;HOLD CODE BASE
SUBCH2: MOVSI T,(10B5) ;SYMBOL LOCAL?
TDNN T,(E)
AOBJN E,[HRRZ F,(E) ;NO, HOLD PROGRAM CODE BASE
AOBJN E,SUBCH9]
MOVE A,1(E) ;DEFINED ARRAY?
TLNN A,LBLFLG
TLNN A,SUBMSK
JRST SUBCH9 ;NO
LDB C,[POINT 12,A,17]
ADD C,SCRIPT
TLNE A,ARRFLG ;YES, VARIABLE DIMENSIONS?
ADD C,(C) ;NO, BUMP SCRIPT TO REFS
HRLI C,(POINT 18,,35) ; POINT TO BYTES
MOVSI D,(SUB.) ;SETUP UUO
MOVEI T,(E)
SUB T,MANSYM
LSH T,-1
DPB T,[POINT 8,D,21]
LSH T,-10
DPB T,[POINT 4,D,12]
JRST SUBCH8 ;ENTER LOOP
SUBCH4: ADDI B,(F) ;MAKE REF ADR ABSOLUTE
CAIL B,(G) ;BELOW LIMIT?
CAIL B,(H) ;ABOVE LIMIT?
JRST SUBCH8 ;YES
MOVE U,(B) ;PICK UP WHAT'S THERE
JUMPL X,SUBCH6 ;JUMP IF REMOVING BREAKS
TLO X,1 ;WE'RE SETTING BREAK
TLNN U,760000 ;BREAK THERE?
JRST SUBCH5 ;YES
SBCH4P: PUSHJ P,TOPGET ;NO, GET PLACE FOR BROKEN INSTR
ANDI U,BRKMSK ;MAKE UUO
IOR U,D
EXCH U,(B) ;DEPOSIT IT
MOVEM U,(W)
JRST SUBCH8 ; & PROCESS NEXT REF
SUBCH5: TLC U,(3B8) ;ON. BREAK THERE?
TLCN U,(3B8)
JRST SBCH4P ;YES, PLACE BREAK OVER IT
MOVE T,D ;MAKE ATSUB. BREAK IF AT. THERE
TLC T,(3B8)
TRZ U,-BRKMSK-1
TRO T,(U)
TLNN U,(3B8)
MOVEM T,(B)
JRST SUBCH8 ; & PROCESS NEXT
SUBCH6: TLNE U,(760B8)
JRST SUBCH8
TLNE U,(2B8) ;REMOVING, BREAK THERE?
JRST SUBCH7 ;NOT AT.
MOVE T,[AT. BRKMSK] ;MAKE ATSUB. INTO AT. BREAK
ANDM T,(B)
JRST SUBCH8 ;AND PROCESS NEXT INSTR
SUBCH7: TLNE U,(1B8) ;ON. BREAK?
JRST SUBCH8 ;YES
ORCMI U,BRKMSK ;ADD TO HIGH AVAIL LIST
MOVE T,U
EXCH T,BRIST$
EXCH T,@BROKE$ ; & RESTORE BROKEN INSTR
MOVEM T,(B)
SUBCH8: ILDB B,C ;PICK UP NEXT REF BYTE
TLNN C,100
CAIL B,1000
JUMPN B,SUBCH4 ;ANOTHER REF?
TLC C,3300 ;SWITCH TO 9-BIT REF BYTES
JUMPN B,SUBCH4 ;GO PROCESS IT
SUBCH9: AOBJN E,.+1 ;GO PROCESS NEXT SYMBOL
AOBJN E,SUBCH2
JUMPGE X,[TLNE X,1 ;FINISHED IF SETTING UP SUBCHECKING
OUTSTR[ASCIZ"SETUP
"]
TLNN X,1
OUTSTR[ASCIZ"NO COMPUTED REFS"]
POPJ P,]
SKIPN G ;ANY BREAKS AT ALL UP THERE?
SKIPE @HISTOP ; (CONSULT TEMP CLEAR FLAG)
TOPFFA: POPJ P, TOPFF$
MOVEI L,TOPFFA ;NONE AT ALL
PUSHJ P,DECOR.## ;SO DEALLOCATE ALL BROKEN SPACE
SETZM TOPFF$
SETZM BRIST$
POPJ P, ;RETURN
TOPGUP: PUSH P,L ;PRESERVE AC J
MOVEI L,UA ;SETUP CALLING SEQUENCE
SKIPN U,TOPFF$
JRST TOPINI ;NO SPACE AT ALL
MOVEI T,-204(U) ;ALLOCATE LARGER SPACE
HRRZ U,BROKE$
SUB U,T
PUSHJ P,ALCOR.##
JUMPL T,NOCORE ;JUMP IF NO SPACE
PUSH P,T ;HOLD ALLOCATED ADR
ADD U,T ;MOVE OLD BROKEN TO NEW SPACE
HRRM U,BROKE$
HRL T,TOPFF$
ADDI T,204
BLT T,-1(U)
MOVE U,TOPFF$ ;RELEASE OLD SPACE
PUSHJ P,DECOR.##
POP P,T ;REMEMBER NEW SPACE
MOVSI U,203 ;SETUP AVAILABLE LIST
TOPSET: MOVEM T,TOPFF$
HRR U,BROKE$
SUBM T,U
HRREM U,BRIST$
AOBJP U,.+3
HRREM U,@T
AOJA T,.-2
SETZM @T
POP P,L ;RESTORE AC J
TOPGET: SKIPN U,BRIST$ ;AVAILABLE FROM LINKED LIST?
JRST TOPGUP ;NO
MOVEI W,@BROKE$ ;YES
MOVE T,(W)
MOVEM T,BRIST$
UA: POPJ P, U
TOPINI: MOVEI U,DDB.SZ ;MAKE INITIAL BROKEN ALLOCATION
PUSHJ P,ALCOR.##
ADD U,T
HRRM U,BROKE$
MOVSI U,DDB.SZ-1 ;GO SETUP AVAILABLE LIST
JRST TOPSET
NOCORE: OUTSTR [ASCIZ"?TOO LITTLE CORE
"]
JRST PROMPT
SUBTTL SUBCHECK BREAK HANDLE
$SUB: POP P,J ;GET PC (DESTROY AC J)
MOVEM J,F4PC
MOVE U,-1(J) ;GET BREAK DATA
LDB J,[POINT 8,U,21]
LSH J,1
LDB T,[POINT 4,U,12]
DPB T,[POINT 4,J,26]
ORCMI U,BRKMSK
MOVE U,@BROKE$ ;GET BROKEN INSTR
MOVEM U,INSTR
TLNN U,(764B8) ;MACHINE INSTR?
JRST [ORCMI U,BRKMSK ;NO
MOVE U,@BROKE$
JRST .-1]
MOVEI T,@U ;GET ARRAY REFERENCE ADR
MOVEM U,SUBINS ;HOLD MACHINE INSTR
ADD J,MANSYM ;SYMBOL ADR
HRRZM J,SUBSYM ;HOLD SYMBOL POINTER
MOVE J,1(J) ;FLAGS & BOTTOM OF ARRAY
TLNE J,DMYFLG
HRR J,(J)
CAIGE T,(J) ;REFERENCE BELOW BOTTOM?
JRST $SUB1 ;YES, TELL USER
LDB U,[POINT 12,J,17] ;GET TOP OF ARRAY
MOVS U,@SCRIPT
TLNE U,-200 ;VARIABLE DIMENSIONS?
MOVE U,(U) ;YES, GET TOP SETUP BY ADJ.
ADDI U,(J) ;NO, COMPUTE TOP
CAIL T,(U) ;REFERENCE ABOVE TOP?
JRST $SUB1 ;YES, TELL USER
MOVE U,F4PC ;REFERENCE OK BUT IS THIS AT BREAK TOO?
MOVE T,-1(U)
TLNE T,(1B8)
JRST $AT+1 ;YES, TAKE IT
MOVE U,ACSAVE+U
MOVE T,ACSAVE+T
JRST INSTR ;CONTINUE PROGRAM
$SUB1: MOVEI T,-1 ;SWITCH OUTPUT TO TTY
MOVEM T,CHAN
MOVE T,SUBINS ;IS THIS DATA. BREAK?
TLNN T,757000
JRST $SUB2
MOVE U,[W,,ACSAVE+W]
BLT U,ACSAVE+P
MOVE T,[9,,[ASCII"(' REFERENCE TO 'A6,' ILLEGAL AT '2A7,A1,I4)"]]
OUT. T,@CHAN
MOVE W,@SUBSYM
PUSHJ P,SQZOUT
HRRZ T,F4PC
PUSHJ P,IDLOCS
MOVE F,F4PC
MOVE F,-1(F)
TLON F,(401B8) ;SET FLAG IF HANDLING AT. BREAK NOW
JRST PROMPT
FIN.
JRST $AT0
$SUB2: AND T,[DATA. 17,] ;SETUP SIMULATE FORTRAN UUO
MOVEM T,.JBUUO
MOVE T,F4PC
MOVEM T,@UUOPC
MOVE J,SUBSYM
SKIPN U,DRAIN ;FIRST BAD REF THIS I/O STMT?
JRST $SUB5 ;YES, GO PLACE TEMP BREAK ON FIN.
MOVE T,HISTOP ;THIS ARRAY BAD ALREADY NOTED?
HRLI U,0
CAME J,@T
SOJG U,[AOJA T,.-1]
JUMPG U,$SUB4 ;JUMP YES
$SUB3: AOS U,DRAIN ;NOTE BAD REF TO THIS ARRAY
ADD U,HISTOP
MOVEM J,-1(U)
$SUB4: ;THROW AWAY THIS DATA
SETZB T,U ; OR WRITE ZERO AS APPROPRIATE
JRST @MANUUF ;SIMULATE UUO
$SUB5: MOVEI T,REEFIN ;FIRST BAD REF, USE REENTR CODE
MOVEM T,FINMAN
JRST $SUB3 ;GO NOTE BAD REFERENCE
$SUB9: HRRZ F,DRAIN
$SUB8: FIN.
SOJL F,$ON7 ;GO SEE IF ANY ON BREAKS TO REPORT
MOVE T,[12,,[ASCII"(' ILLEGAL I/O REFERENCES 'A6,A4,/T9,6(A6,A4,1X))"]]
OUT. T,-1
ADD F,HISTOP
SKIPA X,HISTOP
$SUB7: DATA. HOLLER,G
MOVE W,@(X)
PUSHJ P,SQZOUT
CAIG F,(X)
SKIPA G,[ASCII" AND"]
MOVSI G,(ASCII" ,")
CAIE F,(X)
AOJA X,$SUB7
SETO F, ;INDICATE ILLEGAL REFS
JRST $SUB8
SUBTTL ONCALL COMMAND DECODE
ON$: PUSHJ P,SQZINS ;CHECK FOR ONCALL
CAIE V,"/"
CAME W,[SQUOZE 0,CALL]
JRST ON$0 ;IT'S ON BREAK COMMAND
CALL$: PUSHJ P,SQZINS
HLRZ X,CALL ;SEARCH ONCALL ROLL
SKIPA U,CALL
CALL$1: ADD X,J
CAIN X,(U)
JRST PDFERR ;NOT FOUND
LDB J,[POINT 6,(X),17]
HRR H,(X) ;ADR OF SYMBOL BLOCK
CAME W,-4(H)
JRST CALL$1
PUSHJ P,STOP+1 ;FOUND, CHECK FOR STOP
TLO H,(1B1) ;FLAG ACTIVE
MOVEM H,(Y)
HLL H,-3(H) ;HOLD ONCALL PROGRAM
MOVEM H,GLOBAL
SEMIY: AOJA Y,SEMIV
SUBTTL ONCALL BREAK HANDLE
$CALL: SETOM GLOBAL ;FLAG CALL OR RETURN USING 'GLOBAL'
POP P,U ;WAS UUO JRA?
MOVE U,-1(U)
TLZE U,37
JRA J,$CALL4
MOVE T,[W,,ACSAVE+W] ;THIS IS ENTRY, SAVE AC'S
BLT T,ACSAVE+P ; FOR ARGUMENT REFERENCE LATER
MOVE T,-3(U)
HLL U,T
HRLI T,(JRST) ;BROKEN WAS JUMP
MOVEM T,INSTR
HRRZM T,F4PC ;UPDATE PROG PC
EXCH U,CURRENT ;NOTE THIS PROGRAM
SKIPL U ;CALL MAY BE FROM PROG WITHOUT SYMBOLS
MOVEI U,1B18
HLRZ T,J ;REMEMBER CALLING PROGRAM
HLL U,PROJMP
MOVEM U,@T ; IN JSA LOCATION
HRLZS J,ACSAVE+J ;HOLD RETURN ADR BUT INVALIDATE 16 FOR IDLOC
IFDEF FTPROFILE,< HRLZ T,INSTR
TLNE U,-1
MOVEM T,PROJMP>
HRRZ T,CURRENT ;IDENTIFY NODE IN AC Y
HLRZ Y,CALL
AOSA U,HISTORY
$CALL1: ADDI Y,(X) ;AND NODE LENGTH IN AC X
LDB X,[POINT 6,(Y),17]
MOVE F,(Y)
CAIE T,(F)
JRST $CALL1
HRLI U,0 ;RECORD CALL IN HISTORY
CAML U,HISTOP
HLRS U,HISTORY
HRROM F,(U)
SKIPG D,REESTOP
SKIPGE TROUT
JRST .+3
TLNN F,(1B1) ;ACTIVE BREAK?
JRST INSTR ;NO, CONTINUE IF NO TRACE OUTPUT
SETZM GLOBAL ;IDENTIFY PROGRAM NOW
MOVE T,[7,,[ASCII"(' 'A6,' CALLED FROM '2A7,A1,I4)"]]
OUT. T,@CHAN
MOVE W,-4(F)
PUSHJ P,SQZOUT
HLRZ T,ACSAVE+J
PUSHJ P,IDLOCS
FIN.
TLNN F,(1B1)
JUMPL D,@INSTR ;CONTINUE IF BREAK INACTIVE
HRRI F,0 ;NOTE THIS IS ONCALL
;FOLLOWING KLUDGE TO FORCE CALC OF VARIABLE ARRAY SIZES
MOVE U,CURRENT ;SPECIAL INITIALIZATION?
MOVS U,-1(U)
TRNE U,LBLFLG
JRST $CALL2 ;NO
ANDI U,STAMSK ;YES, GET ADR OF EXECUTABLE STMT
ADD U,STATAB
MOVE U,-1(U)
HRLI U,(JRST)
MOVE J,POPJ ;PLACE TEMP BREAK THERE
EXCH J,(U) ; & HOLD BROKEN
EXCH U,INSTR ;RE SETUP INSTR
PUSH P,F ;SAVE IMPORTANT AC'S
PUSH P,X
PUSH P,Y
PUSHJ P,(U) ;DO INITIALIZATION
POP P,Y ;RESTORE AC'S & TEMP BREAK
POP P,X
POP P,F
MOVEM J,@INSTR
$CALL2: MOVEI G,1 ;NOTE HEAD LENGTH OF ONCALL ROLL
JRST EXERCISE
$CALL4:
IFDEF FTPROFILE,< MOVE U,CURRENT
HRLZ U,-2(U)
TLNE J,-1
PUSHJ P,PUTPROFILE
HLLZM J,PROJMP>
TRNN J,1B18 ;UPDATE PROG SYMBOL POINTER
HLL J,-3(J) ;UNLESS WITHOUT SYMBOL
MOVEM J,CURRENT
AOS U,HISTORY ;MAKE HISTORY ENTRY
HRLI U,0
CAML U,HISTOP
HLRS U,HISTORY
HRROM T,(U)
HRRZM T,F4PC ;SETUP F4 PC
SKIPL TROUT
JRST $CALL3
MOVE T,[3,,[ASCII"(' RETURNED')"]]
OUT. T,@CHAN
FIN.
$CALL3: SKIPL REESTOP
JRST REEYES
MOVE U,ACSAVE+U ;RESTORE AC'S
MOVE T,ACSAVE+T
JRST @F4PC ; AND CONTINUE
SUBTTL KILL COMMAND DECODE
KILL: JUMPE V,CLEAR ;JUMP IF GENERAL KILL
PUSHJ P,SQZINS ;GET BREAK TYPE SYMBOL
CAMN W,STOP%
PUSHJ P,SQZINS
SETZB D,E ;ASSUME IT'S ONCALL
CAMN W,BEFOR% ;BEFORE RETURN FROM ?
TLOA D,(1B0) ;YES, SKIP SET FLAG
CAMN W,AT% ;AT ?
TROA D,2 ;YES, SKIP INDICATE ROLL
CAMN W,ONCAL% ;ONCALL ?
JRST KILL1 ;YES, WE HAVE CODE IN AC D
CAME W,ON%
JRST KILERR
PUSHJ P,SQZINS
CAIE V,"/" ;ONCALL?
CAME W,[SQUOZE 0,CALL]
TROA D,1 ;NO, IT'S ON ROLL AND SKIP
KILL1: PUSHJ P,SQZINS ;GET BROKEN SYMBOL
JUMPLE D,[MOVE T,V ;GLOBAL LOOKUP FOR ONCALL
PUSHJ P,GLOOK ; & BEFORE RETURN
SKIPL A,V ;POINTER IN AC A
JRST DEFERR
MOVE V,T
JUMPE D,KILL3
HRRZ A,-2(A)
JRST KILL3]
CAIE D,1 ;ON ?
JRST [PUSHJ P,ATLOC+1 ;NO, AT
JRST KILL3]
PUSHJ P,IDENTL ;YES
TLNE A,DMYFLG
HRRI A,1(E)
SUB V,MANSYM
HRL A,V
MOVS E,A
PUSHJ P,BETWEEN
MOVS A,E
MOVEI D,1
KILL3: JUMPE F,KILL$ ;ATTACHED?
DPB D,[POINT 5,A,4] ;YES, DEPOSIT ROLL ID
TLO A,(1B2) ;INDICATE KILL ATTACHMENT
MOVEM A,(Y) ;YES
HRLM G,H ;HOLD LIMITS TOO
CAIN D,1 ;ON ?
PUSH Y,H
AOJA Y,SEMIV
KILL$: JUMPN V,TAXERR
HRLI D,0 ;ZERO BEFORE RETURN FLAG
MOVE X,CALL(D) ;HOLD ROLL POINTER
PUSHJ P,KILLER ;MAKE KILL
JUMPL D,PROMPT ;ONCALL MUST BE SUCCESSFULLY KILLED
CAMN X,ON(D) ;SUCCESS ?
KILERR: OUTSTR [ASCIZ"?KILL WHAT?"]
JRST PROMPT
SUBTTL KILL STORED COMMAND
KILLER: SOJE D,KILLON ;ON ROLL?
HLRZ B,ON(D) ;NO, BOTTOM OF ROLL
SKIPA C,ON(D) ;TOP OF ROLL
KILER1: ADDI B,(V) ;NEXT NODE
CAIL B,(C) ;END OF ROLL?
POPJ P, ;YES, RETURN UNSUCCESSFUL
LDB V,[POINT 6,(B),17] ;NODE SIZE
HRRZ T,(B) ;MATCH?
CAIE T,(A)
JRST KILER1 ;NO
JUMPG D,KILER2 ;YES, ONCALL?
MOVSI T,1 ;YES, INACTIVATE
HLLM T,(B)
SOJA V,[AOJA B,KNODE] ;ADJUST DELETE LENGTH
KILER2: PUSH P,KILER3 ;REMOVE AT BREAK
KATS: MOVE U,(A)
TLNE U,(1B8)
JRST [TLC U,(3B8)
MOVEM U,(A)
JRST KILER3]
ORCMI U,BRKMSK
MOVE T,U
EXCH T,BRIST$
EXCH T,@BROKE$
MOVEM T,(A)
KILER3: POPJ P,KNODE
KNODE: SUBI C,(V) ;NEW TOP OF ROLL
ADDI V,(B) ;TOP OF NODE
MOVSI T,(V) ;BLT WORD
HRRI T,(B)
CAIE B,(C) ;SOMETHING TO MOVE?
BLT T,-1(C) ;YES
MOVEM C,ON(D) ;NEW ROLL POINTER
POPJ P, ;RETURN KILLED
SUBTTL KILL INTERSECTING ON COMMANDS
KILLON: HLRZ B,ON(D) ;SETUP ROLL SEARCH
SKIPA C,ON
KILON1: ADDI B,(V) ;NEXT NODE
CAIL B,(C)
KILON2: POPJ P,.-1 ;RETURN DONE
LDB V,[POINT 6,(B),17] ;GET NODE LENGTH
MOVE W,1(B) ;SAME BREAK SPECIFICATION?
SUB W,MANSYM
HRL W,(B)
CAME W,E
JUMPN E,KILON1 ;NO
MOVE W,2(B) ;YES, GET LIMITS
MOVS A,W
CAIGE G,(W) ;HIGH MORE THAN LOW
CAIG H,(A) ; AND LOW LESS THAN HIGH ?
JUMPN E,KILON1 ;NO
SUB W,A ;YES, MAKE AOBJN POINTER TO CODE
HLLM W,A
LDB W,[POINT 8,(B),8] ;MAKE BREAK LOOKING FOR
LSH W,^D14
TLO W,(ON.)
PUSH P,KILON2 ;PUSH KNODE RETURN
MOVEI T,INSTR ;CHECK FOR PENDING ON
JRST KILON5-2 ;ENTER LOOP TO REMOVE BREAKS
KILON3: MOVE U,(A) ;MAKE QUICK ELEMINATION
TLNE U,(764B8)
AOBJN A,.-2
JUMPG A,KNODE ;JUMP TO FINALLY KILL NODE
MOVEI T,(A) ;IS THIS ON BREAK LOOKING FOR?
JRST KILON5
KILON4: MOVE U,@T
ORCMI U,BRKMSK
MOVEI T,@BROKE$
MOVE U,@T
TLNN U,(764B8)
KILON5: TLNN U,(10B8)
AOBJN A,KILON3 ;NO
AND U,[777B8+377B21]
CAME U,W
JRST KILON4
MOVE U,@T ;YES, REMOVE ON BREAK
ORCMI U,BRKMSK
PUSH P,@BROKE$
POP P,@T
MOVE T,U
EXCH T,BRIST$
MOVEM T,@BROKE$
AOBJN A,KILON3 ; & CONTINUE
SUBTTL CLEAR AWAY STORED COMMANDS
CLEAR: JUMPN F,GKERR ;GENERAL KILL MUST BE DIRECT
MOVE V,AT ;REMOVE AT BREAKS
HLRZ W,V
CLEAR4: CAIL W,(V)
JRST CLEAR5
MOVE A,(W)
PUSHJ P,KATS
LDB T,[POINT 6,(W),17]
ADD W,T
JRST CLEAR4
CLEAR5: SETZB D,E ;REMOVE ON BREAKS
PUSHJ P,KILLON
MOVE V,CALL ;INACTIVATE ONCALLS
HLRZ W,V
MOVEI A,(W)
JRST CLEAR2
CLEAR1: LDB U,[POINT 6,(W),17]
HRRZ T,(W)
TLO T,1
MOVEM T,-1(A)
ADDI W,(U)
CLEAR2: CAIE W,(V)
AOJA A,CLEAR1
HRRM A,CALL
HRLS A ;RESET ROLL POINTERS
MOVEM A,ON
MOVEM A,AT
SETZM @HISTOP ;SET CLEAR FLAG TEMP
POPJ P,
SUBTTL GO COMMAND DECODE
GO: JUMPE V,GONOW ;CONTINUE?
PUSHJ P,ATLOC ;GET WHERE
JUMPN V,NFGERR ;NOTHING MAY FOLLOW
JUMPN F,[SKIPG @HISTOP ;ATTACHED, CAN'T STOP AND GO
JRST NSGERR
SUB B,MANSYM
HRLI A,200000(B) ;FLAG AS GO
MOVEM A,(Y)
AOJA Y,INSERT]
HLRZ U,-2(B) ;HAS PROG BEEN CALLED YET AT ALL??
SKIPN (U)
JUMPN U,PNGERR ;NO!!
MOVEM B,CURRENT
AOSN DRAIN ;CANCEL HISTORY ENTRY?
SKIPA U,HISTORY ;YES
AOS U,HISTORY ;RECORD COMMAND GO IN TRACE TABLE
HRLI U,0
CAML U,HISTOP
HLRS U,HISTORY
HRLI A,(1B1)
MOVEM A,(U)
HRLI A,(JRST)
MOVEM A,INSTR
ZERON: SETZM ONA ;FORGET ANY MORE ON BREAKS
GONOW: JUMPN F,AGNERR ;ATTACHED GO WITH NO LABEL?
SKIPN U,INSTR ;CAN'T CONTINUE AFTER SYSTEM ERROR
JRST AGNERR
HLRZ T,U
CAIN T,(JRST)
HRRZM U,F4PC
FIN. ;GO AHEAD !
SETZM DRAIN ;RESET DRAIN FOR SURE
MOVSI (TRN) ;RESET REENTER STOP
MOVEM REESTOP
JRST TINUE
SUBTTL OUTPUT COMMAND DECODE
TYPE: MOVEI T,-1 ;SWITCH OUTPUT TO TTY
MOVEM T,CHAN
JRST OUTPT
OUT0: PUSHJ P,SKIP
OUTPT: PUSHJ P,LOCATE ;PINPOINT ELEMENT
JUMPE A,NELERR ;WHOLE ARRAY NOT ALLOWED
JUMPLE F,.+3 ;ATTACHED ARRAY REFERENCE?
TLNE A,ARRFLG!DMYFLG
MOVEI A,(E) ;YES, USE RELATIVE ELEMENT ADR
SUB V,MANSYM ;PUT RELATIVE POINTER OPPOSITE ELEMENT ADR
TRZE A,1B18 ;BUT IF IT'S ARG MAKE POINTER ZERO
MOVEI V,0
HRLM V,A
MOVEI B,20(W) ;OUTPUT FLAG & TYPE IN AC B
MOVE V,T ;IN OCTAL OR TEXT?
PUSHJ P,SQZIN
JUMPE W,OUT1
PUSHJ P,SKIPS
PUSHJ P,SQZIN+1
CAMN W,[SQUOZE 0,INOCTAL]
JRST .+4 ;IN OCTAL
CAME W,[SQUOZE 0,INTEXT]
JRST TAXERR
TROA B,10 ;FLAG AS IN TEXT
MOVEI B,24 ;TYPE AS OCTAL
PUSHJ P,SKIPS
OUT1: DPB B,[POINT 5,A,4] ;HOLD OUT-FLAG, TEXT-FLAG & TYPE CODE
JUMPL F,APUT ;SECTION OUTPUT?
MOVEM A,(Y)
CAIN V,"," ;ANOTHER VARIABLE?
AOJA Y,OUT0 ;YES
JUMPN F,SEMIY ;ATTACHED COMMAND?
JUMPN V,TAXERR ;NO, WE OUTPUT NOW
MOVE B,HISTOP
OUT$: FIN.
MOVE A,(B)
LDB V,[POINT 5,A,4]
MOVE T,[1,,[ASCII"(99G)"]]
TRZE V,10
MOVE T,[2,,[ASCII"(1X,A10)"]]
OUT. T,@CHAN
MOVSI T,(DATA. (A))
DPB V,[POINT 4,T,12]
XCT T
CAIE B,(Y)
AOJA B,OUT$
JRST PROMPT
APUT: JUMPN V,TAXERR
FIN.
ANDI B,7 ;MASK TYPE
MOVEI T,[ASCII"(4G) (1X,14A5)"]
CAIL B,DOUBLE
MOVEI T,[ASCII"(3G) (1X,7A10)"]
HRLI T,2
TLNE A,(1B1)
ADDI T,1
OUT. T,@CHAN
MOVSI T,(DATA. (A))
DPB B,[POINT 4,T,12]
HRROS -1(Y)
APUT1: MOVE D,HISTOP ;SETUP ELEMENT LOOP
HRRZ C,1(D)
APUT2: XCT T ;OUTPUT ELEMENT
ADD A,(D) ;NEXT ELEMENT
SOJG C,APUT2 ;COUNT ELEMENTS
APUT3: HLRS C,1(D) ;RESET COUNT
JUMPL C,POFFO ;LAST?
ADDI D,2 ;NO, NEXT ASTER
ADD A,(D) ;INCREMENT
SOS C,1(D) ;COUNT
TRNN C,-1
JRST APUT3 ;MORE?
JRST APUT1 ;YES
SUBTTL ASSIGNMENT COMMAND DECODE
STORE: PUSHJ P,IDENTL ;PINPOINT ELEMENT
CAIE T,"=" ;HAD BETTER BE ASSIGNMENT
JRST NCERR
JUMPE A,NELERR ;WHOLE ARRAY NOT ALLOWED
JUMPL F,ASTORE ;SECTION ASSIGNMENT?
JUMPE F,STORE2 ;ATTACHED COMMAND?
TRNE A,1B18 ;YES, ARG?
JRST [HLRZ T,A ;YES, IDENTIFY VARIABLE
PUSHJ P,INTERN
CAIE T,(W)
JRST NRFERR ;NOT IDENTIFIED SO WE DON'T KNOW TYPE
MOVE V,A ;HOLD SYMBOL TABLE ADR
MOVE A,1(V) ;PICK UP ADR
LDB W,[POINT 3,A,2] ; & TYPE
JRST STORE1]
TLNN A,DMYFLG ;DUMMY ARRAY?
STORE1: MOVEI E,(A) ;NO, USE REAL ADR
SUB V,MANSYM ;PUT SYMBOL POINTER OPPOSITE ADR
HRLM V,E
MOVEI A,1(Y) ;SET INPUT ADR
STORE2: PUSHJ P,INPUT ;INPUT CHANGE
JUMPN F,STORE$ ;DIRECT?
CAIN T,";" ;ALLOW MORE THAN ONE ASSIGNMENT
SOJA F,GET ; ON A LINE
JUMPE T,PROMPT
JRST TAXERR
STORE$: CAIL W,DOUBLE ;DOUBLE-ELEMENT?
TLO E,(1B4) ;YES, SET FLAG
MOVEM E,(Y) ;HOLD TEMP
ADDI Y,2
TLNE E,(1B4)
ADDI Y,1
SEMIT: MOVE V,T
JRST SEMIV
ASTORE: PUSH P,A ;GET VALUE IN AC'S G & H
MOVEI A,G
PUSHJ P,INPUT
POP P,A
JUMPN T,TAXERR
HRROS -1(Y) ;FLAG LAST ASTERISK
ASTR1: MOVE D,HISTOP ;SETUP ELEMENT LOOP
HRRZ C,1(D)
ASTR2: MOVEM G,(A) ;MAKE CHANGE
CAIL W,DOUBLE
MOVEM H,1(A)
ADD A,(D) ;NEXT ELEMENT
SOJG C,ASTR2 ;COUNT ELEMENTS
ASTR3: HLRS C,1(D) ;RESET COUNT
JUMPL C,PROMPT ;LAST?
ADDI D,2 ;NO, NEXT ASTER
ADD A,(D) ;INCREMENT
SOS C,1(D) ;COUNT
TRNN C,-1
JRST ASTR3 ;MORE?
JRST ASTR1 ;YES, MAKE ELEMENT CHANGES
INPOCT: MOVEI W,OCTAL ;INPUT WORD IN OCTAL
INPUT: MOVSI T,(DATA. (A)) ;INPUT CHANGE
DPB W,[POINT 4,T,12]
PUSHJ P,FIRSCH ;READ NUMBER
JRST INPUT5 ;NOTHING THERE
XCT T
POPJ P,
INPUT5: CAIN T,40+'"' ;BUT NOT DECIMAL?
JRST INPOCT ;OCTAL
CAIE T,"'" ;TEXT?
JRST TAXERR ;ILLEGAL CHAR
MOVE T,[ASCII" "] ;BLANK WORDS
MOVEM T,(A)
CAIL W,DOUBLE
MOVEM T,1(A)
HRLI A,(POINT 7,,)
MOVEI T,(A)
INPUT1: PUSHJ P,WIN
CAIE V,"'"
JRST INPUT2
PUSHJ P,WIN
CAIE V,"'"
JRST INPUT3
INPUT2: IBP A ;IS THERE ROOM?
CAIG T,-2(A)
JRST INPUT1
CAIE T,(A)
CAIL W,DOUBLE
DPB V,A ;YES
JRST INPUT1
INPUT3: PUSHJ P,SKIPS
MOVE T,V
INPUT4: POPJ P, ;RETURN
SUBTTL EXERCISE ATTACHMENTS
EXERCISE:
ADD X,Y ;END OF NODE
PUSH P,Y ;HOLD START OF NODE
ADD Y,G ;ATTACHMENTS
EXER1: CAIL Y,(X) ;MORE?
EXER2: JRST [SKPINL ;NO, STOP?
JUMPG F,TINUE
JRST POFFO]
MOVE A,(Y) ;DISPATCH ATTACHMENT
JUMPL A,$OUT ;OUTPUT?
TLZE A,(1B1) ;GO?
JRST $GO
TLZE A,(1B2) ;KILL?
JRST $KILL
$STORE: ADDI Y,2 ;ASSIGNMENT
LDB V,[POINT 13,A,17] ;SYMBOL POINTER
ADD V,MANSYM
MOVE U,1(V) ;DUMMY?
TLNN U,DMYFLG
JRST $STR1 ;NO
HRRZ T,(U) ;GET REAL ADR
ADD A,T
JUMPE T,$STR2 ;IF DUMMY NOT DEFINED IGNORE STORE
$STR1: MOVE U,CURRENT ;MAKE SURE WE DON'T CHANGE
MOVS U,-2(U) ; LABEL, CONSTANT, OR EXPR ARGUMENT
JUMPE U,$STR3
HRRZ U,(U)
JUMPE U,$STR3
HRRZ T,-3(U)
HRRZ U,-1(U)
CAIG T,(A)
CAIG U,(A)
JRST $STR3 ;IT'S OK!
OUTSTR[ASCIZ/
?STOPPING BECAUSE OF ILLEGAL ASSIGNMENT/]
TLO F,(1B0) ;SET STOP BIT & DO REST OF ATTACHMENTS
$STR2: TLNE A,(1B4) ;SKIP OVER DOUBLE-ELEMENT
AOJ Y,
JRST EXER1 ; AND DO REST OF ATTACHMENTS
$STR3: MOVE W,-1(Y) ;MAKE CHANGE
MOVEM W,(A)
TLNN A,(1B4) ;DOUBLEWORD?
JRST EXER1
PUSH A,(Y)
$STR4: AOJA Y,EXER1
SUBTTL EXERCISE GO ATTACHMENT
$GO: SETZM ONA ;FORGET ANY MORE ON BREAKS
HLRZ U,A ;UPDATE CURRENT PROG
ADD U,MANSYM
HLRZ T,-2(U)
SKIPN @T
JUMPN T,PNGERR ;PROG NEVER CALLED YET??
HLL U,-3(U)
MOVEM U,CURRENT
HRLI A,(JRST)
MOVEM A,INSTR
HRRZM A,F4PC
AOS U,HISTORY
HRLI U,0
CAML U,HISTOP
HLRS U,HISTORY
HRLI A,(1B1)
MOVEM A,(U)
SKIPL TROUT
JRST TINUE
MOVE T,[5,,[ASCII"(' CMD GOTO '2A7,A1,I4)"]]
OUT. T,@CHAN
PUSHJ P,IDLOCA
FINGO: FIN.
SKPINL
JRST TINUE
JRST PROMPT
SUBTTL EXERCISE OUTPUT ATTACHMENT
$OUT: LDB B,[POINT 3,A,4] ;GET GIVEN TYPE
LDB C,[POINT 13,A,17] ;RELATIVE SYMBOL POINTER
JUMPN C,$OUT1 ;ARGUMENT?
HRRZ C,(A) ;YES, ADR PART OF PUSH
MOVEI G,1(C) ;NUMBER OF ARG
HLRZ T,ACSAVE+J ;RETURN ADR
ADD C,T ;ADR OF ARG POINTER
CAIE B,OCTAL ;PICK UP TYPE FROM THERE
LDB B,[POINT 4,(C),12] ;UNLESS GIVEN TYPE IS OCTAL
MOVEI T,$OUTG ;FORMAT ADR
TLNN A,(1B1) ;TEXT FORMAT?
CAIN B,HOLLER
MOVEI T,$OUTA
HRLI T,4
OUT. T,@CHAN ;OUTPUT ARG ID
DATA. INTEGER,G
MOVEI A,@(C) ;ADR OF ARG
CAIG A,20 ;ARG IN AC'S?
ADDI A,ACSAVE ;YES, FIX ADR
PUSH P,$OUT5 ;PUSH RETURN ADR
JRST $OUT4 ;GO OUTPUT ARGUMENT
$OUTG: ASCII"(' ARG:',I2,'=',G)"
$OUTA: ASCII"(' ARG:',I2,'=',A10)"
$OUT1: ADD C,MANSYM ;ADR OF SYMBOL
LDB D,[POINT 12,1(C),17] ;SCRIPT INDEX
JUMPE D,$OUT6 ;ARRAY OUTPUT?
MOVEI J,(A) ;YES, HOLD RELATIVE ADR TEMP
MOVE W,1(C) ;DUMMY?
TLNE W,DMYFLG
HRRZ W,(W) ;YES, GET REAL ADR
JUMPE W,$STR4 ;IF DUMMY NOT DEFINED IGNORE OUTPUT
ADDI A,(W) ;REAL ADR IN AC A
$OUT6: PUSH P,$OUT5 ;PUSH NORMAL RETURN
$OUT60: SKIPE U,D ;NUMBER OF DIMENSIONS
HRRZ U,@SCRIPT
TRNN U,-200 ;VARIABLE DIMENSIONS?
JRST .+4
TLO J,(1B0) ;YES, SET FLAG
MOVE D,U ; & SETUP ADR OF BOUNDS LIST
HRRZ U,-2(D) ; AND DIMENSIONALITY
MOVE W,HISTOP ;POINT TO TEMP FORMAT
PUSH W,[ASCII"(' 'A"]
JUMPE U,$OUT2 ;ARRAY?
PUSH W,[ASCII"6,'('"] ;YES, OPENING PAREN
SKIPA E,U ;HOLD NUMBER OF DIMENSIONS
PUSH W,[ASCII",',,,"] ;MORE
PUSH W,[ASCII",I6,'"]
SOJG U,.-2 ;MORE?
SKIPA U,[ASCII") =',"] ;NO, CLOSING PAREN & EQSIGN
$OUT2: MOVE U,[ASCII"6,'='"] ;EQSIGN
PUSH W,U
MOVE T,$OUTG+3 ;END FORMAT
TLNE A,(1B1) ;TEXT FORMAT?
MOVE T,$OUTA+3 ;YES
PUSH W,T ;FORMAT COMPLETED!
SUB W,HISTOP ;PUT LENGTH OF FORMAT
MOVSI W,(W) ;OPPOSITE ADR
HRR W,HISTOP ;OUTPUT ID
ADDI W,1
OUT. W,@CHAN
MOVE W,(C)
PUSHJ P,SQZOUT
JUMPE D,$OUT4 ;ARRAY?
MOVEI G,(J)
CAIL B,DOUBLE
ASH G,-1
$OUT3: AOS U,D ;GET BOUNDS
JUMPL J,[MOVE W,@0(D)
MOVE V,@-1(D)
AOJA D,.+3]
HLRE W,@SCRIPT
HRRE V,@SCRIPT
SUB V,W ;COMPUTE SUBSCRIPT
IDIVI G,1(V)
ADD H,W
DATA. INTEGER,H
SOJG E,$OUT3 ;COUNT DIMENSIONS
$OUT4: JUMPE A,$OUT5-1 ;DON'T OUTPUT VALUE IF NO ADR GIVEN
MOVSI T,(DATA. (A)) ;OUTPUT VALUE FINALLY
DPB B,[POINT 4,T,12]
XCT T
FIN.
$OUT5: POPJ P,$STR4 ;FINISHED
SUBTTL EXERCISE KILL ATTACHMENT
$KILL: LDB D,[POINT 5,A,4] ;PICK UP ROLL WHERE KILLING
MOVNI W,2 ;ASSUME KILLING ON
CAIE D,1
AOJA W,$KILLK ;NOT SO
TLZ A,(7B4) ;SETUP FOR KILLING ON
MOVS E,A
HLRZ G,1(Y)
HRRZ H,1(Y)
$KILLK: MOVSI U,(W) ;KILL KILL ATTACHMENT
MOVSI T,(Y)
SUB T,U
HRRI T,(Y)
ADDB U,@(P) ;NEW NODE HEAD
ADDB W,CALL(F) ; & ROLL POINTER
BLT T,-1(W)
SUB Y,(P) ;GET OFFSET INTO ROLL
PUSH P,F ;SAVE COMMAND ROLL ID
PUSH P,CALL(D) ; & POINTER WHERE KILLING
PUSH P,U ; & NODE HEAD FOR IDENTIFICATION
PUSHJ P,KILLER ;PERFORM KILL
POP P,U
POP P,H
POP P,F
HLRZ W,CALL(F) ;SEARCH FOR COMMAND NODE
SKIPA V,CALL(F)
$KILLA: ADDI W,(X)
CAIL W,(V)
JRST EXER2 ;KILLED SELF
LDB X,[POINT 6,(W),17]
CAME U,(W)
JRST $KILLA
ADDI X,(W) ;FIX AC'S X & Y
ADDI Y,(W)
JUMPL D,EXER1 ;KILL SUCCESSFUL?
CAME H,ON(D)
JRST EXER1
MOVE T,[4,,[ASCII"(' %MISSED KILL')"]]
OUT. T,@CHAN
FIN.
JRST EXER1
SUBTTL TRACE COMMAND
TRACE: HLRZ F,H ;POSITIVE MEANS TRACE ON
TRC F,(1B0) ; WHILE ZERO MEANS OFF
EXCH F,TROUT
SETZM PAUSE
JUMPE V,TRACE1
PUSHJ P,SQZINS
CAMN W,[SQUOZE 0,PAUSE] ;TRACE OUTPUT PAUSE ?
JUMPE V,[JUMPN H,PROMPT ;ZERO MEANS NO PAUSE
SETOM PAUSE ;NONZERO MEANS PAUSE
JRST TRACE1-2]
JUMPN V,TAXERR
CAME W,OUTPT%
JRST TAXERR
HRRZM F,TROUT
JUMPN H,PROMPT
SETOM TROUT ;MINUS MEANS TRACE OUTPUT
JUMPN F,PROMPT ;JUMP IF BREAKS ALREADY THERE
TRACE1: HRLOI G,7777 ;MASK FOR PLACING BREAK
MOVE F,MANSYM
TRACE2: SKIPN U,2(F) ;MAKE AOBJN CODE POINTER IN AC E
MOVS U,START
HLRZ D,U ;HOLD END OF CODE
MOVS E,1(F)
SUB E,U
HRR E,1(F)
HLLZ W,3(F) ;GET REAL START OF CODE
HLRS W
TRZ W,-STAMSK-1
ADD W,STATAB
TLNE W,LBLFLG
JRST TRACE3
MOVE W,-1(W)
SUBI W,(E) ;ADJUST AOBJN POINTER
HRLS W
ADD E,W
TRACE3: ADD F,[4,,4] ;ADJUST SYMBOL POINTER TO LABELS
JUMPN H,TRACER ;JUMP IF REMOVING BREAKS
TRACE4: HLRZ T,(E) ;GET LEFT HALF OF INSTR
CAIG T,(CALL.) ;STORED BREAK?
JRST [CAIGE T,(AT.)
JRST TRACE9-1 ;NO, IT'S TRACE BREAK ALREADY
MOVE U,(E) ;GET BROKEN INSTR
ORCMI U,BRKMSK
MOVE W,@BROKE$
TLNE W,523777
AOBJN E,TRACE4
CAIL D,(W) ;IGNORE RETURN JUMP
ANDM G,@BROKE$ ;MODIFY BROKEN INSTR
JRST TRACE9-1] ;NEXT INSTR
CAIL T,(JRST)
CAIL T,(SKIPL)
IFNDEF FTPROFILE,< AOBJN E,TRACE4 ;CAN'T BREAK HERE
JUMPG E,TRACE9 ;JUMP IF FINISHED PROGR>
IFDEF FTPROFILE,< JRST TPROF>
CAIG T,(JUMPL) ;JRST INSTR?
JRST TRACE7 ;YES
HLRZ T,-2(E) ;WE'VE JUMP INSTR, DO LOOP?
CAIN T,(SKIPGE 00,)
IFNDEF FTPROFILE,< AOBJN E,TRACE4 ;YES>
IFDEF FTPROFILE,< JRST TPRO1>
TRACE5: HRRZ A,(E) ;BACKWARD?
CAIG A,(E)
JRST TRACE6 ;YES, PLACE BREAK
HLRZ T,1(E)
ANDI T,770000; (TEST FOR MULTIPLE ARITHMETIC IF JUMPS)
CAIE T,(EXCH) ; (TEST FOR JRST)
CAIN T,(JUMP)
JRST TRACE6 ;NO, PLACE BREAK
HRRZ V,1(F) ;MAYBE LOGICAL IF, LOOK FOR
CAIG V,(E) ; LABEL JUST ABOVE
AOBJN F,[AOBJN F,.-2
JRST TRACE6]
MOVE W,1(F) ;JUMP REACHS?
TLZE W,LBLFLG
CAIGE A,(W)
JRST TRACE8 ;NO, WE'VE LOGICAL IF
CAIE A,(W) ;JUMPS PAST IT?
JRST TRACE6 ;YES, PLACE BREAK
LSHC W,-^D30 ;SEE IF WE'VE LOGICAL IF BY
LSH V,-^D24 ; STEPPING BACK ONE STMT
ADD V,STATAB ; FROM LABEL
MOVE T,-1(V)
MOVE U,(V)
MOVNS W
LSHC T,(W)
LDB W,[POINT 4,U,35]
TRNN U,007400 ;TRIPLE BYTE?
TRNN U,170000
JRST .+3 ;NO, SINGLE
LDB W,[POINT 4,U,31]
DPB U,[POINT 4,W,31]
HRRZ V,1(F)
SUBI V,(W) ;STEP BACK THE ONE STMT
CAIL V,(E) ;ARE WE IN STMT JUST BEFORE LABEL?
JRST TRACE6 ;NO, NOT LOGICAL IF
TRACE8: HLRZ T,(E) ;JRST-TYPE LOGICAL IF?
CAIG T,(JUMP) ;SEE IF BREAKING CAM INSTR
AOBJN E,[ANDM G,-2(E) ;YES, JRST-TYPE
MOVSI T,(JSP) ;FLAG IT BY CHANGING JRST INSTR TO JSP
HLLM T,-1(E)
AOBJN E,TRACE4]
MOVEI T,1B18 ;SET LOGICAL IF FLAG IN JUMP INSTR
IORM T,(E)
TRACE6: ANDM G,(E) ;PLACE BREAK
AOBJN E,TRACE4
IFDEF FTPROFILE,<
TPROF: CAIN T,(AOJA 15,) ;CODE AOJ/SOJ IN INDEX BITS
AOJA T,TPRO2
CAIE T,(SOJA 15,)
JRST TRACE9-1
TROA T,2
TPRO1: MOVEI T,3
TPRO2: SKIPN PROJMP
JRST TRACE9-1
HRLZS T
JRST TRACE6-1>
TRACE7: CAIL T,(JFCL) ;REALLY JRST INSTR?
JRST TRACE9-1
TRNE T,37 ;YES, INDEXED OR INDIRECT ?
JRST TRACE6 ;YES, PLACE BREAK
MOVS W,(E) ;PICK UP INSTR
LDB T,[POINT 7,1(E),6] ;AROUND FORMAT?
CAIN T,"("
JRST [HLRZS W ;YES, FIX AOBJN POINTER FOR SPEED
SUBI W,(E)
HRLS W
ADD E,W
JRST TRACE4]
HLRZ U,W ;IGNORE RETURN JUMP
CAIG D,(U)
JRST TRACE9-1
MOVS W,-1(E)
ANDI W,770740 ;DO CONTINUE?
CAIN W,(CAM 15,)
IFNDEF FTPROFILE,< JRST TRACE9-1 ;YES, IGNORE>
IFDEF FTPROFILE,< JRST TPRO1>
TRNN W,760000 ;BROKEN?
TRNN W,010000
JRST .+4
MOVE U,-1(E)
ORCMI U,BRKMSK
MOVS W,@BROKE$
ANDI W,750000 ;CONDITIONAL?
CAIN W,(CAM)
JRST TRACE5 ;YES, PROCESS LIKE JUMP
ANDM G,(E) ;NO, MAKE BREAK
AOBJN E,TRACE4
TRACE9: SKIPA U,[14B5] ;FINISHED THIS PROGRAM
AOBJP F,POPJ
TDNE U,(F)
AOBJN F,.-2
JUMPL F,TRACE2 ;DO NEXT PROGRAM NOW
POPJ
TRACER: MOVSI G,760000 ;REMOVE ALL TRACE BREAKS
TDNE G,(E)
TRACR1: AOBJN E,.-1
JUMPG E,TRACE9
MOVE W,E
TRACR2: MOVE U,(W)
HLRZ T,U
CAIL T,(AT.)
JRST [CAIL T,(ATSUB.)
JRST TRACR1
ORCMI U,BRKMSK
MOVEI W,@BROKE$
JRST TRACR2]
HLRZ T,1(E) ;SEE IF JRST TYPE LOGICAL IF
CAIN T,(JSP)
AOBJN E,[TLO U,(CAM) ;IT IS, RESTORE CAM INSTR
MOVSI T,(JRST) ; AND JRST INSTR FOLLOWING
HLLM T,(E)
AOBJN E,TRACR3]
TRZ U,1B18
TLNN U,(3B8)
TLOA U,(JRST)
TLO U,(JUMP)
TRACR3: MOVEM U,(W)
JRST TRACR1
SUBTTL TRACE BREAK HANDLE
$TRACE: POP P,ONTEMP
HLRZ U,@ONTEMP ;SEE IF THIS IS JRST-TYPE LOGICAL IF
CAIN U,(JSP)
TLOA T,(CAM) ;YES, MAKE BREAK CAM INSTR
TLOA T,(CAI) ;NO, MAKE BREAK CAI 0 INSTR
SKIPA J,T ;GET INSTR INTO AC J DESTROYING IT!
HLLZ J,T
EXCH T,.JBUUO ;SEE IF CONDITION TRUE
MOVE U,ACSAVE+U
XCT J
JRST $TROOP ;NOT TRUE
HRR J,.JBUUO ;TRUE
TRCE J,1B18 ;LOGICAL IF 'JUMP' ?
JRST $TJUMP ;YES, MAKE JUMP NOW
IFDEF FTPROFILE,< MOVS U,-1(U)
TRNE U,17
JRST $TPRO2
SKIPE PROJMP
JRST $TPRO1>
TLNE J,(10B8) ;LEAVE FLAG ON IF LOGICAL IF 'CAM'
AOS J,ONTEMP ; AND NUDGE PC OVER JRST
$TTRUE: TRC J,1B18 ;SET LOGICAL IF FLAG APPROPRIATELY
AOS U,HISTORY ;MAKE HISTORY ENTRY
HRLI U,0
CAML U,HISTOP
HLRS U,HISTORY
HRRZM J,(U)
SKIPL TROUT ;TRACE OUTPUT?
SKIPL REESTOP ; OR REENTER STOP?
JRST $TROUT
TRZ J,1B18 ;NO
JRST (J)
$TROOP: HRRE J,.JBUUO ;LOGICAL IF 'JUMP' ?
JUMPG J,@ONTEMP ;NO, CONTINUE PROGRAM
HRRZ J,ONTEMP ;TRUE, COMPENSATE FOR BROKEN BY AT. UUO
CAIN J,INSTR+1
MOVEI J,@F4PC
JRST $TTRUE
$TROUT: MOVE U,[W,,ACSAVE+W] ;SAVE AC'S FIRST
BLT U,ACSAVE+P
MOVEI T,[ASCII"(' GO TO '2A7,A1,I4)"]
TRZE J,1B18
MOVEI T,[ASCII"(' IF TRUE AT '2A7,A1,I4)"]
HRLI J,(JRST)
MOVEM J,INSTR
SKIPL TROUT
JRST $TSTOP
HRLI T,5
OUT. T,@CHAN
HRRZ T,INSTR
PUSHJ P,IDLOC
SKPINL
SKIPE PAUSE
SOSA DRAIN ;SET FLAG TO POSSIBLY IGNORE HISTORY ENTRY
JRST FINGO
JRST PROMPT
IFDEF FTPROFILE,<
$TPRO1: TLNE J,(10B8) ;LOGICAL IF NOT PROFILE JUMP
JRST $TTRUE-1
$TPRO2: TRZ J,1B18 ;BIT WAS STUPIDLY SET
ANDI U,17 ;DO DO ACTION IF ANY
XCT [JFCL
ADDI 15,1
SUBI 15,1
JFCL](U)
MOVE T,PROJMP
HRR T,ONTEMP
HRLZM J,PROJMP
SOSG PROCNT
OUTPUT
IDPB T,PROPNT
JUMPE U,$TTRUE+1
JRST (J)
PUTPROFILE:SOSG PROCNT
OUTPUT
IDPB U,PROPNT
POPJ P,>
PROFILE:IFNDEF FTPROFILE,<JRST NOTIMP>
IFDEF FTPROFILE,<
PUSHJ P,SQZINS
JUMPE W,TAXERR
JUMPN V,TAXERR
SKIPE PROJMP
JRST PROMPT
MOVEM W,PRONAME
HLRZ T,INSTR
CAIN T,(JRST)
SKIPA U,INSTR
MOVE U,F4PC
HRLZM U,PROJMP
INIT 14
SIXBIT/DSK/
XWD PROBUF,PROBUF
HALT .
MOVE T,['PROFIL']
MOVSI T+1,'JMP'
SETZB T+2,T+3
ENTER T
HALT .
OUTBUF 2
JRST PROMPT
GENPROFILE:
JUMPN V,TAXERR
FIN.
CLOSE
MOVE T,['PROFIL']
MOVSI T+1,'JMP'
SETZB T+2,T+3
LOOKUP T
HALT .
MTOP. 4,USECHAN
MOVE W,PRONAME
PUSHJ P,SQZDATA
MOVE T,G
MOVE T+1,G+1
OUTF. T,USECHAN
MOVEI T,[ASCII"(G,6X,2A7,A1,I4)"]
HRLI T,5
OUT. T,USECHAN
MOVE U,HISTOP ;ZERO PROGRAMS
HRLI U,-1(U)
MOVE W,FORSE
SETZM -1(U)
BLT U,-1(W)
PROWORD:SOSG PROCNT ;GENERATE CRUDE
PUSHJ P,PROINP
ILDB W,PROPNT
MOVS U,W
SUB W,U
TLNE U,-1
HLL U,W
AOS (U)
AOBJN U,.-1
JRST PROWORD
PROINP: IN
POPJ P,
MOVE X,HISTOP ;GENERATE LISTING
SUB X,FORSE
HRLZS X
HRR X,HISTOP
SETZ Y,
PROPRT: CAME Y,(X)
SKIPN Y,(X)
AOBJN X,.-2
JUMPG X,PROEND
DATA. INTEGER,(X)
MOVEI T,(X)
SETO J,
PUSHJ P,IDLOC
AOBJN X,PROPRT
PROEND: JRST SEXFIN
> ;END OF FTPROFILE CONDITIONAL
SUBTTL HISTORY COMMAND
HISTRY: JUMPN V,TAXERR
MOVS F,HISTORY
HLRZ Y,F
MOVE X,HISTOP
MOVE E,Y
AOJA J,HISTR2 ;SET AC J POSITIVE FOR IDLOC
HISTR1: CAIN E,(Y) ;FINISHED?
JRST POFFO ;YES
HISTR2: CAIGE E,(F) ;TO BOTTOM?
MOVEI E,-1(X) ;YES, BUMP TO TOP
SKIPN A,(E) ;IS THERE AN ENTRY
JRST POFFO ;NO, TABLE IS NOT FULL
FIN. ;FINISHED PREVIOUS RECORD
JUMPG A,HISTR3 ;ONCALL OR RETURNED?
HRRZ U,MANSYM ;YES, WHICH?
MOVEI T,[ASCII"(' RETURNED TO '2A7,A1,I4)"]
CAIL U,(A)
JRST HISTR4
MOVEI T,[ASCII"(' 'A6,' CALLED')"]
HRLI T,5
OUT. T,@CHAN
MOVE W,-4(A)
PUSHJ P,SQZOUT
SOJA E,HISTR1
HISTR3: MOVEI T,[ASCII"(' GO TO '2A7,A1,I4)"]
TRZE A,1B18
MOVEI T,[ASCII"(' IF TRUE AT '2A7,A1,I4)"]
TLNE A,(1B1)
MOVEI T,[ASCII"(' CMD GOTO '2A7,A1,I4)"]
HISTR4: HRLI T,5
OUT. T,@CHAN
PUSHJ P,IDLOCA
SOJA E,HISTR1
SUBTTL USE AND MTOP COMMANDS
USE: PUSHJ P,SQZINS
JUMPN V,TAXERR
CAIN W,SQUOZE 0,TTY ;TTY FOR OUTPUT?
SOJA V,USE0 ;YES
PUSHJ P,SQZDATA
MOVEI V,USECHAN
CAME H,USENAME+1 ;ALREADY OPEN?
JRST USE1 ;NO
CAMN G,USENAME ;ALREADY OPEN?
JRST USE0 ;YES
USE1: FIN.
MOVEM G,USENAME ;REMEMBER NEW FILE NAME
MOVEM H,USENAME+1
MOVEI L,USE9
PUSHJ P,OPEN.## ;GO OPEN FILE
MOVE T,[4,,[ASCII"(' MANTIS OUTPUT'/)"]]
OUT. T,(V)
USE0: HRRZM V,CHAN ;NEW CHANNEL
JRST PROMPT
-5,,0
USE9: <TP%INT>B12+V ; UNIT #
3B8+<TP%LIT>B12+[ASCIZ/DSK/] ;DEVICE IS DISK ALWAYS
2B8+<TP%LIT>B12+[ASCIZ/SEQO/] ;ACCESS MODE IS SEQOUT
6B8+<TP%DOR>B12+USENAME ;FILENAME PTR
4B8+1B0+1 ; # BUFFERS
MTOP: CAIN V,"#"
PUSHJ P,FIRSCH ;READ NUMBER
JRST TAXERR
DATA. INTEGER,A
JUMPLE A,MTAERR
SKIPE USENAME
CAIE A,USECHAN
CAILE A,FLU.MX
JRST MTAERR
JUMPN T,TAXERR
CAIN W,RELE%-SQZTAB
JRST RELEAS
SUBI W,MTOP%-SQZTAB
ROT W,-^D13
TLO W,(MTOP. (A))
XCT W
JRST PROMPT
RELEAS: MOVEI L,RELEA9
PUSHJ P,RELEA.##
JRST PROMPT
-1,,0
RELEA9: <TP%INT>B12+A ; UNIT #
SUBTTL QUIT COMMAND
; QUIT NOT IMPLEMENTED!
QUIT:
SYSEXIT:
IFDEF FTPROFILE,< SKIPE PROJMP
JRST GENPROFILE>
JUMPN V,TAXERR ;FINISH RECORD
SEXFIN: FIN.
PUSHJ P,SAVE.##
JRST EXIT%##+1
SUBTTL RESTART COMMAND
RESTART:JUMPN V,TAXERR ;FINISH RECORD
FIN.
MOVE P4,.JBOPS ;CLOSE OUT I/O CHANNELS - TAKEN FROM EXIT%%
MOVEI P2,CHN.TB+1(P4)
HRLI P2,-17
REST.1: SETCM P3,0(P2)
JUMPE P3,REST.2
SKIPE P3,(P2)
PUSHJ P,RELE%%##
REST.2: AOBJN P2,REST.1
HRRI P,STK.SV-1(P4) ;RESET PUSHDOWN POINTER
HRLI P,-STK.SZ
PUSHJ P,TRPIN.## ;RESET PROCESSOR TRAP ROUTINE
MOVEM P,ACSAVE+P
HRRZ U,START ; & PC
HLRZ T,(U)
CAIN T,(15B8) ;(RESET. OPCODE)
HRRZ U,1(U)
MOVEM U,F4PC
MOVE U,MANSYM ; & CURRENT PROGRAM
ADDI U,4
HLL U,-3(U)
SKIPE -2(U)
SETZ U,
MOVEM U,CURRENT
MOVSI T,(JFCL) ; & INSTR
MOVEM T,INSTR
MOVEI T,-1 ; & USE CHANNEL
MOVEM T,CHAN
SETZM USENAME
SETZM USENAME+1
HLRS U,HISTORY ; & HISTORY
CLEARM (U)
AOS U
MOVE W,HISTOP
BLT U,-1(W)
OUTSTR [ASCIZ"
INITIALIZE DATA AND GO"]
JRST PROMPT
SUBTTL ATTEMPTED EXIT AND ERRROR HANDLE
MANEXA: POP P,T1 ;ENTER FROM APR FAULT PROC
SKIPA T2,T4
MANEXT: MOVE T2,@(T1) ;ENTER FROM FORERR SYSTEM EXIT CODE
MOVEM T2,.JBOPC## ;SAVE USER PC
MANEXJ: JSP T3,.-. ;RETURN TO RESTORE ACS AND COME BACK TO (T3)
JRST REENTR
MANXIT: HRRZM J,F4PC ;SAVE USER PC
SETZM INSTR ;CANT CONTINUE
MOVE T,[5,,[ASCII"(' EXIT AT '2A7,A1,I4)"]]
JRST REEOUT
SUBTTL REENTRY HANDLE
REEFN7: HRRZM T2,.JBOPC##
SKIPA T2,ACC.SV+T2(T1)
REENTR: PUSH P,U ;PRESERVE TEMP
HRRE U,.JBOPC##
CAIL U,@MANUUF
CAIL U,@MANUUE
SKIPA U,.JBOPS##
JRST REEFN5
SKIPE IOL.P3(U)
JRST REEFN0 ;YES
HRRE U,.JBOPC## ;GET INTERRUPT PC
CAIL U,1000 ;PC IN HIGHSEG?
JRST REEFN4 ;NO, INTERRUPT NOW
CAML U,[-1,,MANTS.] ;IN DEBUGGER?
JRST REETIN ;YES
REEFN0: MOVEI U,REEFIN ;SETUP TO GET CONTROL ON LEAVING FOROTS
MOVEM U,FINMAN
REETIN: MOVE U,[JRST MAYREE] ;MAYBE REGAIN CONTROL WHEN DEBUGGER GOES TO USER
MOVEM U,REESTOP
POP P,U ;CONTINUE FROM .REENTER
JRSTF @.JBOPC
REEFN5: MOVE U,REEFN6
MOVEM U,@FORSE
POP P,U
JRSTF @.JBOPC
REEFN6: JRST .+1
MOVE T1,.JBOPS##
PUSH P,@UUOPC
POP P,USR.PC(T1)
REEFIN: MOVE T1,.JBOPS## ;HERE ON LEAVING FOROTS
SKIPN IOL.P3(T1) ;IS I/O ACTIVE?
JRST REEFN2 ;NO
REEFN1: HRLI T1,ACC.SV+T1(T1) ;RESTORE AC T1 AND CONTINUE
JRA T1,@USR.PC(T1)
REEFN2: MOVSI T2,(JRSTF @)
HRRI T2,@UUOPC
MOVEM T2,@FORSE
MOVSI T2,((L))
MOVEM T2,FINMAN
HRRE T2,USR.PC(T1) ;LEAVING BACK TO DEBUGGER?
CAML T2,[-1,,MANTS.]
JRST REEFN3 ;NO
MOVE T2,ACC.SV+T2(T1) ;YES, RESTORE AC T2
JRST REEFN1 ; AND CONTINUE
REEFN3: PUSH P,ACC.SV+T1(T1)
CAIL T2,@MANUUF
CAIL T2,@MANUUE
SKIPA T2,ACC.SV+T2(T1)
JRST REEFN7
MOVE U,USR.PC(T1) ;SETUP F4 PC
REEFN4: MOVEM T,ACSAVE+T ;SAVE ACS
POP P,ACSAVE+U
HRRZM U,F4PC ;STORE PC
REEYES: MOVE U,[W,,ACSAVE+W] ;SAVE AC'S AND TELL USER
BLT U,ACSAVE+P
MOVSI T,(TRN) ; NO-OP INSTR
MOVEM T,INSTR
REETELL:MOVE T,[5,,[ASCII"(' PROGRAM AT '2A7,A1,I4)"]]
REEOUT: OUT. T,-1
MOVEI T,-1
MOVEM T,CHAN
MOVEI J,1
HRRZ T,F4PC
PUSHJ P,IDLOCS
SKIPN DRAIN
JRST PROMPT
JRST $SUB9
MAYREE: SKIPN ONA ;DON'T STOP IF IN THE MIDDLE OF ANYTHING
SKIPE DRAIN
JRST REESTOP+1
JRST REETELL
$TJUMP: SKIPG REESTOP ;MAYBE STOP
JRST (J) ;NO, TRACE JUMP
$TSTOP: HRRZM J,F4PC
JRST REEYES
SUBTTL PINPOINT ELEMENT ROUTINE
LOCATE: PUSHJ P,SQZINS
IDENTL: PUSHJ P,IDENT0 ;IDENTIFY NAME
JUMPGE V,DEFERR
TLNE A,LBLFLG
JRST DEFERR
MOVEI E,0 ;ZERO RELATIVE ELEMENT ADR
TLNN A,ARRFLG!DMYFLG ;ARRAY?
JRST LOCAT2 ;NO
LDB W,[POINT 12,A,17] ;PICK UP INDEX
SKIPN U,W ;HAD BETTER BE DEFINED
JRST NBUERR
CAIE T,"(" ;ELEMENT SPECIFIED?
JRST LOCAT6 ;NO
HRRZ H,@SCRIPT ;PICK UP # DIMENSIONS IN CASE OF FIXED BOUNDS
TLNN A,DMYFLG ;DUMMY?
JRST LOCAT5 ;NO
TLNE A,ARRFLG ;VARIABLE BOUNDS?
JRST LOCAT4 ;NO, FIXED BOUNDS
REMARK THAT VARIABLE BOUNDS ARE ALLOWED ATTACHED
MOVEI W,(H) ;POINT TO ADJ. PARMLIST
HRRZ H,-2(W) ;PICK UP # DIMENSIONS
LOCAT4: JUMPN F,LOCAT5 ;ATTACHED DUMMY MAY NOT BE DEFINED AT MOMENT
HRR A,(A) ;GET REAL ADR
TRNN A,-1 ;HAS CALL BEEN MADE?
JRST PNGERR
LOCAT5: MOVEI D,1 ;INITIAL FACTOR
PUSH P,B ;SAVE PROGRAM SYMBOL POINTER
LOCAT1: TLNN A,ARRFLG ;VARIABLE BOUNDS?
AOJA W,[MOVE B,@0(W) ;YES, LOWER BOUND
MOVE C,@-1(W) ; & UPPER BOUND
AOJA W,.+4]
AOS U,W ;NO, GET INDEX TO AC U
HLRE B,@SCRIPT ;PICK UP LOWER BOUND
HRRE C,@SCRIPT ; & UPPER BOUND
PUSHJ P,FIRSCH ;READ NUMBER
JRST LOCAT8 ;NOTHING THERE
DATA. INTEGER,G ;INPUT SUBSCRIPT
JRST LOCAT7
LOCAT8: CAIN T,"*" ;SECTION NOTATION?
JUMPLE F,[ ;YES, DIRECT?
SKIPN J ;MAKE SURE TEMP POINTER RIGHT
MOVE Y,HISTOP
SUBM D,J ;YES, COMPUTE INCREMENT
TLC A,(6B2) ;DOUBLE WORD?
TLCN A,(6B2)
ASH J,1
MOVEM J,(Y)
SUBI C,-1(B) ; & RANGE
HRLS C
MOVEM C,1(Y)
ADDI Y,2 ;INCREMENT TEMP NODE POINTER
IMULI D,(C) ;NEW FACTOR
MOVEI J,(D) ;REMEMBER FACTOR
PUSHJ P,TSKIP ;DELIMITER
SOJA F,LOCAT3] ;FLAG & CONTINUE
JRST TAXERR
LOCAT7: CAML G,B ;SUBSCRIPT IN RANGE?
CAMLE G,C
JRST ELMERR
SUB G,B ;COMPUTE NEW RELATIVE ADR
IMUL G,D
ADD E,G
SUB C,B ;COMPUTE NEW FACTOR
IMULI D,1(C)
LOCAT3: CAIN T,"," ;DOES ANOTHER SUBSCRIPT FOLLOW?
SOJG H,LOCAT1 ;SHOULD IT?
CAIN T,")" ;END?
CAIE H,1
JRST ELMERR
PUSHJ P,TSKIP ;GET FINAL DELIMITER
POP P,B ;RESTORE PROGRAM SYMBOL POINTER
LOCAT2: LDB W,[POINT 3,A,2] ;PICK UP TYPE CODE
CAIL W,DOUBLE ;DOUBLEWORD ELEMENTS?
ASH E,1 ;YES, DOUBLE RELATIVE ADR
ADD A,E ;ADR OF ELEMENT FINALLY
POPJ P, ; & RETURN
LOCAT6: LDB W,[POINT 3,A,2] ;PICK UP TYPE CODE
SETZ A, ;SET WHOLE ARRAY FLAG
POPJ P,
SUBTTL IDENTIFY SYMBOL ROUTINE
IDENT: PUSHJ P,SQZINS ;GET NAME
IDENT0: MOVE B,GLOBAL ;DEFAULT GLOBAL
CAIN V,":" ;ARGUMENT NOTATION?
CAIE W,SQUOZE 0,ARG
JRST IDENT1 ;NO
JUMPE F,NARERR ;ONLY VALID ONCALL
TLNE J,-1
JRST NARERR
PUSHJ P,FIRSCH ;READ NUMBER
JRST TAXERR ;NOTHING THERE
DATA. INTEGER,W ;GET # ARG
SOJL W,GTZERR
HRRO V,@HISTOP ;PROGRAM POINTER
HLRZ A,-2(V) ;PROLOGUE ADR
HLRZ U,2(A) ;FIND ARGUMENT AREA ADR
CAIG U,(15B8) ;(RESET. OPCODE)
JRST NAAERR ;NO ARGS AT ALL
CAIE U,(MOVEI 00,)
AOJA A,.-4
HRL A,2(A) ;HOLD ARG AREA ADR IN LH OF AC A
AOJA A,IDENT4 ;GO FIND ADR WITHIN AREA OF ARG
IDENT3: CAIN U,14 ;ONCALL?
JRST NAAERR ;YES, NO SUCH ARG
CAIN U,550 ;HRRZ?
IDENT4: AOBJN A,NAAERR ;YES, IGNORE PUSH ;COUNT PUSH
LDB U,[POINT 9,(A),8] ;OPCODE
CAIE U,261 ;PUSH?
AOJA A,IDENT3 ;NO, TRY NEXT INSTR
HRRZ U,(A) ;OURS YET?
CAIGE U,(W)
JRST IDENT4 ;NO
CAIE U,(W) ;HE CAN'T REFERENCE LABEL ARGS
JRST NASERR
MOVE W,(A) ;ONLY SCALAR ARGS
TLNE W,(1B13)
CAIN T,"("
JRST NASERR
TRO A,1B18 ;FLAG ADR
POPJ P, ; & RETURN ARG NOTATION
IDENT1: CAIE V,"/" ;DO WE HAVE LOCAL SYMBOL?
JRST IDENT2 ;YES
PUSHJ P,GLOOK ;GLOBAL LOOKUP
SKIPL B,V ;DEFINED?
POPJ P,
PUSHJ P,SKIP ;GET LOCAL NAME
PUSHJ P,SQZINS
IDENT2: MOVE T,V ;HOLD DELIMITER IN AC T !
SKIPGE V,B ;LOOKUP LOCAL NAME
LOOK: TLOA W,(10B5) ;SET LOCAL CODE
AOBJP V,OPSYMS ;RETURN NOT FOUND
CAME W,(V)
AOBJN V,.-2
MOVE A,1(V) ;PUT VALUE OF SYMBOL IN AC A !
POPJ: POPJ P, ; & RETURN
OPSYMS: SKIPA V,OPSYMT ;LOOK INTERNAL TABLE
AOBJP V,POPJ ;NOT FOUND EVEN HERE
CAME W,(V)
AOBJN V,.-2
MOVE A,.JBOPS## ;FOUND
MOVEI A,@1(V) ;GET ADDRESS
POPJ P, ; & RETURN
OPSYMT: .+1-GLOOK,,.+1
SQUOZE 10,ERRMX.
ERRMX.(A)
GLOOK: SKIPL V,MANSYM ;LOOKUP PROGRAM NAME
AOBJP V,POPJ ;JUMP RETURN NOT FOUND
CAME W,(V)
AOBJN V,.-2
ADDI V,4 ;FIX POINTER
HLL V,-3(V)
POPJ P,
SUBTTL BETWEEN POSITIONS ROUTINE
BETWEEN:MOVE V,T
PUSHJ P,SQZIN ;MAYBE GET WORD
MOVE G,GLOBAL ;DEFAULT LIMITS
SKIPN H,-2(G)
MOVS H,START
HLRZS H
HLLZ C,-1(G) ; & DEFAULT BYTE POINTER
HLRS C
TDZ C,[STAMSK,,-STAMSK-1]
TLO C,400
ADD C,STATAB
TLZN C,LBLFLG
SKIPA G,-1(C)
HRRZ G,-3(G)
JUMPE W,POPJ ;JUMP IF DEFAULT
PUSHJ P,SKIPS
MOVE H,W ;HOLD OPTION NAME
PUSHJ P,ATLOC ;GET POSITION
MOVEI G,(A) ; INTO AC G
EXCH C,H ;HOLD BYTE POINTER
PUSH P,BTWEEP ;PUSH RETURN FROM SECOND POSITION CALL
CAIN C,SQUOZE 0,AT ;SINGLE STMT?
JRST AD1LOC ;YES, RETURN TO BTWEEH
PUSHJ P,SQZINS ;MUST BE BETWEEN PHRASE
CAMN C,[SQUOZE 0,BETWEEN]
CAIE W,SQUOZE 0,AND
JRST TAXERR
JRST ATLOC ;GET UPPER POSITION ADR
BTWEEH: MOVE C,H ;HOLD BYTE POINTER
MOVEI H,(A) ; & UPPER POSITION
CAML G,H
JRST ATERR
BTWEEP: POPJ P,BTWEEH ;RETURN LIMITS & BYTE POINTER
SUBTTL IDENTIFY LOCATION ROUTINE
ATLOC: PUSHJ P,SQZINS
MOVE B,GLOBAL
CAIE V,"/"
JRST ATLOC1
PUSHJ P,GLOOK
SKIPL B,V
JRST DEFERR
PUSHJ P,SQZINK
PUSHJ P,SKIPS
MOVE T,V
HRRZ A,-3(B)
HLLZ U,-1(B)
JUMPE W,ATLOC2 ;JUMP TO USE CODE BASE
ATLOC1: PUSHJ P,IDENT2
JUMPGE V,DEFERR
TLNN A,LBLFLG
JRST ATERR
HLLZ U,1(V)
ATLOC2: HLRS C,U ;GET REAL START OF CODE
TDZ C,[STAMSK,,-STAMSK-1]
TLO C,400 ;MAKE LENGTHS BYTE POINTER
ADD C,STATAB
PUSH P,D ; (SAVE AC D)
TLZN C,LBLFLG
SKIPA D,-1(C)
SKIPA D,-3(B)
HRRZ A,D
CAIN T,"+" ;ABOVE?
JRST ATLOC3 ;YES
CAIE T,"-" ;BELOW?
JRST ATLOC4 ;RIGHT AT LABEL
ATLOC3: PUSH P,T ;READ NUMBER
PUSHJ P,FIRSCH
JRST TAXERR ;NOTHING THERE
DATA. INTEGER,V ;GET OFFSET
EXCH T,(P)
CAIN T,"-"
MOVNS V
JUMPN W,.+2 ;ADJUST OFFSET IF FROM CODE BASE
SOJE V,.+2
PUSHJ P,ADDLOC ;APPLY IT
POP P,T ;GET DELIMITER OF NUMBER
ATLOC4: POP P,D ;RESTORE AC D
ATLOC5: MOVE V,T ;PUT DELIMITER IN AC V
POPJ P, ; WHERE IT BELONGS AND RETURN
AD1LOC: MOVE C,H
MOVEI V,1 ;STEP ONE STMT
ADDLOC: JUMPLE V,ADLOC1 ;JUMP IF GOING DOWN
ADLOC6: ILDB U,C ;GO UP
JUMPN U,.+6
ILDB U,C
LSHC U,-4
ILDB U,C
LSHC U,4
JUMPE U,ATERR ;JUMP IF TOO BIG
ADDI A,(U)
LDB U,[POINT 7,1(A),6] ;IGNORE FORMAT STMT
CAIN U,"("
JRST ADLOC6
SOJG V,ADLOC6
SKIPN U,-2(B) ;GET END OF PROG LOGIC
MOVS U,START
HLRZS U
CAIG U,(A) ;ADR IN PROG LOGIC?
JRST ATERR ;NO
JRST ATLOC5 ;RETURN
ADLOC1: JUMPE V,POPJ
PUSH P,B ;SAVE PROGRAM SYMBOL POINTER
LDB B,[POINT 4,C,3] ;GET BYTE POSITION
MOVE T,-1(C) ;GET CURRENT BYTE WORDS
MOVE U,(C)
MOVNI W,(B) ;MAKE INITIAL SHIFT
ASH W,2
LSHC T,(W)
SUBI B,^D9 ;INITIAL COUNT OF BYTES
HRLI D,0 ;BASE OF CODE
ADLOC2: CAIL D,(A) ;BELOW CODE?
JRST ATERR ;YES, OFFSET IS TOO NEGATIVE
TRNN U,007400 ;SINGLE BYTE LONG?
JRST ADLOC5 ;MAYBE NOT
ADLOC3: LDB W,[POINT 4,U,35] ;YES
ADLOC4: AOJG B,[MOVNI B,^D8 ;COUNT BYTES, DECREMENT POINTER
MOVE T,-2(C)
SOJA C,.+1]
LSHC T,-4 ;FORGET BYTE
SUBI A,(W) ;STEP BACK ONE STMT
LDB W,[POINT 7,1(A),6] ;IGNORE FORMAT STMT
CAIN W,"("
JRST ADLOC2
AOJL V,ADLOC2
ADDI B,^D9 ;FIX BYTE POINTER
DPB B,[POINT 4,C,3]
POP P,B ;RESTORE PROGRAM SYMBOL POINTER
POPJ P, ;RETURN FINALLY
ADLOC5: TRNN U,170000 ;TRIPLE BYTE?
JRST ADLOC3 ;NO, SINGLE BYTE LONG
LDB W,[POINT 4,U,31]
DPB U,[POINT 4,W,31]
AOJG B,[MOVNI B,^D8 ;COUNT BYTES, DECREMENT POINTER
MOVE T,-2(C)
SOJA C,.+1]
LSHC T,-4
AOJG B,[MOVNI B,^D8
MOVE T,-2(C)
SOJA C,.+1]
LSHC T,-4
JRST ADLOC4 ;DECREMENT THIRD TIME
SUBTTL BASIC INPUT ROUTINES
STOP: MOVE V,T ;HOLD CHAR IN AC V
PUSHJ P,SQZIN
JUMPE W,POPJ ;NOTHING?
CAME W,STOP% ;MUST BE STOP
JRST TAXERR
TLOA H,(1B0) ;FLAG & SKIP
SKIP: PUSHJ P,WIN ;INPUT CHAR
SKIPS: CAIE V," " ;TAB OR
CAIN V," " ;BLANK
JRST SKIP
POPJ P,
SQZINS: PUSHJ P,SQZIN
JUMPN W,SKIPS
JRST TAXERR
SQZINK: PUSHJ P,SKIP
SQZIN: SETZ W,SQZIN+1 ;ZERO RECEIVING AC
CAIN V,"." ;IS CHAR A DOT??
SKIPA V,["Z"+1] ;YES
CAIG V,"Z" ;IS CHAR VALID?
CAIGE V,"A"
CAIG V,"9"
CAIGE V,"0"
POPJ P, ;NO
CAML W,[50*50*50*50*50] ;TOO MANY CHARS?
JRST SQZWIN ;YES, IGNORE THEM
IMULI W,50
CAIGE V,"A"
ADDI V,7
ADDI W,-66(V)
SQZWIN: PUSH P,SQZIN ;GET NEXT CHAR
WIN: PUSH P,T0 ;PRESERVE ACS
PUSH P,P1
PUSH P,P3
PUSH P,P4
MOVE P4,.JBOPS ;GET DEV BLK PTR & FLGS
SKIPN P3,IOL.P3(P4)
JRST WINEOL
JSP P1,IBYTE.## ;GO GET BYTE
MOVEM P3,IOL.P3(P4)
TLNE P3,IO.EOL
WINEOL: TDZA V,V
MOVE V,T0
POP P,P4
POP P,P3 ;RESTORE ACS AND RETURN
POP P,P1 ;WITH CHAR IN V
POP P,T0
POPJ P,
ACCEPT: MOVE T,[1,,[ASCII"(99G)"]] ;ACCEPT INPUT FROM TTY IN G FORMAT
IN. T,-4
POPJ P,
FIRSC2: SUB P,[1,,1]
POPJ P,
FIRSCH: PUSH P,T
PUSHJ P,TSKIP
CAIE T,"+"
CAIN T,"-"
JRST FIRSC1
CAIE T,"."
CAIL T,"0"
CAILE T,"9"
JRST FIRSC2
FIRSC1: MOVE U,.JBOPS##
MOVEM T,CH.SAV(U)
POP P,T
AOS (P)
XCT @(P)
AOS (P)
NUDGE: MOVE U,.JBOPS ;GET DELIMITING CHAR
SETZM CH.SAV(U)
SKIPE U,IOL.P3(U)
TLNE U,IO.EOL
TDZA T,T
LDB T,DD.HRI+1(U)
CAIE T," " ;BLANK?
POPJ P,
TSKIP: PUSH P,V ;PRESERVE AC V
PUSHJ P,SKIP ;GET SIGNIFICANT CHAR
MOVEI T,(V) ; INTO AC T !
POP P,V
POPJ P,
SUBTTL IDENTIFY AND OUTPUT POSITION ROUTINE
IDLOCS: SOJA T,IDLOC
IDLOCA: MOVEI T,(A) ;PUT LOCATION IN AC T
IDLOC: CAIG T,@FORSE ;PC IN LIBRARY?
JRST IDPC4 ;NO
MOVSI W,(JSA J,) ;YES, SO TRACE CHAIN OF JSA CALLS
MOVE V,ACSAVE+J
IDPC1: MOVEI U,(V)
HLR W,V
CAIL U,1000
CAIL U,@.JBFF ;PC OUT OF RANGE?
JRST IDPC2
CAME W,-1(V) ; OR INSTR NOT JSA TO ENTRY POINT?
JRST IDPC2
MOVEI T,-1(V) ;WAS CALL
JRA V,IDPC1 ;SEE IF ANOTHER
IDPC2: CAME V,ACSAVE+J ;ANY JSA'S?
JRST IDPC4 ;YES
MOVE V,.JBOPS ;NO, SO MAYBE PUSHJ CALL
IDPC3: HRRZ W,STK.SV(V) ;PC OUT OF RANGE?
CAIL W,1000
CAIL W,@.JBFF
JRST IDPC4 ;YES
HLRZ U,-1(W) ;REALLY PUSHJ THERE?
CAIN U,(JSA J,) ;OR JSA PROBABLY TO CAIA!
JRST .+3
CAIE U,(PUSHJ P,)
AOJA V,IDPC3 ;NO, STEP UP STACK
MOVEI T,-1(W) ;YES, MAYBE F4 PC
IDPC4: MOVEM T,GLOBAL ;HOLD LOCATION TEMP
PUSHJ P,INTERN ;LOOKUP LOCATION
JUMPL W,QUOUT ;JUMP IF BELOW EVERYTHING
MOVE W,(A) ;GET SQUOZE
TLNN W,(10B5) ;PROGRAM NAME?
JRST IDLOC1 ;YES, WE'RE BELOW FIRST LABEL
MOVE U,1(A) ;GET VALUE WORD
TLNN U,LBLFLG ;LABEL NAME?
JRST QUOUT ;NO, WE'RE ABOVE CODE
MOVE U,A
MOVSI T,20000 ;IDENTIFY PROGRAM
TDNN T,-3(U)
SOJA U,[SOJA U,.-1]
SKIPA W,-4(U)
IDLOC1: HRROI A,2(A)
JUMPE J,IDLOC2 ;OUTPUT PROGRAM NAME?
PUSHJ P,SQZDATA ;YES, APPEND SLASH
TLO H,(BYTE(7),57)
DATA. DOUBLE,G
IDLOC2: HRRZ V,1(A) ;SETUP CODE AND BYTE POINTERS
SETZB B,G
JUMPL A,[HRRZ V,-1(A) ;FROM CODE BASE?
AOJA B,.+1]
HLLZ W,1(A)
HLRS W
TDZ W,[STAMSK,,-STAMSK-1]
TLO W,400
ADD W,STATAB
TLZN W,LBLFLG
HRRZ V,-1(W)
IDLOC3: ILDB T,W ;STEP THROUGH STMTS
JUMPN T,.+6
ILDB T,W
LSHC T,-4
ILDB T,W
LSHC T,4
JUMPE T,IDLOC5 ;JUMP IF ABOVE CODE
ADD V,T
LDB T,[POINT 7,1(V),6] ;IGNORE FORMAT STMT
CAIN T,"("
JRST IDLOC3
CAMG V,GLOBAL
AOJA B,IDLOC3
MOVE H,3(A) ;ANOTHER LABEL ABOVE?
TLNN H,LBLFLG
JRST IDLOC5 ;NOPE
MOVEM B,GLOBAL ;SAVE POSITIVE STMT COUNT
MOVEI B,1 ;SEE WHAT NEGATIVE COUNT IS
JRST IDLOC7
IDLOC4: ILDB T,W
JUMPN T,.+5
ILDB T,W
LSHC T,-4
ILDB T,W
LSHC T,4
ADD V,T
LDB T,[POINT 7,1(V),6] ;IGNORE FORMAT STMT
CAIN T,"("
JRST IDLOC4
IDLOC7: CAIGE V,(H)
AOJA B,IDLOC4
CAMG B,GLOBAL ;SEE WHICH COUNT IS LESS
TLOA B,1 ;NEGATIVE ONE IS LESS, SET FLAG
SKIPA B,GLOBAL ;SKIP POSITIVE COUNT IS LESS
MOVEI A,2(A)
IDLOC5: JUMPL A,IDLOC6 ;JUMP IF FROM CODE BASE
MOVE T,1(A) ;TELL USER LABEL NAME
MOVE W,(A)
TLNE T,LBLFLG
PUSHJ P,SQZDATA
IDLOC6: DATA. HOLLER,G
MOVSI G,(ASCII"+") ;TELL SIGN OF OFFSET
TLZE B,1
MOVSI G,(ASCII"-")
AOSE J ;IF FLAG -1 OUTPUT OFFSET EVEN IF ZERO
JUMPE B,POPJ ;RETURN IF OFFSET ZERO
DATA. HOLLER,G
DATA. INTEGER,B
POPJ P, ;RETURN
SUBTTL INTERNAL AND SQUOZE OUTPUT ROUTINES
INTERN: SETO W, ;INITIAL BEST FIT
SKIPA V,MANSYM ;LOOK FOR CLOSEST VALUE
AOBJP V,POPJ ;JUMP IF FINISHED
MOVE U,1(V) ;PICK UP VALUE OF SYMBOL
CAIL T,(U) ;SMALLER THAN TARGET?
CAILE W,(U) ;YES, LARGER THAN BEST SO FAR?
AOBJN V,INTERN+2 ;NO, TRY NEXT SYMBOL PAIR
MOVEI W,(U) ;THIS IS BETTER
MOVEI A,(V) ;NOTE PLACE AS WELL
AOBJN V,INTERN+2 ;TRY NEXT PAIR
QUOUT: MOVSI G,(ASCII" ?")
TDZA H,H
SQZOUT: PUSHJ P,SQZDATA
DATA.G: DATA. DOUBLE,G
LNFEED: POPJ P, 12
SQZDATA:MOVSI T,(POINT 7,,) ;ASCII BYTES
HRRI T,G ;POINT TO RECEIVING AC'S
SETZB G,H ;ZERO THEM
TLZ W,(74B5) ;ZERO CODE BITS
IDIVI W,50 ;DIVIDE OFF CHAR
ADDI V,66 ;FIX TO ASCII
CAIGE V,"A"
SUBI V,7
JUMPE W,.+4 ;FINISHED?
HRLM V,(P) ;NO, RECURSE
PUSHJ P,.-6
HLRZ V,(P) ;POP CHAR
IDPB V,T
QMARK: POPJ P, "?"
SUBTTL INSERT NODE IN ROLL
INSERJ: MOVEI C,(Y) ;LENGTH OF INCREASE
SUBI C,(J)
MOVSS J ;ROLL OF INSERTION
INSERC: JUMPLE C,SHRINK ;EXPAND ROLL?
MOVE D,X ;YES, NODES ABOVE
ADD D,C
MOVEI E,(J) ;SET ROLL POINTER
INUP: HLRZ A,CALL+1(E) ;BOTTOM OF NEXT ROLL
MOVE U,A ;ROOM TO EXPAND
SUB U,CALL(E)
SUBI C,(U) ;EXTRA?
JUMPGE C,.+3
ADD A,C ;YES, NEW TOP OF ROLL
ADD U,C ; & ADJUSTMENT IN AC U
HRRZ B,CALL(E) ;SETUP FOR EXPANSION
CAILE B,(D) ;MORE TO MOVE?
SOJA B,[MOVE T,(B) ;YES
MOVEM T,-1(A)
SOJA A,.-1]
HRLS U ;ADJUSTMENT IN BOTH HALVES
SKIPA B,E ;ADJUST ROLL POINTERS
ADDM U,CALL+1(B)
CAIE B,(J) ;MORE?
SOJA B,.-2 ;YES
ADD U,CALL(B) ;ADJUST TOP OF EXPANDING ROLL
HRRM U,CALL(B)
JUMPLE C,INSET ;EXPAND STILL MORE?
MOVE D,A ;YES, NODES ABOVE
CAIE E,HISTORY-CALL-1 ;CAN WE?
AOJA E,INUP ;YES, RECURSE
MOVEI E,(J) ;SET ROLL POINTER FOR DOWNWARD CRUNCH
INDOWN: JUMPE E,TOOMANY ;HIT BOTTOM?
HLRZ D,CALL(E) ;BOTTOM OF ROLL
HRRZ U,CALL-1(E) ;TOP OF LOWER ROLL
MOVE T,U ;HOLD TOP OF LOWER IN AC T
SUBM D,U ;ROOM TO EXPAND
SUBI C,(U)
JUMPGE C,.+3 ;EXTRA?
SUB T,C ;YES, NEW BOTTOM
ADD U,C ; & ADJUSTMENT IN U
HRL T,D ;BLT POINTER
SUB D,U ;NEW BOTTOM
SUB X,U ;NEW INSERTION POINT
CAIE X,(D) ;SOMETHING TO MOVE?
BLT T,-1(X) ;YES, BLOCK MOVE
JUMPE U,.+3 ;ADJUST ROLL POINTERS
MOVNS U
HRLI U,-1(U)
SKIPA B,E
ADDM U,CALL-1(B)
CAIE B,(J)
AOJA B,.-2
HRLM D,CALL(B)
JUMPLE C,INSET
SOJA E,INDOWN ;EXPAND STILL MORE!
TOOMANY:OUTSTR [ASCIZ"?TOO MANY COMMAND STRINGS"]
JUMPGE J,.+4 ;ON?
SKIPE (P)
OUTSTR [ASCIZ"
THOUGH ON CMDS WITH INTERSECTING RANGES HAVE BEEN REVOKED"]
TDZA T,T
HLRZ T,J ;CLOSE HOLE IN ROLL
ADDM T,C
ADDB T,X
SUBB C,Y
SUBM X,C
HRL X,C
ADDB Y,CALL(J)
CAIE T,(Y)
BLT X,-1(Y)
JRST PROMPT
SHRINK: JUMPE C,INSET ;SHRINK ROLL?
HRLS U,Y ;YES, BLT POINTER
HRLS X
ADD U,X
SUB U,C
MOVS T,U
ADDB C,CALL(J) ;ADJUST ROLL POINTER
HRLI C,0 ;SOMETHING TO MOVE?
CAIE C,(U)
BLT T,-1(C) ;YES, BLOCK MOVE DOWN
INSET: HRL X,HISTOP ;INSERT NODE FINALLY
ADD Y,X
BLT X,-1(Y)
JUMPL J,ON.1 ;JUMP TO PLACE ON BREAKS
TRNN J,-1 ;AT BREAK?
JRST INSURE ;NO
MOVE A,@HISTOP ;YES, PLACE BREAK
MOVE V,(A)
TLNN V,(764B8)
TLNN V,(10B8)
JRST INSAT
TLC V,(3B8) ;ON BREAK?
TLCN V,(3B8)
JRST INSAT ;YES
TLZE V,(2B8)
TLO V,(1B8)
MOVEM V,(A)
JRST INSURE
INSAT: PUSHJ P,TOPGET
MOVEM V,@BROKE$
ANDI U,BRKMSK
TLO U,(AT.)
MOVEM U,(A)
INSURE: OUTSTR [ASCIZ"STORED
"]
JRST PROMPT
SUBTTL CANNED ERROR HANDLE
DEFINE ERROR (M)
< JSP W,ERROR
ASCIZ \M\>
ERROR: OUTCHR QMARK
OUTSTR @W
OUTCHR LNFEED
JRST PROMPT
SALL
NCERR: ERROR NOT A COMMAND
NAERR: ERROR NOT VALID ATTACHED
TAXERR: ERROR SYNTAX ERROR
DEFERR: ERROR NAME UNDEFINED
PDFERR: ERROR PROGRAM NOT LOADED OR HAS NO SYMBOLS
GTZERR: ERROR NUMBER MUST BE POSITIVE
RELERR: ERROR INVALID RELATION
GKERR: ERROR GENERAL KILL CANNOT BE ATTACHED
NFGERR: ERROR NOTHING MAY FOLLOW GO
NSGERR: ERROR CAN'T STOP AND GO
PNGERR: ERROR PROG HAS NOT BEEN CALLED YET
AGNERR: ERROR GO WHERE?
NELERR: ERROR SPECIFY ARRAY ELEMENT OR SECTION
SECERR: ERROR SPECIFY ELEMENT OR JUST NAME
ELMERR: ERROR BAD ARRAY ELEMENT
NRFERR: ERROR ARG NEVER USED
MTAERR: ERROR INVALID UNIT
NBUERR: ERROR BOUNDS UNDEFINED
NARERR: ERROR ARG: VALID ONLY ONCALL
NAAERR: ERROR NO SUCH ARGUMENT
NASERR: ERROR ONLY SCALAR ARGS ALLOWED
ATERR: ERROR BAD POSITION
NRRERR: ERROR WILL NOT WORK NOW
RESER.: POP P,F4PC ;SAVE PC AND ACS SO
MOVE U,[W,,ACSAVE+W] ; USER CAN PROCEED
BLT U,ACSAVE+P
MOVSI (CAI) ;NOOP INSTR
MOVEM INSTR
ERROR RESET. LUUOS NOT ALLOWED
NOTIMP: ERROR NOT IMPLEMENTED
END SETHGH