diff --git a/build/muddle.tcl b/build/muddle.tcl index 60421c58..fa0b0655 100644 --- a/build/muddle.tcl +++ b/build/muddle.tcl @@ -1,7 +1,7 @@ log_progress "ENTERING BUILD SCRIPT: MUDDLE" respond "*" ":cwd mudsys\r" -respond "*" ":midas ts stinkm_stink\r" +respond "*" ":midas ts stink_sysen2;stink 121t\r" expect ":KILL" respond "*" ":xfile assem xfile\r" @@ -9,7 +9,7 @@ expect -timeout 300 "Assembly done!" mkdir "mudsav" -respond "*" ":stinkm\r" +respond "*" ":mudsys;stink\r" respond "STINK." "MMUD56 STINK\033@\033\033" expect "SETPUR" respond "\n" "D\033\033" diff --git a/src/mudsys/assem.xfile b/src/mudsys/assem.xfile index aa86b5aa..6ee884bf 100644 --- a/src/mudsys/assem.xfile +++ b/src/mudsys/assem.xfile @@ -35,7 +35,7 @@ :midas;73 INITM : To link and initialize: - :stinkm + :mudsys;stink MMUD56 STINK$@$$ (must be uppercase) D$$ (must be uppercase) strng/$1"56^?^?^?$ (type ^? as ^ then ?) diff --git a/src/mudsys/stink.2 b/src/mudsys/stink.2 deleted file mode 100644 index e9c44503..00000000 --- a/src/mudsys/stink.2 +++ /dev/null @@ -1,3427 +0,0 @@ -TITLE TSTINKING ODOR - -ITS==1 ; 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,[PUSHJ P,RPB ;Expunge for nonexistant symbol - ignore - JRST DATABK] - 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 - \ No newline at end of file