3 ITS==1 ; FLAG SAYING WHETHER FOR ITS OR 20
5 IFE ITS,.INSRT MUDSYS;STENEX >
29 ERCHN==4 ;CHANNEL FOR ERROR DEVICE
36 UNDEF==10 ;COMPLAIN ABOUT UNDEF
38 GLOSYM==40 ;ENTER GLOBAL SYMS INTO DDT TABLE
40 CODEF==200 ;SPECIAL WORD LOADED
41 GPARAM==400 ;ENTER GPA LOCALS
42 COND==1000 ;LOAD TIME CONDITIONAL
43 NAME==2000 ;SET JOB NAME TO PROGRAM NAME
44 LOCF=4000 ;LOCAL IN SYM PRT
45 JBN==10000 ;JOB NAME SET BY JCOMMAND
46 GOF==20000 ;LEAVING LDR BY G COMMAND
47 GETTY==40000 ;GE CONSOLE
48 MLAST==100000 ;LAST COMMAND WAS AN "M"
49 NOTNUM==200000 ;USED FOR DUMMY SYMBOL LOGIC
50 SETDEV==400000 ;DEVICE SET LAST TIME
55 ;MISCELLANEOUS CONSTANTS
57 LOWLOD==0 ;LOWEST LOCATION LOADED
59 CBUFL==2000 ;COMMAND BUFFER LENGTH (MOBY LONG!)
60 DOLL==44 ;REAL DOLLAR SIGN (NOT ALT MODE ETC.)
61 INHASH==151. ; HASH TABLE LENGTH
62 ICOMM==10000 ;INITIAL COMMON
64 PPDL==60 ;POLISH PUSH DOWN LENGTH
65 SATPDL==5 ;SATED PUSH DOWN LENGTH
66 MNLNKS==20 ;MAXIMUM NUMBER OF LINKS
67 STNBLN==200 ;STINK INPUT BUFFER SIZE
73 POLREQ==200000 ;MARKS GLOGAL REQUEST AS POLISH REQUEST
74 DEFINT==400000 ;DEFERED INTERNAL
77 MFOR==101000 ; FOR .CBLK
80 BUCK==2 ; OFFSETS INTO SYMBOL BLOCKS
88 IF2,COMLOD=TPOK ;IS YOUR TAPE OK?
95 DEFINE CONC69 A,B,C,D,E,F,G,H
96 A!B!C!D!E!F!G!H!TERMIN
117 IFN LOWLOD,[CAIGE ADR,LOWLOD
119 ]GCR2: CAMLE ADR,MEMTOP
127 DATBK1: PUSHJ P,RLKUP
129 JRST DECODE ;LINK OR EXTEND
137 JRST USE2 ;PREV DEFINED
144 GCR1: TRNE ADR,400000 ; PURE?
145 JRST HIGHSG ; YES, USE HIGH SEG
149 HIGHSG: CAMLE ADR,HIGTOP ; WITHIN HIGH BOUND?
150 PUSHJ P,GETHI ; NO, GROW
151 MOVEM T,(ADR) ; STORE
154 ; ROUTINE TO GROW HIGH SEGMENT
159 SKIPE TT,USINDX ; DO WE KNOW USER INDEX
160 JRST GETHI1 ; YES, CONTINUE
162 IFN ITS, .SUSET [.RUIND,,USINDX]
165 GETHI1: MOVEI A,200001 ; FOR SEG #1 FROM CORE JOB
166 DPB TT,[MFOR,,A] ; STORE USER POINTER
167 MOVEI TT,(ADR) ; GET WHERE TO POINTER
168 SUBI TT,400000-2000 ; ROUND UP AND REMOVE HIGH BIT
169 ASH TT,-10. ; TO BLOCKS
170 DPB TT,[MBLKS,,A] ; STORE IT ALSO
172 .CBLK A, ; GOT TO SYSTEM
175 MOVE A,HIBLK ; GET NO. OF HIGH BLOCKS
176 SUBM TT,A ; GET NEW BLOCKS
177 MOVEM TT,HIBLK ; AND STORE
178 ASH TT,10. ; NOW COMPUTE NEW HIGTOP
179 TRO TT,400000 ; WITH HIGH BIT
190 SUB TT,HIBLK ;NUMBER OF BLOCKS TO GET
191 ADDM TT,HIBLK ;NUMBER OF BLOCKS WE ARE GOING TO HAVE
210 USE2: MOVE T,1(D) ;FILL REQUEST
219 JRST DEF1A ;ENTER DEF
220 ERR2: (5000+SIXBIT /UGA/)
225 TRNN FF,INDEF+GPARAM ;DEFINE ALL SYMBOLS
226 TLNE A,40000 ;OTHERWISE, FLUSH LOCALS
230 RDEF: TRO TT,10 ;SET FLAG FOR REDEFINITION
233 DFSYM1: PUSH P,CDATABK
235 DFSYM2: MOVEM A,CGLOB ;SAVE SQUOOZE IN CASE WE SATISFY POLISH
236 JUMPGE D,DEF1 ;NOT PREV SEEN
237 TLNN B,200000 ;PREVIOUSLY DEFINED
238 JRST PATCH5 ;PREVIOUSLY NEEDED
240 DEF2: TRNE TT,100 ;REDEFINE NOT OK
247 PATCH3: PUSH P,PATCH6
248 PATCH: PUSH P,A ; SAVE SYMBOL
249 HRRZ D,T2 ; DELETE REFERENCES FROM TABLE
251 TLNE A,200000 ; CHECK FOR DEFINED SYMBOL
252 JRST PATCH2 ; DON'T DELETE REFERENCES
253 HRRZ A,1(D) ; FIRST REFERENCE
259 PATCH2: HRRZ A,T2 ; POINT TO SYMBOL TO BE FLUSHED(REFS ARE GONE)
260 HRRZ B,LIST(A) ; GET LIST POINTER LEFT
261 HLRZ C,LIST(A) ; AND RIGHT
263 HRLM C,LIST(B) ; NO, SPLICE
266 HRRZ C,BUCK(A) ; NOW GET BUCKET POINTERS
268 CAMG B,HTOP ; SEE IF POINTS TO HASH TABLE
271 HRRM C,(B) ; IT IS, CLOBBER IN
273 HRRM C,BUCK(B) ; SPLICE BUCKET
275 HRLM B,BUCK(C) ; SPLICE IT ALSO
276 CAIN A,(BOT) ; RESET BOT?
277 HRRZ BOT,LIST(BOT) ; YES
278 SETZM LIST(A) ; CLEAR FOR DEBUGGING
279 PUSHJ P,QUADRT ; RETURN BLOCK
280 POP P,A ; RESTORE SYMBOL
282 JRST UNSATE ;DELETE THEM
284 \fPATCH7: PUSHJ P,LKUP1A
288 HRRZ B,1(D) ; POINT TO REF CHAIN
292 MOVE B,1(D) ; GET REF WORD
297 JRST DEFIF ;DEFERED INTERNAL
299 JRST POLSAT ;POLISH REQUEST
303 JRST GEN ;GENERAL REQUEST
305 UNTHR: TRNN B,400000 ; HIGH SEG?
306 MOVEI B,@BPTR ; NO FUDGE
311 CPTCH1: POPJ P,PATCH1
313 JRST DEFIF1 ;MUST SATISFY DEFERRED INTERNAL
318 MOVE A,B ;GET THE SYMBOL BACK
321 DEFIF1: TLNN ADR,FIXRT+FIXLT
322 JRST 4,. ;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE
325 JRST 4,. ;BOTH BITS TURNED ON!!
327 PUSH P,B ;POINTS TO VALUE PAIR
328 MOVE T,1(B) ;SQUOOZE FOR DEFERRED INTERNAL
330 JUMPGE D,DEFIF4 ;PERHAPS ITS'S IN DDT TABLE
333 PUSHJ P,GLOBS3 ;FIND THE VALUE
336 JRST DEFIFR ;RIGHT HANDED
338 JRST DEFIF2 ;LEFT HANDED FIXUP
347 MOVEM A,1(B) ;WRITE THE REFERENCE WORD BACK
348 MOVE T,1(A) ;SAVE VALUE OF THIS GLOBAL IN CASE
350 POP P,A ;POINTS TO VALUE PAIR
353 JRST DEFIF3 ;STILL NOT COMPLETELY DEFINED
354 MOVE B,(D) ;SIMULATE CALL TO LKUP
360 PUSHJ P,DEFSYM ;HOLD YOUR BREATH
376 PUSH P,T1 ;VALUE TO BE ADDED
377 PUSH P,[DEFIF5] ;WHERE TO RETURN
378 TLZ T,200000 ;ASSUME RIGHT HALF FIX
380 TLO T,200000 ;ITS LEFT HALF FIX
388 TRNN B,400000 ; HIGH SEG
389 MOVEI B,@BPTR ; NO GET REAL LOC
414 JRST THRDR ;6 > LINK REQ
417 DEF ;DEFINE SYMBOL (70)
418 COMMON ;COMMON RELOCATION (71)
419 LOCGLO ;LOCAL TO GLOBAL RECOVERY (72)
420 LIBREQ ;LIBRARY REQUEST (73)
421 RDEF ;REDEFINITION (74)
422 REPT ;GLOBAL MULTIPLIED BY 1024>N>0 (75)
423 DEFPT ;DEFINE AS POINT (76)
430 LKUP3: MOVEI B,0(ADR) ;CONTAINS GLOBAL OFFSET
436 SUB B,HBOT ; COMP LENGTH
437 IDIVI A,(B) ; HASH THE SYMBOL
438 ADD B,HBOT ; POINT TO THE BUCKET
439 HRRZ D,(B) ; SKIP IF NOT EMPTY
440 MOVE A,(P) ; RESTORE SYMBOL
442 LKUP1: MOVE B,(D) ; GET A CANDIDATE
444 CAMN A,B ; SKIP IF NOT FOUND
446 HRRZ D,BUCK(D) ; GO TO NEXT IN BUCKET
447 LKUP7: JUMPE D,LKUP6 ; FAIL, GO ON
452 LKUP5: MOVE B,(D) ; SYMBOL WITH ALL FLAGS TO B
465 PUSHJ P,PAIR ; GET A REF PAIR
466 HRRZ ZR,1(D) ; SAVE OLD REF
467 MOVEM A,1(D) ; CLOBBER IT
468 MOVEM ZR,(A) ; AND PATCH
469 MOVEI D,1(A) ; POINT D TO DESTINATION OF REF WRD
472 ;HERE TO CREATE NEW TABLE ENTRY
476 DEF1A: PUSH P,CDATABK
477 DEF2A: PUSH P,A ; SAVE SYMBOL
478 PUSHJ P,PAIR ; GET PAIR FOR REF CHAIN
479 MOVEM T,1(A) ; SAVE REF WORD
480 MOVEI T,(A) ; USE POINTER AS VALUE
486 PUSHJ P,QUAD ; GET A QUADRAD FOR SYMBOL
487 MOVE D,A ; POINT WITH C
488 MOVE A,-1(P) ; RESTORE SYMBOL FOR HASHING
489 MOVE B,HTOP ; -LNTH OF TABLE
491 TLZ A,600000 ; CLOBBER FLAGS
492 IDIVI A,(B) ; GET HASH
493 ADD B,HBOT ; POINT TO BUCKET
494 HRRZ C,(B) ; GET CONTENTS THEREOF
495 HRROM D,(B) ; PUT NEW ONE IN
496 HRRM C,BUCK(D) ; PUT OLD ONE IN
497 HRLM B,BUCK(D) ; POINT BACK TO TABLE
498 SKIPE C ; SKIP IF NO NEXT
502 HRRZM BOT,LIST(D) ; INTO LIST OF ALL SYMBOLS
503 MOVEI BOT,(D) ; AND RESET
516 JRST THRD2 ;PREV DEFINED
517 PUSHJ P,DOWN ;ENTER LINK REQUEST
526 LOCGLO: JUMPGE T,LG2 ;JUMP FOR NORMAL LOCAL TO GLOBAL RECOVERY
528 ;HERE TO EXPUNGE OR RENAME LOCAL IN LOADER TABLE
530 JUMPGE D,[(5000+SIXBIT /ENS/)
531 PUSHJ P,RPB ;Expunge for nonexistant symbol - ignore
533 HRRZM D,T2 ;TABLE ENTRY TO DELETE
534 PUSHJ P,RPB ;SOAK UP ANOTHER WORD
535 JUMPGE T,LG1 ;JUMP TO RENAME LOCAL
536 TLNN B,200000 ;MAKE SURE THING IS DEFINED
537 JRST 4,. ;CANNOT HACK UNDEFINED SYMBOL
541 ;HERE TO RENAME LOCAL IN LOADER TABLE
543 LG1: PUSH P,(D) ;SQUOZE
545 MOVSI B,200000 ;MARK AS DEFINED SO THAT . . .
546 IORM B,(D) ;PATCH WILL NOT HACK REFERENCES
551 TDZ B,[37777,,-1] ;CLEAR SQUOZE
552 TLZ A,700000 ;CLEAR FLAGS OF NEW NAME
553 IOR A,B ;FOLD FLAGS, NEW NAME
554 MOVEI B,DATABK ;ASSUME IT WILL BE LOCAL
555 TLZE A,40000 ;SEE IF WE MUST RECOVER TO GLOBAL
556 MOVEI B,.+3 ;MUST RECOVER TO GLOBAL
557 PUSH P,B ;RETURN ADDRESS
559 MOVE B,(D) ;SQUOZE AND FLAGS
560 MOVE A,B ;SQUOZE WITH . . .
561 TLZA A,740000 ;FLAGS CLEARED
564 ;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY
566 LG2: JUMPGE D,DATABK ;LOCAL-GLOBAL RECOVERY
567 MOVE T,D ;D POINTS TO LOCAL
569 PUSHJ P,LKUP1B ;FIND OCCURANCE OF GLOBAL
570 IORM A,(T) ;SMASH OLD LOCAL OCCURENCE
574 MOVE B,1(D) ;ALREADY DEFINED
578 PUSHJ P,PATCH ;CLOBBER DEFINITION
581 JRST PATCH7 ;FILL IN OLD LOCAL REQ
583 LIBREQ: JUMPL D,DATABK ;ALREADY THERE
590 COMMON: ADD RH,COMLOC
593 DEFPT: MOVEI T,@LKUP3
602 LIB6: CAIN A,12 ;END OF CONDITIONAL
606 CAIE T,5 ;LOADER VALUE CONDITIONAL
607 CAIN A,11 ;COUNT MATCHING CONDITIONALS
617 TLNN T,40000 ;REAL END
619 JRST OMIT1 ;LEAVE LIB SEARCH MODE
626 JUMPGE D,LIB3 ;NOT ENTERED
629 TLNE B,200000 ;RQST NOT FILLED
630 LIB3: TLC T,200000 ;"AND NOT" BIT
632 JRST LIB1 ;THIS ONE LOSES
637 OMIT1: TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG
643 PUSHJ P,GTWD ;SOAK UP CKSUM
646 LOAD: JRST (LL) ;READ SWITCH
659 TRZ FF,COND ;FUDGE FOR IMPROPER USE OF .LIBRA
662 LDCMD ;LOADER COMMAND (1)
665 PRGN ;PROGRAM NAME (4)
667 COMLOD ;COMMON LOADING (6)
668 GPA ;GLOBAL PARAMETER ASSIGNMENT (7)
669 SYMSW: DDSYMS ;LOCAL SYMBOLS (10)
670 LDCND ;LOAD TIME CONDITIONAL (11)
671 SYMFLG: SETZ OMIT ;END LDCND (12)
672 HLFKIL ;HALF KILL A BLOCK OF SYMBOLS
673 OMIT ;OMIT BLOCK GENERATED BY LIBRARY CREATOR
674 OMIT ;LATER WILL BE .ENTRY
675 AEXTER ;BLOCK OF STUFF FOR SDAT OR USDAT
677 GLOBS ;GLOBAL SYMBOLS BLOCK TYPE 20
678 FIXES ;FIXUPS BLOCK TYPE 21
679 POLFIX ;POLISH FIXUPS BLOCK TYPE 22
680 LINK ;LINK LIST HACK (23)
682 OMIT ;LOAD LIBRARY (25)
683 OMIT ;LVAR (26) OBSOLETE
684 OMIT ;INDEX (27) NEW DEC STUFF
691 ;HERE TO PROCESS AN .EXTERN
693 AEXTER: PUSHJ P,RPB ;READ AND LOOK UP SYMBOL
694 TLO T,40000 ;TURN ON GLOBAL BIT
695 PUSHJ P,LKUP ;NOW LOOK IT UP
696 JUMPGE D,.+3 ;NEVER APPEARED, MUST ENTER
697 TLNE B,200000 ;SKIP IF NOT DEFINED
698 JRST AEXTER ;THIS ONE EXISTS, GO AGAIN
699 MOVE B,USDATP ;GET POINTER TO USDAT
700 PUSH P,A ;SAVE SYMBOL
701 TLZ A,740000 ;KILL ALL FLAGS
702 MOVE T,B ;SAVE A COPY OF THIS
703 ADD T,[3,,3] ;ENOUGH ROOM?
704 JUMPGE T,TMX ;NO, BARF AT THE LOSER
705 MOVEM T,USDATP ;NOW SAVE
706 TRNN B,400000 ; HIGH SEG?
707 MOVEM A,@BPTR ; NO GET REAL LOC
708 TRNE B,400000 ; SKIP IF LOW SEG
709 MOVEM A,(B) ;STORE INTO CORE IMAGE BEING BUILT
710 POP P,A ;RESTORE SYMBOL
711 MOVEI T,1(B) ;ALSO COMPUTE 'VALUE' OF SYMBOL
718 TMX: (3000+SIXBIT /TMX/)
723 LDCMD: ADDI T,LDCMD2+1
726 DPB T,[(330300)LDCVAL]
734 LDCMD1: TRZ FF,UNDEF+CODEF
741 GLOBAL ;GLOBAL LOCATION ASSIGNMENT (2)
742 COMSET ;COMMON ORIGIN (3)
743 RESPNT ;RESET GLOBAL RELOCATION (4)
744 LDCVAL ;LOADER VALUE CONDITIONAL (5)
745 .OFFSET ;GLOBAL OFFSET (6)
746 L.OP ;LOADER EXECUTE (7)
747 .RESOF ;RESET GLOBAL OFFSET
\f
772 .OFFSET: HRRM D,LKUP3
775 L.OP: MOVE B,T1 ;B=3 C=4 D=5
793 L.OP2:] IOR B,[0 4,5]
801 SETJNM: MOVEI A,SJNM1
820 MOVEI TT,100 ;DON'T GENERATE MDG
837 DDLUP2: TLZ T,740000 ;MARK AS BLOCK NAME
839 \f;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20
841 GLOBS: PUSHJ P,GETBIT ;CODE BITS
844 PUSHJ P,GETBIT ;CODE BITS
845 PUSHJ P,RRELOC ;VALUE
848 TLO T,40000 ;GLOBAL FLAG
849 PUSHJ P,LKUP ;SYMBOL LKUP
850 LDB C,[400400,,CGLOB] ;FLAGS
852 JRST GLOBRQ ;GLOBAL REQUEST
854 ;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION
856 TRNN C,10_-2 ;TEST FOR VALID FLAGS
857 TRNN C,4_-2 ;FORMAT IS XX01
859 LSH C,-2 ;SHIFT OUT GARBAGE
860 JUMPE C,GLBDEF ;FLAGS 04=> GLOBAL DEFINITION
861 CAIN C,40_-4 ;*****JUST A GUESS
862 JRST GLBDEF ;*****JUST A GUESS
864 ;DUMP A DEFERRED INTERNAL INTO LOADER TABLE
866 JUMPL D,GDFIT ;JUMP IF IN LOADER TABLE
867 PUSHJ P,PAIR ;GET VALUE PAIR
869 HRR T,A ;REFERENCE WORD POINTS TO PAIR
871 SETZM (T) ;MARK AS VALUE
872 MOVEM A,1(T) ;SECOND WORD IS VALUE
873 GLOBS0: MOVE A,CGLOB ;SQUOOZE
874 TLZ A,300000 ;FIX THE FLAGS
876 PUSHJ P,DEF2A ;PUT IT INTO LOADER TABLE
879 ;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE
882 JRST 4,. ;ALREADY DEFINED
883 PUSHJ P,GLOBS3 ;RETURNS REFERENCE WORD IN A
884 JUMPE B,GDFIT1 ;MUST ADD DEFERRED VALUE
887 JRST 4,. ;REFERENCE WORDS DON'T MATCH
890 JRST 4,. ;VALUES DON'T MATCH
891 JRST GLOBS ;ALL'S WELL THAT ENDS WELL
898 SETZM (T) ;MARK AS VALUE
902 \f;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60
904 GLOBRQ: SKIPGE T,CGLOBV ;SKIP IF THREADED LIST
905 JRST GLOBR1 ;SINGLE WORD FIX UP MUST WORK HARDER
909 JUMPE T,GLOBS ;IGNORE NULL REQUEST
910 JUMPGE D,GLOBNT ;JUMP IF SYMBOL NOT IN TABLE
911 TLNE B,200000 ;TEST TO SEE IF DEFINED
912 JRST GLOBPD ;PREVIOUSLY DEFINED
913 PUSHJ P,DOWN ;NOT DEFINED, ENTER REQEST INTO TABLE
915 HRLI C,100000 ;THIS IS A LINK LIST
919 ;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04
921 GLBDEF: MOVE T,CGLOBV ;VALUE
922 MOVEI TT,0 ;REDEFINE NOT OKAY, SEE DEF2
923 PUSHJ P,DEFSYM ;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP
925 \f; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN
927 GLOBPD: MOVE T,1(D) ;VALUE
928 MOVE B,CGLOBV ;POINTER TO CHAIN
932 ; ENTER NEW SYMBOL WITH LINK REQUEST
934 GLOBNT: MOVEI C,44_-2 ;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ
936 HRLI T,100000 ;SET LINK BIT IN REQUEST
940 ; SINGLE WORD FIX UP -- FLAGS=60
942 GLOBR1: TLNE T,100000 ;TEST FOR SYMBOL TABLE FIX
943 JRST GLOBST ;SYMBOL TABLE FIX
944 JUMPGE D,GLOBR2 ;JUMP IF NOT IN TABLE
946 JRST GLOBR3 ;NOT PREVIOUSLY DEFINED
947 HRRZ B,T ;FIX UP LOCATION
948 PUSHJ P,MAPB ;DO THE RIGHT THING IF B IN HIGH SEGMENT
949 TLNE T,200000 ;LEFT OR RIGHT?
951 HWAR: HRRE C,(B) ;HALF WORD ADD RIGHT
956 HWAL: HLRE C,(B) ;HALF WORD ADD LEFT
961 ; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED
963 GLOBR3: PUSHJ P,DOWN ;MAKE ROOM IN TABLE
965 HRLI T,40001 ;ASSUME RIGHT HALF
966 TLNE C,200000 ;RIGHT OR LEFT?
971 ;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS
973 MAPB: TRNN B,400000 ;SECOND SEGMENT
974 HRRI B,@BPTR ;NO, RELOCATE THE ADDRESS
976 \f; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE
978 GLOBR2: TLO A,400000 ;SYMBOL FLAG
980 HRLI T,1 ;ASSUME RIGHT HALF FIX
981 TLNE C,200000 ;LEFT OR RIGHT?
986 ; HERE FOR SYMBOL TABLE FIX
990 ; TLZ A,700000 ;MAKE SURE WE ARE STILL FIXING SAME SYMBOL
992 ; JRST 4,. ;DON'T AGREE
993 JUMPGE D,GLOBS5 ;JUMP IF FIXUP NOT SEEN
995 JRST GLOBS6 ;FIXUP NOT EVEN DEFINED
996 PUSH P,1(D) ;SAVE POINTER TO OLD SYMBOL
1003 PUSHJ P,GLOBS3 ;FIND THE GLOBAL VALUE
1008 EXCH B,(P) ;GET BACK VALUE OF FIXUP SYMBOL
1009 TLNE T,200000 ;LEFT OR RIGHT?
1014 TLZN A,FIXRT ;DID WE REALLY WANT TO DO THIS
1018 GLOBS1: HLRE C,1(A) ;LEFT HALF FIX
1021 TLZN A,FIXLT ;DID WE REALLY WANT TO DO THIS
1024 ; HERE TO FINISH UP SYMBOL TABLE FIX
1027 MOVEM A,1(B) ;STORE BACK REFERENCE WORD
1028 TLNE A,FIXLT+FIXRT ;DO WE HAVE MORE FIXING
1030 MOVE T,1(A) ;FIXED VALUE
1031 MOVEI TT,100 ;OKAY TO REDEFINE, TT USED AT DEF2
1035 ;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL
1037 GLOBS3: MOVE B,1(D) ;FIRST REFERENCE WORD
1038 GLOBS4: SKIPGE A,1(B)
1042 POPJ P, ;REFERENCE WORD NOT FOUND
1044 JRST GLOBS9 ;DEFERED INTERNAL FOR ANOTHER SYMBOL
1047 GLOBS5: PUSHJ P,GLOBS7
1050 GLOBS6: PUSHJ P,GLOBS7
1055 GLOBS7: PUSHJ P,PAIR
1059 MOVSI T,DEFINT+FIXRT
1064 MOVEM B,(T) ;MARK AS SQUOOZE
1066 MOVEM B,1(T) ;SQUOOZE
1069 GLST1: POP P,(P) ;VALUE TO ADD ON TOP OF STACK
1072 ;HERE TO FIX UP DIFFERED INTERNAL
1073 ;THAT MIGHT BE A LOCAL CALL WITH STACK
1074 ; -1(P) VALUE TO ADD
1075 ; (P) RETURN ADDRESS
1076 ; T SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX)
1081 JRST 4,. ;ITS GLOBAL, THERE'S NO HOPE
1082 MOVEI B,0 ;BLOCK NAME
1083 MOVE C,T ;SYMBOL TO FIX
1087 MOVE B,1(T) ;VALUE TO FIX
1088 HLRZ C,B ;THE LEFT HALF
1099 \f; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21
1102 JRST FIXESL ;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK
1103 PUSHJ P,GETBIT ;CODE BITS
1104 PUSHJ P,RRELOC ;FIX UP WORD
1105 CAMN T,[-1] ;SKIPS ON RIGHT HALF FIX
1106 JRST FIXESL ;LEFT HALF FIX
1107 HLRZ B,T ;C(T) = POINTER,,VALUE C(B)=POINTER
1111 FIXESL: SETOM LFTFIX ;IN CASE RRELOC GETS US OUT OF BLOCK
1114 SETZM LFTFIX ;OFF TO THE RACES
1120 HLL T,(B) ;CALL IS POINTER IN B
1121 HRLM T,(B) ; VALUE IN T
1132 \f;POLISH FIXUPS <BLOCK TYPE 22>
1134 PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
1137 COMPOL: (3000+SIXBIT /PTC/)
1138 LOAD4A: (3000+SIXBIT /IBF/)
1141 ;READ A HALF WORD AT A TIME
1143 RDHLF: TLON FF,HSW ;WHICH HALF
1145 PUSHJ P,RWORD ;GET A NEW ONE
1146 TLZ FF,HSW ;SET TO READ OTEHR HALF
1147 MOVEM T,SVHWD ;SAVE IT
1148 HLRZS T ;GET LEFT HALF
1150 NORD: HRRZ T,SVHWD ;GET RIGHT HALF
1159 ;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE
1161 ; T/ VALUE (IGNORED IF OPERATOR)
1164 PUSHJ P,PAIR ;GET TWO WORDS
1166 EXCH T,POLPNT ;POINTER TO CHAIN
1167 MOVEM T,(A) ;INTO NEW NODE
1168 HRLM C,(A) ;TOKEN TYPE INTO LEFT HALF OF FIRST WORD
1170 EXCH T,POLPNT ;RESTORE T, POINTER TO NEW NODE
1172 \f;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED)
1173 ;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED
1183 TLNN B,200000 ;SKIP IF DEFINED
1184 AOS -5(P) ;INCREMENT ADDRESS
1185 MOVEM D,-4(P) ;SET POINTER IN A
1193 ;START READING THE POLISH
1195 POLFIX: MOVE D,PPDP ;SET UP THE POLISH PUSHDOWN LIST
1196 MOVEI B,100 ;IN CASE OF ON OPERATORS
1198 SETOM POLSW ;WE ARE DOING POLISH
1199 TLO FF,HSW ;FIX TO READ A WORD THE FIRST TIME
1200 SETOM GLBCNT ;NUMBER OF GLOBALS IN THIS FIXUP
1201 SETZM POLPNT ;NULL POINTER TO POLISH CHAIN
1202 PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK
1204 RPOL: PUSHJ P,RDHLF ;GET A HALF WORD
1205 TRNE T,400000 ;IS IT A STORE OP?
1206 JRST STOROP ;YES, DO IT
1207 CAIGE T,3 ;0,1,2 ARE OPERANDS
1209 CAILE T,14 ;14 IS HIGHEST OPERATOR
1210 JRST LOAD4A ;ILL FORMAT
1211 PUSH D,T ;SAVE OPERATOR IN STACK
1212 MOVE B,DESTB-3(T) ;GET NUMBER OF OPERANDS NEEDED
1213 MOVEM B,SVSAT ;ALSO SAVE IT
1214 JRST RPOL ;BACK FOR MORE
1216 \f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
1219 OPND: MOVE A,T ;GET THE OPERAND TYPE HERE
1220 PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND
1221 MOVE C,T ;GET IT INTO C
1222 JUMPE A,HLFOP1 ;0 IS HALF-WORD OPERAND
1223 PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF
1224 HRL C,T ;GET HALF IN RIGHT PLACE
1225 MOVSS C ;WELL ALMOST RIGHT
1226 SOJE A,HLFOP1 ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
1229 TLNE C,40000 ;CHECK FOR FUNNY LOCAL
1230 PUSHJ P,SQZCON ;CONVERT TO STINKING SQUOOZE
1232 PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED
1233 JRST OPND1 ;YES, WE WIN
1234 AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
1235 AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
1236 PUSH P,C ;SAVE GLOBAL REQUESTS FOR LATER
1237 MOVEI T,0 ;MARK AS SQUOOZE
1239 PUSHJ P,SYM3X2 ;INTO THE LOADER TABLE
1240 HRRZ C,POLPNT ;NEW "VALUE"
1241 SKIPA A,[400000];SET UP GLOBAL FLAG
1242 HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG
1243 HLFOP1: SOJL B,CSAT ;ENOUGH OPERANDS SEEN?
1244 PUSH D,C ;NO, SAVE VALUE(OR GLOBAL NAME)
1245 HRLI A,400000 ;PUT IN A VALUE MARKER
1246 PUSH D,A ;TO THE STACK
1247 JRST RPOL ;GET MORE POLISH
1249 ;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT: THE FLAG BITS ARE CLEARED
1251 SQZCON: TLZ C,740000
1253 SQZ1: CAML C,[50*50*50*50*50]
1258 ; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME
1260 OPND1: MOVE C,1(A) ;SYMBOL VALUE
1262 \f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
1264 CSAT: HRRZS A ;KEEP ONLY THE GLOBAL-VALUE HALF
1265 SKIPN SVSAT ;IS IT UNARY
1266 JRST UNOP ;YES, NO NEED TO GET 2ND OPERAND
1267 HRL A,(D) ;GET GLOBAL VALUE MARKER FOR 2ND OP
1269 POP D,T ;VALUE OR GLOBAL NAME
1270 UNOP: POP D,B ;OPERATOR
1271 JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
1272 XCT OPTAB-3(B) ;IF BOTH VALUES JUST XCT
1273 MOVE C,T ;GET THE CURRENT VALUE
1274 SETSAT: SKIPG B,(D) ;IS THERE A VALUE IN THE STACK
1275 MOVE B,-2(D) ;YES, THIS MUST BE THE OPERATOR
1276 MOVE B,DESTB-3(B) ;GET NUMBER OF OPERANDS NEEDED
1277 MOVEM B,SVSAT ;SAVE IT HERE
1278 SKIPG (D) ;WAS THERE AN OPERAND
1279 SUBI B,1 ;HAVE 1 OPERAND ALREADY
1280 JRST HLFOP1 ;GO SEE WHAT WE SHOULD DO NOW
1284 GLOB: TRNE A,-1 ;IS IT IN RIGHT HALF
1285 JRST TLHG ;NO NEED TO SAVE THIS VALUE IF ITS GLOBAL
1286 PUSH P,T ;SAVE FOR A WHILE
1288 MOVEI C,1 ;MARK AS VALUE
1290 HRRZ C,POLPNT ;POINTER TO VALUE
1291 POP P,T ;RETRIEVE THE OTHER VALUE
1292 TLHG: SKIPE SVSAT ;WAS THIS A UNARY OPERATOR
1293 TLNE A,-1 ;WAS THERE A GLOBAL IN LEFT HALF
1296 MOVEI C,1 ;SEE ABOVE
1298 HRRZ T,POLPNT ;POINTER TO VALUE
1301 GLSET: EXCH C,B ;OPERATOR INTO RIGHT AC
1302 SKIPE SVSAT ;SKIP ON UNARY OPERATOR
1303 HRL B,T ;SECOND,,FIRST
1304 MOVE T,B ;SET UP FOR CALL TO SYM3X2
1306 MOVEI A,400000 ;SET UP AS A GLOBAL VALUE
1307 HRRZ C,POLPNT ;POINTER TO "VALUE"
1308 JRST SETSAT ;AND SET UP FOR NEXT OPERATOR
1309 \f;FINALLY WE GET TO STORE THIS MESS
1311 STOROP: MOVE B,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR
1313 JRST LOAD4A ;NO, ILL FORMAT
1314 HRRZ B,(D) ;GET THE VALUE TYPE
1315 JUMPN B,GLSTR ;AND TREAT GLOBALS SPECIAL
1316 MOVE A,T ;THE TYPE OF STORE OPERATOR
1318 PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP, MUST WORK HARDER
1319 PUSHJ P,RDHLF ;GET THE ADDRESS
1320 MOVE B,T ;SET UP FOR FIXUPS
1321 POP D,T ;GET THE VALUE
1322 POP D,T ;AFTER IGNORING THE FLAG
1323 PUSHJ P,@STRTAB+6(A) ;CALL THE CORRECT FIXUP ROUTINE
1325 COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
1328 JRST COMPOL ;TOO BIG, GIVE ERROR
1329 PUSHJ P,RWORD ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
1330 JRST LOAD4A ;IF NOT, SOMETHING IS WRONG
1334 JRST 4,. ;PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP
1335 PUSHJ P,RDHLF ;GET THE STORE LOCATION
1336 SUB D,[2,,2] ;VALUE AND MARKER ON STACK MEANINGLESS
1338 PUSHJ P,SYM3X2 ;STORE LOC ALREADY IN T
1339 AOS T,GLBCNT ;WE STARTED AT -1 REMEMBER?
1340 HRRZ C,HEADNM ;GET HEADER #
1341 TLO C,440000 ;MARK FIXUP AS GLOBAL BEASTIE
1342 PUSHJ P,SYM3X2 ;LAST OF POLISH FIXUP
1343 HRRZ T,POLPNT ;POINTER TO POLISH BODY
1344 MOVE A,C ;FIXUP NAME
1346 GLSTR1: SOSGE GLBCNT ;MUST PUT GLOBAL REQUESTS IN TABLE
1347 JRST COMSTR ;AND FINISH
1350 MOVE A,HEADNM ;SETUP REQUEST WORD
1351 TLO A,POLREQ ;MARK AS POLISH REQUEST
1352 JUMPGE D,GLSTR2 ;JUMP IF NOT SEEN
1357 GLSTR2: EXCH A,T ;NOT PREVIOUSLY SEEN ENTER FULL REQUEST
1358 TLO A,400000 ;MARK AS NEW TABLE ENTRY
1361 \fSTRTAB: ALSYM ;-6 FULL SYMBOL TABLE FIXUP
1362 LFSYM ;-5 LEFT HALF SYMBOL FIX
1363 RHSYM ;-4 RIGHT HALF SYMBOL FIX
1364 UNTHF ;-3 FULL WORD FIXUP
1365 UNTHL ;-2 LEFT HALF WORD FIXUP
1366 UNTHR ;-1 RIGHT HALF WIRD FIXUP
1392 ;HERE TO LOOK UP LOCAL IN SYMBOL TABLE
1394 FSYMT: PUSHJ P,FSYMT1 ;BLOCK NAME
1395 MOVE B,C ;SAVE SYMBOL
1396 PUSHJ P,FSYMT1 ;SYMBOL NAME
1397 EXCH B,C ;BLOCK NAME IN B, SYMBOL NAME IN C
1398 FSYMT2: PUSH P,A ;SAVE IT
1399 MOVE T,DDPTR ;AOBJN POINTER TO LOCALS
1400 SLCL: MOVE A,(T) ;SQUOZE
1401 TLZN A,740000 ;CLEAR FLAGS FOR COMPARE
1402 JRST SLCL3 ;BLOCK NAME
1403 CAMN A,C ;IS THIS THE SYMBOL WE SEEK
1404 JRST SLCL1 ;YES, WE MUST STILL VERIFY THE BLOCK
1405 SLCL4: ADD T,[1,,1] ;NO KEEP LOOKING
1407 JRST 4,. ;SYMBOL NOT FOUND
1409 SLCL1: JUMPE B,POPAJ1 ;SYMBOL IS IN THIS BLOCK
1410 PUSH P,T ;THIS POINTER POSSIBLY A WINNER
1411 ADD T,[2,,2] ;NEXT SYMBOL
1412 JUMPGE T,[JRST 4,.] ;WE HAVE RUN OUT OF TABLE
1414 TLNE A,740000 ;SKIP ON BLOCK NAME
1417 ; HERE WHEN WE FIND BLOCK NAME
1419 CAME A,B ;DOES THE BLOCK NAME MATCH
1420 JRST SLCL2 ;NO KEEP LOOKING
1421 POP P,T ;WINNING SYMBOL TABLE ENTRY
1422 POPAJ1: POP P,A ;RESTORE A
1423 AOS (P) ;SKIP THE PUSHJ P,RDHLF THAT FOLLOWS THIS CALL
1426 SLCL3: JUMPN B,SLCL4
1427 JRST 4,. ;SYMBOL SHOULD BE IN THIS BLOCK
1429 SLCL2: SUB P,[1,,1] ;FLUSH THE LOSING SYMBOL POINTER
1432 FSYMT1: PUSHJ P,RDHLF
1437 \f;HERE TO SATISFY GLOBAL REQUEST FOR POLISH
1439 POLSAT: PUSH P,D ;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST
1440 HRRZ T,B ;LOOK UP POLISH TO BE FIXED
1443 JUMPGE D,[JRST 4,.] ;CANNOT FIND POLISH
1444 MOVE T,CGLOB ;SQUOOZE (SET UP AT DFSYM2)
1446 MOVE B,(B) ;STORE OP
1447 MOVE B,(B) ;FIRST TOKEN
1450 SOSG 1(B) ;UPDATE UNDEFINED GLOBAL COUNT
1451 JRST PALSAT ;COUNTED OUT FINISH THIS FIXUP
1452 POLRET: MOVE A,CGLOB
1456 ;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH
1458 FIXPOL: HLRZ A,(B) ;TOKEN TYPE
1459 JUMPN A,FXP1 ;JUMP IF NOT SQUOZE
1461 JRST FXP1 ;SQUOOZE DOES NOT MATCH
1462 HRRI A,1 ;MARK AS VALUE
1464 HRLM A,(B) ;NEW TOKEN TYPE
1465 MOVEM T,1(B) ;NEW VALUE
1468 FXP1: HRRZ B,(B) ;POINTER TO NEXT TOKEN
1470 JRST 4,. ;DID NOT FIND SYMBOL
1471 \f;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED
1473 PALSAT: AOS SATED ;NUMBER OF FIXUPS SATISFIED
1474 PUSH P,(D) ;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION
1475 MOVE A,1(D) ;POINTS TO COUNT
1476 MOVE A,(A) ;STORE OP
1478 HLLZ B,(A) ;STORE OP
1479 HRRZ T,1(A) ;PLACE TO STORE
1481 PUSH D,T ;STORE ADDRESS
1482 MOVEI T,-1(D) ;POINTER TO STORE OP
1484 MOVE A,(A) ;POINTS TO FIRST TOKEN
1486 PSAT1: HLRE B,(A) ;OPERATOR
1487 JUMPL B,ENDPOL ;FOUND STORE OP
1490 JRST 4,. ;NOT OPERATOR
1491 MOVE T,1(A) ;OPERANDS (SECOND,,FIRST)
1492 HLRZ C,(T) ;FIRST OPERAND
1493 JUMPE C,[JRST 4,.] ;SQUOZE NEVER DEFINED
1494 CAIE C,1 ;SKIP IF DEFINED
1495 JRST PSDOWN ;GO DOWN A LEVEL IN TREE
1497 JRST PSAT2 ;IF UNARY OP WE ARE DONE
1499 HLRZ C,(T) ;SECOND OPERAND
1505 ;HERE TO PERFORM OPERATION
1507 PSAT2: MOVE C,1(T) ;VALUE FIRST OPERAND
1510 MOVE T,1(T) ;GET SECOND OPERAND ONLY IF NECESSARY
1511 XCT OPTAB-3(B) ;WOW!
1512 MOVEM T,1(A) ;NEW VALUE
1514 HRLM C,(A) ;MARK AS VALUE
1515 POP D,A ;GO UP A LEVEL IN TREE
1518 ;HERE TO GO DOWN LEVEL IN TREE
1520 PSDOWN: PUSH D,A ;SAVE THE OLD NODE
1523 \f;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T)
1525 ENDPOL: POP D,B ;STORE ADDRESS
1526 MOVS A,(D) ;STORE OP
1527 PUSHJ P,@STRTAB+6(A)
1528 POP P,D ;NAME OF THIS FIXUP
1529 EXCH P,SATPDP ;SAVE THIS NAME FOR LATER DELETION FROM TABLE
1534 ; HERE TO DO SYMBOL TABLE FIXUPS
1536 ; B/ SYMBOL TABLE POINTER
1538 RHSYM: HRRM T,1(B) ;RIGHT HALF FIX
1541 LFSYM: HRLM T,1(B) ;LEFT HALF FIX
1544 ALSYM: MOVEM T,1(B) ;FULL WORD FIX
1548 ;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE
1551 MOVE A,[-SATPDL,,SATPDB-1]
1552 EXCH A,SATPDP ;SET UP PUSH DOWN POINTER
1553 MOVE B,SATED ;# FIXUPS TO BE DELETED
1555 CAILE B,SATPDP ;LIST LONG ENOUGH?
1556 JRST 4,. ;TIME TO REASSEMBLE
1557 UNSAT1: SOJL B,UNSAT3
1561 PUSHJ P,LKUP ;LOOK IT UP
1563 UNSAT2: PUSHJ P,PATCH ;REMOVE IT FROM TABLE
1568 UNSAT3: POP P,T2 ;POINTS TO TABLE ENTRY
1569 MOVE T,T1 ;SYMBOL VALUE
1570 MOVE A,CGLOB ;SQUOOZE
1572 \f; HERE TO HANDLE LINKS (BLOCK TYPE 23)
1574 LINK: SETOM LINKDB ;LINKS BEING HACKED
1575 PUSHJ P,GETBIT ;RELOCATION BITS INTO TT
1576 PUSHJ P,RRELOC ;LINK #
1578 JUMPE A,LOAD4A ;ILLEGAL LINK #
1580 PUSHJ P,RRELOC ;STORE ADDRESS
1582 JUMPL A,LNKEND ;JUMP ON LINK END
1584 JRST LOAD4A ;ILLEGAL LINK #
1586 HRRZ C,LINKDB(A) ;LINK VALUE
1589 HRRM C,(B) ;VALUE INTO STORE ADDRESS
1591 HRRM B,LINKDB(A) ;NEW VALUE
1596 LNKEND: MOVNS A ;LINK #
1598 JRST LOAD4A ;ILLEGAL LINK #
1599 HRLM B,LINKDB(A) ;LINK END ADDRESS
1602 ;HERE AFTER ALL LOADING TO CLEAN UP LINKS
1608 LNKF1: MOVS B,LINKDB(A) ;VALUE,,STORE ADDRESS
1609 TRNN B,-1 ;DON'T STORE FOR ZERO STORE ADDRESS
1615 \f;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER
1617 HLFKIL: MOVE D,DDPTR ;RESTORE POINTER TO LOCAL TABLE
1618 ADD D,[2,,2] ;BUMP IT
1619 NXTKIL: MOVE B,D ;PUT POINTER ALSO IN B
1620 PUSHJ P,RPB ;GET A WORD
1621 TLZ T,740000 ;MAKE SURE NO FLAGS
1622 NXTSYK: MOVE A,(B) ;GET A SYMBOL
1623 TLZN A,740000 ;IF PROG NAME HIT, TIME TO QUIT
1625 CAME T,A ;IS THIS ONE
1626 JRST NOKIL ;NO TRY AGAIN
1627 TLO A,400000 ;TURN ON HALF KILL BIT IN DDT
1628 IORM A,(B) ;RESTORE SYMBOL TO TABLE
1632 AOBJN B,NXTSYK ;TRY ANOTHER
1633 JRST NXTKIL ;TRY ANOTHER ONE
1646 PUSHJ P,PRGEND ;REAL PRGM END
1650 MOVE A,(BOT) ; GET CURRENT PRG NAME
1651 NODMCG, MOVSI T,1 ; WANT NON-ZERO, BUT POSITIVE LEFT HALF
1652 DMCG, MOVE T,1(BOT) ; POINTS TO TOP AND BOTTOM OF PROGRAM
1653 TLZ A,740000 ; MARK AS PROGNAME
1655 PUSHJ P,ADDDDT ; TO DDT TABLE
1657 PUSHJ P,SHUFLE ;PUT THE SYMBOLS IN THE RIGHT ORDER
1662 PRGEND: HRRZM ADR,FACTOR
1667 ;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE
1668 ;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER
1669 ;THAT THE TRANSLATOR GAVE THEM TO STINK
1671 SHUFLE: MOVE B,DDPTR
1672 ADD B,[2,,2] ;IGNORE THIS PROGRAM NAME
1673 JUMPGE B,CPOPJ ;NO LOCALS IN DDT'S TABLE
1675 SHUF1: MOVE A,(B) ;SQUOOZE
1677 JRST SHUF2 ;FOUND A BLOCK NAME
1681 SHUF4: HRRZ A,DDPTR ;EXTENT OF THE SYMBOLS IS KNOWN
1682 ;A/POINTER TO BOTTOM SYMBOLS
1683 ;B/POINTER TO TOP OF SYMBOLS
1684 SHUF5: ADDI A,2 ;SYMBOL AT BOTTOM
1685 HRRZI B,-2(B) ;SYMBOL AT TOP
1687 POPJ P, ;WE HAVE MET THE ENEMY AND THEY IS US!
1689 MOVE C,(A) ;SWAP THESE TWO ENTRIES
1698 ;HERE WHEN WE FIND A BLOCK NAME
1700 SHUF2: MOVE A,1(B) ;VALUE
1701 TLNE A,-1 ;PROGRAM NAME?
1703 JRST SHUF3 ;IGNORE BLOCK NAME
1705 GTWD: PUSHJ P,RDWRD ;GOBBLE A WORD FROM THE BUFFER
1708 JFCL 4,[AOJA CKS,.+1]
1711 GETBIT: ILDB TT,BITPTR
1721 ;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.)
1723 RDWRD: PUSH P,TT ;SAVE TT
1724 MOVE TT,INPTR ;GOBBLE POINTER
1725 MOVE T,(TT) ;GOBBLE DATUM
1726 AOBJN TT,RDRET ;BUFFER EMPTY?
1727 DOREAD: MOVE TT,[-STNBLN,,STNBUF] ;YES, READ A NEW ONE
1728 IFN ITS, .IOT TPCHN,TT ;GOBBLE IT
1746 MOVE TT,[-STNBLN,,STNBUF] ;RE GOOBBLE
1747 RDRET: MOVEM TT,INPTR ;SAVE IT
1751 ;HERE TO START FIRST READ
1754 JRST DOREAD ;READ A NEW BUFFER
1756 RCKS: (3000+SIXBIT /CKS/)
1770 TYPR2: PUSHJ P,SIXTYO
1793 PUSH P,["*-"0+1,,.+1]
1807 ;0 1-12 13-44 45 46 47
1810 LI4: CAMN A,[(10700)CBUF-1]
1816 IFN ITS, .IOT TYOC,T
1823 IFN T-1, MOVE 1,JSYS1
1828 IFN ITS, .IOT TYIC,T
1847 LI3: MOVE A,[(10700)CBUF-1]
1849 MOVE P,[(,-LPDL)PDL-1]
1861 CAMN A,[(10700)CBUF+CBUFL]
1882 CAIN T,DOLL ;CHECK FOR A REAL DOLLAR SIGN
1889 MOVEI A,SLIS(T) ;WHERE TO?
1890 CAIE A,DUMPY ;IS IT A DUMP
1891 TRZ FF,MLAST+SETDEV ;NO, KILL FUNNY FLAGS
1892 CAIE A,HASHS ; HASH SET?
1893 PUSHJ P,HASHS1 ; MAYBE DO IT
1911 ORCMI TT,7 ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
1912 AOJN TT,LIST2 ; NOT PROG NAME
1914 LIST5: PUSHJ P,VALPT
1917 LIST2: XOR TT,C ; TT/ -1 IF S AND DEF, OR ? AND UNDEF
1918 AOJE TT,LIST7 ; PRINT VALUES
1919 LIST6: HRRZ D,LIST(D) ; NEXT SYMBOL
1920 JUMPN D,LISTER ; MORE, GO ON
1923 LIST7: PUSHJ P,SPC ; PRINT UNDEFINED SYMBOL
1924 PUSHJ P,ASPT ; PRINT SYMBOL
1926 TRNE FF,ARG ; SKIP IF 1?
1927 JUMPN C,LIST9 ; JUMP IF ?
1930 LIST9: MOVE D,1(D) ; POINT TO CHAIN
1938 HRRZ T,1(D) ; SMALL VAL
1939 TRNN FF,ARG ; ARG GIVEN?
1940 SKIPN C ; OR SS COMM
1941 MOVE T,1(D) ; USE FULL WORD
1944 ; INITIALIZES ALL AREAS OF CORE
1946 HASHS: MOVE A,D ; SIZE TO A
1947 TRNN FF,ARG ; SKI IF ARG GIVEN
1948 HASHS1: MOVEI A,INHASH ; USE INITIAL
1949 SKIPE HBOT ; SKIP IF NOT DONE
1951 PUSH P,A ; NOW SAVEE IT
1955 MOVEI B,LOSYM ; CURRENT TOP
1957 CAIG A,<INITCR*2000> ; MORE CORE NEEDED?
1958 JRST HASHS3 ; NO, OK
1959 SUBI A,<INITCR*2000>+1777
1961 HASHS2: PUSHJ P,CORRUP ; UP THE CORE
1962 SOJN A,.-1 ; FOR ALL BLOCKS
1964 HASHS3: MOVEM B,HBOT ; STORE AS BOTTOM OF HASH TABLE
1965 ADD B,-2(P) ; ADD LENGTH
1966 MOVEM B,HTOP ; INTOTOP
1969 MOVEM B,PARBOT ; SAVE AS BOTTOM OF LOADER TABLE AREA
1970 MOVEM B,PARCUR ; ALSO AS CURRENT PLACE
1972 MOVE B,LOBLKS ; CURRENT TOP OF CORE
1977 ADDI B,1 ; NOW DDT TABLE
1981 MOVEM B,DDTOP ; TOP OF DDT TABLE
1983 HRRM B,ADRPTR ; INTO CORE SLOTS
1987 PUSHJ P,CORRUP ; INITIAL CCORE BLOCK
1991 ; SET UP INIT SYMBOLS
1993 MOVE C,[EISYM-EISYME,,EISYM]
1999 IDIVI A,(B) ; HASH IT
2001 HRRZ A,(B) ; GET CONTENTS
2016 CORRUP: PUSHJ P,GETCOR
2020 PUSHJ P,WINP ; WE HAVE THE CORE, TELL LOSER
2027 IFN ITS,TMSERR: JRST SCE
2054 TYO: IFN ITS, .IOT TYOC,T
2061 IFN T-1, MOVE 1,JSYS1
2070 TDDT: SKIPE LINKDB ;TEST FOR LINK HACKAGE
2071 PUSHJ P,LNKFIN ;CLEAN UP LINKS
2072 PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
2076 SYMS: JUMPE D,SYMS5 ; DONE, QUIT
2077 MOVE A,(D) ; GET SYMBOL
2078 TLNN A,200000 ; SKIP IF DEFINED
2080 TLNE A,40000 ; SKIP IF LOCAL
2081 TRNE FF,GLOSYM ; SKIP IF GLOBALS NOT ACCEPTABLE
2082 TLNE A,100000 ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
2083 JRST SYMS6 ; LOSER, OMIT
2084 TRNN FF,GLOSYM ; SKIP IF GLOBAL
2085 SKIPL SYMSW ; SKIP IF NO LOCALS
2086 JRST SYMS3 ; WINNER!!!, MOVE IT OUT
2088 SYMS8: HRRZ A,LIST(D) ; POINT TO NEXT
2090 MOVEM D,T2 ; SAVE FOR PATCH
2091 PUSHJ P,PATCH ; FLUSH FROM TABLE
2092 POP P,D ; POINT TO NEXT
2095 SYMS6: HRRZ D,LIST(D) ; POINT TO NEXT SYMBOL
2096 JRST SYMS ; AND CONTINUE
2098 SYMS3: TRZ FF,NOTNUM ;ASSUME ALL NUMERIC
2100 MOVE T,A ;SEE IF IT IS A FUNNY SYMBOL
2101 IDIVI T,50 ;GET LAST CHAR IN TT
2103 DIVSYM: CAIG TT,12 ;IS THE SYMBOL > 9
2104 CAIGE TT,1 ;AND LESS THAN OR EQUAL TO 0
2105 TRO FF,NOTNUM ;NO, SAY NOT A NUMBER
2106 IDIVI T,50 ;CHECK NEXT
2107 JUMPE TT,SYMS8 ;NULL IN THE MIDDLE LOSES
2108 JUMPN T,DIVSYM ;DIVIDE UNTIL T IS 0
2109 CAIN TT,21 ;IS THIS A "G"
2110 TRNE FF,NOTNUM ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
2114 HRRZ C,LIST(D) ; POINT TO NEXT
2117 PUSHJ P,PATCH ; FLUSH IT
2121 TLC A,140000 ;DDT LOCAL
2122 TLNN A,37777 ;IF SQUOZE "NAME" < 1000000,
2123 PUSHJ P,ADDDD2 ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
2134 EXAM: CAMLE D,MEMTOP
2135 JRST TRYHI ; COULD BE IN HIGH SEG
2139 TRYHI: TRNE D,400000 ; SKIP IF NOT HIGH
2140 CAMLE D,HIGTOP ; SKIP IF OK
2142 MOVE T,(D) ; GET CONTENTS
2147 GETCOM: MOVE A,[10700,,CBUF-1]
2149 MOVE P,[(,-LPDL)PDL-1]
2153 MOVEI T,0 ;REOPEN CHANNEL IN ASCII MODE
2155 .OPEN TPCHN,DEV ;RE OPEN
2166 MOVE 2,[070000,,200000]
2177 IFN ITS, .IOT TPCHN,T
2194 JUMPL T,FIXOPN ;JUMP IF EOF
2195 CAIN T,3 ;CHECK FOR EOF
2196 JRST FIXOPN ;IF SO QUIT
2201 IDPB T,A ;DEPOSIT CHARACTER
2202 CAME A,[10700,,CBUF+CBUFL]
2206 IFN ITS, .IOT TYOC,T
2213 PUSHJ P,FIXOPN ;FIX UP OPEN CODE
2222 FNF2: PUSHJ P,FIXOPN
2226 PAPER: MOVEI A,(SIXBIT /PTR/)
2228 POPJ P, ;REAL OPEN WILL OCCUR LATER
2232 TRO FF,SETDEV ;SETTING DEVICE
2235 OPNTP: TRO FF,MLAST ;SET M LAST COMMAND
2237 IFN ITS, .SUSET [.SSNAM,,SNAME]
2240 POPJ P, ;REAL OPEN WILL OCCUR LATER
2246 JRST RDFRST ;STAART UP THE READ ING
2257 MOVE 2,[440000,,200000]
2268 NTS: (3000+SIXBIT /NTS/)
2270 DEV: 6,,(SIXBIT /DSK/)
2274 SNAME: 0 ;SYSTEM NAME
2281 SIXTYO: JUMPE TT,CPOPJ
2296 DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
2301 REPEAT 2,PUSHJ P,SPC
2303 .OPEN ERCHN,ERRBL ;OPEN ERROR DEVICE
2304 JRST .-1 ;DON'T TAKE NO FOR AN ANSWER
2306 ERLP: .IOT ERCHN,A ;READ A CHAR
2307 CAIE A,14 ;IF FORM FEED
2314 ERDON: .CLOSE ERCHN,
2320 ERRBL: (SIXBIT /ERR/) ;ERROR DEVICE
2330 TYPF2: SKIPN TT,DEV(A)
2345 MOVE A,[440700,,FILSTR]
2357 LOADN: SKIPA C,SYMFLG
2358 LOADG: MOVEI C,DDSYMS
2359 PUSHJ P,OPNPTR ;DO THE REAL OPEN (AND FIRST READ)
2363 RESTAR: MOVEM P,SAVPDL
2367 RESETT: MOVEI A,FACTOR ;LEAVE GLOBAL LOCATION MODE
2369 TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND
2370 SFACT: MOVEM D,FACTOR
2374 COMVAL: SKIPA COMLOC
2377 COMSET: MOVEM D,COMLOC
2394 SOFSET: HRRM D,LKUP3
2411 MOVE C,[(000600)A-1]
2419 DDT1: MOVEI C,[CONC69 ASCIZ \
\e\eJ,\SA,[/
\e9B!
\eQ
\r],\DDPTR,[/
\eQ
\e\19:VP \]]
2423 JUMPN T,DDT6 ;END OF STRING MARKED WITH ZERO BYTE
2424 MOVE T,SA ;GET STARTING ADDRESS
2425 TLNN T,777000 ;IF INSTRUCTION PART ZERO,
2426 TLO T,(JRST) ;THEN TURN INTO JRST
2427 MOVEM T,SA ;USE AS STARTING ADDRESS
2428 TRNE FF,GOF ;IF G COMMAND,
2429 MOVEM T,EXIT ;THEN USE AS LOADER EXIT
2430 MOVE B,LOBLKS ;GET CURRENT CORE ALLOCATION+1
2431 SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2432 HRRM B,PALLOC ;SAVE IN EXIT ROUTINE
2433 LSH B,10. ;SHIFT TO MEMORY LOCATION
2434 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2435 HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2436 HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2437 ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2438 MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
2440 IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
2442 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2443 BLT B,LEXEND ;BLT IN EXIT ROUTINE
2444 BLT 17,17 ;BLT IN PROGRAM AC'S
2445 EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2460 ;EXIT ROUTINE FROM LOADER
2461 ;BLT'ED INTO 30 - 30+N
2463 EXBLTP: .+1,,LEXIT ;BLT POINTER
2464 OFST==30-. ;LEXIT=30
2466 PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
2467 MOVE 17,SV17 ;GIVE USER HIS LOCATION 17
2469 IFN ITS, .CORE ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
2472 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
2474 IFN ITS, .VALUE LEXEND
2477 0 ;END OF EXIT ROUTINE
2480 DDT1: MOVE T,SA ;GET STARTING ADDRESS
2481 TLNN T,777000 ;IF INSTRUCTION PART ZERO,
2482 TLO T,(JRST) ;THEN TURN INTO JRST
2483 MOVEM T,SA ;USE AS STARTING ADDRESS
2484 TRNE FF,GOF ;IF G COMMAND,
2485 MOVEM T,EXIT ;THEN USE AS LOADER EXIT
2486 MOVEI T,DDT4 ;MAKE OPT GO TO DDT4
2487 HRRM T,TYOM ;INSTEAD OF TYO
2488 MOVEI C,[ASCIZ \
\e\eJ
\e9B/#0
\r#1
\e\19\eP
\16\] ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
2490 PUSHJ P,DDTSG ;GENERATE REST OF STRING
2491 MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
2492 SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2493 MOVE C,B ;SAVE OUR SIZE
2494 LSH B,10. ;SHIFT TO MEMORY LOCATION
2495 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2496 HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2498 MOVNM C,PALL0 ;NUMBER OF BLOCKS TO FLUSH
2500 TRZ C,400000 ;DELETE PAGE
2502 HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2503 ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2504 MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
2506 IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
2508 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2509 BLT B,LEXEND ;BLT IN EXIT ROUTINE
2510 BLT 17,17 ;BLT IN PROGRAM AC'S
2511 EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2526 DDTST: MOVE T,SA ;#0
2529 DDTSN: ILDB T,C ;GET DIGIT AFTER NUMBER SIGN
2530 XCT DDTST-"0(T) ;GET VALUE IN T
2531 PUSHJ P,OPT ;"TYPE OUT" INTO VALRET STRING IN OCTAL
2532 DDTSG: ILDB T,C ;GET CHAR FROM INPUT STRING
2533 CAIN T,"# ;NUMBER SIGN?
2534 JRST DDTSN ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
2535 IDPB T,B ;DEPOSIT IN OUTPUT STRING
2536 JUMPN T,DDTSG ;LOOP ON NOT DONE YET
2539 ;EXIT ROUTINE FROM LOADER
2540 ;BLT'ED INTO 20 - 20+N
2542 EXBLTP: .+1,,LEXIT ;BLT POINTER
2543 OFST==20-. ;OFFSET, THIS CODE DESTINED FOR LEXIT
2544 LEXIT=.+OFST ;LEXIT=20
2546 PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
2550 PSV17: 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
2554 MOVE 17,PSV17+OFST ;GIVE USER HIS LOCATION 17
2556 IFN ITS, .VALUE .+OFST+1
2561 LEXEND=.+OFST-1 ;END OF EXIT ROUTINE
2562 SV17=PSV17+OFST ;LOCATION TO SAVE 17
2568 ZERO: MOVEI A,(NBLKS)
2572 PUSHJ P,SCE ;GO TO ERROR
2580 GETMEM: PUSHJ P,GETCOR
2605 SUB B,LOWSIZ ;NUMBER OF BLOCKS WE WANT
2619 GETC2: AOS -2(P) ;SKIP RETURN
2624 SCE: SOS (P) ;MAKE POPJ BE A "JRST .-1"
2626 PUSHJ P,COREQ ;ASK LOSER
2627 POPJ P, ;HE SAID YES
2630 COREQ: PUSH P,A ;SAVE SOME ACS
2631 SKIPE KEEP ; SKIP IF NOT LOOPING
2633 COREQ0: MOVEI A,[ASCIZ /NO CORE:
2634 TYPE C TO TRY INDEFINITELY
2639 .IOT TYIC,A ;READ A CHARACTER
2641 CAIN A,"N ; WANTS LOSSAGE?
2655 ;ROUTINE TO PRINT A LINE
2659 MOVSI B,440700+A ;BYTE POINTER TO INDEX OF A
2661 LINO1: ILDB C,B ;GET CHAR
2662 JUMPE C,LINO2 ;ZERO, END
2663 IFN ITS, .IOT TYOC,C
2671 LINO2: MOVEI A,15 ;PUT OUT CR
2672 IFN ITS, .IOT TYOC,A
2683 MOVEI A,[ASCIZ /WIN!!!/]
2689 (<<A-SLIS>_9>+B-SLIS)<<C-SLIS>_9>+D-SLIS
2692 DTAB: (331100+T)DTB-74/4
2697 DTB: FOUR LBRAK,EQLS,ERR,MLIS, ;< = > ?
2698 FOUR GETCOM,ERR,BEG,COMSET, ;@ A B C
2699 FOUR DDT,NTS,NTS,GO, ;D E F G
2700 FOUR HASHS,ERR,JOB,KILL, ;H I J K
2701 FOUR LOADG,UTAP,LOADN,SOFSET, ;L M N O
2702 FOUR PAPER,COMVAL,SFACT,SLIS, ;P Q R S
2703 FOUR CPOPJ,ERR,ERR,ERR, ;T U V W
2704 FOUR SADR,DUMPY,ZERO,EXAM, ;X Y Z [
2706 IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW
2708 INFORM [DISPATCH ROOM]\<1000-DDT+SLIS>
2711 ;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
2712 ;STINK TO KILL ITSELF.
2716 TRZN FF,MLAST ;WAS "M" THE LAST COMMAND?
2717 PUSHJ P,FIXFIL ;FIX UP THE FILE NAME
2718 MOVEI A,(SIXBIT /DSK/)
2719 TRZN FF,SETDEV ;WAS DEVICE SET?
2720 HRRM A,DEV ;NO, SET IT
2722 .OPEN TPCHN,DEV ;SEE IF IT EXISTS
2725 .CLOSE TPCHN, ;CLOSE IT
2726 .FDELE DEV ;DELETE IT
2727 JFCL ;IGNORE LOSSAGE
2729 OPNOK: MOVSI A,7 ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK
2731 .OPEN TPCHN,DEV ;OPEN THE CHANNEL
2742 MOVE 2,[440000,,300000]
2752 PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE
2754 MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
2755 PUSHJ P,OUTWRD ;PUT IT OUT
2757 MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
2758 SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2759 LSH B,10. ;SHIFT TO MEMORY LOCATION
2760 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2761 MOVEI ADR,20 ; GET TOP OF LOW SEG IN USER'S LOC 20
2764 MOVN ADR,MEMTOP ;GET -<LENGTH OF CORE IMAGE>
2765 HRLZS ADR ;AOBJN POINTER
2767 DMP2: SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD
2768 AOBJN ADR,.-1 ;UNTIL THE WORLD IS EXHAUSTED
2769 JUMPGE ADR,CHKHI ;DROPPED THROUGH, JUMP IF CORE EMPTY
2771 MOVEI C,(ADR) ;SAVE POINTER TO NON ZERO WORD
2772 MOVEI A,(C) ;AND ANOTHER COPY
2774 DMP1: SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK
2775 AOBJN ADR,.-1 ;UNTIL WORLD EXHAUSTED
2776 JUMPGE ADR,DMPLST ;IF WORLD EMPTY, QUIT
2778 AOBJP ADR,DMPLST ;CHECK NEXT WORD
2779 SKIPE B,@ADRPTR ;FOR BEING ZERO
2780 JRST DMP1 ;ONE LONE ZERO, DON'T END BLOCK
2782 DMPLST: MOVEI D,(ADR) ;POINT TO END
2783 SUB C,D ;C/ -<LENGTH OF BLOCK>
2784 HRL A,C ;A/ AOBJN TO BLOCK
2785 MOVE B,A ;COPY TO B FOR OUTWRD
2787 PUSHJ P,OUTWRD ;PUT IT OUT
2789 HRRI B,@BPTR ;NOW POINT TO REAL CORE
2790 IFN ITS, .IOT TPCHN,B ;BARF IT OUT
2807 MOVE B,A ;GET POINTER BACK IN B
2808 MOVE C,B ;FIRST WORD IN CHECK SUM
2809 HRRI B,@BPTR ;POINT TO REAL CORE
2813 AOBJN B,.-2 ;AND DO FOR ENTIRE BLOCK
2816 PUSHJ P,OUTWRD ;AND PUT IT OUT
2818 JUMPL ADR,DMP2 ;IF MORE, GO DO IT
2820 CHKHI: SKIPN MEMTOP,HIGTOP ; ANY HIGH SEG
2821 JRST DMPSYMS ; NO, GO ON TO SYMS
2822 SETZM HIGTOP ; RESET IT
2823 HLLZS ADRPTR ; FIX UP POINTERS
2825 LDB ADR,[2100,,MEMTOP] ; GET NO. OF WORDS
2828 HRRI ADR,400000 ; START OF HIGH SEG
2832 ;HERE TO DO START ADDRESS
2834 DMPSYMS: HRRZ B,SA ;GET START ADR
2835 IFN ITS, HRLI B,(JUMPA) ;USE "JUMPA" TO MAKE DDT HAPPY
2842 ; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE
2852 MOVE 1,[440700,,FILSTR]
2870 MOVE 3,[440700,,[ASCIZ /SYMBOLS/]]
2879 MOVE 2,[440000,,300000]
2890 HLLZ B,DDPTR ;GET NUMBER
2891 PUSHJ P,OUTWRD ;PUT IT OUT
2893 MOVE C,DDPTR ;FOR CKS
2894 .IOT TPCHN,DDPTR ;OUT GOES THE WHOLE TABLE
2899 MOVEI B,0 ; WILL COUNT SYMS
2902 TLZ T,740000 ; KILL SQUOZE BITS
2905 IDIVI T,50 ; CONVERT TO 10X/20 SQUOZE
2911 TLZ T,37777 ; JUST GET SQUOZE BITS
2912 JUMPN T,TWNTY2 ; JUMP UNLESS PROG NAME
2920 ; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING
2925 PUSHJ P,OUTWRD ; PUT OUT COUNT
2931 TWNTY5: MOVE T,(A) ; SEARCH FOR A PROG NAME (OR END)
2938 TWNTY6: JUMPE C,TWNTY7
2953 TWNTY7: ADD A,[2,,2]
2961 PUSHJ P,OUTWRD ;PUT OUT THE CKS
2963 MOVSI B,(JRST) ;FINISH WITH "JRST 0"
2966 MOVNI B,1 ;FINISH WITH NEGATIVE
2969 .CLOSE TPCHN, ;CLOSE THE FILE
2978 IFN ITS, .VALUE [ASCIZ /:KILL /] ;KILL
2993 ;SUBROUTINE TO PUT OUT ONE WORD
2995 OUTWRD: HRROI T,B ;AOBJN POINTER TO B
2996 IFN ITS, .IOT TPCHN,T
3013 ;HERE TO BUILD DEFAULT OUTPUT FILE NAME
3015 FIXFIL: MOVE A,[SIXBIT /_STNK_/] ;DEFAULT NAME 1
3017 MOVE A,[SIXBIT /DUMP/] ;AND NAME 2
3021 ; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.
3024 SKIPN A,PARLST ; ANY ON FREE LIST?
3025 JRST PAIR1 ; NO, TRY FREE AREA
3026 HRRZ B,(A) ; YES, CDR THE LIST
3028 PAIR3A: SETZM (A) ; CLEAR 1ST WORD
3032 PAIR1: MOVE A,PARCUR ; TRY FREE AREA
3033 ADDI A,2 ; WORDS NEEDED
3034 CAML A,PARTOP ; SKIP IF ROOM EXISTS
3036 PAIR4: EXCH A,PARCUR ; RETURN POINTER AND RESET PARCUR
3040 SKIPN A,QUADLS ; SKIP IF ANY THERE
3042 HRRZ B,(A) ; CDR THE QUAD LIST
3046 QUAD1: MOVE A,PARCUR ; GET TOP
3048 CAML A,PARTOP ; OVERFLOW?
3049 JRST QUAD2 ; YES, GET MORE
3050 JRST PAIR4 ; NO, WIN
3052 PAIR2: PUSHJ P,MORPAR ; GET MORE CORE
3055 QUAD2: PUSHJ P,MORPAR
3059 HRRZ B,PARLST ; SPLICE IT INTO FREE LIST
3062 JRST PAIR3 ; RETURN POPPING B
3070 ; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
3072 MORPAR: PUSHJ P,GETCOR ; TRY AND GET A BLOCK
3074 PUSHJ P,TMSERR ; COMPLAIN
3080 PUSHJ P,MOVCOD ; TRY AND GET CODE OUT OF THE WAY
3081 PUSHJ P,MOVDD ; ALSO GET DDT SYMBOLS OUT
3082 MOVEI A,2000 ; INCREASE PARTOP
3091 HRRZ A,ADRPTR ; POINT TO CURRENT START
3092 ADDI A,2000 ; NEW START
3094 HRRM A,ADRPTR ; FIX POINTERS
3097 MOVE B,LOBLKS ; GEV(CURRENT TOP (IN BLOCKS)
3098 ASH B,10. ; CONVERT TO WORDS
3100 MOVCO3: MOVEI A,-2000(B) ; A/ POINT TO LAST DESTINATION
3101 CAIG B,(C) ; SKIP IF NOT DONE
3103 HRLI A,-2000(A) ; B/ FIRST SOURCE,,FIRST DESTINATION
3113 ; HERE TO MOVE DDT SYMBOLS
3117 HRRZ A,DDPTR ; GET CURRENT POINTER
3120 HRRZ A,DDTOP ; TOP OF DDT TABLE
3124 MOVEI B,1(A) ; SET UP FOR BLT LOOP
3128 JRST MOVCO3 ; FALL INTO BLT LOOP
3131 ;HAVE NAME W/ FLAGS IN A, VALUE IN T,
3132 ;PUT SYM IN DDT SYMBOL TABLE.
3135 ADDDD1: MOVE A,DDPTR
3138 CAILE B,(A) ; SKIP IF OK
3139 JRST GROWDD ; MUST GROW DDT TABLE
3141 MOVEM T,1(A) ; CLOBBER AWAY
3144 MOVE A,(A) ; RESTORE A
3147 GROWDD: PUSHJ P,GETCOR
3155 PUSHJ P,MOVCOD ; MOVE THE CODE
3162 ADDDD2: PUSH P,A ;CALL HERE FROM SYMS OR TDDT.
3164 SKIPA B,DDPTR ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
3165 ADDDD3: ADD B,[2,,2]
3166 JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM.
3169 JRST ADDDD3 ;NOT THIS ONE.
3170 MOVE A,1(B) ;SYM'S REAL NAME IS IN 2ND WD OF STE,
3172 MOVEM T,1(B) ;PUT IN THE VALUE.
3175 ;TDDT EXITS THROUGH HERE.
3176 TDDTEX: PUSH P,A ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
3179 TDDTE1: ADD A,[2,,2]
3180 JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM.
3183 JRST TDDTE1 ;THIS NOT PROGRAM NAME.
3185 JRST POPBAJ ;IF IT'S ALREADY 1ST, NO PROBLEM.
3188 EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
3192 \fISYM: MOVSI C,(50*50*50*50*50*50)
3193 MOVSI T,40000 ;GLOBAL BIT
3216 FRD2: CAME B,[SIXBIT /@/]
3219 FRD: MOVSI B,(SIXBIT /@/)
3220 MOVSI C,(SIXBIT /@/)
3225 JRST CHBIN ;CHECK IF SHOULD CHANGE NAME 2 TO BIN
3241 USRSET: MOVEM C,SNAME
3244 DEVNAM: PUSH P,CDEVN1
3248 DEVNM1: TRO FF,SETDEV ;SAY DEVICE SET
3251 JRST CHBIN ;CHECK FOR CHANGE TO BIN
3253 DEVSET: TRO FF,SETDEV ;DEVICE SET
3257 CHBIN: CAME B,[SIXBIT /@/] ;WAS NO NAME2 SUPPLIED?
3258 POPJ P, ;NAME2 SUPPLIED, GO AWAY
3259 MOVE B,C ;MAKE NAME1 INTO NAME2
3260 NODMCG, MOVSI C,(SIXBIT /REL/) ;USE REL FOR NAME2
3261 DMCG, MOVSI C,(SIXBIT /BIN/)
3262 CDEVN1: POPJ P,DEVNM1
3266 MOVE B,[440700,,FILSTR]
3271 JRST FRD1 ; FINISHED
3282 EISYM: ;INITIAL SYMBOLS
3284 CRELPT: SQUOZE 64,$R.
3287 CPOINT: SQUOZE 64,$.
3301 POLSW: 0 ;-1=>WE ARE DOING POLISH
3302 PPDP: -PPDL,,PPDB-1 ;INITIAL POLISH PUSH DOWN POINTER
3303 PPDB: BLOCK PPDL+1 ;POLISH PUSH DOWN BLOCK
3304 SATED: 0 ;COUNT OF POLISH FIXUPS TO BE DELETED
3305 SATPDP: -SATPDL,,SATPDB-1 ;POINTER TO POLISH FIXUPS TO BE DELETED
3306 SATPDB: BLOCK SATPDL+1 ;LIST OF POLISH FIXUPS TO BE DELETED
3307 SVSAT: 0 ;# OF OPERANDS NEEDED
3308 POLPNT: 0 ;POINTER TO POLISH CHAIN
3309 CGLOB: 0 ;CURRENT GLOBAL IN SOME SENSE
3310 CGLOBV: 0 ;CURRENT GLOBAL VALUE IN SOME SENSE
3311 GLBFS: 0 ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
3312 SVHWD: 0 ;WORD CURRENTLY BEING READ BY POLISH
3313 GLBCNT: 0 ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
3314 HEADNM: 0 ;# POLISH FIXUPS SEEN
3315 LFTFIX: 0 ;-1=> LEFT HALF FIXUP IN PROGRESS
3316 LINKDB: BLOCK MNLNKS+1 ;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
3317 HIBLK: 0 ; BLOCKS IN HIGH SEG
3318 KEEP: 0 ; FLAG SAYING WE ARE IN A CORE LOOP
3320 USINDX: 0 ; USER INDEX
3322 HIGTOP: 0 ; TOP OF HIGH SEG
3323 INPTR: 0 ;HOLDS CURRENT IO POINTER
3324 STNBUF: BLOCK STNBLN ;BUFFER FOR BLOCK READS
3329 ADRPTR: <INITCR*2000>(ADR)
3330 BPTR: <INITCR*2000>(B)
3331 DPTR: <INITCR*2000>(D)
3345 ; CORE MANAGEMENT VARIABLES
3348 CWORD0: 4000,,400000+<<INITCR-1>_9.>
3349 CWORD1: 4000,,600000-1000
3350 LOWSIZ: INITCR ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
3352 LOBLKS: INITCR+1 ; NUMBER OF BLOCKS OF CORE WE WANT
3353 PARBOT: 0 ; POINT TO BOTTOM OF SYMBOL TABLES
3354 PARTOP: 0 ; POINT TO TOP OF SAME
3355 PARLST: 0 ; LIST OF AVAILABLE 2 WORD BLOCKS
3356 QUADLS: 0 ; LIST OF AVAILABLE 4 WORD BLOCKS
3357 PARCUR: 0 ; TOP CURRENTLY IN USE SYMBOL TABLE CORE
3359 DDPTR: 0 ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
3360 DDTOP: 0 ; HIGHEST ALLOCATED FOR DDT
3361 DDBOT: 0 ; LOWEST ALLOCATED FOR DDT
3363 HTOP: 0 ; TOP OF HASH TABLE
3364 HBOT: 0 ; BOTTOM OF HASH TABLE
3366 PDL: IFN ITS, .SUSET [.RSNAM,,SNAME] ;GET INITIAL SYSTEM NAME
3369 MOVE NBLKS,[20,,INITCR]
3388 MOVE TT,[SIXBIT /STINK./]
3392 IFN ITS, .SUSET [.RMEMT,,TT]
3394 MOVEI TT,INITCR*2000
3400 TDO TT,[4000,,400000]
3418 FILSTR: BLOCK 10 ; GOOD FOR 40 CHARS
3419 LOSYM: ;LOWEST LOC AVAIL FOR SYM TBL
3420 INITCR==<LOSYM+3000>/2000 ;LDR LENGTH IN BLOCKS
3422 INFORM [HIGHEST USED]\LOSYM
3423 INFORM [LOWEST LOCATION LOADED ]\LOWLOD
3424 INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
3425 INFORM [INITIAL CORE ALLOCATION]\INITCR