7 .GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT
\r
8 .GLOBAL TD.LNT,TD.GET,TD.PUT
\r
10 ; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING
\r
11 ; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN
\r
14 ; A/ INSTRUCTION TO BE EXECUTED
\r
17 GCHACK: HRRZ E,TYPVEC+1(TVP) ; SET UP TYPE POINTER
\r
18 HRLI E,C ; WILL HAVE TYPE CODE IN C
\r
19 MOVE B,PARBOT ; START AT PARBOT
\r
20 SETOM 1(TP) ; FENCE POST PDL
\r
23 PUSHJ P,FRMUNG ; MUNG CURRENT FRAME
\r
26 ; FIRST HACK PAIR SPACE
\r
28 PHACK: CAML B,PARTOP ; SKIP IF MORE PAIRS
\r
29 JRST VHACK ; DONE, NOW HACK VECTORS
\r
30 GETYP C,(B) ; TYPE OF CURRENT PAIR
\r
31 MOVE D,1(B) ; AND ITS DATUM
\r
36 ; NOW DO THE SAME THING TO VECTOR SPACE
\r
38 VHACK: MOVE B,VECTOP ; START AT TOP, MOVE DOWN
\r
39 SUBI B,1 ; POINT TO TOPMOST VECTOR
\r
40 VHACK2: CAMG B,VECBOT ; SKIP IF MORE TO DO
\r
41 JRST REHASQ ; SEE IF MUST REHASH
\r
43 HLRE D,-1(B) ; GET TYPE FROM D.W.
\r
44 HLRZ C,(B) ; AND TOTAL LENGTH
\r
45 SUBI B,(C)-1 ; POINT TO START OF VECTOR
\r
47 SUBI C,2 ; CHECK WINNAGE
\r
48 JUMPL C,BADV ; FATAL LOSSAGE
\r
49 PUSH P,C ; SAVE COUNT
\r
50 JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED
\r
52 ; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL
\r
54 JUMPGE D,UHACK ; UNIFORM
\r
55 TRNE D,377777 ; SKIP IF GENERAL
\r
56 JRST SHACK ; SPECIAL
\r
58 ; FALL THROUGH TO GENERAL
\r
60 GHACK1: GETYP C,(B) ; LOOK A T 1ST ELEMENT
\r
62 CAIN C,TENTRY ; FRAME ON STACK
\r
65 CAIN C,TBIND ; BINDING BLOCK
\r
67 CAIN C,TGATOM ; ATOM WITH GDECL?
\r
69 MOVE D,1(B) ; GET DATUM
\r
71 ADDI B,2 ; NEXT ELEMENT
\r
73 SOSLE (P) ; COUNT ELEMENTS
\r
74 SKIPGE (B) ; OR FENCE POST HIT
\r
78 ; HERE TO GO OVER UVECTORS
\r
80 UHACK: CAMN A,[PUSHJ P,SBSTIS]
\r
81 JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC
\r
82 MOVEI C,(D) ; COPY UNIFORM TYPE
\r
85 UHACK1: MOVE D,1(B) ; DATUM
\r
87 SOSLE (P) ; COUNT DOEN
\r
91 ; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES
\r
93 SHACK: ANDI D,377777 ; KILL EXTRA CRUFT
\r
96 CAIE D,STPSTK ; STACK OR
\r
97 CAIN D,SPVP ; PROCESS
\r
98 JRST GHACK1 ; TREAT LIKE GENERAL
\r
99 CAIN D,SASOC ; ASSOCATION
\r
101 CAIG D,NUMSAT ; TEMPLATE MAYBE?
\r
102 JRST BADV ; NO CHANCE
\r
103 ADDI C,(B) ; POINT TO DOPE WORDS
\r
106 ADD D,TD.LNT+1(TVP)
\r
107 JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER
\r
109 CAMN A,[PUSHJ P,SBSTIS]
\r
112 TD.UPD: PUSH P,A ; INS TO EXECUTE
\r
114 HLRZ E,B ; POSSIBLE BASIC LENGTH
\r
117 MOVEI B,(B) ; ISOLATE LENGTH
\r
118 PUSH P,C ; SAVE POINTER TO OBJECT
\r
120 PUSH P,[0] ; HOME FOR VALUES
\r
121 PUSH P,[0] ; SLOT FOR TEMP
\r
123 SUB D,TD.LNT+1(TVP)
\r
124 PUSH P,D ; SAVE FOR FINDING OTHER TABLES
\r
125 JUMPE E,TD.UP2 ; NO REPEATING SEQ
\r
126 ADD D,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ
\r
127 HLRE D,(D) ; D ==> - LNTH OF TEMPLATE
\r
128 ADDI D,(E) ; D ==> -LENGTH OF REP SEQ
\r
130 HRLM D,-5(P) ; SAVE IT AND BASIC
\r
132 TD.UP2: SKIPG D,-1(P) ; ANY LEFT?
\r
135 MOVE E,TD.GET+1(TVP)
\r
137 MOVE E,(E) ; POINTER TO VECTOR IN E
\r
138 MOVEM D,-6(P) ; SAVE ELMENT #
\r
139 SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST
\r
142 MOVEI 0,(B) ; BASIC LNT TO 0
\r
143 SUBI 0,(D) ; SEE IF PAST BASIC
\r
144 JUMPGE 0,.-3 ; JUMP IF O.K.
\r
145 MOVSS B ; REP LNT TO RH, BASIC TO LH
\r
146 IDIVI 0,(B) ; A==> -WHICH REPEATER
\r
148 ADD A,-5(P) ; PLUS BASIC
\r
149 ADDI A,1 ; AND FUDGE
\r
150 MOVEM A,-6(P) ; SAVE FOR PUTTER
\r
151 ADDI E,-1(A) ; POINT
\r
154 TD.UP3: ADDI E,(D) ; POINT TO SLOT
\r
155 XCT (E) ; GET THIS ELEMENT INTO A AND B
\r
156 MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT
\r
158 GETYP C,A ; TYPE TO C
\r
160 MOVEI B,-3(P) ; POINTER TO HOME
\r
161 MOVE A,-7(P) ; GET INS
\r
163 MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT
\r
164 MOVE E,TD.PUT+1(TVP)
\r
165 SOS D,-1(P) ; RESTORE COUNT
\r
167 MOVE E,(E) ; POINTER TO VECTOR IN E
\r
168 MOVE B,-6(P) ; SAVED OFFSET
\r
169 ADDI E,(B)-1 ; POINT TO SLOT
\r
170 MOVE A,-3(P) ; RESTORE TYPE WORD
\r
172 XCT (E) ; SMASH IT BACK
\r
173 FATAL TEMPLATE LOSSAGE
\r
177 TD.UP1: MOVE A,-7(P) ; RESTORE INS
\r
179 MOVSI D,400000 ; RESTORE MARK/UNMARK BIT
\r
182 ; FATAL LOSSAGE ARRIVES HERE
\r
184 BADV: FATAL GC SPACE IN A BAD STATE
\r
186 ; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)
\r
188 EHACK: MOVSI D,-FRAMLN ; SET UP AOBJN PNTR
\r
190 EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE
\r
191 PUSH P,D ; SAVE AOBJN
\r
192 MOVE D,1(B) ; GET ITEM
\r
193 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
\r
194 XCT A ; USER GOODIE
\r
195 POP P,D ; RESTORE AOBJN
\r
197 SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR
\r
199 AOJA B,GHACK1 ; AND GO ON
\r
201 ; TABLE OF ENTRY BLOCK TYPES
\r
211 ; HERE TO GROVEL OVER BINDING BLOCKS
\r
213 BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM
\r
215 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
\r
217 PUSHJ P,NXTGDY ; NEXT GOODIE
\r
218 PUSHJ P,NXTGDY ; AND NEXT
\r
219 MOVEI C,TSP ; TYPE THE BACK LOCATIVE
\r
220 PUSHJ P,NXTGD1 ; AND NEXT
\r
222 HLRZ D,-2(B) ; DECL POINTER
\r
223 MOVEI B,0 ; MAKE SURE NO CLOBBER
\r
225 XCT A ; DO THE THING BEING DONE
\r
227 HRLM D,-2(B) ; FIX UP IN CASE CHANGED
\r
230 ; HERE TO HACK ATOMS WITH GDECLS
\r
232 GDHACK: CAMN A,[PUSHJ P,SBSTIS]
\r
235 MOVEI C,TATOM ; TREAT LIKE ATOM
\r
238 HRRZ D,(B) ; GET DECL
\r
240 CAIN D,-1 ; WATCH OUT FOR MAINFEST
\r
242 PUSH P,B ; SAVE POINTER
\r
250 ; HERE TO HACK ATOMS
\r
252 ATHACK: ADDI B,1 ; POINT PRIOR TO OBL SLOT
\r
253 MOVEI C,TOBLS ; GET TYPE
\r
254 MOVE D,1(B) ; AND DATUM
\r
255 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
\r
259 ; HERE TO HACK ASSOCIATION BLOCKS
\r
261 ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK
\r
266 PUSH P,D ; SAVE POINTER
\r
268 POP P,D ; GET OLD BACK
\r
269 CAME D,1(B) ; CHANGED?
\r
270 TLO E,400000 ; SET NON-VIRGIN FLAG
\r
272 PUSHJ P,BMP ; TO NEXT
\r
275 ; HERE TO GOT TO NEXT VECTOR
\r
277 VHACK1: MOVE B,-1(P) ; GET POINTER
\r
278 SUB P,[2,,2] ; FLUSH CRUFT
\r
279 SOJA B,VHACK2 ; FIXUP POINTER AND GO ON
\r
281 ; ROUTINE TO GET A GOODIE
\r
283 NXTGDY: GETYP C,(B)
\r
284 NXTGD1: MOVE D,1(B)
\r
285 XCT A ; DO IT TO IT
\r
294 REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT
\r
298 MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]
\r
300 ;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO
\r
301 ;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT
\r
303 ;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE
\r
304 ;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.
\r
305 ;BOTH ITEMS MUST BE OF THE SAME TYPE OR
\r
306 ;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS
\r
307 ; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN
\r
308 ; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN
\r
309 ; A FEW OTHER YUCKY PLACES.
\r
310 ;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT
\r
315 SBSTI1: GETYP A,2(AB)
\r
318 MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE?
\r
321 SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG
\r
323 PUSHJ P,NWORDT ; AND STORAGE ALLOCATION
\r
325 GETYP A,(AB) ; GET TYPE OF FIRST ARG
\r
328 CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION
\r
332 JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES
\r
335 CAIN D,0 ; IF GOODIE IS OF TYPE ZERO
\r
336 MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE
\r
339 PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE
\r
341 PUSH TP,D ; TYPE OF GOODIE
\r
345 AOS (TP) ; 1=TYPE LIST, 0=ELSE
\r
347 PUSH TP,2(AB) ; TYPE-WORD
\r
349 PUSH TP,3(AB) ; VALUE-WORD
\r
351 PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO
\r
352 MOVE A,[PUSHJ P,SBSTIR]
\r
353 CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER
\r
354 MOVE A,[PUSHJ P,SBSTIS]
\r
355 PUSHJ P,GCHACK ; DO-IT
\r
358 JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE
\r
360 SBSTIR: CAME D,-2(TP)
\r
361 JRST LSUB ; THIS IS IT
\r
363 JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE
\r
364 JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT
\r
366 MOVEM 0,1(B) ; SMASH IT
\r
367 MOVE 0,-1(TP) ; GET TYPE WORD
\r
368 SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST
\r
369 MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT
\r
371 LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON
\r
372 POPJ P, ; ELSE THATS ALL
\r
374 CAMGE B,PARBOT ; IS IT IN LIST SPACE?
\r
375 POPJ P, ; WELL NO LIST SMASHING THIS TIME
\r
376 HRRZ 0,(B) ; GET ITS LIST POINTER
\r
378 POPJ P, ; THIS ONE DIDNT MATCH
\r
379 MOVE 0,(TP) ; GET THE NEW REST OF THE LIST
\r
380 HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST
\r
383 SBSTIS: CAMN D,-2(TP)
\r
386 SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE
\r
389 MOVEM 0,1(B) ; KLOBBER VALUE CELL
\r
391 HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE
\r
394 SBSTIL: PUSH TP,$TATOM ; LOSSAGE ON DIFFERENT TYPES, ONE DOUBLE WORD
\r
395 PUSH TP,EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
\r