8 .GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG
9 .GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR
11 UBIT==40000 ; BIT INDICATING VECTOR
14 ; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING
15 ; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN
18 ; A/ INSTRUCTION TO BE EXECUTED
19 ; PVP/ NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS
22 ; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE
24 GCHK10: PUSHJ P,GHSTUP
27 GCHACK: PUSHJ P,GHSTUP ; SETUP
28 MOVE B,CODTOP ; START OFF WITH IMPURE STORAGE
29 SUBI B,1 ; START AT FIRST WORD
32 HRRE 0,1(B) ; GET INDICATOR OF MODIFICATION
33 JUMPGE 0,LOSTO ; JUMP IF GARBAGE
36 LOSTO: HLRZ C,1(B) ; BACK OF VECTOR
38 SUBI B,(C) ; SKIP OVER VECTOR
41 GCHK1: MOVE B,VECTOP ; NO LOOP THRU GCS
47 EXCH C,NXTTAB ; SWAP LOCATIONS
49 TLZ B,.LIST. ; TURN OFF LIST BIT
50 CAMGE B,GCSBOT ; SEE IF DONE
51 JRST REHASQ ; SEE IF ASSOCIATIONS ARE GOOD
52 MOVE C,(B) ; GET ELEMENT
53 TLNE C,.VECT. ; SEE IF IT IS A VECTOR
54 JRST VHCK ; JUMP IF IT IS
55 GLSTHK: GETYP C,(B) ; TYPE OF CURRENT PAIR
56 MOVE D,1(B) ; AND ITS DATUM
57 TLO B,.LIST. ; INDICATE A LIST
58 SKIPL (B) ; SKIP IF MARKED
62 VHCK: PUSHJ P,VHACK ; TO VHACK
65 ; NOW DO THE SAME THING TO VECTOR SPACE
66 VHACK: HLRE D,(B) ; GET TYPE FROM D.W.
67 TRZ D,.VECT. ; GET RID OF VECTOR INDICATION BIT
68 HLRZ C,1(B) ; AND TOTAL LENGTH
69 TRZE C,400000 ; GET RID OF POSSIBLE MARK BIT
70 JRST MKHAK ; JUMP IF MARKED
71 SUBI B,(C)-2 ; POINT TO START OF VECTOR
73 SUBI C,2 ; CHECK WINNAGE
74 JUMPL C,BADV ; FATAL LOSSAGE
76 JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED
78 ; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL
80 JUMPGE D,UHACK ; UNIFORM
81 TRNE D,377777 ; SKIP IF GENERAL
84 ; FALL THROUGH TO GENERAL
86 GHACK1: SKIPGE (B) ; CHECK FOR FENCE POST
88 GETYP C,(B) ; LOOK A T 1ST ELEMENT
90 CAIN C,TENTRY ; FRAME ON STACK
93 CAIN C,TBIND ; BINDING BLOCK
95 CAIN C,TGATOM ; ATOM WITH GDECL?
97 MOVE D,1(B) ; GET DATUM
99 GDHCK1: ADDI B,2 ; NEXT ELEMENT
101 SOSLE (P) ; COUNT ELEMENTS
102 SKIPGE (B) ; OR FENCE POST HIT
106 ; HERE TO GO OVER UVECTORS
108 UHACK: CAMN A,[PUSHJ P,SBSTIS]
109 JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC
110 MOVEI C,(D) ; COPY UNIFORM TYPE
111 JUMPE PVP,UHACKX ; JUMP IF NOT ONLY ATOMS
112 ASH C,1 ; COMPUTE SAT
115 ANDI C,SATMSK ; GOT ITS SAT
116 CAIE C,SCHSTR ; COULD BE SPNAME
118 CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS
121 UHACKX: PUSH P,C ; ATFIX CLOBBERS C
125 TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR
128 SOSLE -1(P) ; COUNT DOEN
134 ; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES
136 SHACK: ANDI D,377777 ; KILL EXTRA CRUFT
139 CAIE D,STPSTK ; STACK OR
140 CAIN D,SPVP ; PROCESS
141 JRST GHACK1 ; TREAT LIKE GENERAL
142 CAIN D,SASOC ; ASSOCATION
144 CAIG D,NUMSAT ; TEMPLATE MAYBE?
145 JRST BADV ; NO CHANCE
146 ADDI C,(B) ; POINT TO DOPE WORDS
150 JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER
152 CAMN A,[PUSHJ P,SBSTIS]
155 TD.UPD: PUSH P,A ; INS TO EXECUTE
157 HLRZ E,B ; POSSIBLE BASIC LENGTH
160 MOVEI B,(B) ; ISOLATE LENGTH
161 PUSH P,C ; SAVE POINTER TO OBJECT
163 PUSH P,[0] ; HOME FOR VALUES
164 PUSH P,[0] ; SLOT FOR TEMP
167 PUSH P,D ; SAVE FOR FINDING OTHER TABLES
168 JUMPE E,TD.UP2 ; NO REPEATING SEQ
169 ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ
170 HLRE D,(D) ; D ==> - LNTH OF TEMPLATE
171 ADDI D,(E) ; D ==> -LENGTH OF REP SEQ
173 HRLM D,-5(P) ; SAVE IT AND BASIC
175 TD.UP2: SKIPG D,-1(P) ; ANY LEFT?
180 MOVE E,(E) ; POINTER TO VECTOR IN E
181 MOVEM D,-6(P) ; SAVE ELMENT #
182 SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST
185 MOVEI 0,(B) ; BASIC LNT TO 0
186 SUBI 0,(D) ; SEE IF PAST BASIC
187 JUMPGE 0,.-3 ; JUMP IF O.K.
188 MOVSS B ; REP LNT TO RH, BASIC TO LH
189 IDIVI 0,(B) ; A==> -WHICH REPEATER
191 ADD A,-5(P) ; PLUS BASIC
193 MOVEM A,-6(P) ; SAVE FOR PUTTER
197 TD.UP3: ADDI E,(D) ; POINT TO SLOT
198 XCT (E) ; GET THIS ELEMENT INTO A AND B
199 TLO A,UBIT ; INDICATE ITS A ANY
200 MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT
202 GETYP C,A ; TYPE TO C
204 MOVEI B,-3(P) ; POINTER TO HOME
205 MOVE A,-7(P) ; GET INS
207 MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT
209 SOS D,-1(P) ; RESTORE COUNT
211 MOVE E,(E) ; POINTER TO VECTOR IN E
212 MOVE B,-6(P) ; SAVED OFFSET
213 ADDI E,(B)-1 ; POINT TO SLOT
214 MOVE A,-3(P) ; RESTORE TYPE WORD
216 XCT (E) ; SMASH IT BACK
222 FATAL TEMPLATE LOSSAGE
225 TD.UP1: MOVE A,-7(P) ; RESTORE INS
227 MOVSI D,400000 ; RESTORE MARK/UNMARK BIT
230 ; FATAL LOSSAGE ARRIVES HERE
232 BADV: FATAL GC SPACE IN A BAD STATE
234 ; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)
236 EHACK: JUMPE PVP,EHACKX
237 ADDI B,FRAMLN+1 ; SKIP THE FRAME
246 CAME A,[PUSHJ P,SBSTIS]
247 XCT A ; XCT SUBSTITUTE
248 POP P,C ; RESTORE TYPE
249 HLLM C,1(B) ; SMASH BACK
251 MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR
253 EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE
254 PUSH P,D ; SAVE AOBJN
255 MOVE D,1(B) ; GET ITEM
256 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
258 POP P,D ; RESTORE AOBJN
260 SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR
262 AOJA B,GHACK1 ; AND GO ON
264 ; TABLE OF ENTRY BLOCK TYPES
273 ; HERE TO GROVEL OVER BINDING BLOCKS
275 BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM
277 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
279 PUSHJ P,NXTGDY ; NEXT GOODIE
280 PUSHJ P,NXTGDY ; AND NEXT
281 MOVEI C,TSP ; TYPE THE BACK LOCATIVE
284 PUSHJ P,BMP ; AND NEXT
286 HLRZ D,-2(B) ; DECL POINTER
287 MOVEI B,0 ; MAKE SURE NO CLOBBER
289 XCT A ; DO THE THING BEING DONE
291 HRLM D,-2(B) ; FIX UP IN CASE CHANGED
294 ; HERE TO HACK ATOMS WITH GDECLS
296 GDHACK: CAMN A,[PUSHJ P,SBSTIS]
299 MOVEI C,TATOM ; TREAT LIKE ATOM
302 HRRZ D,(B) ; GET DECL
304 CAIN D,-1 ; WATCH OUT FOR MAINFEST
306 PUSH P,B ; SAVE POINTER
317 ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST
318 MOVEI C,TOBLS ; GET TYPE
319 HRRZ D,2(B) ; AND DATUM
320 JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH
322 MOVE D,(D) ; GET REAL OBLIST POINTER
324 CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
331 BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
337 MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK
342 ; SUB D,B ; D NOW ATOM PNTR
352 ; HERE TO HACK ASSOCIATION BLOCKS
354 ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK
359 PUSH P,D ; SAVE POINTER
361 POP P,D ; GET OLD BACK
362 CAME D,1(B) ; CHANGED?
363 TLO E,400000 ; SET NON-VIRGIN FLAG
365 PUSHJ P,BMP ; TO NEXT
368 ; HERE TO GOT TO NEXT VECTOR
370 VHACK1: MOVE B,-1(P) ; GET POINTER
371 SUB P,[2,,2] ; FLUSH CRUFT
372 SUBI B,2 ; FIX UP PTR
375 ; HERE TO SKIP OVER MARKED VECTOR
377 MKHAK: SUBI B,(C) ; POINT BELOW VECTOR
380 ; ROUTINE TO GET A GOODIE
393 REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT
397 MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]
399 ;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO
400 ;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT
402 ;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE
403 ;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.
404 ;BOTH ITEMS MUST BE OF THE SAME TYPE OR
405 ;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS
406 ; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN
407 ; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN
408 ; A FEW OTHER YUCKY PLACES.
409 ;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT
414 SBSTI1: GETYP A,2(AB)
417 MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE?
419 GETYP A,(AB) ; ATOM FOR ATOM SUBS?
422 MOVE B,3(AB) ; SEE IF OLD GUY
424 SUBM B,A ; POINT TO DOPE
425 HRRZ A,(A) ; POSSIBLE TYPE CODE
426 JUMPE A,SBSTI2 ; NOT A TYPE, GO
430 HRRZ C,(C) ; GET OTHER POSSIBLE CODE
433 PUSHJ P,IMPURI ; IMPURIFY FOR SMASH
440 SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG
442 PUSHJ P,NWORDT ; AND STORAGE ALLOCATION
444 GETYP A,(AB) ; GET TYPE OF FIRST ARG
447 CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION
451 JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES
454 CAIN D,0 ; IF GOODIE IS OF TYPE ZERO
455 MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE
458 PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE
460 PUSH TP,D ; TYPE OF GOODIE
464 AOS (TP) ; 1=TYPE LIST, 0=ELSE
466 PUSH TP,2(AB) ; TYPE-WORD
468 PUSH TP,3(AB) ; VALUE-WORD
470 PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO
471 MOVE A,[PUSHJ P,SBSTIR]
472 CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER
473 MOVE A,[PUSHJ P,SBSTIS]
474 MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING
475 PUSHJ P,GCHACK ; DO-IT
478 JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE
480 SBSTIR: CAME D,-2(TP)
481 JRST LSUB ; THIS IS IT
483 JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE
484 JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT
486 MOVEM 0,1(B) ; SMASH IT
487 MOVE 0,-1(TP) ; GET TYPE WORD
488 SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST
489 MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT
491 LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON
492 POPJ P, ; ELSE THATS ALL
493 TLNN B,.LIST. ; SEE IF A LIST
494 POPJ P, ; WELL NO LIST SMASHING THIS TIME
495 HRRZ 0,(B) ; GET ITS LIST POINTER
497 POPJ P, ; THIS ONE DIDNT MATCH
498 MOVE 0,(TP) ; GET THE NEW REST OF THE LIST
499 HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST
502 SBSTIS: CAMN D,-2(TP)
505 SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE
508 MOVEM 0,1(B) ; KLOBBER VALUE CELL
510 HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE
513 SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
514 BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE
516 GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER
517 HRLI E,C ; WILL HAVE TYPE CODE IN C
518 SETOM 1(TP) ; FENCE POST PDL
521 PUSHJ P,FRMUNG ; MUNG CURRENT FRAME
528 ; LOCATION TO REMEMBER PREVIOUS VALUES