SUBTTL DICK GRUEN: V25 3 AUG 68 L==1 ;L=1 MEANS THE LISP LOADER IFNDEF L, IFNDEF HE, IFE HE-1, ;HE=1 IS HAND EYE 1K LOADER IFE HE-2, ;HE=2 IS HAND-EYE FORTRAN LOADER ;K=1 ;K=1 MEANS 1KLOADER IFNDEF K, ;K=0 MEANS F4 LOADER STANSW=1 ;GIVES STANFORD FEATURES IFNDEF STANSW, IFN STANSW,< LDAC=1 EXPAND=1 BLTSYM=1 PP=1 RPGSW=1 FAILSW=1> IFN L,< RPGSW=0 BLTSYM=0 LDAC=0> UTAHSW=1 ;NUMERIC PPN'S, BUT OTHERWISE = STANSW=1. IFNDEF UTAHSW, ;FAILSW=1 ;MEANS INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS IFNDEF FAILSW, ;RPGSW=1 ;MEANS RPG FEATURE IFNDEF RPGSW, ;LDAC=1 ;MEANS LOAD CODE INTO ACS IFNDEF LDAC, ;BLTSYM=1 ;MOVE SYMBOL TABLE DOWN TO END OF PROG IFNDEF BLTSYM, ;EXPAND=1 ;FOR AUTOMATIC CORE EXPANSION IFNDEF EXPAND,< IFN K, IFE K,> ;PP=1 ;ALLOW PROJ-PROG # IFNDEF PP, IFN HE, ;CHN5=0 ;IF CHAIN WHICH DOESN'T SAVES JOB41 IFNDEF CHN5, IFE K,< TITLE LOADER - LOADS MACROX AND SIXTRAN FOUR> IFN K,< TITLE 1KLOAD - LOADS MACROX> ;ACCUMULATOR ASSIGNMENTS F=0 ;FLAGS IN LH, SA IN RH N=1 ;PROGRAM NAME POINTER X=2 ;LOADER OFFSET H=3 ;HIGHEST LOC LOADED S=4 ;UNDEFINED POINTER R=5 ;RELOCATION CONSTANT B=6 ;SYMBOL TABLE POINTER D=7 T=10 V=T+1 W=12 ;VALUE C=W+1 ;SYMBOL E=C+1 ;DATA WORD COUNTER Q=15 ;RELOCATION BITS A=Q+1 ;SYMBOL SEARCH POINTER P=17 ;PUSHDOWN POINTER ;FLAGS F(0 - 17) CSW==1 ;ON - COLON SEEN ESW==2 ;ON - EXPLICIT EXTENSION IDENT. SKIPSW==4 ;ON - DO NOT LOAD THIS PROGRAM FSW==10 ;ON - SCAN FORCED TO COMPLETION FCONSW==20 ;ON - FORCE CONSOLE OUTPUT ASW==100 ;ON - LEFT ARROW ILLEGAL FULLSW==200 ;ON - STORAGE EXCEEDED SLIBSW==400 ;ON - LIB SEARCH IN THIS PROG DSYMSW==1000 ;ON - LOAD WITH SYMBOLS FOR DDT REWSW==2000 ;ON - REWIND AFTER INIT LIBSW==4000 ;ON - LIBRARY SEARCH MODE F4LIB==10000 ;ON - F4 LIBRARY SEARCH LOOKUP ISW==20000 ;ON - DO NOT PERFORM INIT SYMSW==40000 ;ON - LOAD LOCAL SYMBOLS DSW==100000 ;ON - CHAR IN IDENTIFIER NSW==200000 ;ON - SUPPRESS LIBRARY SEARCH SSW==400000 ;ON - SWITCH MODE ;FLAGS N(0 - 17) ALLFLG==1 ;ON - LIST ALL GLOBALS ISAFLG==2 ;ON - IGNORE STARTING ADDRESSES COMFLG==4 ;ON - SIZE OF COMMON SET IFE K,< F4SW==10 ;F4 IN PROGRESS RCF==20 ;READ DATA COUNT SYDAT==40 ;SYMBOL IN DATA> SLASH==100 ;SLASH SEEN IFE K,< BLKD1==200 ;ON- FIRST BLOCK DATA SEEN PGM1==400 ;ON FIRST F4 PROG SEEN DZER==1000 ;ON - ZERO SECOND DATA WORD> EXEQSW==2000 ;IMMEDIATE EXECUTION DDSW==4000 ;GO TO DDT IFN RPGSW, AUXSWI==20000 ;ON - AUX. DEVICE INITIALIZED AUXSWE==40000 ;ON - AUX. DEVICE ENTERED IFN PP, IFN FAILSW, LOC 137 OCT 25 ;VERSION # RELOC MLON SALL ;MONITOR LOCATIONS IN THE USER AREA JOBPRO==140 ;PROGRAM ORIGIN JOBBLT==134 ;BLT ORIGIN JOBCHN==131 ;RH = PROG BREAK OF FIRST BLOCK DATA ;LH = PROG BREAK OF FIRST F4 PROG ;CALLI DEFINITIONS CDDTOUT==3 ;CALLI DDTOUT CEXIT==12 ;CALLI EXIT CDDTGT==5 ;CALLI DDTGT CSETDDT==2 ;CALLI SETDDT ;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS PPDL==60 IFN RPGSW,< RPGSET: CALLI 0 INIT 17,1 ;SET UP DSK SIXBIT /DSK/ XWD 0,CTLIN JRST NUTS MOVE [SIXBIT /QQLOAD/] ;NAME OF COMMAND FILE MOVEM CTLNAM MOVSI (SIXBIT /RPG/) ;AND EXT MOVEM CTLNAM+1 SETZM CTLNAM+3 LOOKUP 17,CTLNAM ;THERE? JRST NUTS ;NO INIT 16,16 ;GET SET TO DELETE QQLOAD.RPG SIXBIT /DSK/ 0 JRST LD ;GIVE UP COMPLETELY SETZM CTLNAM+3 HLLZS CTLNAM+1 ;CLEAR OUT EXTRA JUNK LOOKUP 16,CTLNAM JRST LD RENAME 16,ZEROS ;DELETE IT JFCL ;IGNORE IF IT WILL NOT GO RELEASE 16,0 ;GET RID OF THIS DEVICE SETZM NONLOD ;THIS IS NOT A CONTINUATION RPGS3: MOVEI CTLBUF MOVEM JOBFF ;SET UP BUFFER INBUF 17,1 MOVEI [ASCIZ / LOADING /] ;PRINT MESSAGE THAT WE ARE STARTING CALLI CDDTOUT SKIPE NONLOD ;CONTINUATION? JRST RPGS2 ;YES, SPECIAL SETUP MOVSI R,F.I ;NOW SO WE CAN SET FLAG BLT R,R TLO N,RPGF JRST CTLSET ;SET UP TTY RPGS1: PUSHJ P,[TLNE F,ESW ;HERE FROM FOO* COMMAND, STORE NAME JRST LDDT3 ;SAVE EXTENSION TLZE F,CSW!DSW ;OR AS NAME MOVEM W,DTIN POPJ P,] MOVEM 0,SVRPG# ;SAVE 0 JUST IN CASE SETZM NONLOD# ;DETERMINE IF CONTINUATION MOVEI 0,2(B) ;BY SEEING IF ANY SYMBOLS LOADED CAME 0,JOBREL SETOM NONLOD ;SET TO -1 AND SKIP CALLI MOVE 0,ILD1 MOVEM 0,RPG1 INIT 17,1 RPG1: 0 XWD 0,CTLIN JSP A,ILD5 LOOKUP 17,DTIN ;THE FILE NAME JRST ILD9 JRST RPGS3 RPGS2: MOVSI 0,RPGF ;SET FLAG IORM 0,F.C+N TLO N,RPGF MOVE 0,SVRPG JRST LD2Q ;BACK TO INPUT SCANNING > IFN HE, < .LOAD: SETZM ERRFLG; HAND-EYE LOADER INITIALIZATION SETZM RESET MOVSI R,F.I+1; INITIALIZE ACS AOS R BLT R,R OR F,F.I MOVE B,JOBSYM; SET UP SYMBOL TABLE POINTER HLRZ H,JOBSA HLR R,JOBSA; LOAD STARTING AT PROGRAM BREAK MOVS E,R; CLEAR CORE HRRI E,1(R) SETZM (R) BLT E,(B) PUSHJ P,FIXNAM MOVE S,JOBUSY SKIPN S HRRZ S,B SOS S SOS B MOVEM P,SAVP#; SAVE SUBR POINTER JRST BEG; FINISH INIT F.I: XWD SYMSW,0; INITIAL F XWD ALLFLG+ISAFLG+COMFLG,0; INITIAL N XWD V,0; INITIAL X - LOAD IN PLACE Z Z XWD W,0; INITIAL R Z .AC: BLOCK 17 LNKSAV: BLOCK 21 LD5B1: HALT > IFN HE,< .PRMAP: MOVEM 16,.AC+16; PRINT STORAGE MAP HRRZI 16,.AC; SAVE ACS BLT 16,.AC+15 MOVE F,F.I+F; SET UP ACS AS NEEDED MOVE N,F.I+N HLRZ R,JOBSA MOVE S,JOBUSY SOS S MOVE B,JOBSYM SOS B INIT 2,1; INITIALIZE LPT SIXBIT /LPT/ XWD ABUF,0 JSP A,ILD5 MOVEI E,AUX MOVEM E,JOBFF OUTBUF 2,1 TLO N,AUXSWI PUSHJ P,PRMAP; PRINT MAP RELEASE 2, HRLZI 16,.AC BLT 16,16 POPJ P, > IFN HE,< ILD: MOVEI W,BUF1; INITIALIZE FILE LOADING MOVEM W,JOBFF TLOE F,ISW JRST ILD6 INIT 1,14 SIXBIT /DSK/ Z BUFR JSP A,ILD5; ERROR RETURN ILD6: LOOKUP 1,DTIN; LOOKUP FILE JRST ILD3 INBUF 1,2 MOVE 15,..NAME MOVEI 12,-2(S) SUBI S,2 POP B,2(12) POP B,1(12) MOVE 12,.NAME; RIGHT HALF VALUE IS LINK HRL 12,R; LEFT HALF IS RELOCATION MOVEM 12,2(B) MOVEM 15,1(B) HRRZM B,.NAME POPJ P, ILD3: PUSHJ P,ILDX; LOOKUP FAILURE JRST ILD9; NO HOPE JRST ILD6; TRY AGAIN ILDX: MOVE W,DTIN2 CAMN W,[SIXBIT / H HE/] POPJ P,; IF H,HE THERE IS NO HOPE CAMN W,[SIXBIT / 1 3/] JRST [ MOVE W,DTIN; CHECK IF HELIB[1,3] CAME W,[SIXBIT /HELIB/] POPJ P,; YES - TRY BACKUP FILE JRST IX] IX: MOVE W,[SIXBIT / H HE/] MOVEM W,DTIN2; NOT H,HE - TRY LIBRARY AREA AOS (P); TRY AGAIN POPJ P, > IFN HE,< FIXNAM: HLRE T,B; GET END OF PROGRAM NAME LIST MOVMS T ADDI T,(B) SUBI T,3 HLRZ D,2(T) JUMPE D,.+3 ADD T,D JRST .-3 HRRI N,2(T) POPJ P, LD2: SKIPN RESET JRST LD2Q-2 CAMN B,F.C+B CAME S,F.C+S CAIA JRST .+4 MOVEI T,[ASCIZ / CANNOT RECOVER/] CALLI T,CDDTOUT CALLI CEXIT MOVE T,.NAME; REMOVE NAME HRRZ T,2(T) MOVEM T,.NAME MOVEI T,1(S) ADDI S,2 PUSH B,1(T) PUSH B,2(T) AOSA ERRFLG# PUSHJ P,LDF LD2Q: MOVSI T,F.C BLT T,B > IFN HE,< GETF: MOVE P,SAVP; RESTORE SUBR POINTER SKIPN RESET JRST GETF4 SETZM RESET; RECOVERABLE ERROR PUSHJ P,ILDX; CHECK FOR ANOTHER COPY JRST GETF4; NO MOVEI T,[ASCIZ /_ /] CALLI T,CDDTOUT JRST LD2Q-1 GETF4: TLNE F,LIBSW JRST GETFY+1; LIBRARY MODE - CONTINUE PUSHJ P,.GETF; GET NEXT FILE SETZM 13 LSHC 13,6 CAIE 13,"/" JRST GETF1 ROT 14,6; FIRST CHAR SLASH - DECODE SWITCH CAIN 14,"D" JRST .DDT CAIN 14,"S" JRST [ TLO F,SYMSW JRST GETF4+2] CAIN 14,"W" JRST [ TLZ F,SYMSW+DSYMSW JRST GETF4+2] CAIN 14,'C' JRST GETF4+2; SAVE /C DECODING FOR LATER JSP A,ERRPT8; UNKNOWN SWITCH - ERROR SIXBIT /SYNTAX%/ JRST LD2 .DDT: MOVSI W,444464; LOAD DDT MOVEM W,DTIN MOVE W,[SIXBIT / 1 3/] MOVEM W,DTIN2 JRST LD2Q-1 > IFN HE,< GETF1: LSHC 13,-6 JUMPE 14,GETF2; FILE NAME ZERO - FINISHED OR 15,[XWD 600000,0] SKIPN 13,.NAME# JRST GETF3; NO FILES LOADED CAMN 15,2(13); SEARCH FOR FILE NAME JRST GETF4+1; FOUND - DO NOT LOAD HRRZ 13,1(13) JUMPN 13,.-3 GETF3: MOVEM 15,..NAME# MOVEM 14,DTIN; SET UP ENTER BLOCK MOVEM 16,DTIN2 JRST LD2Q-1 GETF2: MOVEI W,3; END OF FILES - SEARCH LIBRARIES MOVEM W,CNT# SKIPA GETFY: TLZ F,SYMSW+DSYMSW; TURN OFF LOCAL SYMBOLS AFTER HELIB JUMPGE S,GETF11 TLO F,LIBSW+SKIPSW MOVE W,[SIXBIT / 1 3/] MOVEM W,DTIN2 SOSGE W,CNT JRST GETF11 MOVE W,.TAB(W) MOVEM W,DTIN JRST LD2Q-1 .TAB: SIXBIT /JOBDAT/ SIXBIT /LIB40/ SIXBIT /HELIB/ GETF11: PUSHJ P,SAS1; TERMINATE LOADING RELEASE 1, PUSHJ P,BLTSET IFN FAILSW,< MOVE R,[XWD LINKTB,LNKSAV] BLT R,LNKSAV+20>; SAVE LINK TABLE MOVE R,JOBDDT CALLI R,CSETDDT HLRE 16,S MOVMS 16 LSH 16,-1; RIGHT HALF AC16 IS # UNDEF SYMBS HRL 16,ERRFLG POPJ P, > IFE HE,< ;MONITOR LOADER CONTROL BEG: IFE L,< LD: IFN RPGSW, HLLZS 42 ;GET RID OF ERROR COUNT IF NOT IN RPG MODE CALLI 0 ;INITIALIZE THIS JOB NUTS: MOVSI R,F.I ;SET UP INITIAL ACCUMULATORS BLT R,R > IFN L,< LD: HRRZM 0,LSPXIT# ;RETURN ADDRESS FOR LISP MOVEI 0,0 HRRZM R,RINITL# CALLI 0 > CTLSET: INIT 3,1 ;INITIALIZE CONSOLE SIXBIT /TTY/ XWD BUFO,BUFI CALLEX: CALLI CEXIT ;DEVICE ERROR, FATAL TO JOB MOVEI E,TTY1 MOVEM E,JOBFF INBUF 3,1 OUTBUF 3,1 ;INITIALIZE OUTPUT BUFFERS OUTPUT 3, ;DO INITIAL REDUNDANT OUTPUT IFE L,< HRRZ B,JOBREL ;PICK UP CORE BOUND SKIPE JOBDDT ;DOES DDT EXIST? HRRZ B,JOBSYM ;USED BOTTOM OF SYMBOL TABLE INSTEAD > IFN L,< MOVE B,JOBSYM> SUB B,SE3 ;INITIALIZE SYMBOL TABLE POINTER CAILE H,1(B) ;TEST CORE ALLOCATION CALLI CEXIT ;INSUFFICIENT CORE, FATAL TO JOB IFE L,< MOVS E,X ;SET UP BLT POINTER HRRI E,1(X)> IFN L,< MOVS E,H HRRI E,1(H)> SETZM -1(E) ;ZERO FIRST WORD BLT E,(B) ;ZERO CORE UP TO THE SYMBOL AREA HRRZ S,B ;INITIALIZE UNDEF. POINTER HRR N,B ;INITIALIZE PROGRAM NAME POINTER IFE L, MOVE E,COMM ;SET .COMM. AS THE FIRST PROGRAM MOVEM E,1(B) ;STORE IN SYMBOL TABLE HRRZM R,2(B) ;STORE COMMON ORIGIN > IFN HE, MOVEI E,F.C ;INITIALIZE STATE OF THE LOADER BLT E,B.C SETZM MDG ;MULTIPLY DEFINED GLOBAL COUNT IFE HE,< IFN FAILSW,< SETZM LINKTB ;ZERO OUT TE LINK TABLE MOVE W,[XWD LINKTB,LINKTB+1] BLT W,LINKTB+20 ;BEFORE STARTING> IFE L,< MOVSI W,254200 ;STORE HALT IN JOB41 MOVEM W,JOB41(X)> ;... IFN L,< MOVE W,JOBREL HRRZM W,OLDJR#>> IFN HE,> IFN STANSW, IFN FAILSW,< MOVEI W,440000 ;SET UP THE SPECIAL BITS OF HEADNUM (ADD+POLISH) MOVEM W,HEADNM# SETZM POLSW# ;SWITCH SAYS WE ARE DOING POLISH MOVEI W,PDLOV ;ENABLE FOR PDL OV MOVEM W,JOBAPR MOVEI W,200000 CALLI W,16 EXTERNAL JOBAPR > IFN LDAC!BLTSYM, IFN HE, IFE HE,< IFN RPGSW, LD2: IFN RPGSW, ;LOADER SCAN FOR FILE NAMES LD2Q: MOVSI B,F.C ;RESTORE ACCUMULATORS BLT B,B MOVE P,PDLPT ;INITIALIZE PUSHDOWN LIST SETZM BUFI2 ;CLEAR INPUT BUFFER POINTER IFE PP,< SETZM ILD1 ;CLEAR INPUT DEVICE NAME> IFN PP,< MOVSI T,(SIXBIT /DSK/) ;ASSUME DSK MOVEM T,ILD1 SETZM OLDDEV# ;TO MAKE IT GO BACK AFTER /D FOR LIBSR> SETZM DTIN ;CLEAR INPUT FILE NAME IFN PP, LD2B: RELEAS 1, ;RELEASE BINARY INPUT DEVICE IFN RPGSW,< TLNE N,RPGF ;NOT IF DOING RPG JRST LD2BA> MOVEI T,"*" IDPB T,BUFO1 ;OUTPUT ASTERISK TO START INPUT OUTPUT 3, LD2BA: TLZ F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW TLNE F,LIBSW ;WAS LIBRARY MODE ON? TLO F,SKIPSW ;YES, NORMAL MODE IS SKIPPING LD2D: IFN PP, LD2DA: IFN RPGSW,< SETZM DTIN1 ;CLEAR EXTENSION> MOVEI W,0 ;INITIALIZE IDENTIFIER SCAN MOVEI E,6 ;INITIALIZE CHARACTER COUNTER MOVE V,LSTPT ;INITIALIZE BYTE POINTER TO W TLZ F,SSW+DSW+FSW ;LEAVE SWITCH MODE LD3: IFN RPGSW, SOSG BUFI2 ;DECREMENT CHARACTER COUNT INPUT 3, ;FILL TTY BUFFER ILDB T,BUFI1 ;LOAD T WITH NEXT CHARACTER LD3AA: MOVE Q,T IDIVI Q,11 ;TRANSLATE TO 4 BIT CODE LDB Q,LD8(A) ;LOAD CLASSIFICATION CODE CAIGE Q,4 ;MODIFY CODE IF .GE. 4 TLNN F,SSW ;MODIFY CODE IF SWITCH MODE OFF ADDI Q,4 ;MODIFY CLASS. CODE FOR DISPATCH HRRZ A,LD3A(Q) ;LOAD RH DISPATCH ENTRY CAIL Q,10 ;SKIP IF CORRECT DISPATCH ENTRY HLRZ A,LD3A-10(Q) ;LOAD LH DISPATCH ENTRY JRST @A ;JUMP TO INDICATED LOCATION ;COMMAND DISPATCH TABLE LD3A: XWD LD3,LD7B ;IGNORED CHAR, BAD CHAR (SWITCH) XWD LD6A,LD6 ; OR <(>, LETTER (SWITCH) XWD LD5,LD6C ;<:>, DIGIT (SWITCH ARG.) XWD LD5A,LD6D ;<.>, ESCAPE SWITCH MODE <)> XWD LD5C,LD7 ;<=> OR , BAD CHAR. XWD LD5B,LD4 ;<,>, ALPHABETIC CHAR. XWD LD5D,LD4 ;, NUMERIC CHAR. XWD LD5E1,LD7 ;, BAD CHAR. <)> IFN RPGSW, > ;ALPHANUMERIC CHARACTER, NORMAL MODE IFE HE,< LD4: SOJL E,LD3 ;JUMP IF NO SPACE FOR CHAR IN W SUBI T,40 ;CONVERT FROM ASCII TO SIXBIT IDPB T,V ;DEPOSIT CHAR OF IDENTIFIER IN W TLO F,DSW ;SET IDENTIFIER FLAG JRST LD3 ;RETURN FOR NEXT CHARACTER ;DEVICE IDENTIFIER DELIMITER <:> LD5: PUSH P,W ;SAVE W TLOE F,CSW ;TEST AND SET COLON FLAG PUSHJ P,LDF ;FORCE LOADING POP P,W ;RESTORE W TLNE F,ESW ;TEST SYNTAX JRST LD7A ;ERROR, MISSING COMMA ASSUMED JUMPE W,LD2D ;JUMP IF NULL DEVICE IDENTIFIER MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER IFN PP, TLZ F,ISW+DSW+FSW+REWSW ;CLEAR OLD DEVICE FLAGS IFN PP, JRST LD2D ;RETURN FOR NEXT IDENTIFIER ;FILE NAME EXTENSION IDENTIFIER DELIMITER <.> LD5A: TLOE F,ESW ;TEST AND SET EXTENSION FLAG JRST LD7A ;ERROR, TOO MANY PERIODS TLZE F,CSW+DSW ;SKIP IF NULL IDENT AND NO COLON MOVEM W,DTIN ;STORE FILE IDENTIFIER JRST LD2D ;RETURN FOR NEXT IDENTIFIER ;INPUT SPECIFICATION DELIMITER <,> LD5B: IFN PP, IFG STANSW-UTAHSW,< PUSHJ P,RJUST ;RIGHT JUSTIFY W HRLM W,PPN ;STORE PROJ NAME JRST LD2DB ];GET PROG NAME> PUSHJ P,RBRA ;CHECK FOR MISSING RBRA> TLZN F,FSW ;SKIP IF PREV. FORCED LOADING PUSHJ P,FSCN2 ;LOAD (FSW NOT SET) JRST LD2D ;RETURN FOR NEXT IDENTIFIER LD5B1: TLNE F,ESW ;TEST EXTENSION FLAG JRST LDDT3 ;EXPLICIT EXTENSION IDENTIFIER TLZN F,CSW+DSW ;SKIP IF IDENT. OR COLON POPJ P, MOVEM W,DTIN ;STORE FILE IDENTIFIER JRST LDDT2 ;ASSUME <.REL> IN DEFAULT CASE > ;OUTPUT SPECIFICATION DELIMITER <=> OR ;OR PROJ-PROG # BRACKETS <[> AND <]> IFE HE,< LD5C: IFN RPGSW, IFN PP, IFG STANSW-UTAHSW,< JRST LD2DB]> CAIN T,"]" ;END OF PP #? JRST [PUSHJ P,RBRA ;PROCESS RIGHT BRACKET JRST LD3 ];READ NEXT IDENT> TLOE F,ASW ;TEST AND SET LEFT ARROW FLAG JRST LD7A ;ERROR, MISPLACED LEFT ARROW PUSHJ P,LD5B1 ;STORE IDENTIFIER TLZN F,ESW ;TEST EXTENSION FLAG MOVSI W,554160 ;ASSUME <.MAP> IN DEFAULT CASE MOVEM W,DTOUT1 ;STORE FILE EXTENSION IDENTIFIER MOVE W,DTIN ;LOAD INPUT FILE IDENTIFIER MOVEM W,DTOUT ;USE AS OUTPUT FILE IDENTIFIER IFN PP, MOVE W,ILD1 ;LOAD INPUT DEVICE IDENTIFIER MOVEM W,LD5C1 ;USE AS OUTPUT DEVICE IDENTIFIER IFN PP,< SKIPE W,OLDDEV ;RESTORE OLD MOVEM W,ILD1> ;INITIALIZE AUXILIARY OUTPUT DEVICE TLZE N,AUXSWI+AUXSWE ;FLUSH CURRENT DEVICE RELEASE 2, ;... CALL W,[SIXBIT ?DEVCHR?] ;IS DEVICE A TTY? TLNE W,10 ;... JRST LD2D ;YES, SKIP INIT INIT 2,1 ;INIT THE AUXILIARY DEVICE LD5C1: 0 ;AUXILIARY OUTPUT DEVICE NAME XWD ABUF,0 ;BUFFER HEADER JSP A,ILD5 ;ERROR RETURN TLNE F,REWSW ;REWIND REQUESTED? CALL 2,[SIXBIT /UTPCLR/] ;DECTAPE REWIND TLZE F,REWSW ;SKIP IF NO REWIND REQUESTED MTAPE 2,1 ;REWIND THE AUX DEV MOVEI E,AUX ;SET BUFFER ORIGIN MOVEM E,JOBFF OUTBUF 2,1 ;INITIALIZE SINGLE BUFFER TLO N,AUXSWI ;SET INITIALIZED FLAG JRST LD2D ;RETURN TO CONTINUE SCAN > IFE HE,< ;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS) IFN PP,< RBRA: TLZN N,PPSW ;READING PP #? POPJ P, ;NOPE, RETURN TLZE N,PPCSW ;COMMA SEEN? JRST LD7A ;NOPE, INDICATE ERROR IFLE STANSW-UTAHSW, IFG STANSW-UTAHSW, MOVE W,PPNW# ;PICKUP OLD IDENT MOVE E,PPNE# ;RESTORE CHAR COUNT MOVE V,PPNV# ;RESTORE BYTE PNTR POPJ P, ;TRA 1,4 ;RIGHT JUSTIFY W RJUST: JUMPE W,LD7A ;NOTHING TO RIGHT JUSTIFY TRNE W,77 ;IS W RJUSTED YET? POPJ P, ;YES, TRA 1,4 LSH W,-6 ;NOPE, TRY AGAIN JRST .-3 ;...> > IFE HE,< ;LINE TERMINATION LD5D: IFN PP, PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION JRST LD2B ;RETURN FOR NEXT LINE ;TERMINATE LOADING LD5E: SKIPE D ;ENTER FROM G COMMAND HRR F,D ;USE NUMERIC STARTING ADDRESS LD5E1: PUSHJ P,CRLF ;START A NEW LINE PUSHJ P,SASYM ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY IFN LDAC!BLTSYM, PUSHJ P,[ IFE EXPAND,< JSP A,ERRPT SIXBIT /MORE CORE NEEDED#/> CALLI CEXIT] IFN EXPAND,< JRST .-1]> HRRM R,BOTACS# ;SAVE FOR LATER HRRZ A,R ;SET BLT ADD A,X HRL A,X MOVE Q,A BLT A,17(Q)> IFN BLTSYM, MOVE W,[SIXBIT ?LOADER?] ;FINAL MESSAGE PUSHJ P,BLTSET ;SETUP FOR FINAL BLT RELEASE 2, ;RELEASE AUX. DEV. IFN RPGSW, IFE L,< IFN STANSW,> IFN L,< JRST @LSPXIT> LD5E5: MOVE W,[BLT Q,(A)] ;BLT OF ALL CODE MOVEM W,JOBBLT ;STASH IN JOB DATA AREA MOVEM W,JOBBLT(X) ;STASH IN RELOCATED JOBDATA AREA LD5E2: MOVE W,CALLEX ;EXIT AFTER BLT TLZN N,EXEQSW ;IMMEDIATE EXECUTION REQUESTED? JRST LD5E3 ;NOPE, LET USER TYPE START HIMSELF HRRZ W,JOBSA(X) ;PICKUP USUAL STARTING ADDRESS TLNE N,DDSW ;DDT EXECUTION? HRRZ W,JOBDDT(X) ;USE DDT SA INSTEAD JUMPE W,LD5E2 ;IF SA=0, DON'T EXECUTE HRLI W,(JRST) ;INSTRUCTION TO EXECUTE LD5E3: IFE LDAC, IFN LDAC, JRST JOBBLT ;IF IT WERE DONE, 'TWERE BEST DONE QUICKLY IFE L,< IFN STANSW,> > IFE HE, < ;SEARCH LIBRARY, PRINT UNDEFS, SETUP JOBSA,JOBFF,JOBSYM,JOBUSY SASYM: TLNN F,NSW ;SKIP IF NO SEARCH FLAG ON PUSHJ P,LIBF ;SEARCH LIBRARY FILE PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION PUSHJ P,PMS ;PRINT UNDEFINEDS IFE L,< HRRZM F,JOBSA(X) ;RH OF JOBSA :=STARTING ADDRESS> > SAS1: HRRZ A,H ;COMPUTE PROG BREAK SUBI A,(X) ;... CAIGE A,(R) ;BUT NO HIGHER THAN RELOC HRRZ A,R ;... IFE L,< HRLM A,JOBSA(X) ;LH OR JOBSA IS PROG BREAK HRRZM A,JOBFF(X) ;RH OF JOBFF CONTAINS PROG BREAK> MOVE A,B ;SET JOBSYM W/ SYMBOL TABLE POINTER AOS A ;... IFE L,< MOVEM A,JOBSYM(X) ;...> IFN L,< MOVEM A,JOBSYM> MOVE A,S ;SET JOBUSY W/ UNDEFINED SYMBOL POINTER AOS A ;... IFE L,< MOVEM A,JOBUSY(X) ;...> IFN L,< MOVEM A,JOBUSY> POPJ P, ;RETURN IFE HE,< ;PRINT FINAL MESSAGE, SET UP BLT AC'S, SETDDT, RELEAS BLTSET: PUSHJ P,FCRLF ;START FINAL MESSAGE PUSHJ P,PWORD ;PRINT W PUSHJ P,SPACE > IFN HE,< BLTSET:> IFN FAILSW< MOVSI Q,-20 ;SET TO FIX UP LINKS FXEND: HLRZ V,LINKTB+1(Q) ;GET END LINK INFO JUMPE V,NOEND ;DO NOT LINK THIS ONE HRRZ A,LINKTB+1(Q) ;GET THE THING TO PUT THERE IFN L,< CAML V,RINITL> HRRM A,@X ;PUT IT IN NOEND: AOBJN Q,FXEND ;FINISH UP> IFN HE, IFE HE,< HRRZ Q,JOBREL ;PUBLISH HOW MUCH CORE USED IFN L,< SUB Q,OLDJR ;OLD JOBREL> LSH Q,-12 ;... ADDI Q,1 ;... PUSHJ P,RCNUM ;PUBLISH THE NUMBER MOVE W,[SIXBIT /K CORE/] ;PUBLISH THE UNITS PUSHJ P,PWORD ;... PUSHJ P,CRLF ;... IFE L,< MOVSI Q,20(X) ;HOW MUCH CODE TO BLT HRRI Q,20 ;... HRRZ A,42 ;CHECK ON ERRORS JUMPE A,NOEX ;NONE, GO AHEAD TLZN N,EXEQSW ;DID HE WANT TO START EXECUTION? JRST NOEX ;NO JSP A ,ERRPT ;PRINT AN ERROR MESSAGE SIXBIT /EXECUTION DELETED@/ NOEX: HRRZ A,JOBREL ;WHEN TO STOP BLT HRRZM A,JOBREL(X) ;SETUP FOR POSSIBLE IMMED. XEQ SUBI A,(X) ;... IFE BLTSYM, > RELEAS 1, ;RELEASE DEVICES RELEAS 3, ;... IFE L,< MOVE R,JOBDDT(X) ;SET NEW DDT CALLI R,CSETDDT ;...> POPJ P, ;RETURN > IFE HE,< ;WRITE CHAIN FILES CHNC: SKIPA A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST BLOCK DATA CHNR: HLR A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST F4 PROG HRRZS A ;ONLY RIGHT HALF IS SIGNIFICANT JUMPE A,LD7C ;DON'T CHAIN IF ZERO TLNN N,AUXSWI ;IS THERE AN AUX DEV? JRST LD7D ;NO, DON'T CHAIN PUSH P,A ;SAVE WHEREFROM TO CHAIN SKIPE D ;STARTING ADDR SPECIFIED? HRR F,D ;USE IT PUSHJ P,SASYM ;DO LIB SEARCH, SETUP JOBSA, ETC. POP P,A ;GET WHEREFROM MOVN W,JOBREL ;CALCULATE IOWD FOR DUMP ADDI W,-1-3-CHN5(A) ;... HRLI W,-4-CHN5(A) ;... MOVSM W,IOWDPP ;... ADDI A,-4-CHN5(X) ;ADD IN OFFSET IFN CHN5, PUSH A,JOBDDT(X) ;JOBDDT IN ALL CASES IFE CHN5, PUSH A,JOBSA(X) ;JOBRYM ALWAYS LAST CLOSE 2, ;INSURE END OF MAP FILE SETSTS 2,17 ;SET AUX DEV TO DUMP MODE MOVSI W,435056 ;USE .CHN AS EXTENSION MOVEM W,DTOUT1 ;... PUSHJ P,IAD2 ;DO THE ENTER TLZ N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT MOVE W,[SIXBIT ?CHAIN?] ;FINAL MESSAGE PUSHJ P,BLTSET ;SETUP BLT PNTR, SETDDT, RELEAS IFE STANSW, MOVSI CHNBLT,CHAIN3 ;BLT CHAIN3 INTO ACS BLT CHNBLT,CHNBLT ;... MOVEI P,CHNERR ;POINTER TO ERR MESS JRST 0 ;GO DO CHAIN > IFE HE, < ;THE AC SECTION OF CHAIN CHAIN3: PHASE 0 BLT Q,(A) ;USUAL LDRBLT OUTPUT 2,IOWDP ;WRITE THE CHAIN FILE STATZ 2,IOBAD!IODEND ;CHECK FOR ERROR OR EOF JRST LOSEBIG ;FOUND SAME, GO GRIPE CLOSE 2, ;FINISH OUTPUT STATZ 2,IOBAD!IODEND ;CHECK FOR FINAL ERROR LOSEBI: CALLI CDDTOUT ;GRIPE ABOUT ERROR CALLI CEXIT ;EXIT CHNERR: ASCIZ ?DEVICE ERROR? ;ERROR MESSAGE IOWDP: Z ;STORE IOWD FOR DUMP HERE CHNBLT: ;LAST WORD OF AC CHAIN (ZERO OF I/O POINTER) DEPHASE IOWDPP=.-1 ;MEMORY LOC OF AC IOWDP Z ;TERMINATOR OF DUMP MODE LIST > ;EXPAND CORE IFN EXPAND,< XPAND: PUSH P,H ;GET SOME REGISTERS TO USE PUSH P,X PUSH P,N IFE HE, IFN HE,; CORE ALLOCATOR CALLS THIS JRST XPAND6 IFE K,< HRRZ H,MLTP ;GET LOWEST LOCATION TLNN N,F4SW ;IS FORTRAN LOADING> HRRZ H,S ;NO, USE S IFE HE,< HRRZ X,JOBREL ;NOW MOVE SUBI X,2000 XPAND2: MOVE N,(X) MOVEM N,2000(X) CAMLE X,H ;TEST FOR END SOJA X,XPAND2>; HAND EYE SYSTEM MOVES TABLE HRLI H,-2000 SETZM (H) ;ZERO NEW CORE AOBJN H,.-1 MOVEI H,2000 ADDM H,S ADDM H,B ADDM H,JOBSYM POP P,N ADDI N,2000 IFE K,< TLNN N,F4SW ;F4? JRST XPAND3 ADDM H,PLTP ADDM H,BITP ADDM H,SDSTP ADDM H,MLTP TLNE N,SYDAT ADDM H,V> IFN HE, XPAND3: POP P,X POP P,H AOS (P) POPJ P, XPAND6: JUMPE X,XPAND4 JSP A,ERRPT IFE STANSW, IFN STANSW, XPAND4: JSP A,ERRPT SIXBIT /MORE CORE NEEDED#/ XPAND5: POP P,N POP P,X POP P,H POPJ P, XPAND7: PUSHJ P,XPAND JRST SFULLC JRST POPJM2 POPJM3: SOS (P) ;POPJ TO CALL-2 POPJM2: SOS (P) ;POPJ TO CALL-1 SOS (P) ;SAME AS POPJ TO POPJ P, ;NORMAL POPJ MINUS TWO > IFE HE,< ;ENTER SWITCH MODE LD6A: CAIN T,57 ;WAS CHAR A SLASH? TLO N,SLASH ;REMEBER THAT TLO F,SSW ;ENTER SWITCH MODE LD6A1: MOVEI D,0 ;ZERO THE NUBER REGISTER JRST LD3 ;EAT A SWITCH ;ALPHABETIC CHARACTER, SWITCH MODE LD6: XCT LD6B-101(T) ;EXECUTE SWITCH FUNCTION TLZE N,SLASH ;SWITCH MODE ENTERED W/ SLASH? JRST LD6D ;LEAVE SWITCH MODE JRST LD6A1 ;STAY IN SWITCH MODE ;DISPATCH TABLE FOR SWITCHES ; THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED LD6B: TLO N,ALLFLG ;A - LIST ALL GLOBALS JRST LD7B ;B - ERROR PUSHJ P,CHNC ;C - CHAIN, START W/ COMMON PUSHJ P,LDDT ;D - DEBUG OPTION, LOAD DDT TLO N,EXEQSW ;E - LOAD AND GO PUSHJ P,LIBF ;F - LIBRARY SEARCH PUSHJ P,LD5E ;G - GO INTO EXECUTION PUSHJ P,LRAIDX ;H - LOAD AN START RAID TLO N,ISAFLG ;I - IGNORE STARTING ADDRESSES TLZ N,ISAFLG ;J - USE STARTING ADDRESSES IFE BLTSYM, IFN BLTSYM, TLO F,LIBSW+SKIPSW ;L - ENTER LIBRARY SEARCH PUSHJ P,PRMAP ;M - PRINT STORAGE MAP TLZ F,LIBSW+SKIPSW ;N - LEAVE LIBRARY SEARCH HRR R,D ;O - NEW PROGRAM ORIGIN TLO F,NSW ;P - PREVENT AUTO. LIB. SEARCH TLZ F,NSW ;Q - ALLOW AUTO. LIB. SEARCH PUSHJ P,CHNR ;R - CHAIN, START W/ RESIDENT TLO F,SYMSW ;S - LOAD WITH SYMBOLS PUSHJ P,LDDTX ;T - LOAD AND GO TO DDT PUSHJ P,PMS ;U - PRINT UNDEFINED LIST PUSHJ P,LRAID ;V - LOAD RAID TLZ F,SYMSW+DSYMSW ;W - LOAD WITHOUT SYMBOLS TLZ N,ALLFLG ;X - DO NOT LIST ALL GLOBALS TLO F,REWSW ;Y - REWIND BEFORE USE JRST LD ;Z - RESTART LOADER > IFE HE, < ;SWITCH MODE NUMERIC ARGUMENT LD6C: LSH D,3 ;BUILD OCTAL NUMERIC ARGUMENT ADDI D,-60(T) JRST LD3 ;EXIT FROM SWITCH MODE LD6D: TLZ F,SSW ;CLEAR SWITCH MODE FLAG TLNE F,FSW ;TEST FORCED SCAN FLAG JRST LD2D ;SCAN FORCED, START NEW IDENT. JRST LD3 ;SCAN NOT FORCED, USE PREV IDENT ;ILLEGAL CHARACTER, NORMAL MODE LD7: JSP A,ERRPT8 SIXBIT /CHAR.%/ JRST LD2 ;SYNTAX ERROR, NORMAL MODE LD7A: JSP A,ERRPT8 SIXBIT /SYNTAX%/ JRST LD2 ;ILLEGAL CHARACTER, SWITCH MODE LD7B: JSP A,ERRPT8 SIXBIT /SWITCH%/ JRST LD2 ;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0 LD7C: JSP A,ERRPT ;GRIPE SIXBIT ?UNCHAINABLE AS LOADED@? JRST LD2 ;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE LD7D: JSP A,ERRPT ;GRIPE SIXBIT ?NO CHAIN DEVICE@? JRST LD2 > IFN BLTSYM, IFE HE, < ;CHARACTER CLASSIFICATION TABLE DESCRIPTION: ; EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE ; PACKED IN THE CHARACTER CLASSIFICATION TABLE. THE CHARACTER ; CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE ; DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS. ; CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND ; THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS. FOUR CODES ; ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS ; IN EFFECT. ;CLASSIFICATION BYTE CODES: ; BYTE DISP CLASSIFICATION ; 00 - 00 ILLEGAL CHARACTER, SWITCH MODE ; 01 - 01 ALPHABETIC CHARACTER, SWITCH MODE ; 02 - 02 NUMERIC CHARACTER, SWITCH MODE ; 03 - 03 SWITCH MODE ESCAPE, SWITCH MODE ; 00 - 04 ILLEGAL CHARACTER, NORMAL MODE ; 01 - 05 ALPHABETIC CHARACTER, NORMAL MODE ; 02 - 06 NUMERIC CHARACTER, NORMAL MODE ; 03 - 07 SWITCH MODE ESCAPE, NORMAL MODE ; 04 - 10 IGNORED CHARACTER ; 05 - 11 ENTER SWITCH MODE CHARACTER ; 06 - 12 DEVICE IDENTIFIER DELIMITER ; 07 - 13 FILE EXTENSION DELIMITER ; 10 - 14 OUTPUT SPECIFICATION DELIMITER ; 11 - 15 INPUT SPECIFICATION DELIMITER ; 12 - 16 LINE TERMINATION ; 13 - 17 JOB TERMINATION > IFE HE, < ;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE LD8: POINT 4,LD9(Q),3 POINT 4,LD9(Q),7 POINT 4,LD9(Q),11 POINT 4,LD9(Q),15 POINT 4,LD9(Q),19 POINT 4,LD9(Q),23 POINT 4,LD9(Q),27 POINT 4,LD9(Q),31 POINT 4,LD9(Q),35 ;CHARACTER CLASSIFIACTION TABLE LD9: BYTE (4)4,0,0,0,0,0,0,0,0 BYTE (4)4,4,4,4,12,0,0,0,0 BYTE (4)0,0,0,0,0,0,0,0,0 BYTE (4)13,0,0,0,0,4,0,4,0 BYTE (4)0,0,0,0,5,3,0,0,11 BYTE (4)0,7,5,2,2,2,2,2,2 BYTE (4)2,2,2,2,6,0,0,10,0 IFE RPGSW,< BYTE (4)0,0,1,1,1,1,1,1,1> IFN RPGSW,< BYTE (4) 0,10,1,1,1,1,1,1,1> BYTE (4)1,1,1,1,1,1,1,1,1 BYTE (4)1,1,1,1,1,1,1,1,1 IFE PP, IFN PP, BYTE (4)0,0,0,0,0,0,0,0,0 BYTE (4)0,0,0,0,0,0,0,0,0 BYTE (4)0,0,0,0,0,0,0,0,13 BYTE (4)13,4 > IFE HE, < ;INITIALIZE LOADING OF A FILE ILD: MOVEI W,BUF1 ;LOAD BUFFER ORIGIN MOVEM W,JOBFF TLOE F,ISW ;SKIP IF INIT REQUIRED JRST ILD6 ;DONT DO INIT INIT 1,14 ILD1: 0 ;LOADER INPUT DEVICE XWD 0,BUFR JSP A,ILD5 ;ERROR RETURN ILD6: TLZE F,REWSW ;SKIP IF NO REWIND MTAPE 1,1 ;REWIND ILD2: LOOKUP 1,DTIN ;LOOK UP FILE FROM DIRECTORY JRST ILD3 ;FILE NOT IN DIRECTORY IFE K,< INBUF 1,2 ;SET UP BUFFERS> IFN K,< INBUF 1,1 ;SET UP BUFFER> TLO F,ASW ;SET LEFT ARROW ILLEGAL FLAG TLZ F,ESW+F4LIB ;CLEAR EXTENSION FLAG POPJ P, ; LOOKUP FAILURE ILD3: TLOE F,ESW ;SKIP IF .REL WAS ASSUMED JRST ILD4 ;FATAL LOOKUP FAILURE SETZM DTIN1 ;ZERO FILE EXTENSION JRST ILD2 ;TRY AGAIN WITH NULL EXTENSION ILD4: TLZE F,F4LIB ;WAS THIS A TRY FOR F40 LIBRARY? JRST [MOVE W,[SIXBIT /LIB4/]; YES, TRY LIB4 MOVEM W,DTIN ;... PUSHJ P,LDDT2 ;USE .REL EXTENSION TLZ F,ESW ;... JRST ILD2 ];GO TRY AGAIN > ILD9: JSP A,ERRPT SIXBIT /CANNOT FIND#/ JRST LD2 ; DEVICE SELECTION ERROR ILD5: MOVE W,-3(A) ;LOAD DEVICE NAME FROM INIT TLO F,FCONSW ;INSURE TTY OUTPUT PUSHJ P,PRQ ;START W/ ? PUSHJ P,PWORD ;PRINT DEVICE NAME JSP A,ERRPT7 SIXBIT /UNAVAILABLE@/ JRST LD2 IFE HE, < ;LIBRARY SEARCH CONTROL AND LOADER CONTROL ;LIBF ENABLES A LIBRARY SEARCH OF LIBF: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION PUSHJ P,LIBF1 ;LOAD SYS:JOBDAT.REL TLO F,F4LIB ;INDICATE FORTRAN LIBRARY SEARCH MOVE W,[SIXBIT /LIB40/] ;FIRST TRY AT NAME PUSHJ P,LIBF2 ;LOAD SYS:LIB40.REL LIBF1: MOVE W,[SIXBIT /JOBDAT/] ;LOAD SYS:JOBDAT.REL LIBF2: PUSHJ P,LDDT1 JUMPGE S,EOF2 ;JUMP IF NO UNDEFINED GLOBALS TLO F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH TLZ F,SYMSW+DSYMSW ;DISABLE LOADING WITH SYMBOLS JRST LDF ;INITIALIZE LOADING LIB4 >; HAND - EYE DOES OWN LIB SETUP ; LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE LIB: JUMPGE S,EOF1 ;JUMP IF NO UNDEFINED GLOBALS TLO F,SKIPSW ;SET SKIPSW TO IGNORE MODE JRST LOAD ;CONTINUE LIB. SEARCH LIB1: CAIE A,4 ;TEST FOR ENTRY BLOCK JRST LIB3 ;NOT AN ENTRY BLOCK, IGNORE IT LIB2: PUSHJ P,RWORD ;READ ONE DATA WORD MOVE C,W TLO C,040000 ;SET CODE BITS FOR SEARCH PUSHJ P,SREQ TLZA F,SKIPSW ;REQUEST MATCHES ENTRY, LOAD JRST LIB2 ;NOT FOUND LIB3: PUSHJ P,RWORD ;READ AND IGNORE ONE DATA WORD JRST LIB3 ;LOOP TO IGNORE INPUT IFE HE,< ;LDDT LOADS AND SETS DSYMSW LRAIDX: TLO N,DDSW!EXEQSW ;H - LOAD AND START RAID LRAID: PUSHJ P,FSCN1 ;FORCE END OF SCAN MOVE W,[SIXBIT /RAID/] JRST LDDT0 LDDTX: TLO N,DDSW+EXEQSW ;T - LOAD AND GO TO DDT LDDT: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION MOVSI W,444464 ;FILE IDENTIFIER LDDT0: PUSHJ P,LDDT1 PUSHJ P,LDF ;LOAD TLO F,DSYMSW ;ENABLE LOADING WITH SYMBOLS POPJ P, LDDT1: MOVEM W,DTIN ;STORE FILE IDENTIFIER IFN PP, MOVSI W,637163 ;DEVICE IDENTIFIER MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER TLZ F,ISW+LIBSW+SKIPSW+REWSW ;CLEAR OLD FLAGS LDDT2: MOVSI W,624554 ;EXTENSION IDENTIFIER <.REL> LDDT3: MOVEM W,DTIN1 ;STORE EXTENSION IDENTIFIER IFN PP, POPJ P, >; HAND - EYE DOES OWN DDT LOAD ;EOF TERMINATES LOADING OF A FILE EOF: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER EOF1: TLZ F,SLIBSW+SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG EOF2: POPJ P, ; FORCE SCAN TO COMPLETION, LOAD IF NECESSARY FSCN: PUSHJ P,FSCN1 ;FORCED LOAD BEFORE TEST TLNN F,FULLSW ;TEST FOR OVERLAP POPJ P, ;NO OVERLAP, RETURN MOVE W,H ;FETCH CORE SIZE REQUIRED SUBI W,1(S) ; COMPUT DEFICIENCY JUMPL W,EOF2 ;JUMP IF NO OVERLAP TLO F,FCONSW ;INSURE TTY OUTPUT PUSHJ P,PRQ ;START WITH ? PUSHJ P,PRNUM0 ;INFORM USER JSP A,ERRPT7 SIXBIT /WORDS OF OVERLAP#/ JRST LD2 ;ERROR RETURN FSCN1: IFE HE,; HAND EYE DOES NOT WANT FORCED SCAN POPJ P, FSCN2: PUSHJ P,LD5B1 ;STORE FILE OR EXTENSION IDENT. ; LOADER CONTROL, NORMAL MODE LDF: PUSHJ P,ILD ;INITIALIZE LOADING ;LOAD SUBROUTINE LOAD: MOVEM P,PDSAV ;SAVE PUSHDOWN POINTER IFN FAILSW,< SETZM LFTHSW ;RESET LOAD LEFT HALF FIXUP SW> LOAD1: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER LOAD1A: PUSHJ P,WORD ;INPUT BLOCK HEADER WORD MOVNI E,400000(W) ;WORD COUNT - FROM RH OF HEADER HLRZ A,W ;BLOCK TYPE - FROM LH OF HEADER IFN FAILSW,< SKIPN POLSW ;ERROR IF STILL DOING POLISH> CAILE A,DISPL*2+1 ;TEST BLOCK TYPE NUMBER JRST LOAD4 ;ERROR, ILLEGAL BLOCK TYPE TLNE F,SKIPSW ;BLOCK OK - TEST LOAD STATUS JRST LIB1 ;RETURN TO LIB. SEARCH CONTROL HRRZ T,LOAD2(A) ;LOAD RH DISPATCH ENTRY CAILE A,DISPL ;SKIP IF CORRECT HLRZ T,LOAD2-DISPL-1(A) ;LOAD LH DISPATCH ENTRY TLNE F,FULLSW ;TEST CORE OVERLAP INDICATOR SOJG A,HIGH0 ;IGNORE BLOCK IF NOT TYPE 1 JRST @T ;DISPATCH TO BLOCK SUBROUTINE ;DISPATCH TABLE - BLOCK TYPES LOAD2: XWD NAME,LOAD1A XWD START,PROG XWD LOCD,SYM IFE FAILSW,< XWD LOAD4A,LOAD4A XWD LOAD4A,LIB3> IFN FAILSW,< XWD POLFIX,LOAD4A XWD LINK,LIB3> LOAD3: XWD LOAD4A,HIGH DISPL=LOAD3-LOAD2 ;ERROR EXIT FOR BAD HEADER WORDS LOAD4: IFE K,< CAIN A,400 ;FORTRAN FOUR BLOCK JRST F4LD> IFN HE, LOAD4A: JSP A,ERRPT ;INCORRECT HEADER WORD SIXBIT /ILL. FORMAT#/ IFN HE, JRST LD2 ;LOAD PROGRAMS AND DATA (BLOCK TYPE 1) PROG: HRRZ V,W ;LOAD BLOCK LENGTH PUSHJ P,RWORD ;READ BLOCK ORIGIN IFN HE,; HAND-EYE CANNOT HANDLE CODE BELOW 140 ADD V,W ;COMPUTE NEW PROG. BREAK CAIG H,@X ;COMPARE WITH PREV. PROG. BREAK MOVEI H,@X ;UPDATE PROGRAM BREAK TLNE F,FULLSW JRST FULLC ;NO ERROR MESSAGE CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE IFN EXPAND,< JRST [PUSHJ P,XPAND> JRST FULLC IFN EXPAND,< JRST .-1]> MOVE V,W PROG1: PUSHJ P,RWORD ;READ DATA WORD IFN HE, IFN L,< CAML V,RINITL ;ABSOLUTE > MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC AOJA V,PROG1 ;ADD ONE TO LOADER LOC. COUNTER ;LOAD SYMBOLS (BLOCK TYPE 2) SYM: PUSHJ P,PRWORD ;READ TWO DATA WORDS PUSHJ P,SYMPT; PUT INTO TABLE JRST SYM ; WFW SYMPT: JUMPL C,SYM3; JUMP IF GLOBAL REQUEST SYMPT: TLNE C,200000 ;GLOBAL REQUEST? WFW JUMPL C,SYM3 ;CHECK FOR 60 NOT JUST HIGH BIT WFW TLNE C,100000 JRST SYM1A ;LOCAL SYMBOL PUSHJ P,SREQ ;GLOBAL DEF., SEARCH FOR REQUEST JRST SYM2 ;REQUEST MATCHES PUSHJ P,SDEF ;SEARCH FOR MULTIPLE DEFINITIONS JRST SYM1 ;MULTIPLY DEFINED GLOBAL JRST SYM1B ; PROCESS MULTIPLY DEFINED GLOBAL SYM1: CAMN W,2(A) ;COMPARE NEW AND OLD VALUE POPJ P,; AOS MDG ;COUNT MULTIPLY DEFINED GLOBALS PUSHJ P,PRQ ;START W/ ? PUSHJ P,PRNAM ;PRINT SYMBOL AND VALUE MOVE W,2(A) ;LOAD OLD VALUE PUSHJ P,PRNUM ;PRINT OLD VALUE JSP A,ERRPT7 ;PRINT MESSAGE SIXBIT /MUL. DEF. GLOBAL#/ POPJ P,; IGNORE MUL. DEF. GLOBAL SYM ; LOCAL SYMBOL SYM1A: TLNN F,SYMSW+DSYMSW ;SKIP IF LOAD LOCALS SWITCH ON POPJ P,; IGNORE LOCAL SYMBOLS SYM1B: CAIL H,(S) ;STORE DEFINED SYMBOL IFN EXPAND,< PUSHJ P,XPAND7> IFE EXPAND,< JRST SFULLC> SYM1C: IFE K,< TLNE N,F4SW; FORTRAN FOUR REQUIRES A BLT PUSHJ P,MVDWN; OF THE TABLES> MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2 SYM1D: SUBI S,2; UPDATE UNDEFINED POINTER POP B,2(A) ;MOVE UNDEFINED VALUE POINTER POP B,1(A) ;MOVE UNDEFINED SYMBOL MOVEM W,2(B) ;STORE VALUE MOVEM C,1(B) ;STORE SYMBOL POPJ P,; ; GLOBAL DEFINITION MATCHES REQUEST SYM2: PUSH P,SYM2C ;NEXT MUST BE A SUBROUTINE FOR LATER. SET RETURN SYM2B: MOVE V,2(A) ;LOAD REQUEST POINTER PUSHJ P,REMSYM JUMPL V,SYM2W ;ADDITIVE REQUEST? WFW PUSHJ P,SYM4A ;REPLACE CHAIN WITH DEFINITION ;WFW PATCH TO LOOK FOR MORE THAN ONE REQUEST SYM2W1: PUSHJ P,SREQ ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL JRST SYM2B ;FOUND MORE MOVE A,SVA ;RESTORE A ;END OF PATCH WFW SYM2C: POPJ P,SYM1D ;RETURN, SEE SYM2 FOR USE OF ADDRESS SVA: 0 ;A TEMP CELL WFW ; REQUEST MATCHES GLOBAL DEFINITION SYM2A: MOVE V,W ;LOAD POINTER TO CHAIN MOVE W,2(A) ;LOAD VALUE JUMPL V,FIXWP ;HANDLE ATTITIVE REQUEST WFW JRST SYM4A; REPLACE CHAIN WITH DEFINITION ; PROCESS GLOBAL REQUEST SYM3: TLNE C,040000; COMMON NAME JRST SYM1B TLC C,640000; PERMUTE BITS FROM 60 TO 04 PUSHJ P,SDEF ;SEARCH FOR GLOBAL DEFINITION JRST SYM2A ;MATCHING GLOBAL DEFINITION JUMPL W,SYM3X1 ;ADDITIVE FIXUP WFW PUSHJ P,SREQ ;SEARCH FOR EXISTING REQUEST WFW JRST SYM3A ;EXISTING REQUEST FOUND WFW SYM3X1: TLNN W,100000 ;CHECK SYMBOL TABLE FIXUP JRST SYM3X2 ;NO MOVE V,1(B) ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL XOR V,W ;CHECK FOR IDENTITY TDNE V,[XWD 77777,-1] ;BUT IGNORE HIGH 3 BITS POPJ P, ;NOT SAME, ASSUME NOT LOADED LOCAL HRRI W,2(B) ;GET LOCATION IN RIGHT HALF TLO W,1 SUB W,JOBREL ;AND MAKE RELATIVE IFN FAILSW,< TLZ W,40000> SYM3X2: CAIL H,(S) ;STORE REQUEST IN UNDEF. TABLE WFW IFN EXPAND,< PUSHJ P,XPAND7> IFE EXPAND,< JRST SFULLC> SYM3X: IFE K,< TLNE N,F4SW; FORTRAN FOUR PUSHJ P,MVDWN; ADJUST TABLES IF F4> SUB S,SE3 ;ADVANCE UNDEFINED POINTER MOVEM W,2(S) ;STORE UNDEFINED VALUE POINTER MOVEM C,1(S) ;STORE UNDEFINED SYMBOL POPJ P,; ; COMBINE TWO REQUEST CHAINS SYM3A: SKIPL 2(A) ;IS IT ADDITIVE WFW JRST SYM3A1 ;NO, PROCESS WFW PUSHJ P,SDEF2 ;YES, CONTINUE WFW JRST SYM3A ;FOUND ANOTHER WFW JRST SYM3X2 ;REALLY NO CHAIN THERE WFW SYM3A1: SUBI A,-2(X) ;A=A-(-2+X(18-35)); A RELATIVE TO X WFW SYM3B: HRRZ V,A ; SAVE CHAIN ADDRESS FOR HRRM W,@X IFN L,< CAMGE V,RINITL HALT ;LOSE LOSE LOSE> HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN JUMPN A,SYM3B ; JUMP IF NOT THE LAST ADDR. IN CHAIN HRRM W,@X ;COMBINE CHAINS POPJ P,; ;LHQ PATCH FOR LISP ABSOLUTE FIXUP PREVENTION IFN L,< VTST: 0 MOVEM V,VSVV# HRRZS V CAMGE V,RINITL POPJ P, MOVE V,VSVV JRST @VTST> ;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS FIXWP: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP JRST FIXW MOVE T,1(B) ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED XOR T,V ;CHECK FOR SAME TDNE T,[XWD 77777,-1] ;EXCEPT FOR HEGH CODE BITS POPJ P, ;ASSUME NON-LOADED LOCAL HRRI V,2(B) ;GET LOCATION SUBI V,(X) ;SO WE CAN USE @X FIXW: TLNE V,200000 ;IS IT LEFT HALF JRST FIXWL IFN L,< JSR VTST> MOVE T,@X ;GET WORD ADD T,W ;VALUE OF GLOBAL HRRM T,@X ;FIX WITHOUT CARRY MOVSI D,200000 ;SET UP TO REMOVE DEFERED INTERNAL IF THERE JRST SYMFIX FIXWL: HRLZ T,W ;UPDATE VALUE OF LEFT HALF IFN L,< JSR VTST> ADDM T,@X ;BY VALUE OF GLOBAL MOVSI D,400000 ;LEFT DEFERED INTERNAL SYMFIX: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP POPJ P, ;NO, RETURN ADDI V,(X) ;GET THE LOCATION MOVE T,-1(V) ;GET THE SYMBOL NAME TLNN T,40000 ;CHECK TO SEE IF INTERNAL POPJ P, ;NO, LEAVE ANDCAB D,-1(V) ;REMOVE PROPER BIT TLNE D,600000 ;IS IT STILL DEFERED? POPJ P, ;YES, ALL DONE EXCH C,D ;NO, CHECK FOR A REQUEST FOR IT PUSHJ P,SREQ JRST CHNSYM ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE MOVE C,D ;GET C BACK POPJ P, CHNSYM: PUSH P,D ;HAS THE OLD C IN IT PUSH P,W ;WE MAY NEED IT LATER MOVE W,(V) ;GET VALUE PUSHJ P,SYM2B ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE POP P,W POP P,C ;RESTORE FOR CALLER POPJ P, ;AND GO AWAY SYM2W: IFN FAILSW,< TLNE V,40000 ;CHECK FOR POLISH JRST POLSAT> TLNN V,100000 ;SYMBOL TABLE? JRST SYM2WA ADD V,JOBREL ;MAKE ABSOLUTE SUBI V,(X) ;GET READY TO ADD X SYM2WA: PUSHJ P,FIXW ;DO FIXUP JRST SYM2W1 ;AND LOOK FOR MORE REQUESTS ;END WFW PATCH ;PATCH VALUES INTO CHAINED REQUEST SYM4: IFN L,< CAMGE V,RINITL POPJ P,> HRRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN HRRM W,@X ;INSERT VALUE INTO PROGRAM MOVE V,T SYM4A: JUMPN V,SYM4 ;JUMP IF NOT LAST ADDR. IN CHAIN POPJ P, IFE K,< MVDWN: HRRZ T,MLTP IFN EXPAND,< SUBI T,2> CAIG T,@X; ANY ROOM LEFT? IFN EXPAND,< JRST [PUSHJ P,XPAND> TLOA F,FULLSW IFN EXPAND,< JRST MVDWN JRST .+2]> TLNE F,SKIPSW+FULLSW JRST MVABRT; ABORT BLT HRREI T,-2 ADDM T,PLTP; ADJUST PROGRAMMER LABEL POINTER ADDM T,BITP; AND BIT TABLE POINTER ADDM T,SDSTP; FIRST DATA STATEMENT ADDM T,LTC ADDM T,ITC TLNE N,SYDAT ADDM T,V ADDB T,MLTP; AND FINALLY TO MADE LABEL TABLE HRLS T; SET UP BLT POINTER ADD T,[XWD 2,0] BLT T,(S) MVABRT: POPJ P,; > ;HIGHEST RELOCATABLE POINT (BLOCK TYPE 4) SFULLC: TLOE F,FULLSW ;PREVIOUS OVERFLOW? JRST FULLC ;YES, DON'T PRINT MESSAGE JSP A,ERRPT ;NO, COMPLAIN ABT OVERFLO SIXBIT ?SYMBOL TABLE OVERLAP#? FULLC: TLO F,FULLSW ;CORE OVERLAP ERROR RETURN IFE K,< TLNE N,F4SW POPJ P,> JRST LIB3 ;LOOK FOR MORE HIGH0: CAIE A,4 ; TEST FOR END BLOCK (OVERLAP) JRST LIB3 HIGH: PUSHJ P,PRWORD ;READ TWO DATA WORDS HRR R,C ;SET NEW PROGRAM BREAK ADDI C,X; BE SURE TO RELOCATE CAILE C,1(S) ;TEST PROGRAM BREAK IFN EXPAND, IFE EXPAND, HIGH3: MOVEI A,F.C ;SAVE CURRENT STATE OF LOADER BLT A,B.C TLNE F,SLIBSW+LIBSW ;NORMAL MODE EXIT THROUGH LOAD1 JRST LIB ;LIBRARY SEARCH EXIT JRST LOAD1 ;STARTING ADDRESS (BLOCK TYPE 7) START: PUSHJ P,PRWORD ;READ TWO DATA WORDS TLNN N,ISAFLG ;SKIP IF IGNORE SA FLAG ON HRR F,C ;SET STARTING ADDRESS IFN STANSW, ;PROGRAM NAME (BLOCK TYPE 6) NAME: PUSHJ P,PRWORD ;READ TWO DATA WORDS TLOE N,COMFLG ;SKIP IF COMMON NOT PREV. SET JRST NAME1 ;SIZE OF COMMON PREV. SET MOVEM W,COMSAV ;STORE LENGTH OF COMMON JUMPE W,NAME2 ;JUMP IF NO COMMON IN THIS JOB HRRI R,@R ;FIRST PROGRAM SET LOAD ORIGIN NAME1: CAILE H,-1(S) ;TEST FOR AVAIL. SYMBOL SPACE IFN EXPAND,< PUSHJ P,XPAND7> IFE EXPAND,< JRST SFULLC> SUBI S,2 ;UPDATE UNDEF. TABLE POINTER POP B,2(S) POP B,1(S) HRRZ V,N ;POINTER TO PREVIOUS NAME SUBM B,V ;COMPUTE RELATIVE POSITIONS HRLM V,2(N) ;STORE FORWARD POINTER HRR N,B ;UPDATE NAME POINTER NAME2: MOVEM C,1(B) ;STORE PROGRAM NAME HRRZM R,2(B) ;STORE PROGRAM ORIGIN CAMG W,COMSAV ;CHECK COMMON SIZE JRST LIB3 ;COMMON OK ILC: JSP A,ERRPT SIXBIT /ILL. COMMON#/ IFN HE, JRST LD2 IFN FAILSW,< LINK: PUSHJ P,PRWORD ;GET TWO WORDS JUMPLE C,ENDLNK ;THIS IS AN END OF LINK WORD CAILE C,20 ;IS IT IN RANGE? JRST LOAD4A HRRZ V,W ;GET THE ADDRESS HRRZ W,LINKTB(C) ;GET CURRENT LINK IFN L,< CAML V,RINITL ;LOSE> HRRM W,@X ;PUT INTO CORE HRRM V,LINKTB(C) ;SAVE LINK FOR NEXT ONE JRST LINK ;GO BACK FOR MORE ENDLNK: MOVNS C ;GET ENTRY NUMBER JUMPE C,LOAD4A ;0 IS A LOSER CAILE C,20 ;CHECK RANGE JRST LOAD4A HRLM W,LINKTB(C) ;SAVE END OF LINK INFO JRST LINK ;MORE> ;ONE PASS LOCAL DEFINITION (BLOCK TYPE 10) ;PMP PATCH FOR LEFT HALF FIXUPS IFN FAILSW,< LOCDLH: IFN L,< CAMGE V,RINITL JRST .+3> HLRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN HRLM W,@X ;INSERT VALUE INTO PROGRAM MOVE V,T LOCDLF: JUMPN V,LOCDLH ;JUMP IF NOT LAST ADDR. IN CHAIN POPJ P, LOCDLI: PUSHJ P,LOCDLF AOSA LFTHSW ;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP LOCDLG: SETOM LFTHSW ;TURN ON LEFT HALF FIX SW> ;END PMP PATCH LOCD: PUSHJ P,RWORD ;READ ONE DATA WORD HLRZ V,W ;STORAGE POINTER IN LEFT HALF IFN FAILSW,< SKIPE LFTHSW# ;LEFT HALF CHAINED? PMP JRST LOCDLI ;YES PMP CAMN W,[-1] ;LEFT HALF NEXT? PMP JRST LOCDLG ;YES, SET SWITCH PMP> PUSHJ P,SYM4A ;LINK BACK REFERENCES JRST LOCD IFN STANSW,< LDNAM: MOVE T,[POINT 6,CURNAM] ;POINTER MOVNI D,6 ;SET COUNT TLZ W,740000 ;REMOVE CODE BITS SETNAM: IDIVI W,50 ;CONVERT FROM RAD 50 HRLM C,(P) AOSGE D PUSHJ P,SETNAM HLRZ C,(P) JUMPE C,INAM ADDI C,17 CAILE C,31 ADDI C,7 CAILE C,72 SUBI C,70 CAIN C,3 MOVEI C,16 INAM: IDPB C,T POPJ P, > IFN FAILSW,< ;POLISH FIXUPS PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH? JRST COMPOL ;YES JSP A,ERRPT SIXBIT /PUSHDOWN OVERFLOW#/ IFN HE, JRST LD2 COMPOL: JSP A,ERRPT SIXBIT /POLISH TOO COMPLEX#/ IFN HE, JRST LD2 ;READ A HALF WORD AT A TIME RDHLF: TLON N,HSW ;WHICH HALF JRST NORD PUSHJ P,RWORD ;GET A NEW ONE TLZ N,HSW ;SET TO READ OTEHR HALF MOVEM W,SVHWD# ;SAVE IT HLRZS W ;GET LEFT HALF POPJ P, ;AND RETURN NORD: HRRZ W,SVHWD ;GET RIGHT HALF POPJ P, ;AND RETURN POLFIX: MOVE D,[IOWD PPDL,PPDB] ;SET UP THE POLISH PUSHDOWN LIST MOVEI V,100 ;IN CASE OF ON OPERATORS MOVEM V,SVSAT SETOM POLSW ;WE ARE DOING POLISH TLO N,HSW ;FIX TO READ A WORD THE FIRST TIME SETOM GLBCNT# ;NUMBER OF GLOBALS IN THIS FIXUP SETOM OPNUM# ;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK RPOL: PUSHJ P,RDHLF ;GET A HLAF WORD TRNE W,400000 ;IS IT A STORE OP? JRST STOROP ;YES, DO IT CAIGE W,3 ;0,1,2 ARE OPERANDS JRST OPND CAILE W,14 ;14 IS HIGHEST OPERATOR JRST LOAD4A ;ILL FORMAT PUSH D,W ;SAVE OPERATOR IN STACK MOVE V,DESTB-3(W) ;GET NUMBER OF OPERANDS NEEDED MOVEM V,SVSAT# ;ALSO SAVE IT JRST RPOL ;BACK FOR MORE ;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF ;GLOBAL REQUESTS OPND: MOVE A,W ;GET THE OPERAND TYPE HERE PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND MOVE C,W ;GET IT INTO C JUMPE A,HLFOP ;0 IS HALF-WORD OPERAND PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF HRL C,W ;GET HALF IN RIGHT PLACE MOVSS C ;WELL ALMOST RIGHT SOJE A,HLFOP ;1 IS FULL WORD, 2 IS GLOBAL REQUEST PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED JRST [MOVE C,2(A) ;YES, WE WIN JRST HLFOP] AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL AOS W,OPNUM ;GET AN OPERAND NUMBER LSH W,4 ;SPACE FOR TYPE IORI W,2 ;TYPE 2 IS GLOBAL HRL W,HEADNM ;GET FIXUP NUMBER PUSHJ P,SYM3X2 ;AND PUT INTO UDEFINED AREA ALONG WITH NAME MOVE C,W ;ALSO PUT THAT PART OF THE FIXUP IN PUSHJ P,SYM3X2 SKIPA A,[400000] ;SET UP GLOBAL FLAG HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG HLFOP1: SOJL V,CSAT ;ENOUGH OPERANDS SEEN? PUSH D,C ;NO, SAVE VALUE(OR GLOBAL NAME) HRLI A,400000 ;PUT IN A VALUE MARKER PUSH D,A ;TO THE STACK JRST RPOL ;GET MORE POLISH ;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR CSAT: HRRZS A ;KEEP ONLY THE GLOBAL-VALUE HALF SKIPN SVSAT ;IS IT UNARY JRST UNOP ;YES, NO NEED TO GET 2ND OPERAND HRL A,(D) ;GET GLOBAL VALUE MARKER FOR 2ND OP POP D,W POP D,W ;VALUE OR GLOBAL NAME UNOP: POP D,V ;OPERATOR JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY XCT OPTAB-3(V) ;IF BOTH VALUES JUST XCT MOVE C,W ;GET THE CURRENT VALUE SETSAT: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK MOVE V,-2(D) ;YES, THIS MUST BE THE OPERATOR MOVE V,DESTB-3(V) ;GET NUMBER OF OPERANDS NEEDED MOVEM V,SVSAT ;SAVE IT HERE SKIPG (D) ;WAS THERE AN OPERAND SUBI V,1 ;HAVE 1 OPERAND ALREADY JRST HLFOP1 ;GO SEE WHAT WE SHOULD DO NOW ;HANDLE GLOBALS GLOB: TRNE A,-1 ;IS IT IN RIGHT HALF JRST TLHG ;NO, NEED TO PUT THIS VALUE INTO THE FIXUP LIST PUSH P,W ;SAVE FOR A WHILE MOVE W,C ;THE VALUE AOS C,OPNUM ;GET AN OPERAND NUMBER LSH C,4 ;AND PUT IN TYPE IORI C,2 ;VALUE TYPE HRL C,HEADNM ;THE FIXUP NUMBER PUSHJ P,SYM3X2 POP P,W ;RETRIEVE THE OTHER VALUE TLHG: SKIPE SVSAT ;WAS THIS A UNARY OPERATOR TLNE A,-1 ;WAS THERE A GLOBAL IN LEFT HALF JRST GLSET PUSH P,C ;SAVE THE FIRST OPERAND AOS C,OPNUM ;SEE ABOVE LSH C,4 IORI C,2 HRL C,HEADNM PUSHJ P,SYM3X2 MOVE W,C POP P,C GLSET: EXCH C,W ;GET THEM IN THE OTHER ORDER HRL W,C ;SET UP THE OPERATOR LINK AOS C,OPNUM LSH C,4 ;SPACE FOR THYPE IOR C,V ;THE OPERATOR HRL C,HEADNM PUSHJ P,SYM3X2 ;INTO THE UNDEF LIST MOVEI A,400000 ;SET UP AS A GLOBAL VALUE JRST SETSAT ;AND SET UP FOR NEXT OPERATOR ;FINALLY WE GET TO STORE THIS MESS STOROP: MOVE T,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR CAIE T,15 ;IS IT JRST LOAD4A ;NO, ILL FORMAT HRRZ T,(D) ;GET THE VALUE TYPE JUMPN T,GLSTR ;AND TREAT GLOBALS SPECIAL MOVE A,W ;THE TYPE OF STORE OPERATOR PUSHJ P,RDHLF ;GET THE ADDRESS MOVE V,W ;SET UP FOR FIXUPS POP D,W ;GET THE VALUE POP D,W ;AFTER IGNORING THE FLAG PUSHJ P,@STRTAB+3(A) ;CALL THE CORRECT FIXUP ROUTINE COMSTR: SETZM POLSW ;ALL DONE WITH POLISH MOVE T,OPNUM ;CHECK ON SIZES MOVE V,HEADNM CAIG V,477777 CAILE T,37777 JRST COMPOL ;TOO BIG, GIVE ERROR PUSHJ P,RWORD ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT) JRST LOAD4A ;IF NOT, SOMETHING IS WRONG STRTAB: EXP ALSTR,LOCDLF,SYM4A GLSTR: MOVEI A,20(W) ;CONVERT TO OPERATOR 15-17 PUSHJ P,RDHLF ;GET THE STORE LOCATION POP D,V ;GET VALUE POP D,V HRLM V,W ;SET UP STORAGE ELEMENT AOS C,OPNUM LSH C,4 IOR C,A HRL C,HEADNM PUSHJ P,SYM3X2 MOVE W,C ;NOW SET UP THE HEADER AOS V,GLBCNT ;WHICH HAS NUMBER OF GLOBALS HRLM V,W HRRZ C,HEADNM PUSHJ P,SYM3X2 JRST COMSTR ;AND FINISH ALSTR1: IFN L,< CAMGE V,RINITL POPJ P,> HRRZ T,@X MOVEM W,@X ;FULL WORD FIXUPS MOVE V,T ALSTR: JUMPN V,ALSTR1 POPJ P, DESTB: EXP 1,1,1,1,1,1,1,1,0,0,100 OPTAB: ADD W,C SUB W,C IMUL W,C IDIV W,C AND W,C IOR W,C LSH W,(C) XOR W,C SETCM W,C MOVN W,C REPEAT 3, POLSAT: PUSH P,C ;SAVE SYMBOL MOVE C,V ;POINTER PUSHJ P,SREQ ;GO FIND IT SKIPA JRST LOAD4A ;SOMETHING IS ROTTEN IN DENMARK MOVEM W,2(A) ;STORE VALUE HLRZS C ;NOW FIND HEADER PUSHJ P,SREQ SKIPA JRST LOAD4A HRLZI V,-1 ;AND DECREMENT COUNT ADDB V,2(A) TLNN V,-1 ;IS IT NOW 0 JRST PALSAT ;YES, GO DO POLISH POP P,C ;RESTORE SYMBOL JRST SYM2W1 ;AND RETURN PALSAT: PUSH P,W ;SAVE VALUE MOVEM C,HDSAV# ;SAVE THE HEADER NUMBER MOVE D,[IOWD PPDL,PPDB] ;SET UP A PDL MOVE C,V ;GET THE POINTER HRL C,HDSAV ;AND THE FIXUP NUMBER PUSHJ P,REMSYM ;REMOVE THE HEADER FORM EXISTANCE PUSHJ P,SREQ ;GO FINE THE NEXT LINK SKIPA JRST LOAD4A ;LOSE ANDI C,17 ;GET OPERATOR TYPE HRRZ V,2(A) ;PLACE TO STORE PUSH D,V PUSH D,[XWD 400000,0] PUSH D,C ;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE HLRZ C,2(A) ;GET POINTER TO POLISH CHAIN PSAT1: PUSHJ P,REMSYM ;REMOVE SYMBOL PSAT2: HRL C,HDSAV ;GET FIXUP NUMBER PUSHJ P,SREQ ;LOOK FOR IT SKIPA JRST LOAD4A ANDI C,17 ;THE OPERATOR NUMBER CAIN C,2 ;IS IT AN OPERAND? JRST PSOPD ;YES, GO PROCESS PUSH D,C ;YES STORE IT SKIPN DESTB-3(C) ;IS IT UNARY JRST PSUNOP ;YES HLRZ C,2(A) ;GET FIRST OPERAND HRLI C,600000 ;AND MARK AS VALUE PUSH D,C PSUNOP: HRRZ C,2(A) ;OTHER OPERAND JRST PSAT1 ;AND AWAY WE GO PSOPD: MOVE C,2(A) ;THIS IS A VALUE PUSHJ P,REMSYM ;GET RID OF THAT PART OF THE CHAIN PSOPD1: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK JRST PSOPD2 ;YES, TAKE GOOD CARE OF IT COMOP: POP D,V ;NO, GET THAT OPERATOR OUT OF THERE XCT OPTAB-3(V) ;AND DO IT MOVE C,W ;GET RESULT IN RIGHT PLACE JRST PSOPD1 ;AND TRY FOR MORE PSOPD2: TLNE V,200000 ;IS IT A POINTER JRST DBLOP ;YES, NEEDS MORE WORK MOVE W,C ;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W POP D,C ;VALUE POINTER POP D,C ;2ND OPERAND INTO C JRST COMOP ;GO PROCESS OPERATOR DBLOP: EXCH C,(D) ;PUT VALUE IN STACK AND RETRIEV POINTER PUSH D,[XWD 400000,0] ;MARK AS VALUE JRST PSAT2 ;AND GO LOOK FOR MORE TROUBLE STRSAT: MOVE W,C ;GET VALUE TO STORE IN W MOVE C,V ;GET OPERATOR HERE POP D,V POP D,V ;GET ADDRESS TO STORE PUSHJ P,@STRTAB-15(C) POP P,W ;RESTORE THINGS POP P,C JRST SYM2W1 PPDB: BLOCK PPDL+1> REMSYM: MOVE T,1(S) MOVEM T,1(A) MOVE T,2(S) MOVEM T,2(A) ADD S,SE3 MOVEM A,SVA POPJ P, ;SYMBOL TABLE SEARCH SUBROUTINES ; ENTERED WITH SYMBOL IN C ; RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND ; OTHERWISE, A SKIP ON RETURN OCCURS SREQ: JUMPGE S,CPOPJ1 ;JUMP IF NO UNDEF. SYMBOLS SKIPA A,S ;LOAD REQUEST SEARCH POINTER SDEF: MOVE A,B ;LOAD DEF. SYMBOL SEARCH POINTER SDEF1: CAMN C,1(A) POPJ P, ;SYMBOLS MATCH, RETURN SDEF2: ADD A,SE3 JUMPL A,SDEF1 IFE K,< JRST CPOPJ1 ;SYMBOL NOT FOUND SKIPS ON RETURN> IFN K,< CPOPJ1: AOS (P) ;TRA 2,4 POPJ P, ;...> ;RELOCATION AND BLOCK INPUT PRWORD: PUSHJ P,RWORD ;READ A WORD PAIR MOVE C,W ;LOAD C WITH FIRST DATA WORD TRNE E,377777 ;TEST FOR END OF BLOCK JRST RWORD1 ;INPUT SECOND WORD OF PAIR MOVEI W,0 ;NO SECOND WORD, ASSUME ZERO POPJ P, RWORD: TRNN E,377777 ;TEST FOR END OF BLOCK JRST LOAD1 ;RETURN TO LOAD THE NEXT BLOCK RWORD1: AOBJN E,RWORD2 ;JUMP IF DATA WORD NEXT PUSHJ P,WORD ;READ CONTROL WORD MOVE Q,W ;DON'T COUNT RELOCATION WORDS HRLI E,-22 ;SET RELOCATION WORD BYTE COUNT RWORD2: PUSHJ P,WORD ;READ INPUT WORD JUMPGE Q,RWORD3 ;TEST LH RELOCATION BIT HRLZ T,R ADD W,T ;LH RELOCATION RWORD3: TLNE Q,200000 ;TEST RH RELOCATION BIT HRRI W,@R ;RH RELOCATION LSH Q,2 POPJ P, ;PRINT STORAGE MAP SUBROUTINE PRMAP: PUSHJ P,FSCN1 ;LOAD OTHER FILES FIRST PUSHJ P,CRLFLF ;START NEW PAGE HRRZ W,R PUSHJ P,PRNUM0 JSP A,ERRPT7 SIXBIT ?IS THE PROGRAM BREAK@? PUSHJ P,CRLF ;START STORAGE MAP JSP A,ERRPT0 ;PRINT HEADER SIXBIT ?STORAGE MAP@? HLRE A,B MOVNS A ADDI A,(B) PRMAP1: SUBI A,2 SKIPL C,1(A) ;LOAD SYMBOL, SKIP IF DELETED TLNE C,300000 ;TEST FOR LOCAL SYMBOL JRST PRMAP4 ;IGNORE LOCAL SYMBOLS TLNN C,040000 PUSHJ P,CRLF ;PROGRAM NAME PUSHJ P,PRNAM1 ;PRINT SYMBOL AND VALUE TLNE C,040000 JRST PRMAP3 ;GLOBAL SYMBOL HLRE C,W ;POINTER TO NEXT PROG. NAME JUMPGE C,PRMAP2 ;JUMP IF LAST PROGRAM NAME ADDI C,2(A) ;COMPUTE LOC. OF FOLLOWING NAME SKIPA T,@C ;LOAD ORIGIN OF FOLLOWING PROG. PRMAP2: HRRZ T,R ;LOAD PROGRAM BREAK SUBM T,W ;SUBTRACT ORIGIN TO GET LENGTH PUSHJ P,PRNUM ;PRINT PROGRAM LENGTH PUSHJ P,CRLF TLNN N,ALLFLG ;SKIP IF LIST ALL MODE IS ON TRNE W,777777 ;SKIP IF ZERO LENGTH PROGRAM JRST PRMAP3 JUMPE C,PRMAP5 ;JUMP IF LAST PROGRAM SKIPA A,C ;SKIP GLOBALS, ZERO LENGTH PROG. PRMAP3: PUSHJ P,CRLF PRMAP4: CAILE A,(B) ;TEST FOR END OF SYMBOL TABLE JRST PRMAP1 PRMAP5: ;LIST UNDEFINED GLOBALS PMS: PUSHJ P,FSCN1 ;LOAD FILES FIRST JUMPGE S,PMS3 ;JUMP IF NO UNDEFINED GLOBALS HLLOS 42 ;SET SOME ERROR TO ABORT EXECUTION PUSHJ P,FCRLF ;START THE MESSAGE PUSHJ P,PRQ ;PRINT ? HLRE W,S ;COMPUTE NO. OF UNDEF. GLOBALS MOVMS W LSH W,-1 ;/2 PUSHJ P,PRNUM0 JSP A,ERRPT7 SIXBIT /UNDEFINED GLOBALS@/ MOVE A,S ;LOAD UNDEF. POINTER PMS2: PUSHJ P,CRLF PUSHJ P,PRQ ;PRINT ? PUSHJ P,PRNAM0 ;PRINT SYMBOL AND POINTER ADD A,SE3 JUMPL A,PMS2 PUSHJ P,CRLF ;SPACE AFTER LISTING ;LIST NUMBER OF MULTIPLY DEFINED GLOBALS PMS3: SKIPN W,MDG ;ANY MULTIPLY DEFINED GLOBALS JRST PMS4 ;NO, EXCELSIOR HLLOS 42 ;ANOTHER WAY TO LOSE PUSHJ P,FCRLF ;ROOM AT THE TOP PUSHJ P,PRQ ;PRINT ? PUSHJ P,PRNUM0 ;NUMBER OF MULTIPLES JSP A,ERRPT7 ;REST OF MESSAGE SIXBIT ?MULTIPLY DEFINED GLOBALS@? PMS4: TLNE N,AUXSWE ;AUXILIARY OUTPUT DEVICE? OUTPUT 2, ;INSURE A COMPLETE BUFFER POPJ P, ;RETURN ;ENTER FILE ON AUXILIARY OUTPUT DEVICE IAD2: ENTER 2,DTOUT ;WRITE FILE NAME IN DIRECTORY JRST IMD3 ;NO MORE DIRECTORY SPACE POPJ P, IMD3: JSP A,ERRPT ;DIRECTORY FULL ERROR SIXBIT /DIR. FULL@/ JRST LD2 ;PRINT THE 6 DIGIT OCTAL ADDRESS IN W ; ACCUMULATORS USED: D,T,V PRNAM0: MOVE C,1(A) ;LOAD SYMBOL PRNAM1: MOVE W,2(A) ;LOAD VALUE PRNAM: PUSHJ P,PRNAME PRNUM: PUSHJ P,SPACES PRNUM0: MOVE V,PRNUM2 ;LOAD BYTE POINTER TO RH. OF W MOVNI D,6 ;LOAD CHAR. COUNT PRNUM1: ILDB T,V ;LOAD DIGIT TO BE OUTPUT ADDI T,60 ;CONVERT FROM BINARY TO ASCII PUSHJ P,TYPE2 AOJL D,PRNUM1 ;JUMP IF MORE DIGITS REMAIN POPJ P, PRNUM2: XWD 220300,W ;YE OLDE RECURSIVE NUMBER PRINTER ;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T RCNUM: IDIVI Q,12 ;RADIX DECIMAL ADDI A,"0" HRLM A,(P) SKIPE Q PUSHJ P,RCNUM HLRZ T,(P) JRST TYPE2 ;PRINT FOUR SPACES SPACES: PUSHJ P,SP1 SP1: PUSHJ P,SPACE SPACE: MOVEI T,40 JRST TYPE2 ;SYMBOL PRINT - RADIX 50 ; ACCUMULATORS USED: D,T PRNAME: MOVE T,C ;LOAD SYMBOL TLZ T,740000 ;ZERO CODE BITS MOVNI D,6 ;LOAD CHAR. COUNT SPT: IDIVI T,50 ;THE REMAINDER IS THE NEXT CHAR. HRLM V,(P) ;STORE IN LH. OF PUSHDOWN LIST AOSGE D ;SKIP IF NO CHARS. REMAIN PUSHJ P,SPT ;RECURSIVE CALL FOR NEXT CHAR. HLRZ T,(P) ;LOAD FROM LH. OF PUSHDOWN LIST JUMPE T,TYPE ;BLANK ADDI T,60-1 CAILE T,71 ADDI T,101-72 CAILE T,132 SUBI T,134-44 CAIN T,43 MOVEI T,56 JRST TYPE2 ;PRINT A WORD OF SIXBIT CHARACTERS IN AC W ; ACCUMULATORS USED: Q,T,D PWORD: MOVNI Q,6 ;SET CHARACTER COUNT TO SIX PWORD1: MOVE D,LSTPT ;ENTER HERE WITH Q PRESET PWORD2: ILDB T,D ;LOAD NEXT CHAR. TO BE OUTPUT PUSHJ P,TYPE ;OUTPUT CHARACTER AOJL Q,PWORD2 POPJ P, ;ERROR MESSAGE PRINT SUBROUTINE ; FORM OF CALL: ; JSP A,ERRPT ; SIXBIT // ; ACCUMULATORS USED: T,V,C,W ERRPT: TLO F,FCONSW ;INSURE TTY OUTPUT PUSHJ P,CRLF ;ROOM AT THE TOP PUSHJ P,PRQ ;START OFF WITH ? ERRPT0: PUSH P,Q ;SAVE Q SKIPA V,ERRPT5 ERRPT1: PUSHJ P,TYPE ILDB T,V CAIN T,40 JRST ERRPT4 CAIN T,5 JRST ERRPT9 CAIE T,3 JRST ERRPT1 SKIPN C,DTIN JRST ERRPT4 MOVNI Q,14 MOVEI W,77 ERRPT2: TDNE C,W JRST ERRPT3 LSH W,6 AOJL Q,ERRPT2 ERRPT3: MOVE W,ERRPT6 PUSHJ P,PWORD1 SKIPN W,DTIN1 JRST ERRPT4 LSH W,-6 TLO W,160000 MOVNI Q,4 PUSHJ P,PWORD1 ERRPT4: PUSHJ P,CRLF ERRP41: POP P,Q TLZ F,FCONSW ;ONE ERROR PER CONSOLE AOS V ;PROGRAM BUMMERS BEWARE: JRST @V ;V HAS AN INDEX OF A ERRPT5: POINT 6,0(A) ERRPT6: SIXBIT / FILE / ERRPT8: TLO F,FCONSW ;INSURE TTY OUTPUT PUSHJ P,PRQ ;START WITH ? CAIGE T,140 ;IS IT A NON-PRINTING CHAR? CAIL T,40 JRST ERRP8 PUSH P,T MOVEI T,136 ;UP ARROW PUSHJ P,TYPE2 POP P,T ADDI T,100 ;CONVERT TO PRINTING CHAR. ERRP8: PUSHJ P,TYPE2 ERRPT7: PUSHJ P,SPACE JRST ERRPT0 ERRPT9: MOVEI V,@V PUSH P,V JSP A,ERRPT7 SIXBIT ?ILLEGAL -LOADER@? POP P,V JRST ERRP41 ;PRINT QUESTION MARK PRQ: PUSH P,T ;SAVE MOVEI T,"?" ;PRINT ? PUSHJ P,TYPE2 ;... POP P,T ;RESTORE POPJ P, ;RETURN ;INPUT - OUTPUT INTERFACE ;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W IFE K,< WORDPR: PUSHJ P,WORD ;GET FIRST WORD OF PAIR MOVE C,W ;KEEP IT HANDY> WORD: SOSG BUFR2 ;SKIP IF BUFFER NOT EMPTY JRST WORD2 WORD1: ILDB W,BUFR1 ;PICK UP 36 BIT WORD POPJ P, WORD2: INPUT 1, ;GET NEXT BUFFER LOAD STATUS 1,W ;GET DEVICE STATUS FROM MONITOR TRNE W,IODEND ;TEST FOR EOF JRST EOF ;END OF FILE EXIT TRNN W,IOBAD ;TEST FOR DATA ERROR JRST WORD1 ;DATA OK - CONTINUE LOADING JSP A,ERRPT ;DATA ERROR - PRINT MESSAGE SIXBIT /INPUT ERROR#/ IFN HE, JRST LD2 ;GO TO ERROR RETURN ;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII ;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT ;DEVICE CRLFLF: PUSHJ P,CRLF FCRLF: TLO F,FCONSW ;INSURE TTY OUTPUT CRLF: MOVEI T,15 ;CARRIAGE RETURN LINE FEED PUSHJ P,TYPE2 MOVEI T,12-40 ;LINE FEED IN PSEUDO SIXBIT TYPE: MOVEI T,40(T) ;CONVERT SIXBIT TO ASCII TYPE2: TLNN N,AUXSWI ;IS THER AN AUXILIARY DEVICE? JRST TYPE3 ;NO, DONT OUTPUT TO IT TLON N,AUXSWE ;IS AUX. DEV. ENTERED? PUSHJ P,IAD2 ;NOPE, DO SO! SOSG ABUF2 ;SPACE LEFT IN BUFFER? OUTPUT 2, ;CREATE A NEW BUFFER IDPB T,ABUF1 ;DEPOSIT CHARACTER TLNN F,FCONSW ;FORCE OUTPUT TO CONSOLE TOO? POPJ P, ;NOPE IFE HE,< TYPE3: SKIPN BUFO2 ;END OF BUFFER OUTPUT 3, ;FORCE OUTPUT NOW IDPB T,BUFO1 ;DEPOSIT CHARACTER CAIN T,12 ;END OF LINE OUTPUT 3, ;FORCE AN OUTPUT > IFN HE, < TYPE3: ROT T,-7 MOVEM T,FOO1# MOVEI T,FOO1 CALLI T,CDDTOUT> POPJ P, SE3: XWD 2,2 ;SYMBOL POINTER INCREMENT LSTPT: POINT 6,W ;CHARACTER POINTER TO W PDLPT: XWD -41,PDLST-1; INITIAL PUSHDOWN POINTER COMM: SQUOZE 0,.COMM. PDSAV: 0 ;SAVED PUSHDOWN POINTER COMSAV: 0 ;LENGTH OF COMMON MDG: 0 ;COUNTER FOR MUL DEF GLOBALS PDLST: IFE HE, IFN FAILSW, F.C: 0 0 ;STORE N HERE 0 ;STORE X HERE 0 ;STORE H HERE 0 ;STORE S HERE 0 ;STORE R HERE B.C: 0 IFE HE,< F.I: 0 ;INITIAL F - FLAGS 0 ;INITIAL N XWD V,LDEND ;INITIAL X - LOAD PROGRAM AFTER LOADER EXP LDEND+JOBPRO ;INITIAL H - INITIAL PROG BREAK 0 ;INITIAL S XWD W,JOBPRO ;INITIAL R - INITIAL RELOC 0 ;INITIAL B > ;BUFFER HEADERS AND HEADER HEADERS IFE HE,< BUFO: 0 ;CONSOLE INPUT HEADER HEADER BUFO1: 0 BUFO2: 0 BUFI: 0 ;CONSOLE OUTPUT HEADER HEADER BUFI1: 0 BUFI2: 0 > ABUF: 0 ;AUXILIARY OUTPUT HEADER HEADER ABUF1: 0 ABUF2: 0 BUFR: 0 ;BINARY INPUT HEADER HEADER BUFR1: 0 BUFR2: 0 DTIN: 0 ;DECTAPE INPUT BLOCK IFE HE, IFN HE, 0 DTIN2: 0 DTOUT: 0 ;DECTAPE OUTPUT BLOCK DTOUT1: 0 0 0 TTYL=52 ;TWO TTY BUFFERS IFE K,< BUFL=406 ;TWO DTA BUFFERS FOR LOAD> IFN K,< BUFL=203 ;ONE DTA BUFFER FOR LOAD> ABUFL=203 ;ONE DTA BUFFER FOR AUX DEV IFN HE, IFE HE,< TTY1: BLOCK TTYL ;TTY BUFFER AREA > BUF1: BLOCK BUFL ;LOAD BUFFER AREA AUX: BLOCK ABUFL ;AUX BUFFER AREA ZEROS: REPEAT 4,<0> IFN RPGSW, IOBKTL=40000 IOIMPM=400000 IODERR=200000 IODTER=100000 IODEND=20000 IOBAD=IODERR+IODTER+IOBKTL+IOIMPM IFE HE,< INTERN PWORD,DTIN,DTOUT,LDEND INTERN WORD,LD,BEG,PDLST,LOAD INTERN CRLF,TYPE,PMS,PRMAP INTERN F,P,X,H,S,R,B,N,T,V,W,C,E,Q,A,D > IFN HE,< INTERNAL .LOAD, .PRMAP, PMS, .NAME, ERRPT8 EXTERNAL .GETF > EXTERN JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41 IFE HE,< IFN STANSW, > ;END HERE IF 1K LOADER REQUESTED. IFN K, IFN HE, < LDEND: END >> ;HERE BEGINS FORTRAN FOUR LOADER F4LD: HRRZ V,R; SET PROG BREAK INTO V MOVEM V,LLC; SAVE FIRST WORD ADDRESS MOVEI W,-2(S); GENERATE TABLES TLO N,F4SW HRRZM W,MLTP; MADE LABELS HRRZM W,PLTP; PROGRAMMER LABELS ADD W,[POINT 1,1]; GENERATE BIT-BYTE POINTER MOVEM W,BITP MOVEM W,SDSTP; FIRST DATA STATEMENT AOS SDSTP; MOVE W,[JRST ALLOVE] ;LAST DATA STATEMENT MOVEM W,(S) HRREI W,-^D36; BITS PER WORDUM MOVEM W,BITC; BIT COUNT PUSHJ P,BITWX+1 ;MAKE SURE OF ENOUGH SPACE TEXTR: PUSHJ P,WORD; TEXT BY DEFAULT HLRZ C,W CAIN C,-1 JRST HEADER; HEADER MOVEI C,1; RELOCATABLE PUSHJ P,BITW; SHOVE AND STORE JRST TEXTR; LOOP FOR NEXT WORD ABS: SOSG BLKSIZ; MORE TO GET JRST TEXTR; NOPE ABSI: PUSHJ P,WORD; MOVEI C,0; NON-RELOCATABLE PUSHJ P,BITW; TYPE 0 JRST ABS ;PROCESS TABLE ENTRIES MDLB: TLNE F,FULLSW+SKIPSW; MADE LABEL PROC JRST GLOBDF; NO ROOM AT THE IN HLRZ C,MLTP; GET PRESENT SIZE CAMGE C,BLKSIZ; IF NEW SIZE BIGGER, STR-R-RETCH PUSHJ P,SMLT HRRZ C,MLTP; GET BASE MLPLC: ADD C,BLKSIZ; MAKE INDEX TLNN F,FULLSW+SKIPSW; DONT LOAD HRRZM V,(C); PUT AWAY DEFINITION GLOBDF: PUSHJ P,WORD TLNE F,FULLSW+SKIPSW ;SKIPPING THIS PROG? JRST TEXTR ;YES, DON'T DEFINE MOVEI C,(V); AND LOC EXCH W,C PUSHJ P,SYMXX; PUT IN DDT-SYMBOL TABLE PUSHJ P,BITWX+1 JRST TEXTR PLB: TLNE F,FULLSW+SKIPSW JRST GLOBDF HLRZ C,PLTP; PRESENT SIZE CAMGE C,BLKSIZ PUSHJ P,SPLT HRRZ C,PLTP JRST MLPLC ;STORE WORD AND SET BIT TABLE BITW: TLNE F,FULLSW+SKIPSW; WE DONT LOAD THIS POPJ P,; MOVEM W,@X; STORE AWAY OFFSET IDPB C,BITP; STORE BIT AOSGE BITC; STEP BIT COUNT JRST BITWX; SOME MORE ROOM LEFT HRREI C,-^D36; RESET COUNT MOVEM C,BITC SOS PLTP SOS BITP; ALL UPDATED IFE EXPAND, IFN EXPAND, HRRZ T,SDSTP; GET DATA POINTER BLT C,-1(T); MOVE DOWN LISTS BITWX: AOS V; STEP LOADER LOCATION HRRZ T,MLTP CAIG T,@X; OVERFLOW CHECK IFE EXPAND, IFN EXPAND, POPJ P,; SMLT: SUB C,BLKSIZ; STRETCH MOVS W,MLTP ;LEFT HALF HAS OLD BASE ADD C,MLTP ;RIGHT HALF HAS NEW BASE IFN EXPAND,< HRRZS C ;GET RID OF COUNT CAIG C,@X PUSHJ P,[PUSHJ P,XPAND POPJ P, ADD W,[XWD 2000,0] ADDI C,2000 JRST POPJM2]> HRRM C,MLTP ;PUT IN NEW MLTP HLL C,W ;FORM BLT POINTER ADDI W,(C) ;LAST ENTRY OF MLTP HRL W,BLKSIZ ;NEW SIZE OF MLTP HLLM W,MLTP ;... SLTC: BLT C,0(W); MOVE DOWN (UP?) POPJ P,; SPLT: SUB C,BLKSIZ MOVS W,MLTP; ADDM C,PLTP ADD C,MLTP IFN EXPAND,< HRRZS C CAIG C,@X PUSHJ P,[PUSHJ P,XPAND POPJ P, ADD W,[XWD 2000,0] ADDI C,2000 JRST POPJM2]> HRRM C,MLTP ;PUT IN NEW MLTP HLL C,W HLRZ W,PLTP ;OLD SIZE OF PL TABLE ADD W,PLTP ;NEW BASE OF PL TABLE HRL W,BLKSIZ ;NEW SIZE OF PL TABLE HLLM W,PLTP ;INTO POINTER JRST SLTC PT1: 0 ;PROCESS END CODE WORD ENDS: PUSHJ P,WORD; GET STARTING ADDRESS TLNE F,SKIPSW JRST ENDS1 ;FOOBAZ!!!!!!!! JUMPE W,ENDS1; NOT MAIN ADDI W,(R); RELOCATION OFFSET TLNN N,ISAFLG; IGNORE STARTING ADDRESS HRR F,W; SET SA IFN STANSW, ENDS1: PUSHJ P,WORDPR ;DATA STORE SIZE HRRZM C,PTEMP ;NUMBER OF PERMANENT TEMPS MOVEM V,CCON; START OF CONSTANTS AREA JUMPE W,E1; NULL MOVEM W,BLKSIZ ;SAVE COUNT MOVEI W,0(V) ;DEFINE CONST. MOVE C,CNR50 ;... TLNN F,SKIPSW!FULLSW PUSHJ P,SYMPT ;... PUSHJ P,GSWD ;STORE CONSTANT TABLE E1: MOVEI W,0(V); GET LOADER LOC EXCH W,PTEMP; STORE INTO PERM TEMP POINTER ADD W,PTEMP; FORM TEMP TEMP ADDRESS MOVEM W,TTEMP; POINTER MOVEM V,GSTAB; STORE LOADER LOC IN GLOBSUB MOVE C,TTR50 ;DEFINE %TEMP. TLNE F,SKIPSW!FULLSW JRST E1A PUSHJ P,SYMPT ;... MOVE C,PTR50 ;DEFINE (IF EXTANT) TEMP. MOVEI W,0(V) ;... CAME W,TTEMP ;ANY PERM TEMPS? PUSHJ P,SYMPT ;YES, DEFINE E1A: PUSHJ P,WORD; NUMBER OF GLOBSUBS JUMPE W,E11 MOVEM W,BLKSIZ ;SIZE OF GLOBSUB PUSHJ P,GSWD ;STORE GLOBSUB TABLE E11: MOVEM V,STAB; SCALARS PUSHJ P,WORD; HOW MANY? JUMPE W,E21; NONE PUSHJ P,GSWDPR ;STORE SCALAR TABLE E21: MOVEM V,ATAB; ARRAY POINTER PUSHJ P,WORD; COMMENTS FOR SCALARS APPLY JUMPE W,E31 PUSHJ P,GSWDPR ;STORE ARRAY TABLE E31: MOVEM V,AOTAB; ARRAYS OFFSET PUSHJ P,WORD; SAME COMMENTS AS ABOVE JUMPE W,E41 PUSHJ P,GSWDPR ;STORE ARRAY OFFSET TABLE E41: PUSHJ P,WORD; TEMP, SCALAR, ARRAY SIZE TLNE F,FULLSW!SKIPSW ;SKIPPING THIS PROG? MOVEI W,0 ;DON'T ACCEPT GLOB SUBPROG REQUESTS MOVEM V,CTAB; SETUP COMMON TABLE POINTER ADD W,GSTAB; GLOBAL SUBPROG BASE MOVEM W,COMBAS; START OF COMMON PUSHJ P,WORD; COMMON BLOCK SIZE HRRZM W,BLKSIZ JUMPE W,PASS2; NO COMMON COMTOP: PUSHJ P,WORDPR ;GET A COMMON PAIR PUSHJ P,SDEF; SEARCH JRST COMYES; ALREADY THERE HRLS W HRR W,COMBAS; PICK UP THIS COMMON LOC TLNN F,SKIPSW!FULLSW PUSHJ P,SYMXX; DEFINE IT MOVS W,W; SWAP HALFS ADD W,COMBAS; UPDATE COMMON LOC HRRM W,COMBAS; OLD BASE PLUS NEW SIZE HLRZS W; RETURN ADDRESS TLZ C,400000 TLNN F,SKIPSW!FULLSW PUSHJ P,SYMXX COMCOM: PUSHJ P,CWSTWX ;STORE A WORD PAIR SOS BLKSIZ SOSLE BLKSIZ JRST COMTOP JRST PASS2 COMYES: TLNE F,SKIPSW JRST COMCOM ;NO ERRORS IF SKIPPING HLRZ C,2(A); PICK UP DEFINITION CAMLE W,C; CHECK SIZE JRST ILC; ILLEGAL COMMON MOVE C,1(A); NAME HRRZ W,2(A); BASE JRST COMCOM PRSTWX: PUSHJ P,WORDPR ;GET A WORD PAIR CWSTWX: EXCH C,W ;SPACE TO STORE FIRST WORD OF PAIR? PUSHJ P,WSTWX ;... EXCH C,W ;THERE WAS; IT'S STORED WSTWX: TLNE F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD? POPJ P, ;NOPE, RETURN MOVEM W,@X ;YES, STORE IT. JRST BITWX ;TELL THE TABLES ABOUT IT; THEN RETURN GSWD: PUSHJ P,WORD ;GET WORD FROM TABLE PUSHJ P,WSTWX ;STASH IT SOSE BLKSIZ ;FINISHED? JRST GSWD ;NOPE, LOOP POPJ P, ;TRA 1,4 GSWDPR: MOVEM W,BLKSIZ ;KEEP COUNT GSWDP1: PUSHJ P,PRSTWX ;GET AND STASH A PAIR SOS BLKSIZ ;FINISHED? SOSLE BLKSIZ ;... JRST GSWDP1 ;NOPE, LOOP POPJ P, ;TRA 1,4 ;BEGIN HERE PASS2 TEXT PROCESSING PASS2: ADDI V,(X) MOVEM V,TOPTAB ;SAVE FOR OVERLAP CHECKING TLNE F,FULLSW+SKIPSW; ABORT? JRST ALLOVE; YES MOVE V,LLC ;PICK UP PROGRAM ORIGIN CAML V,CCON ;IS THIS A PROGRAM? JRST FBLKD ;NO, GO LOOK FOR FIRST BLK DATA TLOE N,PGM1 ;YES, IS THIS FIRST F4 PROG? JRST NOPRG ;NO HRR W,COMBAS ;YES, PLACE PROG BREAK IN LH IFE L,< HRLM W,JOBCHN(X) ;FOR CHAIN> NOPRG: HRRZ W,PLTP; GET PROG TABLE BASE HLRZ C,PLTP; AND SIZE ADD W,C; COMPUTE END OF PROG TABLE ADD W,[POINT 1,1]; AND BEGINNING OF BIT TABLE EXCH W,BITP; SWAP POINTERS PASS2B: ILDB C,BITP; GET A BIT JUMPE C,PASS2C; NO PASS2 PROCESSING PUSHJ P,PROC; PROCESS A TAG JRST PASS2B; MORE TO COME JRST ENDTP; PROC: LDB C,[POINT 6,@X,23]; TAG SETZM MODIF; ZERO TO ADDRESS MODIFIER TRZE C,40; AOS MODIF HRLM C,ENDTAB; ERROR SETUP MOVEI W,TABDIS; HEAD OF TABLE HLRZ T,(W); GET ENTRY CAME T,C; CHECK AOJA W,.-2 HRRZ W,(W); GET DISPATCH LDB C,[POINT 12,@X,35] JRST (W); DISPATCH TABDIS: XWD 11,PCONS; CONSTANTS XWD 06,PGS; GLOBAL SUBPROGRAMS XWD 20,PST; SCALARS XWD 22,PAT; ARRAYS XWD 01,PATO; ARRAYS OFFSET XWD 00,PPLT; PROGRAMMER LABELS XWD 31,PMLT; MADE LABESL XWD 26,PPT; PERMANENT TEMPORARYS XWD 27,PTT; TEMPORARY TEMPORARYS ENDTAB: XWD 00,LOAD4A; ERRORS PASS2C: PUSHJ P,PASS2A JRST PASS2B JRST ENDTP ;DISPATCH ON A HEADER HEADER: CAMN W,[EXP -2]; END OF PASS ONE JRST ENDS LDB C,[POINT 12,W,35]; GET SIZE MOVEM C,BLKSIZ ANDI W,770000 JUMPE W,PLB; PROGRAMMER LABEL CAIN W,500000; ABSOLUTE BLOCK JRST ABSI; CAIN W,310000; MADE LABEL JRST MDLB; MADE LABEL CAIN W,600000 JRST GLOBDF CAIN W,700000; DATA STATEMENT JRST DATAS JRST LOAD4A; DATA STATEMENTS WILL GO HERE TOPTAB: 0 ;TOP OF TABLES CTAB: 0; COMMON ATAB: 0; ARRAYS STAB: 0; SCALARS GSTAB: 0; GLOBAL SUBPROGS AOTAB: 0; OFFSET ARRAYS CCON: 0; CONSTANTS PTEMP: 0; PERMANENT TEMPS TTEMP: 0; TEMPORARY TEMPS COMBAS: 0; BASE OF COMMON LLC: 0; PROGRAM ORIGIN BITP: 0; BIT POINTER BITC: 0; BIT COUNT PLTP: 0; PROGRAMMER LABEL TABLE MLTP: 0; MADE LABEL TABLE SDS: 0 ;START OF DATA STATEMENTS SDSTP: 0 ;START OF DATA STATEMENTS POINTER BLKSIZ: 0; BLOCK SIZE MODIF: 0; ADDRESS MODIFICATION +1 TTR50: XWD 136253,114765 ;RADIX 50 %TEMP. PTR50: XWD 100450,614765 ;RADIX 50 TEMP. CNR50: XWD 112320,235025 ;RADIX 50 CONST. ;ROUTINES TO PROCESS POINTERS PCONS: ADD C,CCON; GENERATE CONSTANT ADDRESS SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY PSTA: PUSHJ P,SWAPSY ;NON-COMMON SCALARS AND ARRAYS ADDI C,(R); RELOCATE PCOM1: PUSHJ P,SYDEF ;... PCOMX: ADD C,MODIF ;ADDR RELOC FOR DP HRRM C,@X; REPLACE ADDRESS PASS2A: AOS V; STEP READOUT POINTER CAML V,CCON ;END OF PROCESSABLES? CPOPJ1: AOS (P); SKIP POPJ P,; PAT: SKIPA W,ATAB ;ARRAY TABLE BASE PST: MOVE W,STAB ;SCALAR TABLE BASE ROT C,1 ;SCALE BY 2 ADD C,W ;ADD IN TABLE BASE ADDI C,-2(X); TABLE ENTRY HLRZ W,(C); CHECK FOR COMMON JUMPE W,PSTA; NO COMMON PUSHJ P,COMDID ;PROCESS COMMON JRST PCOM1 COMDID: LSH W,1 ;PROCESS COMMON TABLE ENTRIES ADD W,CTAB; COMMON TAG ADDI W,-2(X); OFFSET PUSHJ P,SWAPSY; GET SYMBOL AND SET TO DEFINED ADD C,1(W); BASE OF COMMON POPJ P, ;RETURN PATO: ROT C,1 ADD C,AOTAB; ARRAY OFFSET ADDI C,-2(X); LOADER OFFSET MOVEM C,CT1; SAVE CURRENT POINTER HRRZ C,1(C); PICK UP REFERENCE POINTER ANDI C,7777; MASK TO ADDRESS ROT C,1; ALWAYS A ARRAY ADDI C,-2(X) ADD C,ATAB HLRZ W,(C); COMMON CHECK JUMPE W,NCO PUSHJ P,COMDID ;PROCESS COMMON PUSHJ P,SYDEF MOVE C,CT1 HRRE C,(C) ADD C,1(W) JRST PCOMX NCO: PUSHJ P,SWAPSY; ADDI C,(R) ;DEFINE SYMBOL IN TRUE LOC PUSHJ P,SYDEF ;... MOVE C,CT1 HRRZ C,(C) ;OFFSET ADDRESS PICKUP ADDI C,(R) ;WHERE IT WILL BE JRST PCOMX ;STASH ADDR AWAY PTT: ADD C,TTEMP; TEMPORARY TEMPS SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY PPT: ADD C,PTEMP; PERMANENT TEMPS SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY PGS: ADD C,GSTAB; GLOBSUBS ADDI C,-1(X); OFFSET MOVE C,(C) TLC C,640000; MAKE A REQUEST PUSHJ P,TBLCHK ;CHECK FOR OVERLAP MOVEI W,(V); THIS LOC HLRM W,@X; ZERO RIGHT HALF PUSHJ P,SYMXX JRST PASS2A SYDEF: TLNE N,SYDAT ;SYMBOL WANTS DEFININITION? POPJ P, ;NO, GO AWAY PUSH P,C ;SAVE THE WORLD PUSH P,W PUSHJ P,TBLCHK ;CHECK FOR OVERLAP MOVE W,C SKIPE C,T ;PICKUP VALUE PUSHJ P,SYMXX POP P,W POP P,C POPJ P,; PMLT: ADD C,MLTP SKIPA PPLT: ADD C,PLTP HRRZ C,(C) JRST PCOMX SYMXX: PUSH P,V PUSHJ P,SYMPT POP P,V POPJ P,; SWAPSY: MOVEI T,0; SET TO EXCHANGE DEFS EXCH T,1(C); GET NAME HRRZ C,(C) ;GET VALUE POPJ P, TBLCHK: HRRZ W,MLTP ;GETT TOP OV TABLES SUBI W,2 CAMG W,TOPTAB ;WILL IT OVERLAP IFE EXPAND, IFN EXPAND,< JRST [PUSHJ P,XPAND TLOA F,FULLSW JRST TBLCHK JRST .+1]> POPJ P, ;END OF PASS2 ALLOVE: TLZ N,F4SW ;END OF F4 PROG TLNE F,FULLSW!SKIPSW JRST HIGH3 HRR R,COMBAS ;TOP OF THE DATA HRR V,R ;IS THIS THE HIGHEST LOC YET? CAIG H,@X ;... MOVEI H,@X ;YES, TELL THE WORLD CAMG H,SDS ;HIGHEST LOC GREATER THAN DATA STATEMENTS? JRST HIGH3 ;NO, RETURN ADDI H,1(S) ;YES, SET UP MEANINGFUL ERROR COMMENT SUB H,SDS ;... TLO F,FULLSW ;INDICATE OVERFLO JRST HIGH3 ;RETURN DATAS: TLNE F,FULLSW+SKIPSW JRST DAX MOVEI C,(S) ;ADDR OF WORD UNDER SYMBOL TABLE MOVN W,BLKSIZ ;HOW FAR DOWN TO BLT ADDM W,PLTP ;UPDATE TABLE POINTERS ADDM W,BITP ;... ADDM W,SDSTP ;... ADD C,W ;RH(C):= WHEN TO STOP BLT HRL C,MLTP ;SOURCE OF BLTED DATA ADD W,MLTP ;UPDATE, GET DESTINATION OF BLT DATA IFN EXPAND,< HRRZS W ;GET RID OF LEFT HALF CAIG W,@X PUSHJ P,[PUSHJ P,XPAND POPJ P, ADDI W,2000 ADD C,[XWD 2000,2000] JRST POPJM2]> HRRM W,MLTP ;NO SET THIS SO EXTRA CORE NOT ZEROED HLL W,C ;FORM BLT POINTER BLT W,-1(C) ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE) PUSHJ P,BITWX+1 DAX: PUSHJ P,WORD; READ ONE WORD TLNN F,FULLSW+SKIPSW MOVEM W,(C) SOSLE BLKSIZ ;COUNT OF DATA SEQUENCE SIZE AOJA C,DAX ;INCREMENT DATA SEQUENCE DEPOSIT LOC JRST TEXTR; DONE FBLKD: TLOE N,BLKD1 ;IS THIS FIRST BLOCK DATA? JRST ENDTP ;NO HRR V,COMBAS ;PLACE PROG BREAK IN RH FOR IFE L,< HRRM V,JOBCHN(X) ;CHAIN> ENDTP: TLNE F,FULLSW+SKIPSW JRST ALLOVE HRR V,GSTAB ENDTP0: CAML V,STAB; ANY MORE GLOBSUBS JRST ENDTP2; NO MOVE C,@X; GET SUBPROG NAME PUSHJ P,SREQ; IS IT ALLREADY REQUESTED AOJA V,ENDTP0; YES PUSHJ P,SDEF; OR DEFINED AOJA V,ENDTP0; YES PUSHJ P,TBLCHK MOVEI W,0 ;PREPARE DUMMY LINK TLNN F,FULLSW+SKIPSW; ABORT PUSHJ P,SYM3X; PUT IN DUMMY REQUEST PUSHJ P,BITWX+1; OVERLAP CHECK AOJA V,ENDTP0 ENDTP2: SETZM PT1 HRR V,SDSTP IFN EXPAND,< SUBI V,(X) CAMG V,COMBAS JRST [PUSHJ P,XPAND TLOA F,FULLSW JRST .-3 JRST .+1] HRR V,SDSTP> HRRZM V,SDS ;DATA STATEMENT LOC ENDTP1: SUBI V,(X); COMPENSATE FOR OFFSET MOVE W,@X; GET WORD TLNE W,-1; NO LEFT HALF IMPLIES COUNT JRST DODON; DATA DONE ADD W,[MOVEI W,3] ADDI W,@X EXCH W,@X AOS V ADD W,@X; ITEMS COUNT MOVEM W,ITC MOVE W,[MOVEM W,LTC] MOVEM W,@X; SETUP FOR DATA EXECUTION AOS V MOVE W,[MOVEI W,0] EXCH W,@X MOVEM W,ENC; END COUNT AOS V MOVEI W,@X ADDM W,ITC LOOP: MOVE W,@X HLRZ T,W; LEFT HALF INST. ANDI T,777000 CAIN T,254000 ;JRST? JRST WRAP ;END OF DATA CAIN T,260000 ;PUSHJ? JRST PJTABL(W) ;DISPATCH VIA TABLE CAIN T,200000; MOVE? AOJA V,INNER CAIN T,270000; ADD? JRST ADDOP CAIN T,221000; IMULI? AOJA V,LOOP CAIE T,220000; IMUL? JRST LOAD4A; NOTA INNER: HRRZ T,@X; GET ADDRESS TRZE T,770000; ZERO TAG? SOJA T,CONPOL; NO, CONSTANT POOL SUB T,PT1; SUBTRACT INDUCTION NUMBER ASH T,1 SOS T; FORM INDUCTION POINTER HRRM T,@X HLRZ T,@X ADDI T,P HRLM T,@X AOJA V,LOOP CONPOL: ADD T,ITC; CONSTANT BASE HRRM T,@X AOJA V,LOOP ADDOP: HRRZ T,@X TRZE T,770000 SOJA T,CONPOL SKIPIN: AOJA V,LOOP PJTABL: JRST DWFS ;PUSHJ 17,0 AOSA PT1 ;INCREMENT DO COUNT SOSA PT1; DECREMENT DO COUNT SKIPA W,[EXP DOINT.] MOVEI W,DOEND. HRRM W,@X AOJA V,SKIPIN ;SKIP A WORD DWFS: MOVEI W,DWFS. HRRM W,@X AOS V TLO N,SYDAT PUSHJ P,PROC; PROCESS THE TAG JRST LOAD4A ;DATA STATEMENT BELOW CODE TOP JRST LOOP ;PROPER RETURN DOINT.: POP P,V; GET ADDRESS OF INITIAL VALUE PUSH P,(V); STORE INDUCTION VARIABLE AOS V PUSH P,V; INITIAL ADDRESS JRST (V) DOEND.: HLRZ T,@(P) ADDM T,-2(P); INCREMENT HRRZ T,@(P); GET FINAL VALUE CAMGE T,-2(P); END CHECK JRST DODONE; WRAP IT UP POP P,(P); BACK UP POINTER JRST @(P) DODONE: POP P,-1(P); BACK UP ADDRESS POP P,-1(P) JRST CPOPJ1 ;RETURN WRAP: MOVE W,ENC; NUMBER OF CONSTANTS ADD W,ITC; CONSTANT BASE MOVEI C,(W); CHAIN HRRM C,@X MOVEI V,(W); READY TO GO JRST ENDTP1 DODON: TLZ N,RCF!SYDAT!DZER ;DATA STATEMENT FLAGS MOVE W,PTEMP ;TOP OF PROG ADDI W,(X) ;+OFFSET MOVE C,COMBAS ;TOP OF DATA ADDI C,(X) ;+OFFSET SECZER: CAML W,C ;ANY DATA TO ZERO? JRST @SDS ;NO, DO DATA STATEMENTS CAML W,SDS ;IS DATA BELOW DATA STATEMENTS? TLO F,FULLSW ;NO, INDICATE OVERFLO TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO? SETZM (W) ;YES, DO SO TLON N,DZER ;GO BACK FOR MORE? AOJA W,SECZER ;YES, PLEASE CAMLE C,SDS ;ALL DATA BELOW DATA STATEMENTS? MOVE C,SDS ;ALL ZEROED DATA MUST BE HRLI W,-1(W) ;SET UP BLT POINTER TO ZERO DATA TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO? BLT W,-1(C) ;YES, DO SO JRST @SDS ;GO DO DATA STATEMENTS DREAD: TLNE N,RCF; NEW REPEAT COUNT NEEDED JRST FETCH; NO MOVE W,LTC MOVEM W,LTCTEM MOVE W,@LTC; GET A WORD HLRZM W,RCNT; SET REPEAT COUNT HRRZM W,WCNT; SET WORD COUNT POP W,(W); SUBTRACT ONE FROM BOTH HALFS HLLM W,@LTC; DECREMENT REPEAT COUNT AOS W,LTC; STEP READOUT TLO N,RCF FETCH: MOVE W,@LTC AOS LTC SOSE WCNT POPJ P,; SOSN RCNT JRST DOFF. MOVE V,LTCTEM; RESTORE READOUT MOVEM V,LTC DOFF.: TLZ N,RCF; RESET DATA REPEAT FLAG POPJ P,; DWFS.: MOVE T,(P) AOS (P) MOVE T,(T); GET ADDRESS HLRZM T,DWCT; DATA WORD COUNT HRRES T ADD T,W; OFFSET ADDI T,(X); LOADER OFFSET DWFS.1: PUSHJ P,DREAD ;GET A DATA WORD CAML T,SDS ;BELOW BEGINNING OF DATA STATEMENTS TLO F,FULLSW ;YES, INDICATE OVERFLO TLNN F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM? MOVEM W,(T) ;YES, STORE IT AOS T SOSE W,DWCT; STEP DOWN AND TEST JRST DWFS.1 ;ONE MORE TIME, MOZART BABY! POPJ P,; ;LITERAL TABLE LITS: LIT VAR CT1: 0 ;TEMP FOR C LTC: 0 ITC: 0 ENC: 0 WCNT: 0 ;DATA WORD COUNT RCNT: 0 ;DATA REPEAT COUNT LTCTEM: 0 ;TEMP FOR LTC DWCT: 0 ;DATA WORD COUNT IFE L,< IFE HE,< LDEND: END LD >> IFN HE,< LDEND: END> IFN L,< LDEND: LODMAK: MOVEI A,LODMAK MOVEM A,137 INIT 17 SIXBIT /DSK/ 0 HALT ENTER LMFILE HALT OUTPUT [IOWD 1,LMLST ;OUTPUT LENGTH OF FILE 0] OUTPUT LMLST STATZ 740000 HALT RELEASE CALL [SIXBIT /EXIT/] LMFILE: SIXBIT /LISP/ SIXBIT /LOD/ 0 0 LMLST: IOWD LODMAK+1-LD,137 0 END LODMAK>