TITLE TSTINKING ODOR ITS==0 ; FLAG SAYING WHETHER FOR ITS OR 20 IFE ITS,.INSRT MUDSYS;STENEX > ZR=0 P=1 A=2 B=3 C=4 ;FOR L.OP D=5 T=6 TT=7 ADR=10 BOT=11 CKS=12 LL=13 RH=14 MEMTOP=15 NBLKS=16 FF=17 ;I/O CHANNELS TPCHN==1 TYOC==2 TYIC==3 ERCHN==4 ;CHANNEL FOR ERROR DEVICE ;RIGHT HALF FLAGS ALTF==1 LOSE==2 ARG==4 UNDEF==10 ;COMPLAIN ABOUT UNDEF INDEF==20 ;GLOBAL LOC GLOSYM==40 ;ENTER GLOBAL SYMS INTO DDT TABLE SEARCH==100 ;LIBRARY CODEF==200 ;SPECIAL WORD LOADED GPARAM==400 ;ENTER GPA LOCALS COND==1000 ;LOAD TIME CONDITIONAL NAME==2000 ;SET JOB NAME TO PROGRAM NAME LOCF=4000 ;LOCAL IN SYM PRT JBN==10000 ;JOB NAME SET BY JCOMMAND GOF==20000 ;LEAVING LDR BY G COMMAND GETTY==40000 ;GE CONSOLE MLAST==100000 ;LAST COMMAND WAS AN "M" NOTNUM==200000 ;USED FOR DUMMY SYMBOL LOGIC SETDEV==400000 ;DEVICE SET LAST TIME HSW==1 ;MISCELLANEOUS CONSTANTS LOWLOD==0 ;LOWEST LOCATION LOADED LPDL==20 CBUFL==2000 ;COMMAND BUFFER LENGTH (MOBY LONG!) DOLL==44 ;REAL DOLLAR SIGN (NOT ALT MODE ETC.) INHASH==151. ; HASH TABLE LENGTH ICOMM==10000 ;INITIAL COMMON PPDL==60 ;POLISH PUSH DOWN LENGTH SATPDL==5 ;SATED PUSH DOWN LENGTH MNLNKS==20 ;MAXIMUM NUMBER OF LINKS STNBLN==200 ;STINK INPUT BUFFER SIZE ;REFERECNE WORD FLAGS FIXRT==1 FIXLT==2 POLREQ==200000 ;MARKS GLOGAL REQUEST AS POLISH REQUEST DEFINT==400000 ;DEFERED INTERNAL MFOR==101000 ; FOR .CBLK MBLKS==301000 BUCK==2 ; OFFSETS INTO SYMBOL BLOCKS LIST==3 LOC 41 JSR TYPR 0 ;TSINT IF2,COMLOD=TPOK ;IS YOUR TAPE OK? DEFINE INFORM A,B IF1,[PRINTX / A = B /] TERMIN DEFINE CONC69 A,B,C,D,E,F,G,H A!B!C!D!E!F!G!H!TERMIN DMCGSW==0 DEFINE DMCG IFN DMCGSW!TERMIN DEFINE NODMCG IFE DMCGSW!TERMIN LOC 200 REL: ADDI@ T,FACTOR ABS: HRRZ ADR,T DATABK: HRRZS ADR PUSHJ P,GETBIT TRZE TT,4 JRST DATBK1 PUSHJ P,RRELOC COM1: ADDB T,AWORD ADD T,RH HLL T,AWORD CLEARB RH,AWORD IFN LOWLOD,[CAIGE ADR,LOWLOD AOJA ADR,DATABK ]GCR2: CAMLE ADR,MEMTOP JRST GCR1 TRNE FF,CODEF MOVEM T,(ADR) TRNN FF,CODEF MOVEM T,@ADRPTR AOJA ADR,DATABK ERR1: DATBK1: PUSHJ P,RLKUP TRNE TT,2 JRST DECODE ;LINK OR EXTEND USE: ROTC T,3 HRL ADR,TT SKIPE C,TIMES CLEARM TIMES DPB C,[(261200)ADR] JUMPGE D,USE1A TLNE B,200000 JRST USE2 ;PREV DEFINED TRNE FF,UNDEF JRST ERR2 PUSHJ P,DOWN MOVEM ADR,(D) CDATABK: JRST DATABK GCR1: TRNE ADR,400000 ; PURE? JRST HIGHSG ; YES, USE HIGH SEG PUSHJ P,GETMEM JRST GCR2 HIGHSG: CAMLE ADR,HIGTOP ; WITHIN HIGH BOUND? PUSHJ P,GETHI ; NO, GROW MOVEM T,(ADR) ; STORE AOJA ADR,DATABK ; ROUTINE TO GROW HIGH SEGMENT GETHI: DMCG,[ PUSH P,A SKIPE TT,USINDX ; DO WE KNOW USER INDEX JRST GETHI1 ; YES, CONTINUE IFN ITS, .SUSET [.RUIND,,USINDX] MOVE TT,USINDX GETHI1: MOVEI A,200001 ; FOR SEG #1 FROM CORE JOB DPB TT,[MFOR,,A] ; STORE USER POINTER MOVEI TT,(ADR) ; GET WHERE TO POINTER SUBI TT,400000-2000 ; ROUND UP AND REMOVE HIGH BIT ASH TT,-10. ; TO BLOCKS DPB TT,[MBLKS,,A] ; STORE IT ALSO IFN ITS,[ .CBLK A, ; GOT TO SYSTEM PUSHJ P,SCE ] MOVE A,HIBLK ; GET NO. OF HIGH BLOCKS SUBM TT,A ; GET NEW BLOCKS MOVEM TT,HIBLK ; AND STORE ASH TT,10. ; NOW COMPUTE NEW HIGTOP TRO TT,400000 ; WITH HIGH BIT SUBI TT,1 MOVEM TT,HIGTOP JRST POPAJ ];DMCG NODMCG,[ PUSH P,A MOVEI TT,(ADR) SUBI TT,400000-2000 ASH TT,-10. SUB TT,HIBLK ;NUMBER OF BLOCKS TO GET ADDM TT,HIBLK ;NUMBER OF BLOCKS WE ARE GOING TO HAVE SKIPG TT IFN ITS, .VALUE IFE ITS, HALTF MOVE A,CWORD1 ADDI A,1000 IFN ITS,[ .CBLK A, PUSHJ P,SCE SOJG TT,.-3 ] MOVEM A,CWORD1 MOVE TT,HIBLK ASH TT,10. ADDI TT,400000-1 MOVEM TT,HIGTOP JRST POPAJ ];NODMCG USE2: MOVE T,1(D) ;FILL REQUEST PUSHJ P,DECGEN ADDM T,AWORD ADDM TT,RH JRST DATABK USE1A: MOVE T,ADR USE1: TLO A,400000 TRNN FF,UNDEF JRST DEF1A ;ENTER DEF ERR2: (5000+SIXBIT /UGA/) JRST DATABK DEF1: TLO A,600000 TRNN FF,INDEF+GPARAM ;DEFINE ALL SYMBOLS TLNE A,40000 ;OTHERWISE, FLUSH LOCALS JRST ENT JRST DEF4 RDEF: TRO TT,10 ;SET FLAG FOR REDEFINITION DEF: ROTC T,3 PUSHJ P,RRELOC DFSYM1: PUSH P,CDATABK DEFSYM: MOVEM T,T1 DFSYM2: MOVEM A,CGLOB ;SAVE SQUOOZE IN CASE WE SATISFY POLISH JUMPGE D,DEF1 ;NOT PREV SEEN TLNN B,200000 ;PREVIOUSLY DEFINED JRST PATCH5 ;PREVIOUSLY NEEDED DEF2: TRNE TT,100 ;REDEFINE NOT OK DEF3: MOVEM T,1(D) CAME T,1(D) (5000+SIXBIT /MDG/) DEF4: TRZ FF,GPARAM POPJ P, PATCH3: PUSH P,PATCH6 PATCH: PUSH P,A ; SAVE SYMBOL HRRZ D,T2 ; DELETE REFERENCES FROM TABLE MOVE A,(D) ; SQUOOZE TLNE A,200000 ; CHECK FOR DEFINED SYMBOL JRST PATCH2 ; DON'T DELETE REFERENCES HRRZ A,1(D) ; FIRST REFERENCE SETZM 1(D) HRRZ D,(A) PUSHJ P,PARRET SKIPE A,D JRST .-3 PATCH2: HRRZ A,T2 ; POINT TO SYMBOL TO BE FLUSHED(REFS ARE GONE) HRRZ B,LIST(A) ; GET LIST POINTER LEFT HLRZ C,LIST(A) ; AND RIGHT SKIPE B ; END? HRLM C,LIST(B) ; NO, SPLICE SKIPE C HRRM B,LIST(C) HRRZ C,BUCK(A) ; NOW GET BUCKET POINTERS HLRZ B,BUCK(A) CAMG B,HTOP ; SEE IF POINTS TO HASH TABLE CAMGE B,HBOT JRST .+3 ; NO, SKIP HRRM C,(B) ; IT IS, CLOBBER IN JRST .+2 HRRM C,BUCK(B) ; SPLICE BUCKET SKIPE C HRLM B,BUCK(C) ; SPLICE IT ALSO CAIN A,(BOT) ; RESET BOT? HRRZ BOT,LIST(BOT) ; YES SETZM LIST(A) ; CLEAR FOR DEBUGGING PUSHJ P,QUADRT ; RETURN BLOCK POP P,A ; RESTORE SYMBOL SKIPE SATED JRST UNSATE ;DELETE THEM PATCH6: POPJ P,.+1 PATCH7: PUSHJ P,LKUP1A JUMPGE D,DEF1 PATCH5: HRRZM D,T2 HRRZ B,1(D) ; POINT TO REF CHAIN MOVEI D,(B) PATCH1: MOVE T,T1 JUMPE D,PATCH3 MOVE B,1(D) ; GET REF WORD HRRZ D,(D) HLL ADR,B HRRZS B TLZE ADR,DEFINT JRST DEFIF ;DEFERED INTERNAL TLZE ADR,POLREQ JRST POLSAT ;POLISH REQUEST CAIGE B,LOWLOD JRST PATCH1 TLZN ADR,100000 JRST GEN ;GENERAL REQUEST PUSH P,CPTCH1 UNTHR: TRNN B,400000 ; HIGH SEG? MOVEI B,@BPTR ; NO FUDGE HRL T,(B) HRRM T,(B) HLRZ B,T JUMPN B,UNTHR CPTCH1: POPJ P,PATCH1 DEFIF: SKIPGE (B) JRST DEFIF1 ;MUST SATISFY DEFERRED INTERNAL TLNE ADR,FIXRT+FIXLT JRST 4,. DEFIF6: EXCH A,B PUSHJ P,PARRET MOVE A,B ;GET THE SYMBOL BACK JRST PATCH1 DEFIF1: TLNN ADR,FIXRT+FIXLT JRST 4,. ;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE TLC ADR,FIXRT+FIXLT TLCN ADR,FIXRT+FIXLT JRST 4,. ;BOTH BITS TURNED ON!! PUSH P,D PUSH P,B ;POINTS TO VALUE PAIR MOVE T,1(B) ;SQUOOZE FOR DEFERRED INTERNAL PUSHJ P,LKUP JUMPGE D,DEFIF4 ;PERHAPS ITS'S IN DDT TABLE TLNE B,200000 JRST 4,. ;LOSER PUSHJ P,GLOBS3 ;FIND THE VALUE JUMPE B,[JRST 4,.] TLNE ADR,FIXRT JRST DEFIFR ;RIGHT HANDED TLNN ADR,FIXLT JRST DEFIF2 ;LEFT HANDED FIXUP TLZN A,FIXLT JRST 4,. HLRE T,1(A) DEFIF2: ADD T,T1 TLZE ADR,FIXRT HRRM T,1(A) TLZE ADR,FIXLT HRLM T,1(A) MOVEM A,1(B) ;WRITE THE REFERENCE WORD BACK MOVE T,1(A) ;SAVE VALUE OF THIS GLOBAL IN CASE MOVE B,A POP P,A ;POINTS TO VALUE PAIR PUSHJ P,PARRET TLNE B,FIXLT+FIXRT JRST DEFIF3 ;STILL NOT COMPLETELY DEFINED MOVE B,(D) ;SIMULATE CALL TO LKUP MOVE A,B TLZ A,700000 PUSH P,T1 PUSH P,T2 PUSH P,CGLOB PUSHJ P,DEFSYM ;HOLD YOUR BREATH POP P,CGLOB POP P,T2 POP P,T1 DEFIF3: POP P,D MOVE A,CGLOB JRST PATCH1 DEFIFR: TLZN A,FIXRT JRST 4,. HRRE T,1(A) JRST DEFIF2 DEFIF4: POP P,B POP P,D PUSH P,B PUSH P,T1 ;VALUE TO BE ADDED PUSH P,[DEFIF5] ;WHERE TO RETURN TLZ T,200000 ;ASSUME RIGHT HALF FIX TLZE ADR,FIXLT TLO T,200000 ;ITS LEFT HALF FIX TLZ ADR,FIXRT JRST GLST2 DEFIF5: POP P,B MOVE A,CGLOB JRST DEFIF6 GEN: PUSHJ P, DECGEN TRNN B,400000 ; HIGH SEG MOVEI B,@BPTR ; NO GET REAL LOC ADD T,(B) ADD TT,T HRR T,TT MOVEM T,(B) JRST PATCH1 DECGEN: MOVEI TT,0 TLNE ADR,10 MOVNS T LDB C,[(261200)ADR] SKIPE C IMUL T,C LDB C,[(220200)ADR] TLNE ADR,4 MOVSS T XCT WRDTAB(C) WRDTAB: POPJ P, ;FW EXCH T,TT ;RH HLLZS T ;LH ROT T,5 ;AC DECODE: TRNN TT,1 JRST THRDR ;6 > LINK REQ PUSHJ P,GETBIT JRST @.+1(TT) DEF ;DEFINE SYMBOL (70) COMMON ;COMMON RELOCATION (71) LOCGLO ;LOCAL TO GLOBAL RECOVERY (72) LIBREQ ;LIBRARY REQUEST (73) RDEF ;REDEFINITION (74) REPT ;GLOBAL MULTIPLIED BY 1024>N>0 (75) DEFPT ;DEFINE AS POINT (76) RLKUP: PUSHJ P,RPB LKUP: MOVE A,T LKUP1B: MOVE D,BOT LKUP3: MOVEI B,0(ADR) ;CONTAINS GLOBAL OFFSET TRNN FF,CODEF MOVEM B,CPOINT+1 ;$. TLZ A,700000 LKUP1A: PUSH P,A MOVE B,HTOP SUB B,HBOT ; COMP LENGTH IDIVI A,(B) ; HASH THE SYMBOL ADD B,HBOT ; POINT TO THE BUCKET HRRZ D,(B) ; SKIP IF NOT EMPTY MOVE A,(P) ; RESTORE SYMBOL JRST LKUP7 LKUP1: MOVE B,(D) ; GET A CANDIDATE TLZ B,600000 CAMN A,B ; SKIP IF NOT FOUND JRST LKUP5 HRRZ D,BUCK(D) ; GO TO NEXT IN BUCKET LKUP7: JUMPE D,LKUP6 ; FAIL, GO ON HRROI D,(D) JRST LKUP1 LKUP6: TROA FF,LOSE LKUP5: MOVE B,(D) ; SYMBOL WITH ALL FLAGS TO B JRST POPAJ RRELOC: PUSHJ P,RPB RELOC: HLRZ C,T TRNE TT,1 ADD T,FACTOR TRNE TT,2 ADD C,FACTOR HRL T,C POPJ P, DOWN: PUSH P,A PUSHJ P,PAIR ; GET A REF PAIR HRRZ ZR,1(D) ; SAVE OLD REF MOVEM A,1(D) ; CLOBBER IT MOVEM ZR,(A) ; AND PATCH MOVEI D,1(A) ; POINT D TO DESTINATION OF REF WRD JRST POPAJ ;HERE TO CREATE NEW TABLE ENTRY ;A/ SQUOZE ;T/ VALUE DEF1A: PUSH P,CDATABK DEF2A: PUSH P,A ; SAVE SYMBOL PUSHJ P,PAIR ; GET PAIR FOR REF CHAIN MOVEM T,1(A) ; SAVE REF WORD MOVEI T,(A) ; USE POINTER AS VALUE SKIPA A,(P) ENT: PUSH P,A PUSH P,C TLZ A,700000 MOVEM A,GLBFS PUSHJ P,QUAD ; GET A QUADRAD FOR SYMBOL MOVE D,A ; POINT WITH C MOVE A,-1(P) ; RESTORE SYMBOL FOR HASHING MOVE B,HTOP ; -LNTH OF TABLE SUB B,HBOT TLZ A,600000 ; CLOBBER FLAGS IDIVI A,(B) ; GET HASH ADD B,HBOT ; POINT TO BUCKET HRRZ C,(B) ; GET CONTENTS THEREOF HRROM D,(B) ; PUT NEW ONE IN HRRM C,BUCK(D) ; PUT OLD ONE IN HRLM B,BUCK(D) ; POINT BACK TO TABLE SKIPE C ; SKIP IF NO NEXT HRLM D,BUCK(C) SKIPE BOT HRLM D,LIST(BOT) HRRZM BOT,LIST(D) ; INTO LIST OF ALL SYMBOLS MOVEI BOT,(D) ; AND RESET MOVE A,-1(P) MOVEM A,(D) MOVEM T,1(D) POP P,C JRST POPAJ THRDR: PUSHJ P,RPB TLNE T,100000 ADD T,FACTOR HRLI T,100000 JUMPGE D,USE1 MOVE B,(D) TLNE B,200000 JRST THRD2 ;PREV DEFINED PUSHJ P,DOWN ;ENTER LINK REQUEST MOVEM T,(D) JRST DATABK THRD2: HRRZ B,T MOVE T,1(D) PUSHJ P,UNTHR JRST DATABK LOCGLO: JUMPGE T,LG2 ;JUMP FOR NORMAL LOCAL TO GLOBAL RECOVERY ;HERE TO EXPUNGE OR RENAME LOCAL IN LOADER TABLE JUMPGE D,[JRST 4,.] ;NO SYMBOL THERE HRRZM D,T2 ;TABLE ENTRY TO DELETE PUSHJ P,RPB ;SOAK UP ANOTHER WORD JUMPGE T,LG1 ;JUMP TO RENAME LOCAL TLNN B,200000 ;MAKE SURE THING IS DEFINED JRST 4,. ;CANNOT HACK UNDEFINED SYMBOL PUSHJ P,PATCH JRST DATABK ;HERE TO RENAME LOCAL IN LOADER TABLE LG1: PUSH P,(D) ;SQUOZE PUSH P,1(D) ;VALUE MOVSI B,200000 ;MARK AS DEFINED SO THAT . . . IORM B,(D) ;PATCH WILL NOT HACK REFERENCES PUSHJ P,PATCH MOVE A,T ;NEW NAME POP P,T ;VALUE POP P,B ;OLD NAME TDZ B,[37777,,-1] ;CLEAR SQUOZE TLZ A,700000 ;CLEAR FLAGS OF NEW NAME IOR A,B ;FOLD FLAGS, NEW NAME MOVEI B,DATABK ;ASSUME IT WILL BE LOCAL TLZE A,40000 ;SEE IF WE MUST RECOVER TO GLOBAL MOVEI B,.+3 ;MUST RECOVER TO GLOBAL PUSH P,B ;RETURN ADDRESS JRST ENT ;ENTER IT MOVE B,(D) ;SQUOZE AND FLAGS MOVE A,B ;SQUOZE WITH . . . TLZA A,740000 ;FLAGS CLEARED ;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY LG2: JUMPGE D,DATABK ;LOCAL-GLOBAL RECOVERY MOVE T,D ;D POINTS TO LOCAL TLO A,40000 ;GLOBAL PUSHJ P,LKUP1B ;FIND OCCURANCE OF GLOBAL IORM A,(T) ;SMASH OLD LOCAL OCCURENCE JUMPGE D,DATABK TLNN B,200000 JRST DATABK MOVE B,1(D) ;ALREADY DEFINED MOVEM B,T1 HRRZM D,T2 ADDI D,2 PUSHJ P,PATCH ;CLOBBER DEFINITION MOVE D,BOT PUSH P,CDATABK JRST PATCH7 ;FILL IN OLD LOCAL REQ LIBREQ: JUMPL D,DATABK ;ALREADY THERE MOVEI T,0 JRST USE1 REPT: MOVEM T,TIMES JRST DATABK COMMON: ADD RH,COMLOC JRST COM1 DEFPT: MOVEI T,@LKUP3 TRO FF,GPARAM JRST DFSYM1 LDCND: TRO FF,COND JRST LIB LIB6: CAIN A,12 ;END OF CONDITIONAL JRST .OMIT1 HRRZS T CAIN A,1 CAIE T,5 ;LOADER VALUE CONDITIONAL CAIN A,11 ;COUNT MATCHING CONDITIONALS AOS FLSH JRST OMIT LIB2: TRNE FF,COND JRST LIB6 CAIN A,5 JRST LIB7 PUSHJ P,RPB CAIN A,4 ;PRGM NAME TLNN T,40000 ;REAL END JRST OMIT JRST OMIT1 ;LEAVE LIB SEARCH MODE LIB1: TRO FF,SEARCH PUSHJ P,RPB JUMPGE T,.-1 TRZ FF,SEARCH LIB4: PUSHJ P,LKUP JUMPGE D,LIB3 ;NOT ENTERED TRNE FF,COND JRST LIB5 TLNE B,200000 ;RQST NOT FILLED LIB3: TLC T,200000 ;"AND NOT" BIT LIB5: TLNE T,200000 JRST LIB1 ;THIS ONE LOSES LIB: CLEARM FLSH LIB7: PUSHJ P,RPB JUMPGE T,LIB4 .OMIT1: SOSGE FLSH OMIT1: TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG OMIT: PUSH P,. RPB: SOSL TC JRST GTWD PUSHJ P,GTWD ;SOAK UP CKSUM AOJN CKS,RCKS LOAD: JRST (LL) ;READ SWITCH LOAD2: PUSHJ P,GTWD LDB A,[(220700)T] MOVEM A,TC MOVSI A,770000 ANDCAM A,BITPTR LDB A,[(310700)T] LOAD1: MOVE P,SAVPDL JUMPLE T,OUT CAIL A,LOADTE-LOADTB JRST TPOK TRNE FF,SEARCH JRST LIB2 TRZ FF,COND ;FUDGE FOR IMPROPER USE OF .LIBRA JRST @.+1(A) LOADTB: TPOK LDCMD ;LOADER COMMAND (1) ABS ;ABSOLUTE (2) REL ;RELOCATABLE (3) PRGN ;PROGRAM NAME (4) LIB ;LIBRARY (5) COMLOD ;COMMON LOADING (6) GPA ;GLOBAL PARAMETER ASSIGNMENT (7) SYMSW: DDSYMS ;LOCAL SYMBOLS (10) LDCND ;LOAD TIME CONDITIONAL (11) SYMFLG: SETZ OMIT ;END LDCND (12) HLFKIL ;HALF KILL A BLOCK OF SYMBOLS OMIT ;OMIT BLOCK GENERATED BY LIBRARY CREATOR OMIT ;LATER WILL BE .ENTRY AEXTER ;BLOCK OF STUFF FOR SDAT OR USDAT OMIT ;FOR .LIFND GLOBS ;GLOBAL SYMBOLS BLOCK TYPE 20 FIXES ;FIXUPS BLOCK TYPE 21 POLFIX ;POLISH FIXUPS BLOCK TYPE 22 LINK ;LINK LIST HACK (23) OMIT ;LOAD FILE (24) OMIT ;LOAD LIBRARY (25) OMIT ;LVAR (26) OBSOLETE OMIT ;INDEX (27) NEW DEC STUFF OMIT ;HIGH SEG(30) LOADTE: OUT: MOVE P,SAVPDL ADRM: POPJ P, ;HERE TO PROCESS AN .EXTERN AEXTER: PUSHJ P,RPB ;READ AND LOOK UP SYMBOL TLO T,40000 ;TURN ON GLOBAL BIT PUSHJ P,LKUP ;NOW LOOK IT UP JUMPGE D,.+3 ;NEVER APPEARED, MUST ENTER TLNE B,200000 ;SKIP IF NOT DEFINED JRST AEXTER ;THIS ONE EXISTS, GO AGAIN MOVE B,USDATP ;GET POINTER TO USDAT PUSH P,A ;SAVE SYMBOL TLZ A,740000 ;KILL ALL FLAGS MOVE T,B ;SAVE A COPY OF THIS ADD T,[3,,3] ;ENOUGH ROOM? JUMPGE T,TMX ;NO, BARF AT THE LOSER MOVEM T,USDATP ;NOW SAVE TRNN B,400000 ; HIGH SEG? MOVEM A,@BPTR ; NO GET REAL LOC TRNE B,400000 ; SKIP IF LOW SEG MOVEM A,(B) ;STORE INTO CORE IMAGE BEING BUILT POP P,A ;RESTORE SYMBOL MOVEI T,1(B) ;ALSO COMPUTE 'VALUE' OF SYMBOL PUSHJ P,DEFSYM JRST AEXTER ;USDAT HAS OVERFLOWN TMX: (3000+SIXBIT /TMX/) GPA: PUSHJ P,RPB MOVEM T,T2 MOVEI T,0 LDCMD: ADDI T,LDCMD2+1 HRRM T,LDCMD2 ROT T,4 DPB T,[(330300)LDCVAL] TRO FF,UNDEF+CODEF HRRM ADR,ADRM MOVEI B,@LKUP3 MOVEM B,CPOINT+1 MOVEI ADR,T1 JSP LL,DATABK LDCMD1: TRZ FF,UNDEF+CODEF HRRZ ADR,ADRM CLEARB RH,AWORD MOVE D,T1 LDCMD2: JRST @. GPA1 JMP ;JUMP BLOCK (1) GLOBAL ;GLOBAL LOCATION ASSIGNMENT (2) COMSET ;COMMON ORIGIN (3) RESPNT ;RESET GLOBAL RELOCATION (4) LDCVAL ;LOADER VALUE CONDITIONAL (5) .OFFSET ;GLOBAL OFFSET (6) L.OP ;LOADER EXECUTE (7) .RESOF ;RESET GLOBAL OFFSET JMP: JUMPE D,JMP1 TRNN FF,JBN TLO FF,NAME MOVEM D,SA JMP1: MOVEI LL,LOAD2 JRST LOAD2 GLOBAL: TRO FF,INDEF HRRM D,RELADR MOVE ADR,D MOVEI D,RELADR GLOB1: HRRM D,REL JRST JMP1 RESPNT: TRZ FF,INDEF MOVEI D,FACTOR HRRZ ADR,FACTOR JRST GLOB1 LDCVAL: JUMP D,JMP1 TRO FF,SEARCH+COND CLEARM FLSH JRST JMP1 .OFFSET: HRRM D,LKUP3 JRST JMP1 L.OP: MOVE B,T1 ;B=3 C=4 D=5 MOVE 4,T1+1 MOVE 5,T1+2 TDNN B,[(757)777777] IFN 0,[ JRST L.OP2 HRRM ADR,ADRM HRRZ ADR,ADRPTR MOVEM 4,4(ADR) MOVEM 5,5(ADR) MOVEM B,20(ADR) HRLZI B,(.RETUUO) MOVEM B,21(ADR) MOVEM B,22(ADR) .XCTUUO NBLKS, MOVE 4,4(ADR) MOVE 5,5(ADR) HRRZ ADR,ADRM JRST .+2 L.OP2:] IOR B,[0 4,5] XCT B MOVEM 4,.VAL1 MOVEM 5,.VAL2 JRST JMP1 .RESOF: MOVEI D,0 JRST .OFFSET SETJNM: MOVEI A,SJNM1 HRRM A,SPTY SETZM A MOVE B,[(600)A-1] PUSHJ P,SPT MOVEM A,JOBNAM MOVEI A,TYO HRRM A,SPTY MOVE A,PRGNAM POPJ P, SJNM1: TRC T,40 DDT4: IDPB T,B POPJ P, GPA1: MOVE T,T2 PUSHJ P,LKUP MOVE T,T1 MOVEI TT,100 ;DON'T GENERATE MDG TRO FF,GPARAM PUSHJ P,DEFSYM JRST JMP1 DDLUP: DDSYMS: PUSHJ P,RPB LDB TT,[(410300)T] TLNE T,40000 JRST DDLUP2 TLZ T,240000 TLO T,100000 DDLUP1: MOVE A,T PUSHJ P,RRELOC PUSHJ P,ADDDDT JRST DDLUP DDLUP2: TLZ T,740000 ;MARK AS BLOCK NAME JRST DDLUP1 ;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20 GLOBS: PUSHJ P,GETBIT ;CODE BITS PUSHJ P,RPB ;SQOOZE MOVEM T,CGLOB PUSHJ P,GETBIT ;CODE BITS PUSHJ P,RRELOC ;VALUE MOVEM T,CGLOBV MOVE T,CGLOB TLO T,40000 ;GLOBAL FLAG PUSHJ P,LKUP ;SYMBOL LKUP LDB C,[400400,,CGLOB] ;FLAGS CAIN C,60_-2 JRST GLOBRQ ;GLOBAL REQUEST ;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION TRNN C,10_-2 ;TEST FOR VALID FLAGS TRNN C,4_-2 ;FORMAT IS XX01 JRST 4,. LSH C,-2 ;SHIFT OUT GARBAGE JUMPE C,GLBDEF ;FLAGS 04=> GLOBAL DEFINITION CAIN C,40_-4 ;*****JUST A GUESS JRST GLBDEF ;*****JUST A GUESS ;DUMP A DEFERRED INTERNAL INTO LOADER TABLE JUMPL D,GDFIT ;JUMP IF IN LOADER TABLE PUSHJ P,PAIR ;GET VALUE PAIR MOVSI T,DEFINT(C) HRR T,A ;REFERENCE WORD POINTS TO PAIR MOVE A,CGLOBV SETZM (T) ;MARK AS VALUE MOVEM A,1(T) ;SECOND WORD IS VALUE GLOBS0: MOVE A,CGLOB ;SQUOOZE TLZ A,300000 ;FIX THE FLAGS TLO A,440000 PUSHJ P,DEF2A ;PUT IT INTO LOADER TABLE JRST GLOBS ;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE GDFIT: TLNE B,200000 JRST 4,. ;ALREADY DEFINED PUSHJ P,GLOBS3 ;RETURNS REFERENCE WORD IN A JUMPE B,GDFIT1 ;MUST ADD DEFERRED VALUE HLRZ B,A CAIE B,DEFINT(C) JRST 4,. ;REFERENCE WORDS DON'T MATCH MOVE B,CGLOBV CAME B,1(A) JRST 4,. ;VALUES DON'T MATCH JRST GLOBS ;ALL'S WELL THAT ENDS WELL GDFIT1: PUSHJ P,DOWN PUSHJ P,PAIR MOVSI T,DEFINT(C) HRR T,A MOVEM T,(D) SETZM (T) ;MARK AS VALUE MOVE A,CGLOBV MOVEM A,1(T) ;VALUE JRST GLOBS ;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60 GLOBRQ: SKIPGE T,CGLOBV ;SKIP IF THREADED LIST JRST GLOBR1 ;SINGLE WORD FIX UP MUST WORK HARDER ;SIMPLE REQUEST JUMPE T,GLOBS ;IGNORE NULL REQUEST JUMPGE D,GLOBNT ;JUMP IF SYMBOL NOT IN TABLE TLNE B,200000 ;TEST TO SEE IF DEFINED JRST GLOBPD ;PREVIOUSLY DEFINED PUSHJ P,DOWN ;NOT DEFINED, ENTER REQEST INTO TABLE MOVE C,CGLOBV HRLI C,100000 ;THIS IS A LINK LIST MOVEM C,(D) JRST GLOBS ;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04 GLBDEF: MOVE T,CGLOBV ;VALUE MOVEI TT,0 ;REDEFINE NOT OKAY, SEE DEF2 PUSHJ P,DEFSYM ;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP JRST GLOBS ; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN GLOBPD: MOVE T,1(D) ;VALUE MOVE B,CGLOBV ;POINTER TO CHAIN PUSHJ P,UNTHR JRST GLOBS ; ENTER NEW SYMBOL WITH LINK REQUEST GLOBNT: MOVEI C,44_-2 ;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ DPB C,[400400,,A] HRLI T,100000 ;SET LINK BIT IN REQUEST PUSHJ P,DEF2A JRST GLOBS ; SINGLE WORD FIX UP -- FLAGS=60 GLOBR1: TLNE T,100000 ;TEST FOR SYMBOL TABLE FIX JRST GLOBST ;SYMBOL TABLE FIX JUMPGE D,GLOBR2 ;JUMP IF NOT IN TABLE TLNN B,200000 JRST GLOBR3 ;NOT PREVIOUSLY DEFINED HRRZ B,T ;FIX UP LOCATION PUSHJ P,MAPB ;DO THE RIGHT THING IF B IN HIGH SEGMENT TLNE T,200000 ;LEFT OR RIGHT? JRST HWAL ;LEFT HWAR: HRRE C,(B) ;HALF WORD ADD RIGHT ADD C,1(D) HRRM C,(B) JRST GLOBS HWAL: HLRE C,(B) ;HALF WORD ADD LEFT ADD C,1(D) HRLM C,(B) JRST GLOBS ; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED GLOBR3: PUSHJ P,DOWN ;MAKE ROOM IN TABLE MOVE C,T HRLI T,40001 ;ASSUME RIGHT HALF TLNE C,200000 ;RIGHT OR LEFT? HRLI T,40002 ;LEFT MOVEM T,(D) JRST GLOBS ;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS MAPB: TRNN B,400000 ;SECOND SEGMENT HRRI B,@BPTR ;NO, RELOCATE THE ADDRESS POPJ P, ; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE GLOBR2: TLO A,400000 ;SYMBOL FLAG MOVE C,T HRLI T,1 ;ASSUME RIGHT HALF FIX TLNE C,200000 ;LEFT OR RIGHT? HRLI T,2 ;LEFT PUSHJ P,DEF2A JRST GLOBS ; HERE FOR SYMBOL TABLE FIX GLOBST: ; MOVE A,CGLOBV ; TLZ A,700000 ;MAKE SURE WE ARE STILL FIXING SAME SYMBOL ; CAME A,GLBFS ; JRST 4,. ;DON'T AGREE JUMPGE D,GLOBS5 ;JUMP IF FIXUP NOT SEEN TLNN B,200000 JRST GLOBS6 ;FIXUP NOT EVEN DEFINED PUSH P,1(D) ;SAVE POINTER TO OLD SYMBOL PUSH P,T MOVE T,CGLOBV PUSHJ P,LKUP JUMPGE D,GLST1 TLNE B,200000 JRST 4,. PUSHJ P,GLOBS3 ;FIND THE GLOBAL VALUE SKIPE B SKIPN (A) JRST 4,. POP P,T EXCH B,(P) ;GET BACK VALUE OF FIXUP SYMBOL TLNE T,200000 ;LEFT OR RIGHT? JRST GLOBS1 ;LEFT HRRE C,1(A) ;RIGHT ADD C,B HRRM C,1(A) TLZN A,FIXRT ;DID WE REALLY WANT TO DO THIS JRST 4,. ;NO JRST GLOBS2 ;YES GLOBS1: HLRE C,1(A) ;LEFT HALF FIX ADD C,B HRLM C,1(A) TLZN A,FIXLT ;DID WE REALLY WANT TO DO THIS JRST 4,. ;NOPE ; HERE TO FINISH UP SYMBOL TABLE FIX GLOBS2: POP P,B MOVEM A,1(B) ;STORE BACK REFERENCE WORD TLNE A,FIXLT+FIXRT ;DO WE HAVE MORE FIXING JRST GLOBS ;NO MOVE T,1(A) ;FIXED VALUE MOVEI TT,100 ;OKAY TO REDEFINE, TT USED AT DEF2 PUSHJ P,DEFSYM JRST GLOBS ;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL GLOBS3: MOVE B,1(D) ;FIRST REFERENCE WORD GLOBS4: SKIPGE A,1(B) JRST GLOBS8 GLOBS9: HRRZ B,(B) JUMPN B,GLOBS4 POPJ P, ;REFERENCE WORD NOT FOUND GLOBS8: SKIPGE (A) JRST GLOBS9 ;DEFERED INTERNAL FOR ANOTHER SYMBOL POPJ P, GLOBS5: PUSHJ P,GLOBS7 JRST GLOBS0 GLOBS6: PUSHJ P,GLOBS7 PUSHJ P,DOWN MOVEM T,(D) CGLOBS: JRST GLOBS GLOBS7: PUSHJ P,PAIR MOVE B,T TLZ T,700000 MOVEM T,1(A) MOVSI T,DEFINT+FIXRT TLNE B,200000 TLC T,FIXRT+FIXLT HRR T,A MOVSI B,400000 MOVEM B,(T) ;MARK AS SQUOOZE MOVE B,CGLOBV MOVEM B,1(T) ;SQUOOZE POPJ P, GLST1: POP P,(P) ;VALUE TO ADD ON TOP OF STACK PUSH P,CGLOBS ;HERE TO FIX UP DIFFERED INTERNAL ;THAT MIGHT BE A LOCAL CALL WITH STACK ; -1(P) VALUE TO ADD ; (P) RETURN ADDRESS ; T SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX) GLST2: PUSH P,A PUSH P,T TLNE T,40000 JRST 4,. ;ITS GLOBAL, THERE'S NO HOPE MOVEI B,0 ;BLOCK NAME MOVE C,T ;SYMBOL TO FIX TLZ C,740000 PUSHJ P,FSYMT2 JRST 4,. ;CROCK MOVE B,1(T) ;VALUE TO FIX HLRZ C,B ;THE LEFT HALF POP P,A TLNN A,200000 ADD B,-2(P) TLNE A,200000 ADD C,-2(P) HRL B,C MOVEM B,1(T) POP P,A POP P,-1(P) POPJ P, ; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21 FIXES: SKIPE LFTFIX JRST FIXESL ;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK PUSHJ P,GETBIT ;CODE BITS PUSHJ P,RRELOC ;FIX UP WORD CAMN T,[-1] ;SKIPS ON RIGHT HALF FIX JRST FIXESL ;LEFT HALF FIX HLRZ B,T ;C(T) = POINTER,,VALUE C(B)=POINTER PUSHJ P,UNTHR JRST FIXES FIXESL: SETOM LFTFIX ;IN CASE RRELOC GETS US OUT OF BLOCK PUSHJ P,GETBIT PUSHJ P,RRELOC SETZM LFTFIX ;OFF TO THE RACES HLRZ B,T PUSHJ P,UNTHL JRST FIXES UNTHL: PUSHJ P,MAPB HLL T,(B) ;CALL IS POINTER IN B HRLM T,(B) ; VALUE IN T HLRZ B,T JUMPN B,UNTHL POPJ P, UNTHF: PUSHJ P,MAPB HRL B,(B) MOVEM T,(B) HLRZS B JUMPN B,UNTHF POPJ P, ;POLISH FIXUPS PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH? JRST COMPOL ;YES (3000+SIXBIT /POV/) COMPOL: (3000+SIXBIT /PTC/) LOAD4A: (3000+SIXBIT /IBF/) ;READ A HALF WORD AT A TIME RDHLF: TLON FF,HSW ;WHICH HALF JRST NORD PUSHJ P,RWORD ;GET A NEW ONE TLZ FF,HSW ;SET TO READ OTEHR HALF MOVEM T,SVHWD ;SAVE IT HLRZS T ;GET LEFT HALF POPJ P, ;AND RETURN NORD: HRRZ T,SVHWD ;GET RIGHT HALF POPJ P, ;AND RETURN RWORD: PUSH P,C PUSHJ P,GETBIT PUSHJ P,RRELOC POP P,C POPJ P, ;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE ; C/ TOKEN TYPE ; T/ VALUE (IGNORED IF OPERATOR) SYM3X2: PUSH P,A PUSHJ P,PAIR ;GET TWO WORDS MOVEM T,1(A) ;VALUE EXCH T,POLPNT ;POINTER TO CHAIN MOVEM T,(A) ;INTO NEW NODE HRLM C,(A) ;TOKEN TYPE INTO LEFT HALF OF FIRST WORD EXCH T,A EXCH T,POLPNT ;RESTORE T, POINTER TO NEW NODE JRST POPAJ ;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED) ;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED SDEF: PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,T MOVE T,C PUSHJ P,LKUP SKIPGE D TLNN B,200000 ;SKIP IF DEFINED AOS -5(P) ;INCREMENT ADDRESS MOVEM D,-4(P) ;SET POINTER IN A POP P,T POP P,D POP P,C POPBAJ: POP P,B POPAJ: POP P,A POPJ P, ;START READING THE POLISH POLFIX: MOVE D,PPDP ;SET UP THE POLISH PUSHDOWN LIST MOVEI B,100 ;IN CASE OF ON OPERATORS MOVEM B,SVSAT SETOM POLSW ;WE ARE DOING POLISH TLO FF,HSW ;FIX TO READ A WORD THE FIRST TIME SETOM GLBCNT ;NUMBER OF GLOBALS IN THIS FIXUP SETZM POLPNT ;NULL POINTER TO POLISH CHAIN PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK RPOL: PUSHJ P,RDHLF ;GET A HALF WORD TRNE T,400000 ;IS IT A STORE OP? JRST STOROP ;YES, DO IT CAIGE T,3 ;0,1,2 ARE OPERANDS JRST OPND CAILE T,14 ;14 IS HIGHEST OPERATOR JRST LOAD4A ;ILL FORMAT PUSH D,T ;SAVE OPERATOR IN STACK MOVE B,DESTB-3(T) ;GET NUMBER OF OPERANDS NEEDED MOVEM B,SVSAT ;ALSO SAVE IT JRST RPOL ;BACK FOR MORE ;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF ;GLOBAL REQUESTS OPND: MOVE A,T ;GET THE OPERAND TYPE HERE PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND MOVE C,T ;GET IT INTO C JUMPE A,HLFOP1 ;0 IS HALF-WORD OPERAND PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF HRL C,T ;GET HALF IN RIGHT PLACE MOVSS C ;WELL ALMOST RIGHT SOJE A,HLFOP1 ;1 IS FULL WORD, 2 IS GLOBAL REQUEST LDB A,[400400,,C] TLNE C,40000 ;CHECK FOR FUNNY LOCAL PUSHJ P,SQZCON ;CONVERT TO STINKING SQUOOZE DPB A,[400400,,C] PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED JRST OPND1 ;YES, WE WIN AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL PUSH P,C ;SAVE GLOBAL REQUESTS FOR LATER MOVEI T,0 ;MARK AS SQUOOZE EXCH C,T PUSHJ P,SYM3X2 ;INTO THE LOADER TABLE HRRZ C,POLPNT ;NEW "VALUE" SKIPA A,[400000];SET UP GLOBAL FLAG HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG HLFOP1: SOJL B,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 ;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT: THE FLAG BITS ARE CLEARED SQZCON: TLZ C,740000 JUMPE C,CPOPJ SQZ1: CAML C,[50*50*50*50*50] POPJ P, IMULI C,50 JRST SQZ1 ; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME OPND1: MOVE C,1(A) ;SYMBOL VALUE JRST HLFOP ;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,T POP D,T ;VALUE OR GLOBAL NAME UNOP: POP D,B ;OPERATOR JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY XCT OPTAB-3(B) ;IF BOTH VALUES JUST XCT MOVE C,T ;GET THE CURRENT VALUE SETSAT: SKIPG B,(D) ;IS THERE A VALUE IN THE STACK MOVE B,-2(D) ;YES, THIS MUST BE THE OPERATOR MOVE B,DESTB-3(B) ;GET NUMBER OF OPERANDS NEEDED MOVEM B,SVSAT ;SAVE IT HERE SKIPG (D) ;WAS THERE AN OPERAND SUBI B,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 SAVE THIS VALUE IF ITS GLOBAL PUSH P,T ;SAVE FOR A WHILE MOVE T,C ;THE VALUE MOVEI C,1 ;MARK AS VALUE PUSHJ P,SYM3X2 HRRZ C,POLPNT ;POINTER TO VALUE POP P,T ;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 MOVEI C,1 ;SEE ABOVE PUSHJ P,SYM3X2 HRRZ T,POLPNT ;POINTER TO VALUE POP P,C GLSET: EXCH C,B ;OPERATOR INTO RIGHT AC SKIPE SVSAT ;SKIP ON UNARY OPERATOR HRL B,T ;SECOND,,FIRST MOVE T,B ;SET UP FOR CALL TO SYM3X2 PUSHJ P,SYM3X2 MOVEI A,400000 ;SET UP AS A GLOBAL VALUE HRRZ C,POLPNT ;POINTER TO "VALUE" JRST SETSAT ;AND SET UP FOR NEXT OPERATOR ;FINALLY WE GET TO STORE THIS MESS STOROP: MOVE B,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR CAIE B,15 ;IS IT JRST LOAD4A ;NO, ILL FORMAT HRRZ B,(D) ;GET THE VALUE TYPE JUMPN B,GLSTR ;AND TREAT GLOBALS SPECIAL MOVE A,T ;THE TYPE OF STORE OPERATOR CAIGE A,-3 PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP, MUST WORK HARDER PUSHJ P,RDHLF ;GET THE ADDRESS MOVE B,T ;SET UP FOR FIXUPS POP D,T ;GET THE VALUE POP D,T ;AFTER IGNORING THE FLAG PUSHJ P,@STRTAB+6(A) ;CALL THE CORRECT FIXUP ROUTINE COMSTR: SETZM POLSW ;ALL DONE WITH POLISH MOVE B,HEADNM CAILE B,477777 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 GLSTR: MOVE A,T CAIGE A,-3 JRST 4,. ;PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP PUSHJ P,RDHLF ;GET THE STORE LOCATION SUB D,[2,,2] ;VALUE AND MARKER ON STACK MEANINGLESS MOVE C,A ;STORE OP PUSHJ P,SYM3X2 ;STORE LOC ALREADY IN T AOS T,GLBCNT ;WE STARTED AT -1 REMEMBER? HRRZ C,HEADNM ;GET HEADER # TLO C,440000 ;MARK FIXUP AS GLOBAL BEASTIE PUSHJ P,SYM3X2 ;LAST OF POLISH FIXUP HRRZ T,POLPNT ;POINTER TO POLISH BODY MOVE A,C ;FIXUP NAME PUSHJ P,ENT GLSTR1: SOSGE GLBCNT ;MUST PUT GLOBAL REQUESTS IN TABLE JRST COMSTR ;AND FINISH POP P,T ;SQUOOZE PUSHJ P,LKUP MOVE A,HEADNM ;SETUP REQUEST WORD TLO A,POLREQ ;MARK AS POLISH REQUEST JUMPGE D,GLSTR2 ;JUMP IF NOT SEEN PUSHJ P,DOWN MOVEM A,(D) JRST GLSTR1 GLSTR2: EXCH A,T ;NOT PREVIOUSLY SEEN ENTER FULL REQUEST TLO A,400000 ;MARK AS NEW TABLE ENTRY PUSHJ P,DEF2A JRST GLSTR1 STRTAB: ALSYM ;-6 FULL SYMBOL TABLE FIXUP LFSYM ;-5 LEFT HALF SYMBOL FIX RHSYM ;-4 RIGHT HALF SYMBOL FIX UNTHF ;-3 FULL WORD FIXUP UNTHL ;-2 LEFT HALF WORD FIXUP UNTHR ;-1 RIGHT HALF WIRD FIXUP CPOPJ ;0 DESTB: 1 1 1 1 1 1 1 1 0 0 100 OPTAB: ADD T,C SUB T,C IMUL T,C IDIV T,C AND T,C IOR T,C LSH T,(C) XOR T,C SETCM T,C MOVN T,C ;HERE TO LOOK UP LOCAL IN SYMBOL TABLE FSYMT: PUSHJ P,FSYMT1 ;BLOCK NAME MOVE B,C ;SAVE SYMBOL PUSHJ P,FSYMT1 ;SYMBOL NAME EXCH B,C ;BLOCK NAME IN B, SYMBOL NAME IN C FSYMT2: PUSH P,A ;SAVE IT MOVE T,DDPTR ;AOBJN POINTER TO LOCALS SLCL: MOVE A,(T) ;SQUOZE TLZN A,740000 ;CLEAR FLAGS FOR COMPARE JRST SLCL3 ;BLOCK NAME CAMN A,C ;IS THIS THE SYMBOL WE SEEK JRST SLCL1 ;YES, WE MUST STILL VERIFY THE BLOCK SLCL4: ADD T,[1,,1] ;NO KEEP LOOKING AOBJN T,SLCL JRST 4,. ;SYMBOL NOT FOUND SLCL1: JUMPE B,POPAJ1 ;SYMBOL IS IN THIS BLOCK PUSH P,T ;THIS POINTER POSSIBLY A WINNER ADD T,[2,,2] ;NEXT SYMBOL JUMPGE T,[JRST 4,.] ;WE HAVE RUN OUT OF TABLE MOVE A,(T) ;SQUOZE TLNE A,740000 ;SKIP ON BLOCK NAME JRST .-4 ; HERE WHEN WE FIND BLOCK NAME CAME A,B ;DOES THE BLOCK NAME MATCH JRST SLCL2 ;NO KEEP LOOKING POP P,T ;WINNING SYMBOL TABLE ENTRY POPAJ1: POP P,A ;RESTORE A AOS (P) ;SKIP THE PUSHJ P,RDHLF THAT FOLLOWS THIS CALL POPJ P, SLCL3: JUMPN B,SLCL4 JRST 4,. ;SYMBOL SHOULD BE IN THIS BLOCK SLCL2: SUB P,[1,,1] ;FLUSH THE LOSING SYMBOL POINTER JRST SLCL FSYMT1: PUSHJ P,RDHLF HRL C,T PUSHJ P,RDHLF HRR C,T JRST SQZCON ;HERE TO SATISFY GLOBAL REQUEST FOR POLISH POLSAT: PUSH P,D ;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST HRRZ T,B ;LOOK UP POLISH TO BE FIXED TLO T,440000 PUSHJ P,LKUP JUMPGE D,[JRST 4,.] ;CANNOT FIND POLISH MOVE T,CGLOB ;SQUOOZE (SET UP AT DFSYM2) MOVE B,1(D) ;COUNT MOVE B,(B) ;STORE OP MOVE B,(B) ;FIRST TOKEN PUSHJ P,FIXPOL MOVE B,1(D) SOSG 1(B) ;UPDATE UNDEFINED GLOBAL COUNT JRST PALSAT ;COUNTED OUT FINISH THIS FIXUP POLRET: MOVE A,CGLOB POP P,D JRST PATCH1 ;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH FIXPOL: HLRZ A,(B) ;TOKEN TYPE JUMPN A,FXP1 ;JUMP IF NOT SQUOZE CAME T,1(B) JRST FXP1 ;SQUOOZE DOES NOT MATCH HRRI A,1 ;MARK AS VALUE MOVE T,T1 ;VALUE HRLM A,(B) ;NEW TOKEN TYPE MOVEM T,1(B) ;NEW VALUE POPJ P, FXP1: HRRZ B,(B) ;POINTER TO NEXT TOKEN JUMPN B,FIXPOL JRST 4,. ;DID NOT FIND SYMBOL ;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED PALSAT: AOS SATED ;NUMBER OF FIXUPS SATISFIED PUSH P,(D) ;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION MOVE A,1(D) ;POINTS TO COUNT MOVE A,(A) ;STORE OP MOVE D,PPDP HLLZ B,(A) ;STORE OP HRRZ T,1(A) ;PLACE TO STORE PUSH D,B ;STORE OP PUSH D,T ;STORE ADDRESS MOVEI T,-1(D) ;POINTER TO STORE OP PUSH D,T MOVE A,(A) ;POINTS TO FIRST TOKEN PSAT1: HLRE B,(A) ;OPERATOR JUMPL B,ENDPOL ;FOUND STORE OP CAIGE B,15 CAIGE B,3 JRST 4,. ;NOT OPERATOR MOVE T,1(A) ;OPERANDS (SECOND,,FIRST) HLRZ C,(T) ;FIRST OPERAND JUMPE C,[JRST 4,.] ;SQUOZE NEVER DEFINED CAIE C,1 ;SKIP IF DEFINED JRST PSDOWN ;GO DOWN A LEVEL IN TREE SKIPN DESTB-3(B) JRST PSAT2 ;IF UNARY OP WE ARE DONE MOVSS T HLRZ C,(T) ;SECOND OPERAND JUMPE C,[JRST 4,.] CAIE C,1 JRST PSDOWN MOVSS T ;HERE TO PERFORM OPERATION PSAT2: MOVE C,1(T) ;VALUE FIRST OPERAND MOVSS T SKIPE DESTB-3(B) MOVE T,1(T) ;GET SECOND OPERAND ONLY IF NECESSARY XCT OPTAB-3(B) ;WOW! MOVEM T,1(A) ;NEW VALUE MOVEI C,1 HRLM C,(A) ;MARK AS VALUE POP D,A ;GO UP A LEVEL IN TREE JRST PSAT1 ;HERE TO GO DOWN LEVEL IN TREE PSDOWN: PUSH D,A ;SAVE THE OLD NODE HRRZ A,T ;NEW NODE JRST PSAT1 ;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T) ENDPOL: POP D,B ;STORE ADDRESS MOVS A,(D) ;STORE OP PUSHJ P,@STRTAB+6(A) POP P,D ;NAME OF THIS FIXUP EXCH P,SATPDP ;SAVE THIS NAME FOR LATER DELETION FROM TABLE PUSH P,D EXCH P,SATPDP JRST POLRET ; HERE TO DO SYMBOL TABLE FIXUPS ; T/ VALUE ; B/ SYMBOL TABLE POINTER RHSYM: HRRM T,1(B) ;RIGHT HALF FIX POPJ P, LFSYM: HRLM T,1(B) ;LEFT HALF FIX POPJ P, ALSYM: MOVEM T,1(B) ;FULL WORD FIX POPJ P, ;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE UNSATE: PUSH P,T2 MOVE A,[-SATPDL,,SATPDB-1] EXCH A,SATPDP ;SET UP PUSH DOWN POINTER MOVE B,SATED ;# FIXUPS TO BE DELETED SETZM SATED CAILE B,SATPDP ;LIST LONG ENOUGH? JRST 4,. ;TIME TO REASSEMBLE UNSAT1: SOJL B,UNSAT3 POP A,T ;FIXUP PUSH P,A PUSH P,B PUSHJ P,LKUP ;LOOK IT UP HRRZM D,T2 UNSAT2: PUSHJ P,PATCH ;REMOVE IT FROM TABLE POP P,B POP P,A JRST UNSAT1 UNSAT3: POP P,T2 ;POINTS TO TABLE ENTRY MOVE T,T1 ;SYMBOL VALUE MOVE A,CGLOB ;SQUOOZE POPJ P, ; HERE TO HANDLE LINKS (BLOCK TYPE 23) LINK: SETOM LINKDB ;LINKS BEING HACKED PUSHJ P,GETBIT ;RELOCATION BITS INTO TT PUSHJ P,RRELOC ;LINK # MOVE A,T JUMPE A,LOAD4A ;ILLEGAL LINK # PUSHJ P,GETBIT PUSHJ P,RRELOC ;STORE ADDRESS HRRZ B,T JUMPL A,LNKEND ;JUMP ON LINK END CAILE A,MNLNKS JRST LOAD4A ;ILLEGAL LINK # HRRZ C,LINKDB(A) ;LINK VALUE PUSH P,B PUSHJ P,MAPB HRRM C,(B) ;VALUE INTO STORE ADDRESS POP P,B HRRM B,LINKDB(A) ;NEW VALUE JRST LINK ;END LINK LNKEND: MOVNS A ;LINK # CAILE A,MNLNKS JRST LOAD4A ;ILLEGAL LINK # HRLM B,LINKDB(A) ;LINK END ADDRESS JRST LINK ;HERE AFTER ALL LOADING TO CLEAN UP LINKS LNKFIN: PUSH P,A PUSH P,B MOVEI A,MNLNKS LNKF1: MOVS B,LINKDB(A) ;VALUE,,STORE ADDRESS TRNN B,-1 ;DON'T STORE FOR ZERO STORE ADDRESS JRST .+3 PUSHJ P,MAPB HLRM B,(B) SOJG A,LNKF1 JRST POPBAJ ;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER HLFKIL: MOVE D,DDPTR ;RESTORE POINTER TO LOCAL TABLE ADD D,[2,,2] ;BUMP IT NXTKIL: MOVE B,D ;PUT POINTER ALSO IN B PUSHJ P,RPB ;GET A WORD TLZ T,740000 ;MAKE SURE NO FLAGS NXTSYK: MOVE A,(B) ;GET A SYMBOL TLZN A,740000 ;IF PROG NAME HIT, TIME TO QUIT JRST NXTKIL CAME T,A ;IS THIS ONE JRST NOKIL ;NO TRY AGAIN TLO A,400000 ;TURN ON HALF KILL BIT IN DDT IORM A,(B) ;RESTORE SYMBOL TO TABLE JRST NXTKIL NOKIL: AOBJN B,.+1 AOBJN B,NXTSYK ;TRY ANOTHER JRST NXTKIL ;TRY ANOTHER ONE PRGN: PUSHJ P,RPB MOVE A,T MOVEM A,PRGNAM TLZE FF,NAME PUSHJ P,SETJNM MOVE T,FACTOR HRL T,ADR TLNE A,40000 PUSHJ P,PRGEND ;REAL PRGM END TLO A,740000 PUSHJ P,ENT PUSHJ P,SYMS MOVE A,(BOT) ; GET CURRENT PRG NAME NODMCG, MOVSI T,1 ; WANT NON-ZERO, BUT POSITIVE LEFT HALF DMCG, MOVE T,1(BOT) ; POINTS TO TOP AND BOTTOM OF PROGRAM TLZ A,740000 ; MARK AS PROGNAME SKIPL SYMSW PUSHJ P,ADDDDT ; TO DDT TABLE SKIPL SYMSW PUSHJ P,SHUFLE ;PUT THE SYMBOLS IN THE RIGHT ORDER HLLZS LKUP3 PUSHJ P,RESETT JRST OMIT PRGEND: HRRZM ADR,FACTOR SETZM LFTFIX POPJ P, ;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE ;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER ;THAT THE TRANSLATOR GAVE THEM TO STINK SHUFLE: MOVE B,DDPTR ADD B,[2,,2] ;IGNORE THIS PROGRAM NAME JUMPGE B,CPOPJ ;NO LOCALS IN DDT'S TABLE SHUF1: MOVE A,(B) ;SQUOOZE TLNN A,740000 JRST SHUF2 ;FOUND A BLOCK NAME SHUF3: ADD B,[1,,1] AOBJN B,SHUF1 SHUF4: HRRZ A,DDPTR ;EXTENT OF THE SYMBOLS IS KNOWN ;A/POINTER TO BOTTOM SYMBOLS ;B/POINTER TO TOP OF SYMBOLS SHUF5: ADDI A,2 ;SYMBOL AT BOTTOM HRRZI B,-2(B) ;SYMBOL AT TOP CAMG B,A POPJ P, ;WE HAVE MET THE ENEMY AND THEY IS US! MOVE C,(A) ;SWAP THESE TWO ENTRIES EXCH C,(B) MOVEM C,(A) MOVE C,1(A) ;VALUE EXCH C,1(B) MOVEM C,1(A) JRST SHUF5 ;HERE WHEN WE FIND A BLOCK NAME SHUF2: MOVE A,1(B) ;VALUE TLNE A,-1 ;PROGRAM NAME? JRST SHUF4 ;YES JRST SHUF3 ;IGNORE BLOCK NAME GTWD: PUSHJ P,RDWRD ;GOBBLE A WORD FROM THE BUFFER JFCL 4,.+1 ADD CKS,T JFCL 4,[AOJA CKS,.+1] RELADR: POPJ P, GETBIT: ILDB TT,BITPTR SKIPL BITPTR POPJ P, EXCH T,BITS SOS BITPTR PUSHJ P,RPB EXCH T,BITS LDB TT,BITPTR POPJ P, ;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.) RDWRD: PUSH P,TT ;SAVE TT MOVE TT,INPTR ;GOBBLE POINTER MOVE T,(TT) ;GOBBLE DATUM AOBJN TT,RDRET ;BUFFER EMPTY? DOREAD: MOVE TT,[-STNBLN,,STNBUF] ;YES, READ A NEW ONE IFN ITS, .IOT TPCHN,TT ;GOBBLE IT IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 2,TT HLRE 3,TT HRLI 2,444400 MOVE 1,IJFN SIN SKIPE 3 CLOSF JFCL MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 ] MOVE TT,[-STNBLN,,STNBUF] ;RE GOOBBLE RDRET: MOVEM TT,INPTR ;SAVE IT POP P,TT POPJ P, ;HERE TO START FIRST READ RDFRST: PUSH P,TT JRST DOREAD ;READ A NEW BUFFER RCKS: (3000+SIXBIT /CKS/) ;LOADER INTERFACE TYPR: 0 PUSH P,C PUSH P,T PUSH P,TT LDB C,[(330300)40] MOVEI TT,LI3 TRON C,4 HRRM TT,TYPR ORCMI C,7 HRLZ TT,40 TYPR2: PUSHJ P,SIXTYO AOJE C,TYPR1 PUSHJ P,SPC HRRZ T,ADR PUSHJ P,OPT AOJE C,TYPR1 PUSHJ P,SPC PUSHJ P,ASPT TYPR1: PUSHJ P,CRL POP P,TT POP P,T POP P,C JRST 2,@TYPR ASPT: MOVE T,A SPT: TLNN T,40000 TRO FF,LOCF SPT2: TLZ T,740000 SPT1: IDIVI T,50 HRLM TT,(P) JUMPE T,SPT3 PUSHJ P,SPT1 SPT3: TRZE FF,LOCF PUSH P,["*-"0+1,,.+1] HLRE T,(P) ADDI T,"0-1 CAILE T,"9 ADDI T,"A-"9-1 CAILE T,"Z SUBI T,"Z-"#+1 CAIN T,"# MOVEI T,". CAIN T,"/ SPC: MOVEI T,40 SPTY: JRST TYO ;0 1-12 13-44 45 46 47 ;NULL 0-9 A-Z . $ % LI4: CAMN A,[(10700)CBUF-1] JRST LI3 LDB T,A ADD A,[(70000)] SKIPGE A SUB A,[(430000)1] IFN ITS, .IOT TYOC,T IFE ITS,[ IFN T-1,[ MOVEM 1,JSYS1 MOVE 1,T ] PBOUT IFN T-1, MOVE 1,JSYS1 ] JRST LI1 TYI: IFN ITS, .IOT TYIC,T IFE ITS,[ IFN T-1,[ MOVEM 1,JSYS1 ] PBIN IFN T-1,[ MOVE T,1 MOVE 1,JSYS1 ] CAIE T,15 CAIN T,12 JRST TYO CAIN T,^R JRST TYO POPJ P, LIS: ANDI FF,GETTY LI3: MOVE A,[(10700)CBUF-1] MOVEM A,CPTR MOVE P,[(,-LPDL)PDL-1] PUSHJ P,CRLS TRZ FF,LOCF LI1: TRZ FF,ALTF LI2: PUSHJ P,TYI CAIN T,33 MOVEI T," CAIN T,7 JRST LI3 CAIN T,177 ;RUBOUT JRST LI4 IDPB T,A CAMN A,[(10700)CBUF+CBUFL] JRST LI4 LIS1: CAIE T," JRST LI1 TRON FF,ALTF JRST LI2 PUSHJ P,CRL CD: MOVEI D,0 CD3: TRZ FF,ARG CD2: ILDB T,CPTR CAIL T,"0 CAILE T,"9 JRST CD1 LSH D,3 ADDI D,-"0(T) VALRET: TRO FF,ARG JRST CD2 CD1: CAIE T,33 CAIN T,DOLL ;CHECK FOR A REAL DOLLAR SIGN JRST LI3 CAIL T,"< CAILE T,"[ JRST CD IDIVI T,4 LDB T,DTAB(TT) MOVEI A,SLIS(T) ;WHERE TO? CAIE A,DUMPY ;IS IT A DUMP TRZ FF,MLAST+SETDEV ;NO, KILL FUNNY FLAGS CAIE A,HASHS ; HASH SET? PUSHJ P,HASHS1 ; MAYBE DO IT PUSHJ P,SLIS(T) JRST CD JRST VALRET SLIS: TDZA C,C MLIS: MOVEI C,2 TRNE FF,GETTY PUSHJ P,FORMF TRNE FF,ARG JUMPL D,LISTER MOVE D,BOT JRST LISTER LISTER: MOVE A,(D) LDB TT,[(410300)A] ORCMI TT,7 ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED AOJN TT,LIST2 ; NOT PROG NAME LIST4: PUSHJ P,ASPT LIST5: PUSHJ P,VALPT JRST LIST6 LIST2: XOR TT,C ; TT/ -1 IF S AND DEF, OR ? AND UNDEF AOJE TT,LIST7 ; PRINT VALUES LIST6: HRRZ D,LIST(D) ; NEXT SYMBOL JUMPN D,LISTER ; MORE, GO ON JRST CRL ; DONE LIST7: PUSHJ P,SPC ; PRINT UNDEFINED SYMBOL PUSHJ P,ASPT ; PRINT SYMBOL PUSH P,D TRNE FF,ARG ; SKIP IF 1? JUMPN C,LIST9 ; JUMP IF ? PUSHJ P,VALPT JRST LIST8 LIST9: MOVE D,1(D) ; POINT TO CHAIN PUSHJ P,VALPT HRRZ D,(D) JUMPN D,.-2 LIST8: POP P,D JRST LIST6 VALPT: PUSHJ P,TAB HRRZ T,1(D) ; SMALL VAL TRNN FF,ARG ; ARG GIVEN? SKIPN C ; OR SS COMM MOVE T,1(D) ; USE FULL WORD JRST OPTCR ; PRINT ; INITIALIZES ALL AREAS OF CORE HASHS: MOVE A,D ; SIZE TO A TRNN FF,ARG ; SKI IF ARG GIVEN HASHS1: MOVEI A,INHASH ; USE INITIAL SKIPE HBOT ; SKIP IF NOT DONE POPJ P, PUSH P,A ; NOW SAVEE IT PUSH P,T PUSH P,B MOVEI B,LOSYM ; CURRENT TOP ADDI A,LOSYM CAIG A, ; MORE CORE NEEDED? JRST HASHS3 ; NO, OK SUBI A,+1777 ASH A,-10. HASHS2: PUSHJ P,CORRUP ; UP THE CORE SOJN A,.-1 ; FOR ALL BLOCKS HASHS3: MOVEM B,HBOT ; STORE AS BOTTOM OF HASH TABLE ADD B,-2(P) ; ADD LENGTH MOVEM B,HTOP ; INTOTOP ADDI B,1 ; BUMP MOVEM B,PARBOT ; SAVE AS BOTTOM OF LOADER TABLE AREA MOVEM B,PARCUR ; ALSO AS CURRENT PLACE MOVE B,LOBLKS ; CURRENT TOP OF CORE PUSHJ P,CORRUP ASH B,10. ; WORDS SUBI B,1 MOVEM B,PARTOP ADDI B,1 ; NOW DDT TABLE MOVEM B,DDBOT ADDI B,1777 MOVEM B,DDPTR MOVEM B,DDTOP ; TOP OF DDT TABLE ADDI B,1 HRRM B,ADRPTR ; INTO CORE SLOTS HRRM B,BPTR HRRM B,DPTR PUSHJ P,CORRUP ; INITIAL CCORE BLOCK PUSHJ P,GETMEM ; SET UP INIT SYMBOLS MOVE C,[EISYM-EISYME,,EISYM] SYMINT: MOVE A,(C) TLZ A,600000 MOVE B,HTOP SUB B,HBOT IDIVI A,(B) ; HASH IT ADD B,HBOT HRRZ A,(B) ; GET CONTENTS HRROM C,(B) HRRM A,BUCK(C) HRLM B,BUCK(C) SKIPE A HRLM C,(A) ADD C,[3,,3] JUMPL C,SYMINT POP P,B POP P,T POP P,A POPJ P, CORRUP: PUSHJ P,GETCOR IFN ITS,[ PUSHJ P,SCE SKIPE KEEP PUSHJ P,WINP ; WE HAVE THE CORE, TELL LOSER ] JFCL AOS NBLKS AOS LOBLKS CCRL: POPJ P,CRL IFN ITS,TMSERR: JRST SCE EQLS: MOVE T,D OPTCR: PUSH P,CCRL OPT: MOVEI TT,10 HRRM TT,OPT1 OPT2: LSHC T,-43 LSH TT,-1 OPT1: DIVI T,10 HRLM TT,(P) JUMPE T,.+2 PUSHJ P,OPT2 HLRZ T,(P) ADDI T,260 TYOM: JRST TYO TAB: PUSHJ P,SPC PUSHJ P,TYO JRST TYO CRLS: TRNE FF,GETTY PUSH P,[CRLS1] CRL: MOVEI T,15 PUSHJ P,TYO CRT: SKIPA T,C.12 FORMF1: MOVEI T,"C TYO: IFN ITS, .IOT TYOC,T IFE ITS,[ IFN T-1,[ MOVEM 1,JSYS1 MOVE 1,T ] PBOUT IFN T-1, MOVE 1,JSYS1 C.12: POPJ P,12 CRLS1: MOVEI T,"* JRST TYO FORMF: POPJ P,12 TDDT: SKIPE LINKDB ;TEST FOR LINK HACKAGE PUSHJ P,LNKFIN ;CLEAN UP LINKS PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE. HRRZ D,BOT TRO FF,GLOSYM SYMS: JUMPE D,SYMS5 ; DONE, QUIT MOVE A,(D) ; GET SYMBOL TLNN A,200000 ; SKIP IF DEFINED JRST SYMS6 TLNE A,40000 ; SKIP IF LOCAL TRNE FF,GLOSYM ; SKIP IF GLOBALS NOT ACCEPTABLE TLNE A,100000 ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME JRST SYMS6 ; LOSER, OMIT TRNN FF,GLOSYM ; SKIP IF GLOBAL SKIPL SYMSW ; SKIP IF NO LOCALS JRST SYMS3 ; WINNER!!!, MOVE IT OUT SYMS8: HRRZ A,LIST(D) ; POINT TO NEXT PUSH P,A ; AND SAVE MOVEM D,T2 ; SAVE FOR PATCH PUSHJ P,PATCH ; FLUSH FROM TABLE POP P,D ; POINT TO NEXT JRST SYMS SYMS6: HRRZ D,LIST(D) ; POINT TO NEXT SYMBOL JRST SYMS ; AND CONTINUE SYMS3: TRZ FF,NOTNUM ;ASSUME ALL NUMERIC TLZ A,740000 MOVE T,A ;SEE IF IT IS A FUNNY SYMBOL IDIVI T,50 ;GET LAST CHAR IN TT JUMPE TT,OKSYM DIVSYM: CAIG TT,12 ;IS THE SYMBOL > 9 CAIGE TT,1 ;AND LESS THAN OR EQUAL TO 0 TRO FF,NOTNUM ;NO, SAY NOT A NUMBER IDIVI T,50 ;CHECK NEXT JUMPE TT,SYMS8 ;NULL IN THE MIDDLE LOSES JUMPN T,DIVSYM ;DIVIDE UNTIL T IS 0 CAIN TT,21 ;IS THIS A "G" TRNE FF,NOTNUM ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT JRST OKSYM ;WIN JRST SYMS8 ;LOSE OKSYM: MOVE T,1(D) HRRZ C,LIST(D) ; POINT TO NEXT PUSH P,C MOVEM D,T2 PUSHJ P,PATCH ; FLUSH IT POP P,D TLO A,40000 TRNN FF,GLOSYM TLC A,140000 ;DDT LOCAL TLNN A,37777 ;IF SQUOZE "NAME" < 1000000, PUSHJ P,ADDDD2 ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX) TLNE A,37777 PUSHJ P,ADDDDT JRST SYMS SYMS5: POPJ P, GO: TRNE FF,ARG MOVEM D,SA TRO FF,GOF JRST DDT EXAM: CAMLE D,MEMTOP JRST TRYHI ; COULD BE IN HIGH SEG MOVE T,@DPTR JRST OPTCR TRYHI: TRNE D,400000 ; SKIP IF NOT HIGH CAMLE D,HIGTOP ; SKIP IF OK (3000+SIXBIT /NEM/) MOVE T,(D) ; GET CONTENTS JRST OPTCR C.CD2: POPJ P,CD2 GETCOM: MOVE A,[10700,,CBUF-1] MOVEM A,CPTR MOVE P,[(,-LPDL)PDL-1] PUSH P,C.CD2 MOVEM P,SAVPDL IFN ITS,[ MOVEI T,0 ;REOPEN CHANNEL IN ASCII MODE HLLM T,DEV .OPEN TPCHN,DEV ;RE OPEN JRST FNF2 ;LOSE ] IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVSI 1,100001 HRROI 2,FILSTR GTJFN JRST .+3 MOVE 2,[070000,,200000] OPENF MOVEI 1,0 MOVEM 1,IJFN MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 SKIPN IJFN JRST FNF ] GTCM1: IFN ITS, .IOT TPCHN,T IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 1,IJFN MOVE 2,[070700,,T] MOVNI 3,1 SIN SKIPGE 3 MOVNI T,1 MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 ] JUMPL T,FIXOPN ;JUMP IF EOF CAIN T,3 ;CHECK FOR EOF JRST FIXOPN ;IF SO QUIT CAIL T,"a CAILE T,"z CAIA SUBI T,40 IDPB T,A ;DEPOSIT CHARACTER CAME A,[10700,,CBUF+CBUFL] JRST GTCM1 TPOK: SKIPA T,BELL ERR: MOVE T,"? IFN ITS, .IOT TYOC,T IFE ITS,[ MOVEM 1,JSYS1 MOVE 1,T PBOUT MOVE 1,JSYS1 ] PUSHJ P,FIXOPN ;FIX UP OPEN CODE JRST LI3 ;HERE TO RESET OPEN FIXOPN: MOVEI T,6 HRLM T,DEV POPJ P, FNF2: PUSHJ P,FIXOPN JRST FNF PAPER: MOVEI A,(SIXBIT /PTR/) HRRM A,DEV POPJ P, ;REAL OPEN WILL OCCUR LATER UTAP: TRZN FF,ARG JRST OPNTP TRO FF,SETDEV ;SETTING DEVICE MOVE A,DEVTBL(D) HRRM A,DEV OPNTP: TRO FF,MLAST ;SET M LAST COMMAND PUSHJ P,FRD IFN ITS, .SUSET [.SSNAM,,SNAME] MOVEM B,NM1 MOVEM C,NM2 POPJ P, ;REAL OPEN WILL OCCUR LATER OPNPTR: IFN ITS,[ .OPEN TPCHN,DEV JRST FNF JRST RDFRST ;STAART UP THE READ ING ] IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVSI 1,100001 HRROI 2,FILSTR GTJFN JRST .+3 MOVE 2,[440000,,200000] OPENF MOVEI 1,0 MOVEM 1,IJFN MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 SKIPN IJFN JRST FNF JRST RDFRST ] NTS: (3000+SIXBIT /NTS/) DEV: 6,,(SIXBIT /DSK/) NM1: SIXBIT /BIN/ NM2: SIXBIT /BIN/ 0 SNAME: 0 ;SYSTEM NAME JSYS1: 0 JSYS2: 0 JSYS3: 0 IJFN: 0 OUTJFN: 0 SIXTYO: JUMPE TT,CPOPJ MOVEI T,0 LSHC T,6 ADDI T,40 PUSHJ P,TYO JRST SIXTYO JOB: PUSHJ P,FRD MOVEM B,JOBNAM TRO FF,JBN POPJ P, JOBNAM: 0 DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8] (SIXBIT /DEV/) TERMIN FNF: PUSHJ P,TYPFIL REPEAT 2,PUSHJ P,SPC IFN ITS,[ .OPEN ERCHN,ERRBL ;OPEN ERROR DEVICE JRST .-1 ;DON'T TAKE NO FOR AN ANSWER ERLP: .IOT ERCHN,A ;READ A CHAR CAIE A,14 ;IF FORM FEED CAIN A,3 ;OR ^C JRST ERDON ;STOP .IOT TYOC,A ;PRINT JRST ERLP ERDON: .CLOSE ERCHN, ] JRST LI3 ERRBL: (SIXBIT /ERR/) ;ERROR DEVICE 2 TPCHN TYPFIL: IFN ITS,[ MOVSI A,-4 HRLZ TT,DEV JRST .+3 TYPF2: SKIPN TT,DEV(A) AOJA A,.-1 PUSHJ P,SIXTYO MOVE T,TYPFTB(A) PUSHJ P,TYO AOBJN A,TYPF2 POPJ P, TYPFTB: ": 40 40 0 "; ] IFE ITS,[ MOVE A,[440700,,FILSTR] ILDB T,A JUMPE T,.+3 PUSHJ P,TYO JRST .-3 POPJ P, ] ] LOADN: SKIPA C,SYMFLG LOADG: MOVEI C,DDSYMS PUSHJ P,OPNPTR ;DO THE REAL OPEN (AND FIRST READ) MOVEM C,SYMSW RESTAR: MOVEM P,SAVPDL CLEARB CKS,TC CLEARB RH,AWORD PUSH P,CJMP1 RESETT: MOVEI A,FACTOR ;LEAVE GLOBAL LOCATION MODE HRRM A,REL TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND SFACT: MOVEM D,FACTOR CJMP1: POPJ P,JMP1 KILL: POPJ P, COMVAL: SKIPA COMLOC SADR: HRRZ D,SA POPJ1: AOSA (P) COMSET: MOVEM D,COMLOC BELL: POPJ P,7 LBRAK: MOVEM D,T1 TRZ FF,LOSE PUSHJ P,ISYM MOVE T,T1 TRO FF,GPARAM TRZE FF,ARG JRST DFSYM2 TLNN B,200000 (3000+SIXBIT /UND/) MOVE D,1(D) TRZN FF,LOSE JRST POPJ1 (2000+SIXBIT /UND/) SOFSET: HRRM D,LKUP3 CPOPJ: POPJ P, BEG: MOVE D,FACTOR JRST POPJ1 DDT: SKIPN JOBNAM JRST NJN PUSHJ P,TDDT MOVE A,JOBNAM HRR B,BPTR ADDI B,30 HRRM B,YPTR HRLI B,440700 MOVEI D,^W IDPB D,B MOVE C,[(000600)A-1] MOVEI T,6 DDT2: ILDB D,C JUMPE D,DDT1 ADDI D,40 IDPB D,B SOJG T,DDT2 DMCG,[ DDT1: MOVEI C,[CONC69 ASCIZ \J,\SA,[/9B!Q ],\DDPTR,[/Q:VP \]] HRLI C,440700 DDT6: ILDB T,C IDPB T,B JUMPN T,DDT6 ;END OF STRING MARKED WITH ZERO BYTE MOVE T,SA ;GET STARTING ADDRESS TLNN T,777000 ;IF INSTRUCTION PART ZERO, TLO T,(JRST) ;THEN TURN INTO JRST MOVEM T,SA ;USE AS STARTING ADDRESS TRNE FF,GOF ;IF G COMMAND, MOVEM T,EXIT ;THEN USE AS LOADER EXIT MOVE B,LOBLKS ;GET CURRENT CORE ALLOCATION+1 SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION HRRM B,PALLOC ;SAVE IN EXIT ROUTINE LSH B,10. ;SHIFT TO MEMORY LOCATION SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND) HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17) ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER YPTR: IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING IFE ITS, HALTF ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G) BLT B,LEXEND ;BLT IN EXIT ROUTINE BLT 17,17 ;BLT IN PROGRAM AC'S EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER IFN ITS,[ .CLOSE TYOC, .CLOSE TYIC, .CLOSE TPCHN, ] IFE ITS,[ MOVEM 1,JSYS1 MOVE 1,IJFN CLOSF JFCL MOVE 1,JSYS1 ] JRST LEXIT ;EXIT ROUTINE FROM LOADER ;BLT'ED INTO 30 - 30+N EXBLTP: .+1,,LEXIT ;BLT POINTER OFST==30-. ;LEXIT=30 LEXIT=.+OFST PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM MOVE 17,SV17 ;GIVE USER HIS LOCATION 17 PALLOC: IFN ITS, .CORE ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM IFE ITS, SKIPA PSV17: SV17=.+OFST 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO EXIT: IFN ITS, .VALUE LEXEND IFE ITS, HALTF LEXEND=.+OFST 0 ;END OF EXIT ROUTINE ];DMCG NODMCG,[ DDT1: MOVE T,SA ;GET STARTING ADDRESS TLNN T,777000 ;IF INSTRUCTION PART ZERO, TLO T,(JRST) ;THEN TURN INTO JRST MOVEM T,SA ;USE AS STARTING ADDRESS TRNE FF,GOF ;IF G COMMAND, MOVEM T,EXIT ;THEN USE AS LOADER EXIT MOVEI T,DDT4 ;MAKE OPT GO TO DDT4 HRRM T,TYOM ;INSTEAD OF TYO MOVEI C,[ASCIZ \J9B/#0 #1P\] ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST HRLI C,440700 PUSHJ P,DDTSG ;GENERATE REST OF STRING MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION MOVE C,B ;SAVE OUR SIZE LSH B,10. ;SHIFT TO MEMORY LOCATION SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND) SUB C,LOWSIZ MOVNM C,PALL0 ;NUMBER OF BLOCKS TO FLUSH MOVE C,CWORD0 TRZ C,400000 ;DELETE PAGE HRRZM C,PALL1 HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17) ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER YPTR: IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING IFE ITS, HALTF ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G) BLT B,LEXEND ;BLT IN EXIT ROUTINE BLT 17,17 ;BLT IN PROGRAM AC'S EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER IFN ITS,[ .CLOSE TYOC, .CLOSE TYIC, .CLOSE TPCHN, ] IFE ITS,[ MOVEM 1,JSYS1 MOVE 1,IJFN CLOSF JFCL MOVE 1,JSYS1 ] JRST LEXIT DDTST: MOVE T,SA ;#0 MOVE T,DDPTR ;#1 DDTSN: ILDB T,C ;GET DIGIT AFTER NUMBER SIGN XCT DDTST-"0(T) ;GET VALUE IN T PUSHJ P,OPT ;"TYPE OUT" INTO VALRET STRING IN OCTAL DDTSG: ILDB T,C ;GET CHAR FROM INPUT STRING CAIN T,"# ;NUMBER SIGN? JRST DDTSN ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT IDPB T,B ;DEPOSIT IN OUTPUT STRING JUMPN T,DDTSG ;LOOP ON NOT DONE YET POPJ P, ;EXIT ROUTINE FROM LOADER ;BLT'ED INTO 20 - 20+N EXBLTP: .+1,,LEXIT ;BLT POINTER OFST==20-. ;OFFSET, THIS CODE DESTINED FOR LEXIT LEXIT=.+OFST ;LEXIT=20 PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM MOVE 17,PALL1+OFST IFN ITS, .CBLK 17, IFE ITS, SKIPA PSV17: 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO SUBI 17,1000 SOSLE PALL0+OFST JRST .+OFST-4 MOVE 17,PSV17+OFST ;GIVE USER HIS LOCATION 17 EXIT: IFN ITS, .VALUE .+OFST+1 IFE ITS, HALTF PALL0: 0 PALL1: 0 LEXEND=.+OFST-1 ;END OF EXIT ROUTINE SV17=PSV17+OFST ;LOCATION TO SAVE 17 ];NODMCG NJN: TRZ FF,GOF (3000+SIXBIT /NJN/) ZERO: MOVEI A,(NBLKS) MOVEM A,LOBLKS PUSHJ P,GETCOR IFN ITS,[ PUSHJ P,SCE ;GO TO ERROR SKIPE KEEP PUSHJ P,WINP ] JFCL SETOM MEMTOP MOVEI A,1(NBLKS) MOVEM A,LOBLKS GETMEM: PUSHJ P,GETCOR IFN ITS,[ PUSHJ P,SCE SKIPE KEEP PUSHJ P,WINP ] JFCL ADDI MEMTOP,2000 AOS LOBLKS POPJ P, GETCOR: DMCG,[ IFN ITS,[ .CORE @LOBLKS POPJ P, ] JRST POPJ1 ];DMCG NODMCG,[ PUSH P,A PUSH P,B MOVE B,LOBLKS SUB B,LOWSIZ ;NUMBER OF BLOCKS WE WANT JUMPE B,GETC2 SKIPG B IFN ITS, .VALUE IFE ITS, HALTF MOVE A,CWORD0 GETC1: ADDI A,1000 IFN ITS,[ .CBLK A, JRST POPBAJ ] MOVEM A,CWORD0 AOS LOWSIZ SOJG B,GETC1 GETC2: AOS -2(P) ;SKIP RETURN JRST POPBAJ ];NODMCG IFN ITS,[ SCE: SOS (P) ;MAKE POPJ BE A "JRST .-1" SOS (P) PUSHJ P,COREQ ;ASK LOSER POPJ P, ;HE SAID YES (2000+SIXBIT /SCE/) COREQ: PUSH P,A ;SAVE SOME ACS SKIPE KEEP ; SKIP IF NOT LOOPING JRST COREQ3 COREQ0: MOVEI A,[ASCIZ /NO CORE: TYPE C TO TRY INDEFINITELY TYPE Y TO TRY ONCE TYPE N TO LOSE/] PUSHJ P,LINOUT .IOT TYIC,A ;READ A CHARACTER .RESET TYIC, CAIN A,"N ; WANTS LOSSAGE? JRST COREQ2 CAIN A,"Y JRST POPAJ CAIE A,"C JRST COREQ0 AOSA KEEP COREQ2: AOS -1(P) JRST POPAJ COREQ3: MOVEI A,1 .SLEEP A, JRST POPAJ ] ;ROUTINE TO PRINT A LINE LINOUT: PUSH P,C PUSH P,B MOVSI B,440700+A ;BYTE POINTER TO INDEX OF A LINO1: ILDB C,B ;GET CHAR JUMPE C,LINO2 ;ZERO, END IFN ITS, .IOT TYOC,C IFE ITS,[ EXCH C,1 PBOUT EXCH C,1 ] JRST LINO1 LINO2: MOVEI A,15 ;PUT OUT CR IFN ITS, .IOT TYOC,A IFE ITS,[ EXCH A,1 PBOUT EXCH A,1 ] POP P,B POP P,C POPJ P, WINP: PUSH P,A MOVEI A,[ASCIZ /WIN!!!/] PUSHJ P,LINOUT SETZM KEEP JRST POPAJ DEFINE FOUR A,B,C,D (<_9>+B-SLIS)<_9>+D-SLIS TERMIN DTAB: (331100+T)DTB-74/4 (221100+T)DTB-74/4 (111100+T)DTB-74/4 (1100+T)DTB-74/4 DTB: FOUR LBRAK,EQLS,ERR,MLIS, ;< = > ? FOUR GETCOM,ERR,BEG,COMSET, ;@ A B C FOUR DDT,NTS,NTS,GO, ;D E F G FOUR HASHS,ERR,JOB,KILL, ;H I J K FOUR LOADG,UTAP,LOADN,SOFSET, ;L M N O FOUR PAPER,COMVAL,SFACT,SLIS, ;P Q R S FOUR CPOPJ,ERR,ERR,ERR, ;T U V W FOUR SADR,DUMPY,ZERO,EXAM, ;X Y Z [ IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW /] INFORM [DISPATCH ROOM]\<1000-DDT+SLIS> ;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES ;STINK TO KILL ITSELF. DUMPY: IFN ITS,[ TRZN FF,MLAST ;WAS "M" THE LAST COMMAND? PUSHJ P,FIXFIL ;FIX UP THE FILE NAME MOVEI A,(SIXBIT /DSK/) TRZN FF,SETDEV ;WAS DEVICE SET? HRRM A,DEV ;NO, SET IT .OPEN TPCHN,DEV ;SEE IF IT EXISTS JRST OPNOK ;NO, WIN .CLOSE TPCHN, ;CLOSE IT .FDELE DEV ;DELETE IT JFCL ;IGNORE LOSSAGE OPNOK: MOVSI A,7 ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK HLLM A,DEV .OPEN TPCHN,DEV ;OPEN THE CHANNEL JRST FNF ] IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVSI 1,1 HRROI 2,FILSTR GTJFN JRST .+3 MOVE 2,[440000,,300000] OPENF MOVEI 1,0 MOVEM 1,OUTJFN MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 SKIPN OUTJFN JRST FNF ] PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE IFN ITS,[ MOVE B,[JRST 1] ;START FILE WITH "JRST 1" PUSHJ P,OUTWRD ;PUT IT OUT ] MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION LSH B,10. ;SHIFT TO MEMORY LOCATION SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM MOVEI ADR,20 ; GET TOP OF LOW SEG IN USER'S LOC 20 HRRZM B,@ADRPTR MOVN ADR,MEMTOP ;GET - HRLZS ADR ;AOBJN POINTER DMP2: SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD AOBJN ADR,.-1 ;UNTIL THE WORLD IS EXHAUSTED JUMPGE ADR,CHKHI ;DROPPED THROUGH, JUMP IF CORE EMPTY MOVEI C,(ADR) ;SAVE POINTER TO NON ZERO WORD MOVEI A,(C) ;AND ANOTHER COPY DMP1: SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK AOBJN ADR,.-1 ;UNTIL WORLD EXHAUSTED JUMPGE ADR,DMPLST ;IF WORLD EMPTY, QUIT AOBJP ADR,DMPLST ;CHECK NEXT WORD SKIPE B,@ADRPTR ;FOR BEING ZERO JRST DMP1 ;ONE LONE ZERO, DON'T END BLOCK DMPLST: MOVEI D,(ADR) ;POINT TO END SUB C,D ;C/ - HRL A,C ;A/ AOBJN TO BLOCK MOVE B,A ;COPY TO B FOR OUTWRD IFE ITS, SUBI B,1 PUSHJ P,OUTWRD ;PUT IT OUT IFE ITS, ADDI B,1 HRRI B,@BPTR ;NOW POINT TO REAL CORE IFN ITS, .IOT TPCHN,B ;BARF IT OUT IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 2,B HLRE 3,B HRLI 2,444400 MOVE 1,OUTJFN SOUT MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 ] IFN ITS,[ MOVE B,A ;GET POINTER BACK IN B MOVE C,B ;FIRST WORD IN CHECK SUM HRRI B,@BPTR ;POINT TO REAL CORE ROT C,1 ;ROTATE CKS ADD C,(B) ;ADD AOBJN B,.-2 ;AND DO FOR ENTIRE BLOCK MOVE B,C ;CKS TO B PUSHJ P,OUTWRD ;AND PUT IT OUT ] JUMPL ADR,DMP2 ;IF MORE, GO DO IT CHKHI: SKIPN MEMTOP,HIGTOP ; ANY HIGH SEG JRST DMPSYMS ; NO, GO ON TO SYMS SETZM HIGTOP ; RESET IT HLLZS ADRPTR ; FIX UP POINTERS HLLZS BPTR LDB ADR,[2100,,MEMTOP] ; GET NO. OF WORDS MOVNS ADR ; NEGATE MOVSI ADR,(ADR) HRRI ADR,400000 ; START OF HIGH SEG JRST DMP2 ;HERE TO DO START ADDRESS DMPSYMS: HRRZ B,SA ;GET START ADR IFN ITS, HRLI B,(JUMPA) ;USE "JUMPA" TO MAKE DDT HAPPY IFE ITS, HRLI B,1 PUSHJ P,OUTWRD ;HERE TO DO SYMBOLS IFE ITS,[ ; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 1,OUTJFN CLOSF JFCL MOVE 1,[440700,,FILSTR] FNDNMX: ILDB 2,1 CAIE 2,"< JRST FNDNM2 ILDB 2,1 CAIE 2,"> JRST .-2 ILDB 2,1 FNDNM2: JUMPE 2,.+3 CAIE 2,". JRST FNDNMX MOVEI 2,". DPB 2,1 MOVE 3,[440700,,[ASCIZ /SYMBOLS/]] ILDB 2,3 IDPB 2,1 JUMPN 2,.-2 MOVSI 1,1 HRROI 2,FILSTR GTJFN JRST .+3 MOVE 2,[440000,,300000] OPENF MOVEI 1,0 MOVEM 1,OUTJFN MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 SKIPN OUTJFN JRST FNF ] IFN ITS,[ HLLZ B,DDPTR ;GET NUMBER PUSHJ P,OUTWRD ;PUT IT OUT MOVE C,DDPTR ;FOR CKS .IOT TPCHN,DDPTR ;OUT GOES THE WHOLE TABLE ] IFE ITS,[ MOVE A,DDPTR MOVEI B,0 ; WILL COUNT SYMS TWNTY1: MOVE T,(A) TLZ T,740000 ; KILL SQUOZE BITS MOVE D,T IDIVI T,50 ; CONVERT TO 10X/20 SQUOZE JUMPN TT,.+3 MOVE D,T JRST .-3 HLLZ T,(A) TLZ T,37777 ; JUST GET SQUOZE BITS JUMPN T,TWNTY2 ; JUMP UNLESS PROG NAME ADDI B,1 TWNTY2: ADDI B,1 IOR D,T MOVEM D,(A) ADD A,[2,,2] JUMPL A,TWNTY1 ; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING ASH B,1 MOVNS B MOVSS B PUSHJ P,OUTWRD ; PUT OUT COUNT MOVE A,DDPTR TWNTY3: MOVE D,A MOVEI C,0 TWNTY5: MOVE T,(A) ; SEARCH FOR A PROG NAME (OR END) TLNN T,740000 JRST TWNTY4 ADD A,[2,,2] ADDI C,2 JUMPL A,TWNTY5 TWNTY6: JUMPE C,TWNTY7 MOVNS C HRL D,C MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 1,OUTJFN MOVE 2,D HRLI 2,444400 HLRE 3,D SOUT MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 TWNTY7: ADD A,[2,,2] JUMPL A,TWNTY3 ] IFN ITS,[ ROT B,1 ADD B,(C) ;ADD IT AOBJN C,.-2 PUSHJ P,OUTWRD ;PUT OUT THE CKS MOVSI B,(JRST) ;FINISH WITH "JRST 0" PUSHJ P,OUTWRD MOVNI B,1 ;FINISH WITH NEGATIVE PUSHJ P,OUTWRD .CLOSE TPCHN, ;CLOSE THE FILE ] IFE ITS,[ EXCH 1,OUTJFN CLOSF JFCL EXCH 1,OUTJFN ] IFN ITS, .VALUE [ASCIZ /:KILL /] ;KILL IFE ITS,[ HALTF TWNTY4: MOVE B,T PUSHJ P,OUTWRD MOVEI B,0 PUSHJ P,OUTWRD MOVEI B,0 PUSHJ P,OUTWRD MOVEI B,0 PUSHJ P,OUTWRD JRST TWNTY6 ;SUBROUTINE TO PUT OUT ONE WORD OUTWRD: HRROI T,B ;AOBJN POINTER TO B IFN ITS, .IOT TPCHN,T IFE ITS,[ MOVEM 1,JSYS1 MOVEM 2,JSYS2 MOVEM 3,JSYS3 MOVE 2,B MOVE 1,OUTJFN BOUT MOVE 1,JSYS1 MOVE 2,JSYS2 MOVE 3,JSYS3 ] POPJ P, ;HERE TO BUILD DEFAULT OUTPUT FILE NAME FIXFIL: MOVE A,[SIXBIT /_STNK_/] ;DEFAULT NAME 1 MOVEM A,NM1 MOVE A,[SIXBIT /DUMP/] ;AND NAME 2 MOVEM A,NM2 POPJ P, ; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK. PAIR: PUSH P,B SKIPN A,PARLST ; ANY ON FREE LIST? JRST PAIR1 ; NO, TRY FREE AREA HRRZ B,(A) ; YES, CDR THE LIST MOVEM B,PARLST PAIR3A: SETZM (A) ; CLEAR 1ST WORD PAIR3: POP P,B POPJ P, PAIR1: MOVE A,PARCUR ; TRY FREE AREA ADDI A,2 ; WORDS NEEDED CAML A,PARTOP ; SKIP IF ROOM EXISTS JRST PAIR2 PAIR4: EXCH A,PARCUR ; RETURN POINTER AND RESET PARCUR JRST PAIR3A QUAD: PUSH P,B SKIPN A,QUADLS ; SKIP IF ANY THERE JRST QUAD1 HRRZ B,(A) ; CDR THE QUAD LIST MOVEM B,QUADLS JRST PAIR3A QUAD1: MOVE A,PARCUR ; GET TOP ADDI A,4 CAML A,PARTOP ; OVERFLOW? JRST QUAD2 ; YES, GET MORE JRST PAIR4 ; NO, WIN PAIR2: PUSHJ P,MORPAR ; GET MORE CORE JRST PAIR1 QUAD2: PUSHJ P,MORPAR JRST QUAD1 PARRET: PUSH P,B HRRZ B,PARLST ; SPLICE IT INTO FREE LIST HRRM B,(A) MOVEM A,PARLST JRST PAIR3 ; RETURN POPPING B QUADRT: PUSH P,B HRRZ B,QUADLS HRRM B,(A) MOVEM A,QUADLS JRST PAIR3 ; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF MORPAR: PUSHJ P,GETCOR ; TRY AND GET A BLOCK IFN ITS,[ PUSHJ P,TMSERR ; COMPLAIN SKIPE KEEP PUSHJ P,WINP ] JFCL AOS NBLKS PUSHJ P,MOVCOD ; TRY AND GET CODE OUT OF THE WAY PUSHJ P,MOVDD ; ALSO GET DDT SYMBOLS OUT MOVEI A,2000 ; INCREASE PARTOP ADDM A,PARTOP AOS LOBLKS POPJ P, ; HERE TO MOVE CODE MOVCOD: PUSH P,C PUSH P,B HRRZ A,ADRPTR ; POINT TO CURRENT START ADDI A,2000 ; NEW START MOVE C,A HRRM A,ADRPTR ; FIX POINTERS HRRM A,BPTR HRRM A,DPTR MOVE B,LOBLKS ; GEV(CURRENT TOP (IN BLOCKS) ASH B,10. ; CONVERT TO WORDS MOVCO3: MOVEI A,-2000(B) ; A/ POINT TO LAST DESTINATION CAIG B,(C) ; SKIP IF NOT DONE JRST MOVCO2 HRLI A,-2000(A) ; B/ FIRST SOURCE,,FIRST DESTINATION BLT A,-1(B) SUBI B,2000 JRST MOVCO3 MOVCO2: POP P,B POP P,C POPJ P, ; HERE TO MOVE DDT SYMBOLS MOVDD: PUSH P,C PUSH P,C HRRZ A,DDPTR ; GET CURRENT POINTER ADDI A,2000 HRRM A,DDPTR HRRZ A,DDTOP ; TOP OF DDT TABLE ADDI A,2000 MOVEM A,DDTOP MOVEI B,1(A) ; SET UP FOR BLT LOOP HRRZ C,DDBOT ADDI C,2000 ; BUMP MOVEM C,DDBOT JRST MOVCO3 ; FALL INTO BLT LOOP ;HAVE NAME W/ FLAGS IN A, VALUE IN T, ;PUT SYM IN DDT SYMBOL TABLE. ADDDDT: PUSH P,A PUSH P,B ADDDD1: MOVE A,DDPTR SUB A,[2,,2] HRRZ B,DDBOT CAILE B,(A) ; SKIP IF OK JRST GROWDD ; MUST GROW DDT TABLE MOVEM A,DDPTR MOVEM T,1(A) ; CLOBBER AWAY POP P,B POP P,(A) MOVE A,(A) ; RESTORE A POPJ P, GROWDD: PUSHJ P,GETCOR IFN ITS,[ PUSHJ P,TMSERR SKIPE KEEP PUSHJ P,WINP ] JFCL AOS NBLKS PUSHJ P,MOVCOD ; MOVE THE CODE PUSHJ P,MOVDD MOVNI A,2000 ADDM A,DDBOT AOS LOBLKS JRST ADDDD1 ADDDD2: PUSH P,A ;CALL HERE FROM SYMS OR TDDT. PUSH P,B SKIPA B,DDPTR ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME". ADDDD3: ADD B,[2,,2] JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM. HLL A,(B) CAME A,(B) JRST ADDDD3 ;NOT THIS ONE. MOVE A,1(B) ;SYM'S REAL NAME IS IN 2ND WD OF STE, MOVEM A,(B) MOVEM T,1(B) ;PUT IN THE VALUE. JRST POPBAJ ;TDDT EXITS THROUGH HERE. TDDTEX: PUSH P,A ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME. PUSH P,B SKIPA A,DDPTR TDDTE1: ADD A,[2,,2] JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM. MOVE B,(A) TLNE B,740000 JRST TDDTE1 ;THIS NOT PROGRAM NAME. CAMN A,DDPTR JRST POPBAJ ;IF IT'S ALREADY 1ST, NO PROBLEM. MOVE B,DDPTR REPEAT 2,[ EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE. EXCH T,.RPCNT(B) EXCH T,.RPCNT(A)] JRST POPBAJ ISYM: MOVSI C,(50*50*50*50*50*50) MOVSI T,40000 ;GLOBAL BIT ISYM0: ILDB A,CPTR CAIN A,"* TLZ T,40000 ;LOCAL CAIN A,"* JRST ISYM0 CAIN A,"> JRST LKUP SUBI A,"0-1 CAIL A,"A-"0+1 SUBI A,"A-"0+1-13 JUMPGE A,ISYM2 ADDI A,61 CAIN A,60 MOVEI A,45 ;. ISYM2: IDIVI C,50 IMUL A,C ADDM A,T JRST ISYM0 IFN ITS,[ FRD2: CAME B,[SIXBIT /@/] JRST DEVNAM SKIPA B,C FRD: MOVSI B,(SIXBIT /@/) MOVSI C,(SIXBIT /@/) MOVE A,[(600)C-1] FRD1: ILDB T,CPTR CAIE T,33 CAIN T,DOLL JRST CHBIN ;CHECK IF SHOULD CHANGE NAME 2 TO BIN TRC T,40 JUMPE T,FRD2 CAIN T,32 JRST DEVSET CAIN T,33 JRST USRSET CAIN T,77 MOVEI T,0 CAME A,[(600)C] IDPB T,A JRST FRD1 USRSET: MOVEM C,SNAME JRST FRD+1 DEVNAM: PUSH P,CDEVN1 MOVEM C,NM2 JRST FRD+1 DEVNM1: TRO FF,SETDEV ;SAY DEVICE SET HLRM C,DEV MOVE C,NM2 JRST CHBIN ;CHECK FOR CHANGE TO BIN DEVSET: TRO FF,SETDEV ;DEVICE SET HLRM C,DEV JRST FRD+1 CHBIN: CAME B,[SIXBIT /@/] ;WAS NO NAME2 SUPPLIED? POPJ P, ;NAME2 SUPPLIED, GO AWAY MOVE B,C ;MAKE NAME1 INTO NAME2 NODMCG, MOVSI C,(SIXBIT /REL/) ;USE REL FOR NAME2 DMCG, MOVSI C,(SIXBIT /BIN/) CDEVN1: POPJ P,DEVNM1 ] IFE ITS,[ FRD: MOVE B,[440700,,FILSTR] FRD2: ILDB T,CPTR CAIE T,DOLL CAIN T,33 JRST FRD1 ; FINISHED IDPB T,B JRST FRD2 FRD1: MOVEI T,0 IDPB T,B ; ASCIZ POPJ P, ] CONSTANTS ;IMPURE STORAGE EISYM: ;INITIAL SYMBOLS CRELPT: SQUOZE 64,$R. FACTOR: 100 0 CPOINT: SQUOZE 64,$. 100 0 SQUOZE 64,.LVAL1 .VAL1: 0 0 SQUOZE 64,.LVAL2 .VAL2: 0 0 SQUOZE 64,USDATL USDATP: 0 0 EISYME: POLSW: 0 ;-1=>WE ARE DOING POLISH PPDP: -PPDL,,PPDB-1 ;INITIAL POLISH PUSH DOWN POINTER PPDB: BLOCK PPDL+1 ;POLISH PUSH DOWN BLOCK SATED: 0 ;COUNT OF POLISH FIXUPS TO BE DELETED SATPDP: -SATPDL,,SATPDB-1 ;POINTER TO POLISH FIXUPS TO BE DELETED SATPDB: BLOCK SATPDL+1 ;LIST OF POLISH FIXUPS TO BE DELETED SVSAT: 0 ;# OF OPERANDS NEEDED POLPNT: 0 ;POINTER TO POLISH CHAIN CGLOB: 0 ;CURRENT GLOBAL IN SOME SENSE CGLOBV: 0 ;CURRENT GLOBAL VALUE IN SOME SENSE GLBFS: 0 ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST SVHWD: 0 ;WORD CURRENTLY BEING READ BY POLISH GLBCNT: 0 ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH HEADNM: 0 ;# POLISH FIXUPS SEEN LFTFIX: 0 ;-1=> LEFT HALF FIXUP IN PROGRESS LINKDB: BLOCK MNLNKS+1 ;LINK DATA BLOCK (END LINK,,CURRENT VALUE) HIBLK: 0 ; BLOCKS IN HIGH SEG KEEP: 0 ; FLAG SAYING WE ARE IN A CORE LOOP DMCG,[ USINDX: 0 ; USER INDEX ];DMCG HIGTOP: 0 ; TOP OF HIGH SEG INPTR: 0 ;HOLDS CURRENT IO POINTER STNBUF: BLOCK STNBLN ;BUFFER FOR BLOCK READS PAT: BLOCK 100 PATEND==.+1 CPTR: 0 AWORD: 0 ADRPTR: (ADR) BPTR: (B) DPTR: (D) SA: 0 TC: 0 BITS: 0 BITPTR: (300)BITS SAVPDL: 0 LBOT: INITCR*2000 TIMES: 0 COMLOC: ICOMM T1: 0 T2: 0 FLSH: 0 PRGNAM: 0 ; CORE MANAGEMENT VARIABLES NODMCG,[ CWORD0: 4000,,400000+<_9.> CWORD1: 4000,,600000-1000 LOWSIZ: INITCR ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT) ];NODMCG LOBLKS: INITCR+1 ; NUMBER OF BLOCKS OF CORE WE WANT PARBOT: 0 ; POINT TO BOTTOM OF SYMBOL TABLES PARTOP: 0 ; POINT TO TOP OF SAME PARLST: 0 ; LIST OF AVAILABLE 2 WORD BLOCKS QUADLS: 0 ; LIST OF AVAILABLE 4 WORD BLOCKS PARCUR: 0 ; TOP CURRENTLY IN USE SYMBOL TABLE CORE DDPTR: 0 ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE DDTOP: 0 ; HIGHEST ALLOCATED FOR DDT DDBOT: 0 ; LOWEST ALLOCATED FOR DDT HTOP: 0 ; TOP OF HASH TABLE HBOT: 0 ; BOTTOM OF HASH TABLE INIT: PDL: IFN ITS, .SUSET [.RSNAM,,SNAME] ;GET INITIAL SYSTEM NAME MOVEI A,100 MOVEM A,FACTOR MOVE NBLKS,[20,,INITCR] MOVEI A,ICOMM MOVEM A,COMLOC HLLZS LKUP3 SETOM MEMTOP MOVEI A,FACTOR HRRM A,REL MOVE P,[-100,,PDL] PUSHJ P,KILL IFN ITS,[ .OPEN TYOC,TTYO .VALUE 0 .OPEN TYIC,TTYI .VALUE 0 .STATUS TYIC,T ANDI T,77 CAIN T,2 TRO FF,GETTY ] MOVE TT,[SIXBIT /STINK./] PUSHJ P,SIXTYO MOVE TT,[.FNAM2] PUSHJ P,SIXTYO IFN ITS, .SUSET [.RMEMT,,TT] IFE ITS,[ MOVEI TT,INITCR*2000 ] LSH TT,-10. MOVEM TT,LOWSIZ SUBI TT,1 LSH TT,9. TDO TT,[4000,,400000] MOVEM TT,CWORD0 JRST LIS TTYO==. 1,,(SIXBIT /TTY/) SIXBIT /STINK/ SIXBIT /OUTPUT/ TTYI==. 30,,(SIXBIT /TTY/) SIXBIT /STINK/ SIXBIT /INPUT/ CONSTANTS LOC PDL+LPDL CBUF: BLOCK CBUFL FILSTR: BLOCK 10 ; GOOD FOR 40 CHARS LOSYM: ;LOWEST LOC AVAIL FOR SYM TBL INITCR==/2000 ;LDR LENGTH IN BLOCKS INFORM [HIGHEST USED]\LOSYM INFORM [LOWEST LOCATION LOADED ]\LOWLOD INFORM [COMMAND BUFFER LENGTH]\ INFORM [INITIAL CORE ALLOCATION]\INITCR END PDL