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,[JRST 4,.] ;NO SYMBOL THERE
531 HRRZM D,T2 ;TABLE ENTRY TO DELETE
532 PUSHJ P,RPB ;SOAK UP ANOTHER WORD
533 JUMPGE T,LG1 ;JUMP TO RENAME LOCAL
534 TLNN B,200000 ;MAKE SURE THING IS DEFINED
535 JRST 4,. ;CANNOT HACK UNDEFINED SYMBOL
539 ;HERE TO RENAME LOCAL IN LOADER TABLE
541 LG1: PUSH P,(D) ;SQUOZE
543 MOVSI B,200000 ;MARK AS DEFINED SO THAT . . .
544 IORM B,(D) ;PATCH WILL NOT HACK REFERENCES
549 TDZ B,[37777,,-1] ;CLEAR SQUOZE
550 TLZ A,700000 ;CLEAR FLAGS OF NEW NAME
551 IOR A,B ;FOLD FLAGS, NEW NAME
552 MOVEI B,DATABK ;ASSUME IT WILL BE LOCAL
553 TLZE A,40000 ;SEE IF WE MUST RECOVER TO GLOBAL
554 MOVEI B,.+3 ;MUST RECOVER TO GLOBAL
555 PUSH P,B ;RETURN ADDRESS
557 MOVE B,(D) ;SQUOZE AND FLAGS
558 MOVE A,B ;SQUOZE WITH . . .
559 TLZA A,740000 ;FLAGS CLEARED
562 ;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY
564 LG2: JUMPGE D,DATABK ;LOCAL-GLOBAL RECOVERY
565 MOVE T,D ;D POINTS TO LOCAL
567 PUSHJ P,LKUP1B ;FIND OCCURANCE OF GLOBAL
568 IORM A,(T) ;SMASH OLD LOCAL OCCURENCE
572 MOVE B,1(D) ;ALREADY DEFINED
576 PUSHJ P,PATCH ;CLOBBER DEFINITION
579 JRST PATCH7 ;FILL IN OLD LOCAL REQ
581 LIBREQ: JUMPL D,DATABK ;ALREADY THERE
588 COMMON: ADD RH,COMLOC
591 DEFPT: MOVEI T,@LKUP3
600 LIB6: CAIN A,12 ;END OF CONDITIONAL
604 CAIE T,5 ;LOADER VALUE CONDITIONAL
605 CAIN A,11 ;COUNT MATCHING CONDITIONALS
615 TLNN T,40000 ;REAL END
617 JRST OMIT1 ;LEAVE LIB SEARCH MODE
624 JUMPGE D,LIB3 ;NOT ENTERED
627 TLNE B,200000 ;RQST NOT FILLED
628 LIB3: TLC T,200000 ;"AND NOT" BIT
630 JRST LIB1 ;THIS ONE LOSES
635 OMIT1: TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG
641 PUSHJ P,GTWD ;SOAK UP CKSUM
644 LOAD: JRST (LL) ;READ SWITCH
657 TRZ FF,COND ;FUDGE FOR IMPROPER USE OF .LIBRA
660 LDCMD ;LOADER COMMAND (1)
663 PRGN ;PROGRAM NAME (4)
665 COMLOD ;COMMON LOADING (6)
666 GPA ;GLOBAL PARAMETER ASSIGNMENT (7)
667 SYMSW: DDSYMS ;LOCAL SYMBOLS (10)
668 LDCND ;LOAD TIME CONDITIONAL (11)
669 SYMFLG: SETZ OMIT ;END LDCND (12)
670 HLFKIL ;HALF KILL A BLOCK OF SYMBOLS
671 OMIT ;OMIT BLOCK GENERATED BY LIBRARY CREATOR
672 OMIT ;LATER WILL BE .ENTRY
673 AEXTER ;BLOCK OF STUFF FOR SDAT OR USDAT
675 GLOBS ;GLOBAL SYMBOLS BLOCK TYPE 20
676 FIXES ;FIXUPS BLOCK TYPE 21
677 POLFIX ;POLISH FIXUPS BLOCK TYPE 22
678 LINK ;LINK LIST HACK (23)
680 OMIT ;LOAD LIBRARY (25)
681 OMIT ;LVAR (26) OBSOLETE
682 OMIT ;INDEX (27) NEW DEC STUFF
689 ;HERE TO PROCESS AN .EXTERN
691 AEXTER: PUSHJ P,RPB ;READ AND LOOK UP SYMBOL
692 TLO T,40000 ;TURN ON GLOBAL BIT
693 PUSHJ P,LKUP ;NOW LOOK IT UP
694 JUMPGE D,.+3 ;NEVER APPEARED, MUST ENTER
695 TLNE B,200000 ;SKIP IF NOT DEFINED
696 JRST AEXTER ;THIS ONE EXISTS, GO AGAIN
697 MOVE B,USDATP ;GET POINTER TO USDAT
698 PUSH P,A ;SAVE SYMBOL
699 TLZ A,740000 ;KILL ALL FLAGS
700 MOVE T,B ;SAVE A COPY OF THIS
701 ADD T,[3,,3] ;ENOUGH ROOM?
702 JUMPGE T,TMX ;NO, BARF AT THE LOSER
703 MOVEM T,USDATP ;NOW SAVE
704 TRNN B,400000 ; HIGH SEG?
705 MOVEM A,@BPTR ; NO GET REAL LOC
706 TRNE B,400000 ; SKIP IF LOW SEG
707 MOVEM A,(B) ;STORE INTO CORE IMAGE BEING BUILT
708 POP P,A ;RESTORE SYMBOL
709 MOVEI T,1(B) ;ALSO COMPUTE 'VALUE' OF SYMBOL
716 TMX: (3000+SIXBIT /TMX/)
721 LDCMD: ADDI T,LDCMD2+1
724 DPB T,[(330300)LDCVAL]
732 LDCMD1: TRZ FF,UNDEF+CODEF
739 GLOBAL ;GLOBAL LOCATION ASSIGNMENT (2)
740 COMSET ;COMMON ORIGIN (3)
741 RESPNT ;RESET GLOBAL RELOCATION (4)
742 LDCVAL ;LOADER VALUE CONDITIONAL (5)
743 .OFFSET ;GLOBAL OFFSET (6)
744 L.OP ;LOADER EXECUTE (7)
745 .RESOF ;RESET GLOBAL OFFSET
\f
770 .OFFSET: HRRM D,LKUP3
773 L.OP: MOVE B,T1 ;B=3 C=4 D=5
791 L.OP2:] IOR B,[0 4,5]
799 SETJNM: MOVEI A,SJNM1
818 MOVEI TT,100 ;DON'T GENERATE MDG
835 DDLUP2: TLZ T,740000 ;MARK AS BLOCK NAME
837 \f;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20
839 GLOBS: PUSHJ P,GETBIT ;CODE BITS
842 PUSHJ P,GETBIT ;CODE BITS
843 PUSHJ P,RRELOC ;VALUE
846 TLO T,40000 ;GLOBAL FLAG
847 PUSHJ P,LKUP ;SYMBOL LKUP
848 LDB C,[400400,,CGLOB] ;FLAGS
850 JRST GLOBRQ ;GLOBAL REQUEST
852 ;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION
854 TRNN C,10_-2 ;TEST FOR VALID FLAGS
855 TRNN C,4_-2 ;FORMAT IS XX01
857 LSH C,-2 ;SHIFT OUT GARBAGE
858 JUMPE C,GLBDEF ;FLAGS 04=> GLOBAL DEFINITION
859 CAIN C,40_-4 ;*****JUST A GUESS
860 JRST GLBDEF ;*****JUST A GUESS
862 ;DUMP A DEFERRED INTERNAL INTO LOADER TABLE
864 JUMPL D,GDFIT ;JUMP IF IN LOADER TABLE
865 PUSHJ P,PAIR ;GET VALUE PAIR
867 HRR T,A ;REFERENCE WORD POINTS TO PAIR
869 SETZM (T) ;MARK AS VALUE
870 MOVEM A,1(T) ;SECOND WORD IS VALUE
871 GLOBS0: MOVE A,CGLOB ;SQUOOZE
872 TLZ A,300000 ;FIX THE FLAGS
874 PUSHJ P,DEF2A ;PUT IT INTO LOADER TABLE
877 ;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE
880 JRST 4,. ;ALREADY DEFINED
881 PUSHJ P,GLOBS3 ;RETURNS REFERENCE WORD IN A
882 JUMPE B,GDFIT1 ;MUST ADD DEFERRED VALUE
885 JRST 4,. ;REFERENCE WORDS DON'T MATCH
888 JRST 4,. ;VALUES DON'T MATCH
889 JRST GLOBS ;ALL'S WELL THAT ENDS WELL
896 SETZM (T) ;MARK AS VALUE
900 \f;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60
902 GLOBRQ: SKIPGE T,CGLOBV ;SKIP IF THREADED LIST
903 JRST GLOBR1 ;SINGLE WORD FIX UP MUST WORK HARDER
907 JUMPE T,GLOBS ;IGNORE NULL REQUEST
908 JUMPGE D,GLOBNT ;JUMP IF SYMBOL NOT IN TABLE
909 TLNE B,200000 ;TEST TO SEE IF DEFINED
910 JRST GLOBPD ;PREVIOUSLY DEFINED
911 PUSHJ P,DOWN ;NOT DEFINED, ENTER REQEST INTO TABLE
913 HRLI C,100000 ;THIS IS A LINK LIST
917 ;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04
919 GLBDEF: MOVE T,CGLOBV ;VALUE
920 MOVEI TT,0 ;REDEFINE NOT OKAY, SEE DEF2
921 PUSHJ P,DEFSYM ;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP
923 \f; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN
925 GLOBPD: MOVE T,1(D) ;VALUE
926 MOVE B,CGLOBV ;POINTER TO CHAIN
930 ; ENTER NEW SYMBOL WITH LINK REQUEST
932 GLOBNT: MOVEI C,44_-2 ;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ
934 HRLI T,100000 ;SET LINK BIT IN REQUEST
938 ; SINGLE WORD FIX UP -- FLAGS=60
940 GLOBR1: TLNE T,100000 ;TEST FOR SYMBOL TABLE FIX
941 JRST GLOBST ;SYMBOL TABLE FIX
942 JUMPGE D,GLOBR2 ;JUMP IF NOT IN TABLE
944 JRST GLOBR3 ;NOT PREVIOUSLY DEFINED
945 HRRZ B,T ;FIX UP LOCATION
946 PUSHJ P,MAPB ;DO THE RIGHT THING IF B IN HIGH SEGMENT
947 TLNE T,200000 ;LEFT OR RIGHT?
949 HWAR: HRRE C,(B) ;HALF WORD ADD RIGHT
954 HWAL: HLRE C,(B) ;HALF WORD ADD LEFT
959 ; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED
961 GLOBR3: PUSHJ P,DOWN ;MAKE ROOM IN TABLE
963 HRLI T,40001 ;ASSUME RIGHT HALF
964 TLNE C,200000 ;RIGHT OR LEFT?
969 ;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS
971 MAPB: TRNN B,400000 ;SECOND SEGMENT
972 HRRI B,@BPTR ;NO, RELOCATE THE ADDRESS
974 \f; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE
976 GLOBR2: TLO A,400000 ;SYMBOL FLAG
978 HRLI T,1 ;ASSUME RIGHT HALF FIX
979 TLNE C,200000 ;LEFT OR RIGHT?
984 ; HERE FOR SYMBOL TABLE FIX
988 ; TLZ A,700000 ;MAKE SURE WE ARE STILL FIXING SAME SYMBOL
990 ; JRST 4,. ;DON'T AGREE
991 JUMPGE D,GLOBS5 ;JUMP IF FIXUP NOT SEEN
993 JRST GLOBS6 ;FIXUP NOT EVEN DEFINED
994 PUSH P,1(D) ;SAVE POINTER TO OLD SYMBOL
1001 PUSHJ P,GLOBS3 ;FIND THE GLOBAL VALUE
1006 EXCH B,(P) ;GET BACK VALUE OF FIXUP SYMBOL
1007 TLNE T,200000 ;LEFT OR RIGHT?
1012 TLZN A,FIXRT ;DID WE REALLY WANT TO DO THIS
1016 GLOBS1: HLRE C,1(A) ;LEFT HALF FIX
1019 TLZN A,FIXLT ;DID WE REALLY WANT TO DO THIS
1022 ; HERE TO FINISH UP SYMBOL TABLE FIX
1025 MOVEM A,1(B) ;STORE BACK REFERENCE WORD
1026 TLNE A,FIXLT+FIXRT ;DO WE HAVE MORE FIXING
1028 MOVE T,1(A) ;FIXED VALUE
1029 MOVEI TT,100 ;OKAY TO REDEFINE, TT USED AT DEF2
1033 ;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL
1035 GLOBS3: MOVE B,1(D) ;FIRST REFERENCE WORD
1036 GLOBS4: SKIPGE A,1(B)
1040 POPJ P, ;REFERENCE WORD NOT FOUND
1042 JRST GLOBS9 ;DEFERED INTERNAL FOR ANOTHER SYMBOL
1045 GLOBS5: PUSHJ P,GLOBS7
1048 GLOBS6: PUSHJ P,GLOBS7
1053 GLOBS7: PUSHJ P,PAIR
1057 MOVSI T,DEFINT+FIXRT
1062 MOVEM B,(T) ;MARK AS SQUOOZE
1064 MOVEM B,1(T) ;SQUOOZE
1067 GLST1: POP P,(P) ;VALUE TO ADD ON TOP OF STACK
1070 ;HERE TO FIX UP DIFFERED INTERNAL
1071 ;THAT MIGHT BE A LOCAL CALL WITH STACK
1072 ; -1(P) VALUE TO ADD
1073 ; (P) RETURN ADDRESS
1074 ; T SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX)
1079 JRST 4,. ;ITS GLOBAL, THERE'S NO HOPE
1080 MOVEI B,0 ;BLOCK NAME
1081 MOVE C,T ;SYMBOL TO FIX
1085 MOVE B,1(T) ;VALUE TO FIX
1086 HLRZ C,B ;THE LEFT HALF
1097 \f; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21
1100 JRST FIXESL ;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK
1101 PUSHJ P,GETBIT ;CODE BITS
1102 PUSHJ P,RRELOC ;FIX UP WORD
1103 CAMN T,[-1] ;SKIPS ON RIGHT HALF FIX
1104 JRST FIXESL ;LEFT HALF FIX
1105 HLRZ B,T ;C(T) = POINTER,,VALUE C(B)=POINTER
1109 FIXESL: SETOM LFTFIX ;IN CASE RRELOC GETS US OUT OF BLOCK
1112 SETZM LFTFIX ;OFF TO THE RACES
1118 HLL T,(B) ;CALL IS POINTER IN B
1119 HRLM T,(B) ; VALUE IN T
1130 \f;POLISH FIXUPS <BLOCK TYPE 22>
1132 PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
1135 COMPOL: (3000+SIXBIT /PTC/)
1136 LOAD4A: (3000+SIXBIT /IBF/)
1139 ;READ A HALF WORD AT A TIME
1141 RDHLF: TLON FF,HSW ;WHICH HALF
1143 PUSHJ P,RWORD ;GET A NEW ONE
1144 TLZ FF,HSW ;SET TO READ OTEHR HALF
1145 MOVEM T,SVHWD ;SAVE IT
1146 HLRZS T ;GET LEFT HALF
1148 NORD: HRRZ T,SVHWD ;GET RIGHT HALF
1157 ;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE
1159 ; T/ VALUE (IGNORED IF OPERATOR)
1162 PUSHJ P,PAIR ;GET TWO WORDS
1164 EXCH T,POLPNT ;POINTER TO CHAIN
1165 MOVEM T,(A) ;INTO NEW NODE
1166 HRLM C,(A) ;TOKEN TYPE INTO LEFT HALF OF FIRST WORD
1168 EXCH T,POLPNT ;RESTORE T, POINTER TO NEW NODE
1170 \f;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED)
1171 ;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED
1181 TLNN B,200000 ;SKIP IF DEFINED
1182 AOS -5(P) ;INCREMENT ADDRESS
1183 MOVEM D,-4(P) ;SET POINTER IN A
1191 ;START READING THE POLISH
1193 POLFIX: MOVE D,PPDP ;SET UP THE POLISH PUSHDOWN LIST
1194 MOVEI B,100 ;IN CASE OF ON OPERATORS
1196 SETOM POLSW ;WE ARE DOING POLISH
1197 TLO FF,HSW ;FIX TO READ A WORD THE FIRST TIME
1198 SETOM GLBCNT ;NUMBER OF GLOBALS IN THIS FIXUP
1199 SETZM POLPNT ;NULL POINTER TO POLISH CHAIN
1200 PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK
1202 RPOL: PUSHJ P,RDHLF ;GET A HALF WORD
1203 TRNE T,400000 ;IS IT A STORE OP?
1204 JRST STOROP ;YES, DO IT
1205 CAIGE T,3 ;0,1,2 ARE OPERANDS
1207 CAILE T,14 ;14 IS HIGHEST OPERATOR
1208 JRST LOAD4A ;ILL FORMAT
1209 PUSH D,T ;SAVE OPERATOR IN STACK
1210 MOVE B,DESTB-3(T) ;GET NUMBER OF OPERANDS NEEDED
1211 MOVEM B,SVSAT ;ALSO SAVE IT
1212 JRST RPOL ;BACK FOR MORE
1214 \f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
1217 OPND: MOVE A,T ;GET THE OPERAND TYPE HERE
1218 PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND
1219 MOVE C,T ;GET IT INTO C
1220 JUMPE A,HLFOP1 ;0 IS HALF-WORD OPERAND
1221 PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF
1222 HRL C,T ;GET HALF IN RIGHT PLACE
1223 MOVSS C ;WELL ALMOST RIGHT
1224 SOJE A,HLFOP1 ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
1227 TLNE C,40000 ;CHECK FOR FUNNY LOCAL
1228 PUSHJ P,SQZCON ;CONVERT TO STINKING SQUOOZE
1230 PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED
1231 JRST OPND1 ;YES, WE WIN
1232 AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
1233 AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
1234 PUSH P,C ;SAVE GLOBAL REQUESTS FOR LATER
1235 MOVEI T,0 ;MARK AS SQUOOZE
1237 PUSHJ P,SYM3X2 ;INTO THE LOADER TABLE
1238 HRRZ C,POLPNT ;NEW "VALUE"
1239 SKIPA A,[400000];SET UP GLOBAL FLAG
1240 HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG
1241 HLFOP1: SOJL B,CSAT ;ENOUGH OPERANDS SEEN?
1242 PUSH D,C ;NO, SAVE VALUE(OR GLOBAL NAME)
1243 HRLI A,400000 ;PUT IN A VALUE MARKER
1244 PUSH D,A ;TO THE STACK
1245 JRST RPOL ;GET MORE POLISH
1247 ;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT: THE FLAG BITS ARE CLEARED
1249 SQZCON: TLZ C,740000
1251 SQZ1: CAML C,[50*50*50*50*50]
1256 ; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME
1258 OPND1: MOVE C,1(A) ;SYMBOL VALUE
1260 \f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
1262 CSAT: HRRZS A ;KEEP ONLY THE GLOBAL-VALUE HALF
1263 SKIPN SVSAT ;IS IT UNARY
1264 JRST UNOP ;YES, NO NEED TO GET 2ND OPERAND
1265 HRL A,(D) ;GET GLOBAL VALUE MARKER FOR 2ND OP
1267 POP D,T ;VALUE OR GLOBAL NAME
1268 UNOP: POP D,B ;OPERATOR
1269 JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
1270 XCT OPTAB-3(B) ;IF BOTH VALUES JUST XCT
1271 MOVE C,T ;GET THE CURRENT VALUE
1272 SETSAT: SKIPG B,(D) ;IS THERE A VALUE IN THE STACK
1273 MOVE B,-2(D) ;YES, THIS MUST BE THE OPERATOR
1274 MOVE B,DESTB-3(B) ;GET NUMBER OF OPERANDS NEEDED
1275 MOVEM B,SVSAT ;SAVE IT HERE
1276 SKIPG (D) ;WAS THERE AN OPERAND
1277 SUBI B,1 ;HAVE 1 OPERAND ALREADY
1278 JRST HLFOP1 ;GO SEE WHAT WE SHOULD DO NOW
1282 GLOB: TRNE A,-1 ;IS IT IN RIGHT HALF
1283 JRST TLHG ;NO NEED TO SAVE THIS VALUE IF ITS GLOBAL
1284 PUSH P,T ;SAVE FOR A WHILE
1286 MOVEI C,1 ;MARK AS VALUE
1288 HRRZ C,POLPNT ;POINTER TO VALUE
1289 POP P,T ;RETRIEVE THE OTHER VALUE
1290 TLHG: SKIPE SVSAT ;WAS THIS A UNARY OPERATOR
1291 TLNE A,-1 ;WAS THERE A GLOBAL IN LEFT HALF
1294 MOVEI C,1 ;SEE ABOVE
1296 HRRZ T,POLPNT ;POINTER TO VALUE
1299 GLSET: EXCH C,B ;OPERATOR INTO RIGHT AC
1300 SKIPE SVSAT ;SKIP ON UNARY OPERATOR
1301 HRL B,T ;SECOND,,FIRST
1302 MOVE T,B ;SET UP FOR CALL TO SYM3X2
1304 MOVEI A,400000 ;SET UP AS A GLOBAL VALUE
1305 HRRZ C,POLPNT ;POINTER TO "VALUE"
1306 JRST SETSAT ;AND SET UP FOR NEXT OPERATOR
1307 \f;FINALLY WE GET TO STORE THIS MESS
1309 STOROP: MOVE B,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR
1311 JRST LOAD4A ;NO, ILL FORMAT
1312 HRRZ B,(D) ;GET THE VALUE TYPE
1313 JUMPN B,GLSTR ;AND TREAT GLOBALS SPECIAL
1314 MOVE A,T ;THE TYPE OF STORE OPERATOR
1316 PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP, MUST WORK HARDER
1317 PUSHJ P,RDHLF ;GET THE ADDRESS
1318 MOVE B,T ;SET UP FOR FIXUPS
1319 POP D,T ;GET THE VALUE
1320 POP D,T ;AFTER IGNORING THE FLAG
1321 PUSHJ P,@STRTAB+6(A) ;CALL THE CORRECT FIXUP ROUTINE
1323 COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
1326 JRST COMPOL ;TOO BIG, GIVE ERROR
1327 PUSHJ P,RWORD ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
1328 JRST LOAD4A ;IF NOT, SOMETHING IS WRONG
1332 JRST 4,. ;PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP
1333 PUSHJ P,RDHLF ;GET THE STORE LOCATION
1334 SUB D,[2,,2] ;VALUE AND MARKER ON STACK MEANINGLESS
1336 PUSHJ P,SYM3X2 ;STORE LOC ALREADY IN T
1337 AOS T,GLBCNT ;WE STARTED AT -1 REMEMBER?
1338 HRRZ C,HEADNM ;GET HEADER #
1339 TLO C,440000 ;MARK FIXUP AS GLOBAL BEASTIE
1340 PUSHJ P,SYM3X2 ;LAST OF POLISH FIXUP
1341 HRRZ T,POLPNT ;POINTER TO POLISH BODY
1342 MOVE A,C ;FIXUP NAME
1344 GLSTR1: SOSGE GLBCNT ;MUST PUT GLOBAL REQUESTS IN TABLE
1345 JRST COMSTR ;AND FINISH
1348 MOVE A,HEADNM ;SETUP REQUEST WORD
1349 TLO A,POLREQ ;MARK AS POLISH REQUEST
1350 JUMPGE D,GLSTR2 ;JUMP IF NOT SEEN
1355 GLSTR2: EXCH A,T ;NOT PREVIOUSLY SEEN ENTER FULL REQUEST
1356 TLO A,400000 ;MARK AS NEW TABLE ENTRY
1359 \fSTRTAB: ALSYM ;-6 FULL SYMBOL TABLE FIXUP
1360 LFSYM ;-5 LEFT HALF SYMBOL FIX
1361 RHSYM ;-4 RIGHT HALF SYMBOL FIX
1362 UNTHF ;-3 FULL WORD FIXUP
1363 UNTHL ;-2 LEFT HALF WORD FIXUP
1364 UNTHR ;-1 RIGHT HALF WIRD FIXUP
1390 ;HERE TO LOOK UP LOCAL IN SYMBOL TABLE
1392 FSYMT: PUSHJ P,FSYMT1 ;BLOCK NAME
1393 MOVE B,C ;SAVE SYMBOL
1394 PUSHJ P,FSYMT1 ;SYMBOL NAME
1395 EXCH B,C ;BLOCK NAME IN B, SYMBOL NAME IN C
1396 FSYMT2: PUSH P,A ;SAVE IT
1397 MOVE T,DDPTR ;AOBJN POINTER TO LOCALS
1398 SLCL: MOVE A,(T) ;SQUOZE
1399 TLZN A,740000 ;CLEAR FLAGS FOR COMPARE
1400 JRST SLCL3 ;BLOCK NAME
1401 CAMN A,C ;IS THIS THE SYMBOL WE SEEK
1402 JRST SLCL1 ;YES, WE MUST STILL VERIFY THE BLOCK
1403 SLCL4: ADD T,[1,,1] ;NO KEEP LOOKING
1405 JRST 4,. ;SYMBOL NOT FOUND
1407 SLCL1: JUMPE B,POPAJ1 ;SYMBOL IS IN THIS BLOCK
1408 PUSH P,T ;THIS POINTER POSSIBLY A WINNER
1409 ADD T,[2,,2] ;NEXT SYMBOL
1410 JUMPGE T,[JRST 4,.] ;WE HAVE RUN OUT OF TABLE
1412 TLNE A,740000 ;SKIP ON BLOCK NAME
1415 ; HERE WHEN WE FIND BLOCK NAME
1417 CAME A,B ;DOES THE BLOCK NAME MATCH
1418 JRST SLCL2 ;NO KEEP LOOKING
1419 POP P,T ;WINNING SYMBOL TABLE ENTRY
1420 POPAJ1: POP P,A ;RESTORE A
1421 AOS (P) ;SKIP THE PUSHJ P,RDHLF THAT FOLLOWS THIS CALL
1424 SLCL3: JUMPN B,SLCL4
1425 JRST 4,. ;SYMBOL SHOULD BE IN THIS BLOCK
1427 SLCL2: SUB P,[1,,1] ;FLUSH THE LOSING SYMBOL POINTER
1430 FSYMT1: PUSHJ P,RDHLF
1435 \f;HERE TO SATISFY GLOBAL REQUEST FOR POLISH
1437 POLSAT: PUSH P,D ;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST
1438 HRRZ T,B ;LOOK UP POLISH TO BE FIXED
1441 JUMPGE D,[JRST 4,.] ;CANNOT FIND POLISH
1442 MOVE T,CGLOB ;SQUOOZE (SET UP AT DFSYM2)
1444 MOVE B,(B) ;STORE OP
1445 MOVE B,(B) ;FIRST TOKEN
1448 SOSG 1(B) ;UPDATE UNDEFINED GLOBAL COUNT
1449 JRST PALSAT ;COUNTED OUT FINISH THIS FIXUP
1450 POLRET: MOVE A,CGLOB
1454 ;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH
1456 FIXPOL: HLRZ A,(B) ;TOKEN TYPE
1457 JUMPN A,FXP1 ;JUMP IF NOT SQUOZE
1459 JRST FXP1 ;SQUOOZE DOES NOT MATCH
1460 HRRI A,1 ;MARK AS VALUE
1462 HRLM A,(B) ;NEW TOKEN TYPE
1463 MOVEM T,1(B) ;NEW VALUE
1466 FXP1: HRRZ B,(B) ;POINTER TO NEXT TOKEN
1468 JRST 4,. ;DID NOT FIND SYMBOL
1469 \f;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED
1471 PALSAT: AOS SATED ;NUMBER OF FIXUPS SATISFIED
1472 PUSH P,(D) ;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION
1473 MOVE A,1(D) ;POINTS TO COUNT
1474 MOVE A,(A) ;STORE OP
1476 HLLZ B,(A) ;STORE OP
1477 HRRZ T,1(A) ;PLACE TO STORE
1479 PUSH D,T ;STORE ADDRESS
1480 MOVEI T,-1(D) ;POINTER TO STORE OP
1482 MOVE A,(A) ;POINTS TO FIRST TOKEN
1484 PSAT1: HLRE B,(A) ;OPERATOR
1485 JUMPL B,ENDPOL ;FOUND STORE OP
1488 JRST 4,. ;NOT OPERATOR
1489 MOVE T,1(A) ;OPERANDS (SECOND,,FIRST)
1490 HLRZ C,(T) ;FIRST OPERAND
1491 JUMPE C,[JRST 4,.] ;SQUOZE NEVER DEFINED
1492 CAIE C,1 ;SKIP IF DEFINED
1493 JRST PSDOWN ;GO DOWN A LEVEL IN TREE
1495 JRST PSAT2 ;IF UNARY OP WE ARE DONE
1497 HLRZ C,(T) ;SECOND OPERAND
1503 ;HERE TO PERFORM OPERATION
1505 PSAT2: MOVE C,1(T) ;VALUE FIRST OPERAND
1508 MOVE T,1(T) ;GET SECOND OPERAND ONLY IF NECESSARY
1509 XCT OPTAB-3(B) ;WOW!
1510 MOVEM T,1(A) ;NEW VALUE
1512 HRLM C,(A) ;MARK AS VALUE
1513 POP D,A ;GO UP A LEVEL IN TREE
1516 ;HERE TO GO DOWN LEVEL IN TREE
1518 PSDOWN: PUSH D,A ;SAVE THE OLD NODE
1521 \f;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T)
1523 ENDPOL: POP D,B ;STORE ADDRESS
1524 MOVS A,(D) ;STORE OP
1525 PUSHJ P,@STRTAB+6(A)
1526 POP P,D ;NAME OF THIS FIXUP
1527 EXCH P,SATPDP ;SAVE THIS NAME FOR LATER DELETION FROM TABLE
1532 ; HERE TO DO SYMBOL TABLE FIXUPS
1534 ; B/ SYMBOL TABLE POINTER
1536 RHSYM: HRRM T,1(B) ;RIGHT HALF FIX
1539 LFSYM: HRLM T,1(B) ;LEFT HALF FIX
1542 ALSYM: MOVEM T,1(B) ;FULL WORD FIX
1546 ;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE
1549 MOVE A,[-SATPDL,,SATPDB-1]
1550 EXCH A,SATPDP ;SET UP PUSH DOWN POINTER
1551 MOVE B,SATED ;# FIXUPS TO BE DELETED
1553 CAILE B,SATPDP ;LIST LONG ENOUGH?
1554 JRST 4,. ;TIME TO REASSEMBLE
1555 UNSAT1: SOJL B,UNSAT3
1559 PUSHJ P,LKUP ;LOOK IT UP
1561 UNSAT2: PUSHJ P,PATCH ;REMOVE IT FROM TABLE
1566 UNSAT3: POP P,T2 ;POINTS TO TABLE ENTRY
1567 MOVE T,T1 ;SYMBOL VALUE
1568 MOVE A,CGLOB ;SQUOOZE
1570 \f; HERE TO HANDLE LINKS (BLOCK TYPE 23)
1572 LINK: SETOM LINKDB ;LINKS BEING HACKED
1573 PUSHJ P,GETBIT ;RELOCATION BITS INTO TT
1574 PUSHJ P,RRELOC ;LINK #
1576 JUMPE A,LOAD4A ;ILLEGAL LINK #
1578 PUSHJ P,RRELOC ;STORE ADDRESS
1580 JUMPL A,LNKEND ;JUMP ON LINK END
1582 JRST LOAD4A ;ILLEGAL LINK #
1584 HRRZ C,LINKDB(A) ;LINK VALUE
1587 HRRM C,(B) ;VALUE INTO STORE ADDRESS
1589 HRRM B,LINKDB(A) ;NEW VALUE
1594 LNKEND: MOVNS A ;LINK #
1596 JRST LOAD4A ;ILLEGAL LINK #
1597 HRLM B,LINKDB(A) ;LINK END ADDRESS
1600 ;HERE AFTER ALL LOADING TO CLEAN UP LINKS
1606 LNKF1: MOVS B,LINKDB(A) ;VALUE,,STORE ADDRESS
1607 TRNN B,-1 ;DON'T STORE FOR ZERO STORE ADDRESS
1613 \f;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER
1615 HLFKIL: MOVE D,DDPTR ;RESTORE POINTER TO LOCAL TABLE
1616 ADD D,[2,,2] ;BUMP IT
1617 NXTKIL: MOVE B,D ;PUT POINTER ALSO IN B
1618 PUSHJ P,RPB ;GET A WORD
1619 TLZ T,740000 ;MAKE SURE NO FLAGS
1620 NXTSYK: MOVE A,(B) ;GET A SYMBOL
1621 TLZN A,740000 ;IF PROG NAME HIT, TIME TO QUIT
1623 CAME T,A ;IS THIS ONE
1624 JRST NOKIL ;NO TRY AGAIN
1625 TLO A,400000 ;TURN ON HALF KILL BIT IN DDT
1626 IORM A,(B) ;RESTORE SYMBOL TO TABLE
1630 AOBJN B,NXTSYK ;TRY ANOTHER
1631 JRST NXTKIL ;TRY ANOTHER ONE
1644 PUSHJ P,PRGEND ;REAL PRGM END
1648 MOVE A,(BOT) ; GET CURRENT PRG NAME
1649 NODMCG, MOVSI T,1 ; WANT NON-ZERO, BUT POSITIVE LEFT HALF
1650 DMCG, MOVE T,1(BOT) ; POINTS TO TOP AND BOTTOM OF PROGRAM
1651 TLZ A,740000 ; MARK AS PROGNAME
1653 PUSHJ P,ADDDDT ; TO DDT TABLE
1655 PUSHJ P,SHUFLE ;PUT THE SYMBOLS IN THE RIGHT ORDER
1660 PRGEND: HRRZM ADR,FACTOR
1665 ;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE
1666 ;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER
1667 ;THAT THE TRANSLATOR GAVE THEM TO STINK
1669 SHUFLE: MOVE B,DDPTR
1670 ADD B,[2,,2] ;IGNORE THIS PROGRAM NAME
1671 JUMPGE B,CPOPJ ;NO LOCALS IN DDT'S TABLE
1673 SHUF1: MOVE A,(B) ;SQUOOZE
1675 JRST SHUF2 ;FOUND A BLOCK NAME
1679 SHUF4: HRRZ A,DDPTR ;EXTENT OF THE SYMBOLS IS KNOWN
1680 ;A/POINTER TO BOTTOM SYMBOLS
1681 ;B/POINTER TO TOP OF SYMBOLS
1682 SHUF5: ADDI A,2 ;SYMBOL AT BOTTOM
1683 HRRZI B,-2(B) ;SYMBOL AT TOP
1685 POPJ P, ;WE HAVE MET THE ENEMY AND THEY IS US!
1687 MOVE C,(A) ;SWAP THESE TWO ENTRIES
1696 ;HERE WHEN WE FIND A BLOCK NAME
1698 SHUF2: MOVE A,1(B) ;VALUE
1699 TLNE A,-1 ;PROGRAM NAME?
1701 JRST SHUF3 ;IGNORE BLOCK NAME
1703 GTWD: PUSHJ P,RDWRD ;GOBBLE A WORD FROM THE BUFFER
1706 JFCL 4,[AOJA CKS,.+1]
1709 GETBIT: ILDB TT,BITPTR
1719 ;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.)
1721 RDWRD: PUSH P,TT ;SAVE TT
1722 MOVE TT,INPTR ;GOBBLE POINTER
1723 MOVE T,(TT) ;GOBBLE DATUM
1724 AOBJN TT,RDRET ;BUFFER EMPTY?
1725 DOREAD: MOVE TT,[-STNBLN,,STNBUF] ;YES, READ A NEW ONE
1726 IFN ITS, .IOT TPCHN,TT ;GOBBLE IT
1744 MOVE TT,[-STNBLN,,STNBUF] ;RE GOOBBLE
1745 RDRET: MOVEM TT,INPTR ;SAVE IT
1749 ;HERE TO START FIRST READ
1752 JRST DOREAD ;READ A NEW BUFFER
1754 RCKS: (3000+SIXBIT /CKS/)
1768 TYPR2: PUSHJ P,SIXTYO
1791 PUSH P,["*-"0+1,,.+1]
1805 ;0 1-12 13-44 45 46 47
1808 LI4: CAMN A,[(10700)CBUF-1]
1814 IFN ITS, .IOT TYOC,T
1821 IFN T-1, MOVE 1,JSYS1
1826 IFN ITS, .IOT TYIC,T
1845 LI3: MOVE A,[(10700)CBUF-1]
1847 MOVE P,[(,-LPDL)PDL-1]
1859 CAMN A,[(10700)CBUF+CBUFL]
1880 CAIN T,DOLL ;CHECK FOR A REAL DOLLAR SIGN
1887 MOVEI A,SLIS(T) ;WHERE TO?
1888 CAIE A,DUMPY ;IS IT A DUMP
1889 TRZ FF,MLAST+SETDEV ;NO, KILL FUNNY FLAGS
1890 CAIE A,HASHS ; HASH SET?
1891 PUSHJ P,HASHS1 ; MAYBE DO IT
1909 ORCMI TT,7 ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
1910 AOJN TT,LIST2 ; NOT PROG NAME
1912 LIST5: PUSHJ P,VALPT
1915 LIST2: XOR TT,C ; TT/ -1 IF S AND DEF, OR ? AND UNDEF
1916 AOJE TT,LIST7 ; PRINT VALUES
1917 LIST6: HRRZ D,LIST(D) ; NEXT SYMBOL
1918 JUMPN D,LISTER ; MORE, GO ON
1921 LIST7: PUSHJ P,SPC ; PRINT UNDEFINED SYMBOL
1922 PUSHJ P,ASPT ; PRINT SYMBOL
1924 TRNE FF,ARG ; SKIP IF 1?
1925 JUMPN C,LIST9 ; JUMP IF ?
1928 LIST9: MOVE D,1(D) ; POINT TO CHAIN
1936 HRRZ T,1(D) ; SMALL VAL
1937 TRNN FF,ARG ; ARG GIVEN?
1938 SKIPN C ; OR SS COMM
1939 MOVE T,1(D) ; USE FULL WORD
1942 ; INITIALIZES ALL AREAS OF CORE
1944 HASHS: MOVE A,D ; SIZE TO A
1945 TRNN FF,ARG ; SKI IF ARG GIVEN
1946 HASHS1: MOVEI A,INHASH ; USE INITIAL
1947 SKIPE HBOT ; SKIP IF NOT DONE
1949 PUSH P,A ; NOW SAVEE IT
1953 MOVEI B,LOSYM ; CURRENT TOP
1955 CAIG A,<INITCR*2000> ; MORE CORE NEEDED?
1956 JRST HASHS3 ; NO, OK
1957 SUBI A,<INITCR*2000>+1777
1959 HASHS2: PUSHJ P,CORRUP ; UP THE CORE
1960 SOJN A,.-1 ; FOR ALL BLOCKS
1962 HASHS3: MOVEM B,HBOT ; STORE AS BOTTOM OF HASH TABLE
1963 ADD B,-2(P) ; ADD LENGTH
1964 MOVEM B,HTOP ; INTOTOP
1967 MOVEM B,PARBOT ; SAVE AS BOTTOM OF LOADER TABLE AREA
1968 MOVEM B,PARCUR ; ALSO AS CURRENT PLACE
1970 MOVE B,LOBLKS ; CURRENT TOP OF CORE
1975 ADDI B,1 ; NOW DDT TABLE
1979 MOVEM B,DDTOP ; TOP OF DDT TABLE
1981 HRRM B,ADRPTR ; INTO CORE SLOTS
1985 PUSHJ P,CORRUP ; INITIAL CCORE BLOCK
1989 ; SET UP INIT SYMBOLS
1991 MOVE C,[EISYM-EISYME,,EISYM]
1997 IDIVI A,(B) ; HASH IT
1999 HRRZ A,(B) ; GET CONTENTS
2014 CORRUP: PUSHJ P,GETCOR
2018 PUSHJ P,WINP ; WE HAVE THE CORE, TELL LOSER
2025 IFN ITS,TMSERR: JRST SCE
2052 TYO: IFN ITS, .IOT TYOC,T
2059 IFN T-1, MOVE 1,JSYS1
2068 TDDT: SKIPE LINKDB ;TEST FOR LINK HACKAGE
2069 PUSHJ P,LNKFIN ;CLEAN UP LINKS
2070 PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
2074 SYMS: JUMPE D,SYMS5 ; DONE, QUIT
2075 MOVE A,(D) ; GET SYMBOL
2076 TLNN A,200000 ; SKIP IF DEFINED
2078 TLNE A,40000 ; SKIP IF LOCAL
2079 TRNE FF,GLOSYM ; SKIP IF GLOBALS NOT ACCEPTABLE
2080 TLNE A,100000 ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
2081 JRST SYMS6 ; LOSER, OMIT
2082 TRNN FF,GLOSYM ; SKIP IF GLOBAL
2083 SKIPL SYMSW ; SKIP IF NO LOCALS
2084 JRST SYMS3 ; WINNER!!!, MOVE IT OUT
2086 SYMS8: HRRZ A,LIST(D) ; POINT TO NEXT
2088 MOVEM D,T2 ; SAVE FOR PATCH
2089 PUSHJ P,PATCH ; FLUSH FROM TABLE
2090 POP P,D ; POINT TO NEXT
2093 SYMS6: HRRZ D,LIST(D) ; POINT TO NEXT SYMBOL
2094 JRST SYMS ; AND CONTINUE
2096 SYMS3: TRZ FF,NOTNUM ;ASSUME ALL NUMERIC
2098 MOVE T,A ;SEE IF IT IS A FUNNY SYMBOL
2099 IDIVI T,50 ;GET LAST CHAR IN TT
2101 DIVSYM: CAIG TT,12 ;IS THE SYMBOL > 9
2102 CAIGE TT,1 ;AND LESS THAN OR EQUAL TO 0
2103 TRO FF,NOTNUM ;NO, SAY NOT A NUMBER
2104 IDIVI T,50 ;CHECK NEXT
2105 JUMPE TT,SYMS8 ;NULL IN THE MIDDLE LOSES
2106 JUMPN T,DIVSYM ;DIVIDE UNTIL T IS 0
2107 CAIN TT,21 ;IS THIS A "G"
2108 TRNE FF,NOTNUM ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
2112 HRRZ C,LIST(D) ; POINT TO NEXT
2115 PUSHJ P,PATCH ; FLUSH IT
2119 TLC A,140000 ;DDT LOCAL
2120 TLNN A,37777 ;IF SQUOZE "NAME" < 1000000,
2121 PUSHJ P,ADDDD2 ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
2132 EXAM: CAMLE D,MEMTOP
2133 JRST TRYHI ; COULD BE IN HIGH SEG
2137 TRYHI: TRNE D,400000 ; SKIP IF NOT HIGH
2138 CAMLE D,HIGTOP ; SKIP IF OK
2140 MOVE T,(D) ; GET CONTENTS
2145 GETCOM: MOVE A,[10700,,CBUF-1]
2147 MOVE P,[(,-LPDL)PDL-1]
2151 MOVEI T,0 ;REOPEN CHANNEL IN ASCII MODE
2153 .OPEN TPCHN,DEV ;RE OPEN
2164 MOVE 2,[070000,,200000]
2175 IFN ITS, .IOT TPCHN,T
2192 JUMPL T,FIXOPN ;JUMP IF EOF
2193 CAIN T,3 ;CHECK FOR EOF
2194 JRST FIXOPN ;IF SO QUIT
2199 IDPB T,A ;DEPOSIT CHARACTER
2200 CAME A,[10700,,CBUF+CBUFL]
2204 IFN ITS, .IOT TYOC,T
2211 PUSHJ P,FIXOPN ;FIX UP OPEN CODE
2220 FNF2: PUSHJ P,FIXOPN
2224 PAPER: MOVEI A,(SIXBIT /PTR/)
2226 POPJ P, ;REAL OPEN WILL OCCUR LATER
2230 TRO FF,SETDEV ;SETTING DEVICE
2233 OPNTP: TRO FF,MLAST ;SET M LAST COMMAND
2235 IFN ITS, .SUSET [.SSNAM,,SNAME]
2238 POPJ P, ;REAL OPEN WILL OCCUR LATER
2244 JRST RDFRST ;STAART UP THE READ ING
2255 MOVE 2,[440000,,200000]
2266 NTS: (3000+SIXBIT /NTS/)
2268 DEV: 6,,(SIXBIT /DSK/)
2272 SNAME: 0 ;SYSTEM NAME
2279 SIXTYO: JUMPE TT,CPOPJ
2294 DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
2299 REPEAT 2,PUSHJ P,SPC
2301 .OPEN ERCHN,ERRBL ;OPEN ERROR DEVICE
2302 JRST .-1 ;DON'T TAKE NO FOR AN ANSWER
2304 ERLP: .IOT ERCHN,A ;READ A CHAR
2305 CAIE A,14 ;IF FORM FEED
2312 ERDON: .CLOSE ERCHN,
2318 ERRBL: (SIXBIT /ERR/) ;ERROR DEVICE
2328 TYPF2: SKIPN TT,DEV(A)
2343 MOVE A,[440700,,FILSTR]
2355 LOADN: SKIPA C,SYMFLG
2356 LOADG: MOVEI C,DDSYMS
2357 PUSHJ P,OPNPTR ;DO THE REAL OPEN (AND FIRST READ)
2361 RESTAR: MOVEM P,SAVPDL
2365 RESETT: MOVEI A,FACTOR ;LEAVE GLOBAL LOCATION MODE
2367 TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND
2368 SFACT: MOVEM D,FACTOR
2372 COMVAL: SKIPA COMLOC
2375 COMSET: MOVEM D,COMLOC
2392 SOFSET: HRRM D,LKUP3
2409 MOVE C,[(000600)A-1]
2417 DDT1: MOVEI C,[CONC69 ASCIZ \
\e\eJ,\SA,[/
\e9B!
\eQ
\r],\DDPTR,[/
\eQ
\e\19:VP \]]
2421 JUMPN T,DDT6 ;END OF STRING MARKED WITH ZERO BYTE
2422 MOVE T,SA ;GET STARTING ADDRESS
2423 TLNN T,777000 ;IF INSTRUCTION PART ZERO,
2424 TLO T,(JRST) ;THEN TURN INTO JRST
2425 MOVEM T,SA ;USE AS STARTING ADDRESS
2426 TRNE FF,GOF ;IF G COMMAND,
2427 MOVEM T,EXIT ;THEN USE AS LOADER EXIT
2428 MOVE B,LOBLKS ;GET CURRENT CORE ALLOCATION+1
2429 SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2430 HRRM B,PALLOC ;SAVE IN EXIT ROUTINE
2431 LSH B,10. ;SHIFT TO MEMORY LOCATION
2432 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2433 HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2434 HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2435 ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2436 MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
2438 IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
2440 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2441 BLT B,LEXEND ;BLT IN EXIT ROUTINE
2442 BLT 17,17 ;BLT IN PROGRAM AC'S
2443 EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2458 ;EXIT ROUTINE FROM LOADER
2459 ;BLT'ED INTO 30 - 30+N
2461 EXBLTP: .+1,,LEXIT ;BLT POINTER
2462 OFST==30-. ;LEXIT=30
2464 PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
2465 MOVE 17,SV17 ;GIVE USER HIS LOCATION 17
2467 IFN ITS, .CORE ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
2470 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
2472 IFN ITS, .VALUE LEXEND
2475 0 ;END OF EXIT ROUTINE
2478 DDT1: MOVE T,SA ;GET STARTING ADDRESS
2479 TLNN T,777000 ;IF INSTRUCTION PART ZERO,
2480 TLO T,(JRST) ;THEN TURN INTO JRST
2481 MOVEM T,SA ;USE AS STARTING ADDRESS
2482 TRNE FF,GOF ;IF G COMMAND,
2483 MOVEM T,EXIT ;THEN USE AS LOADER EXIT
2484 MOVEI T,DDT4 ;MAKE OPT GO TO DDT4
2485 HRRM T,TYOM ;INSTEAD OF TYO
2486 MOVEI C,[ASCIZ \
\e\eJ
\e9B/#0
\r#1
\e\19\eP
\16\] ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
2488 PUSHJ P,DDTSG ;GENERATE REST OF STRING
2489 MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
2490 SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2491 MOVE C,B ;SAVE OUR SIZE
2492 LSH B,10. ;SHIFT TO MEMORY LOCATION
2493 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2494 HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2496 MOVNM C,PALL0 ;NUMBER OF BLOCKS TO FLUSH
2498 TRZ C,400000 ;DELETE PAGE
2500 HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2501 ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2502 MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
2504 IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
2506 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2507 BLT B,LEXEND ;BLT IN EXIT ROUTINE
2508 BLT 17,17 ;BLT IN PROGRAM AC'S
2509 EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2524 DDTST: MOVE T,SA ;#0
2527 DDTSN: ILDB T,C ;GET DIGIT AFTER NUMBER SIGN
2528 XCT DDTST-"0(T) ;GET VALUE IN T
2529 PUSHJ P,OPT ;"TYPE OUT" INTO VALRET STRING IN OCTAL
2530 DDTSG: ILDB T,C ;GET CHAR FROM INPUT STRING
2531 CAIN T,"# ;NUMBER SIGN?
2532 JRST DDTSN ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
2533 IDPB T,B ;DEPOSIT IN OUTPUT STRING
2534 JUMPN T,DDTSG ;LOOP ON NOT DONE YET
2537 ;EXIT ROUTINE FROM LOADER
2538 ;BLT'ED INTO 20 - 20+N
2540 EXBLTP: .+1,,LEXIT ;BLT POINTER
2541 OFST==20-. ;OFFSET, THIS CODE DESTINED FOR LEXIT
2542 LEXIT=.+OFST ;LEXIT=20
2544 PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
2548 PSV17: 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
2552 MOVE 17,PSV17+OFST ;GIVE USER HIS LOCATION 17
2554 IFN ITS, .VALUE .+OFST+1
2559 LEXEND=.+OFST-1 ;END OF EXIT ROUTINE
2560 SV17=PSV17+OFST ;LOCATION TO SAVE 17
2566 ZERO: MOVEI A,(NBLKS)
2570 PUSHJ P,SCE ;GO TO ERROR
2578 GETMEM: PUSHJ P,GETCOR
2603 SUB B,LOWSIZ ;NUMBER OF BLOCKS WE WANT
2617 GETC2: AOS -2(P) ;SKIP RETURN
2622 SCE: SOS (P) ;MAKE POPJ BE A "JRST .-1"
2624 PUSHJ P,COREQ ;ASK LOSER
2625 POPJ P, ;HE SAID YES
2628 COREQ: PUSH P,A ;SAVE SOME ACS
2629 SKIPE KEEP ; SKIP IF NOT LOOPING
2631 COREQ0: MOVEI A,[ASCIZ /NO CORE:
2632 TYPE C TO TRY INDEFINITELY
2637 .IOT TYIC,A ;READ A CHARACTER
2639 CAIN A,"N ; WANTS LOSSAGE?
2653 ;ROUTINE TO PRINT A LINE
2657 MOVSI B,440700+A ;BYTE POINTER TO INDEX OF A
2659 LINO1: ILDB C,B ;GET CHAR
2660 JUMPE C,LINO2 ;ZERO, END
2661 IFN ITS, .IOT TYOC,C
2669 LINO2: MOVEI A,15 ;PUT OUT CR
2670 IFN ITS, .IOT TYOC,A
2681 MOVEI A,[ASCIZ /WIN!!!/]
2687 (<<A-SLIS>_9>+B-SLIS)<<C-SLIS>_9>+D-SLIS
2690 DTAB: (331100+T)DTB-74/4
2695 DTB: FOUR LBRAK,EQLS,ERR,MLIS, ;< = > ?
2696 FOUR GETCOM,ERR,BEG,COMSET, ;@ A B C
2697 FOUR DDT,NTS,NTS,GO, ;D E F G
2698 FOUR HASHS,ERR,JOB,KILL, ;H I J K
2699 FOUR LOADG,UTAP,LOADN,SOFSET, ;L M N O
2700 FOUR PAPER,COMVAL,SFACT,SLIS, ;P Q R S
2701 FOUR CPOPJ,ERR,ERR,ERR, ;T U V W
2702 FOUR SADR,DUMPY,ZERO,EXAM, ;X Y Z [
2704 IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW
2706 INFORM [DISPATCH ROOM]\<1000-DDT+SLIS>
2709 ;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
2710 ;STINK TO KILL ITSELF.
2714 TRZN FF,MLAST ;WAS "M" THE LAST COMMAND?
2715 PUSHJ P,FIXFIL ;FIX UP THE FILE NAME
2716 MOVEI A,(SIXBIT /DSK/)
2717 TRZN FF,SETDEV ;WAS DEVICE SET?
2718 HRRM A,DEV ;NO, SET IT
2720 .OPEN TPCHN,DEV ;SEE IF IT EXISTS
2723 .CLOSE TPCHN, ;CLOSE IT
2724 .FDELE DEV ;DELETE IT
2725 JFCL ;IGNORE LOSSAGE
2727 OPNOK: MOVSI A,7 ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK
2729 .OPEN TPCHN,DEV ;OPEN THE CHANNEL
2740 MOVE 2,[440000,,300000]
2750 PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE
2752 MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
2753 PUSHJ P,OUTWRD ;PUT IT OUT
2755 MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
2756 SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2757 LSH B,10. ;SHIFT TO MEMORY LOCATION
2758 SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2759 MOVEI ADR,20 ; GET TOP OF LOW SEG IN USER'S LOC 20
2762 MOVN ADR,MEMTOP ;GET -<LENGTH OF CORE IMAGE>
2763 HRLZS ADR ;AOBJN POINTER
2765 DMP2: SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD
2766 AOBJN ADR,.-1 ;UNTIL THE WORLD IS EXHAUSTED
2767 JUMPGE ADR,CHKHI ;DROPPED THROUGH, JUMP IF CORE EMPTY
2769 MOVEI C,(ADR) ;SAVE POINTER TO NON ZERO WORD
2770 MOVEI A,(C) ;AND ANOTHER COPY
2772 DMP1: SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK
2773 AOBJN ADR,.-1 ;UNTIL WORLD EXHAUSTED
2774 JUMPGE ADR,DMPLST ;IF WORLD EMPTY, QUIT
2776 AOBJP ADR,DMPLST ;CHECK NEXT WORD
2777 SKIPE B,@ADRPTR ;FOR BEING ZERO
2778 JRST DMP1 ;ONE LONE ZERO, DON'T END BLOCK
2780 DMPLST: MOVEI D,(ADR) ;POINT TO END
2781 SUB C,D ;C/ -<LENGTH OF BLOCK>
2782 HRL A,C ;A/ AOBJN TO BLOCK
2783 MOVE B,A ;COPY TO B FOR OUTWRD
2785 PUSHJ P,OUTWRD ;PUT IT OUT
2787 HRRI B,@BPTR ;NOW POINT TO REAL CORE
2788 IFN ITS, .IOT TPCHN,B ;BARF IT OUT
2805 MOVE B,A ;GET POINTER BACK IN B
2806 MOVE C,B ;FIRST WORD IN CHECK SUM
2807 HRRI B,@BPTR ;POINT TO REAL CORE
2811 AOBJN B,.-2 ;AND DO FOR ENTIRE BLOCK
2814 PUSHJ P,OUTWRD ;AND PUT IT OUT
2816 JUMPL ADR,DMP2 ;IF MORE, GO DO IT
2818 CHKHI: SKIPN MEMTOP,HIGTOP ; ANY HIGH SEG
2819 JRST DMPSYMS ; NO, GO ON TO SYMS
2820 SETZM HIGTOP ; RESET IT
2821 HLLZS ADRPTR ; FIX UP POINTERS
2823 LDB ADR,[2100,,MEMTOP] ; GET NO. OF WORDS
2826 HRRI ADR,400000 ; START OF HIGH SEG
2830 ;HERE TO DO START ADDRESS
2832 DMPSYMS: HRRZ B,SA ;GET START ADR
2833 IFN ITS, HRLI B,(JUMPA) ;USE "JUMPA" TO MAKE DDT HAPPY
2840 ; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE
2850 MOVE 1,[440700,,FILSTR]
2868 MOVE 3,[440700,,[ASCIZ /SYMBOLS/]]
2877 MOVE 2,[440000,,300000]
2888 HLLZ B,DDPTR ;GET NUMBER
2889 PUSHJ P,OUTWRD ;PUT IT OUT
2891 MOVE C,DDPTR ;FOR CKS
2892 .IOT TPCHN,DDPTR ;OUT GOES THE WHOLE TABLE
2897 MOVEI B,0 ; WILL COUNT SYMS
2900 TLZ T,740000 ; KILL SQUOZE BITS
2903 IDIVI T,50 ; CONVERT TO 10X/20 SQUOZE
2909 TLZ T,37777 ; JUST GET SQUOZE BITS
2910 JUMPN T,TWNTY2 ; JUMP UNLESS PROG NAME
2918 ; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING
2923 PUSHJ P,OUTWRD ; PUT OUT COUNT
2929 TWNTY5: MOVE T,(A) ; SEARCH FOR A PROG NAME (OR END)
2936 TWNTY6: JUMPE C,TWNTY7
2951 TWNTY7: ADD A,[2,,2]
2959 PUSHJ P,OUTWRD ;PUT OUT THE CKS
2961 MOVSI B,(JRST) ;FINISH WITH "JRST 0"
2964 MOVNI B,1 ;FINISH WITH NEGATIVE
2967 .CLOSE TPCHN, ;CLOSE THE FILE
2976 IFN ITS, .VALUE [ASCIZ /:KILL /] ;KILL
2991 ;SUBROUTINE TO PUT OUT ONE WORD
2993 OUTWRD: HRROI T,B ;AOBJN POINTER TO B
2994 IFN ITS, .IOT TPCHN,T
3011 ;HERE TO BUILD DEFAULT OUTPUT FILE NAME
3013 FIXFIL: MOVE A,[SIXBIT /_STNK_/] ;DEFAULT NAME 1
3015 MOVE A,[SIXBIT /DUMP/] ;AND NAME 2
3019 ; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.
3022 SKIPN A,PARLST ; ANY ON FREE LIST?
3023 JRST PAIR1 ; NO, TRY FREE AREA
3024 HRRZ B,(A) ; YES, CDR THE LIST
3026 PAIR3A: SETZM (A) ; CLEAR 1ST WORD
3030 PAIR1: MOVE A,PARCUR ; TRY FREE AREA
3031 ADDI A,2 ; WORDS NEEDED
3032 CAML A,PARTOP ; SKIP IF ROOM EXISTS
3034 PAIR4: EXCH A,PARCUR ; RETURN POINTER AND RESET PARCUR
3038 SKIPN A,QUADLS ; SKIP IF ANY THERE
3040 HRRZ B,(A) ; CDR THE QUAD LIST
3044 QUAD1: MOVE A,PARCUR ; GET TOP
3046 CAML A,PARTOP ; OVERFLOW?
3047 JRST QUAD2 ; YES, GET MORE
3048 JRST PAIR4 ; NO, WIN
3050 PAIR2: PUSHJ P,MORPAR ; GET MORE CORE
3053 QUAD2: PUSHJ P,MORPAR
3057 HRRZ B,PARLST ; SPLICE IT INTO FREE LIST
3060 JRST PAIR3 ; RETURN POPPING B
3068 ; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
3070 MORPAR: PUSHJ P,GETCOR ; TRY AND GET A BLOCK
3072 PUSHJ P,TMSERR ; COMPLAIN
3078 PUSHJ P,MOVCOD ; TRY AND GET CODE OUT OF THE WAY
3079 PUSHJ P,MOVDD ; ALSO GET DDT SYMBOLS OUT
3080 MOVEI A,2000 ; INCREASE PARTOP
3089 HRRZ A,ADRPTR ; POINT TO CURRENT START
3090 ADDI A,2000 ; NEW START
3092 HRRM A,ADRPTR ; FIX POINTERS
3095 MOVE B,LOBLKS ; GEV(CURRENT TOP (IN BLOCKS)
3096 ASH B,10. ; CONVERT TO WORDS
3098 MOVCO3: MOVEI A,-2000(B) ; A/ POINT TO LAST DESTINATION
3099 CAIG B,(C) ; SKIP IF NOT DONE
3101 HRLI A,-2000(A) ; B/ FIRST SOURCE,,FIRST DESTINATION
3111 ; HERE TO MOVE DDT SYMBOLS
3115 HRRZ A,DDPTR ; GET CURRENT POINTER
3118 HRRZ A,DDTOP ; TOP OF DDT TABLE
3122 MOVEI B,1(A) ; SET UP FOR BLT LOOP
3126 JRST MOVCO3 ; FALL INTO BLT LOOP
3129 ;HAVE NAME W/ FLAGS IN A, VALUE IN T,
3130 ;PUT SYM IN DDT SYMBOL TABLE.
3133 ADDDD1: MOVE A,DDPTR
3136 CAILE B,(A) ; SKIP IF OK
3137 JRST GROWDD ; MUST GROW DDT TABLE
3139 MOVEM T,1(A) ; CLOBBER AWAY
3142 MOVE A,(A) ; RESTORE A
3145 GROWDD: PUSHJ P,GETCOR
3153 PUSHJ P,MOVCOD ; MOVE THE CODE
3160 ADDDD2: PUSH P,A ;CALL HERE FROM SYMS OR TDDT.
3162 SKIPA B,DDPTR ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
3163 ADDDD3: ADD B,[2,,2]
3164 JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM.
3167 JRST ADDDD3 ;NOT THIS ONE.
3168 MOVE A,1(B) ;SYM'S REAL NAME IS IN 2ND WD OF STE,
3170 MOVEM T,1(B) ;PUT IN THE VALUE.
3173 ;TDDT EXITS THROUGH HERE.
3174 TDDTEX: PUSH P,A ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
3177 TDDTE1: ADD A,[2,,2]
3178 JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM.
3181 JRST TDDTE1 ;THIS NOT PROGRAM NAME.
3183 JRST POPBAJ ;IF IT'S ALREADY 1ST, NO PROBLEM.
3186 EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
3190 \fISYM: MOVSI C,(50*50*50*50*50*50)
3191 MOVSI T,40000 ;GLOBAL BIT
3214 FRD2: CAME B,[SIXBIT /@/]
3217 FRD: MOVSI B,(SIXBIT /@/)
3218 MOVSI C,(SIXBIT /@/)
3223 JRST CHBIN ;CHECK IF SHOULD CHANGE NAME 2 TO BIN
3239 USRSET: MOVEM C,SNAME
3242 DEVNAM: PUSH P,CDEVN1
3246 DEVNM1: TRO FF,SETDEV ;SAY DEVICE SET
3249 JRST CHBIN ;CHECK FOR CHANGE TO BIN
3251 DEVSET: TRO FF,SETDEV ;DEVICE SET
3255 CHBIN: CAME B,[SIXBIT /@/] ;WAS NO NAME2 SUPPLIED?
3256 POPJ P, ;NAME2 SUPPLIED, GO AWAY
3257 MOVE B,C ;MAKE NAME1 INTO NAME2
3258 NODMCG, MOVSI C,(SIXBIT /REL/) ;USE REL FOR NAME2
3259 DMCG, MOVSI C,(SIXBIT /BIN/)
3260 CDEVN1: POPJ P,DEVNM1
3264 MOVE B,[440700,,FILSTR]
3269 JRST FRD1 ; FINISHED
3280 EISYM: ;INITIAL SYMBOLS
3282 CRELPT: SQUOZE 64,$R.
3285 CPOINT: SQUOZE 64,$.
3299 POLSW: 0 ;-1=>WE ARE DOING POLISH
3300 PPDP: -PPDL,,PPDB-1 ;INITIAL POLISH PUSH DOWN POINTER
3301 PPDB: BLOCK PPDL+1 ;POLISH PUSH DOWN BLOCK
3302 SATED: 0 ;COUNT OF POLISH FIXUPS TO BE DELETED
3303 SATPDP: -SATPDL,,SATPDB-1 ;POINTER TO POLISH FIXUPS TO BE DELETED
3304 SATPDB: BLOCK SATPDL+1 ;LIST OF POLISH FIXUPS TO BE DELETED
3305 SVSAT: 0 ;# OF OPERANDS NEEDED
3306 POLPNT: 0 ;POINTER TO POLISH CHAIN
3307 CGLOB: 0 ;CURRENT GLOBAL IN SOME SENSE
3308 CGLOBV: 0 ;CURRENT GLOBAL VALUE IN SOME SENSE
3309 GLBFS: 0 ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
3310 SVHWD: 0 ;WORD CURRENTLY BEING READ BY POLISH
3311 GLBCNT: 0 ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
3312 HEADNM: 0 ;# POLISH FIXUPS SEEN
3313 LFTFIX: 0 ;-1=> LEFT HALF FIXUP IN PROGRESS
3314 LINKDB: BLOCK MNLNKS+1 ;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
3315 HIBLK: 0 ; BLOCKS IN HIGH SEG
3316 KEEP: 0 ; FLAG SAYING WE ARE IN A CORE LOOP
3318 USINDX: 0 ; USER INDEX
3320 HIGTOP: 0 ; TOP OF HIGH SEG
3321 INPTR: 0 ;HOLDS CURRENT IO POINTER
3322 STNBUF: BLOCK STNBLN ;BUFFER FOR BLOCK READS
3327 ADRPTR: <INITCR*2000>(ADR)
3328 BPTR: <INITCR*2000>(B)
3329 DPTR: <INITCR*2000>(D)
3343 ; CORE MANAGEMENT VARIABLES
3346 CWORD0: 4000,,400000+<<INITCR-1>_9.>
3347 CWORD1: 4000,,600000-1000
3348 LOWSIZ: INITCR ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
3350 LOBLKS: INITCR+1 ; NUMBER OF BLOCKS OF CORE WE WANT
3351 PARBOT: 0 ; POINT TO BOTTOM OF SYMBOL TABLES
3352 PARTOP: 0 ; POINT TO TOP OF SAME
3353 PARLST: 0 ; LIST OF AVAILABLE 2 WORD BLOCKS
3354 QUADLS: 0 ; LIST OF AVAILABLE 4 WORD BLOCKS
3355 PARCUR: 0 ; TOP CURRENTLY IN USE SYMBOL TABLE CORE
3357 DDPTR: 0 ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
3358 DDTOP: 0 ; HIGHEST ALLOCATED FOR DDT
3359 DDBOT: 0 ; LOWEST ALLOCATED FOR DDT
3361 HTOP: 0 ; TOP OF HASH TABLE
3362 HBOT: 0 ; BOTTOM OF HASH TABLE
3364 PDL: IFN ITS, .SUSET [.RSNAM,,SNAME] ;GET INITIAL SYSTEM NAME
3367 MOVE NBLKS,[20,,INITCR]
3386 MOVE TT,[SIXBIT /STINK./]
3390 IFN ITS, .SUSET [.RMEMT,,TT]
3392 MOVEI TT,INITCR*2000
3398 TDO TT,[4000,,400000]
3416 FILSTR: BLOCK 10 ; GOOD FOR 40 CHARS
3417 LOSYM: ;LOWEST LOC AVAIL FOR SYM TBL
3418 INITCR==<LOSYM+3000>/2000 ;LDR LENGTH IN BLOCKS
3420 INFORM [HIGHEST USED]\LOSYM
3421 INFORM [LOWEST LOCATION LOADED ]\LOWLOD
3422 INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
3423 INFORM [INITIAL CORE ALLOCATION]\INITCR