TITLE MANTIS UNIVERSITY OF OREGON FORTRAN DEBUGGER V5 SUBTTL L.SALMONSON, DEC 74 ;***COPYRIGHT 1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.*** IFNDEF REENT, ;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,> ;WE MAY NOT WANT LOWSEG IFGE REENT,< ;COMPILE LOWSEG EXCEPT ON SECOND PASS FOR HISEG IFN REENT,< HISEG ;WE'RE COMPILING HISEG FORSE.==>>> LOC 124 ;DEFINE INITIAL REENTRY .JBREN::EXP SETSYM IFN REENT, IFE REENT, ;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*> ;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 OF CONDITIONAL LOW SEGMENT ;PURGE DUMMY EXTERNALS IF1, ;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,_-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, 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: B12+V ; UNIT # 3B8+B12+[ASCIZ/DSK/] ;DEVICE IS DISK ALWAYS 2B8+B12+[ASCIZ/SEQO/] ;ACCESS MODE IS SEQOUT 6B8+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: 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