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,SATOM ; DON'T BOTHER IF NOT ALL ATOMS
119 UHACKX: PUSH P,C ; ATFIX CLOBBERS C
123 TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR
126 SOSLE -1(P) ; COUNT DOEN
132 ; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES
134 SHACK: ANDI D,377777 ; KILL EXTRA CRUFT
137 CAIE D,STPSTK ; STACK OR
138 CAIN D,SPVP ; PROCESS
139 JRST GHACK1 ; TREAT LIKE GENERAL
140 CAIN D,SASOC ; ASSOCATION
142 CAIG D,NUMSAT ; TEMPLATE MAYBE?
143 JRST BADV ; NO CHANCE
144 ADDI C,(B) ; POINT TO DOPE WORDS
148 JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER
150 CAMN A,[PUSHJ P,SBSTIS]
153 TD.UPD: PUSH P,A ; INS TO EXECUTE
155 HLRZ E,B ; POSSIBLE BASIC LENGTH
158 MOVEI B,(B) ; ISOLATE LENGTH
159 PUSH P,C ; SAVE POINTER TO OBJECT
161 PUSH P,[0] ; HOME FOR VALUES
162 PUSH P,[0] ; SLOT FOR TEMP
165 PUSH P,D ; SAVE FOR FINDING OTHER TABLES
166 JUMPE E,TD.UP2 ; NO REPEATING SEQ
167 ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ
168 HLRE D,(D) ; D ==> - LNTH OF TEMPLATE
169 ADDI D,(E) ; D ==> -LENGTH OF REP SEQ
171 HRLM D,-5(P) ; SAVE IT AND BASIC
173 TD.UP2: SKIPG D,-1(P) ; ANY LEFT?
178 MOVE E,(E) ; POINTER TO VECTOR IN E
179 MOVEM D,-6(P) ; SAVE ELMENT #
180 SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST
183 MOVEI 0,(B) ; BASIC LNT TO 0
184 SUBI 0,(D) ; SEE IF PAST BASIC
185 JUMPGE 0,.-3 ; JUMP IF O.K.
186 MOVSS B ; REP LNT TO RH, BASIC TO LH
187 IDIVI 0,(B) ; A==> -WHICH REPEATER
189 ADD A,-5(P) ; PLUS BASIC
191 MOVEM A,-6(P) ; SAVE FOR PUTTER
195 TD.UP3: ADDI E,(D) ; POINT TO SLOT
196 XCT (E) ; GET THIS ELEMENT INTO A AND B
197 TLO A,UBIT ; INDICATE ITS A ANY
198 MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT
200 GETYP C,A ; TYPE TO C
202 MOVEI B,-3(P) ; POINTER TO HOME
203 MOVE A,-7(P) ; GET INS
205 MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT
207 SOS D,-1(P) ; RESTORE COUNT
209 MOVE E,(E) ; POINTER TO VECTOR IN E
210 MOVE B,-6(P) ; SAVED OFFSET
211 ADDI E,(B)-1 ; POINT TO SLOT
212 MOVE A,-3(P) ; RESTORE TYPE WORD
214 XCT (E) ; SMASH IT BACK
220 FATAL TEMPLATE LOSSAGE
223 TD.UP1: MOVE A,-7(P) ; RESTORE INS
225 MOVSI D,400000 ; RESTORE MARK/UNMARK BIT
228 ; FATAL LOSSAGE ARRIVES HERE
230 BADV: FATAL GC SPACE IN A BAD STATE
232 ; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)
234 EHACK: JUMPE PVP,EHACKX
235 ADDI B,FRAMLN+1 ; SKIP THE FRAME
244 CAME A,[PUSHJ P,SBSTIS]
245 XCT A ; XCT SUBSTITUTE
246 POP P,C ; RESTORE TYPE
247 HLLM C,1(B) ; SMASH BACK
249 MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR
251 EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE
252 PUSH P,D ; SAVE AOBJN
253 MOVE D,1(B) ; GET ITEM
254 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
256 POP P,D ; RESTORE AOBJN
258 SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR
260 AOJA B,GHACK1 ; AND GO ON
262 ; TABLE OF ENTRY BLOCK TYPES
271 ; HERE TO GROVEL OVER BINDING BLOCKS
273 BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM
275 CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
277 PUSHJ P,NXTGDY ; NEXT GOODIE
278 PUSHJ P,NXTGDY ; AND NEXT
279 MOVEI C,TSP ; TYPE THE BACK LOCATIVE
282 PUSHJ P,BMP ; AND NEXT
284 HLRZ D,-2(B) ; DECL POINTER
285 MOVEI B,0 ; MAKE SURE NO CLOBBER
287 XCT A ; DO THE THING BEING DONE
289 HRLM D,-2(B) ; FIX UP IN CASE CHANGED
292 ; HERE TO HACK ATOMS WITH GDECLS
294 GDHACK: CAMN A,[PUSHJ P,SBSTIS]
297 MOVEI C,TATOM ; TREAT LIKE ATOM
300 HRRZ D,(B) ; GET DECL
302 CAIN D,-1 ; WATCH OUT FOR MAINFEST
304 PUSH P,B ; SAVE POINTER
315 ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST
316 MOVEI C,TOBLS ; GET TYPE
317 HRRZ D,2(B) ; AND DATUM
318 JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH
320 MOVE D,(D) ; GET REAL OBLIST POINTER
322 CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
329 BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
335 MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK
340 ; SUB D,B ; D NOW ATOM PNTR
350 ; HERE TO HACK ASSOCIATION BLOCKS
352 ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK
357 PUSH P,D ; SAVE POINTER
359 POP P,D ; GET OLD BACK
360 CAME D,1(B) ; CHANGED?
361 TLO E,400000 ; SET NON-VIRGIN FLAG
363 PUSHJ P,BMP ; TO NEXT
366 ; HERE TO GOT TO NEXT VECTOR
368 VHACK1: MOVE B,-1(P) ; GET POINTER
369 SUB P,[2,,2] ; FLUSH CRUFT
370 SUBI B,2 ; FIX UP PTR
373 ; HERE TO SKIP OVER MARKED VECTOR
375 MKHAK: SUBI B,(C) ; POINT BELOW VECTOR
378 ; ROUTINE TO GET A GOODIE
391 REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT
395 MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]
397 ;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO
398 ;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT
400 ;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE
401 ;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.
402 ;BOTH ITEMS MUST BE OF THE SAME TYPE OR
403 ;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS
404 ; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN
405 ; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN
406 ; A FEW OTHER YUCKY PLACES.
407 ;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT
412 SBSTI1: GETYP A,2(AB)
415 MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE?
417 GETYP A,(AB) ; ATOM FOR ATOM SUBS?
420 MOVE B,3(AB) ; SEE IF OLD GUY
422 SUBM B,A ; POINT TO DOPE
423 HRRZ A,(A) ; POSSIBLE TYPE CODE
424 JUMPE A,SBSTI2 ; NOT A TYPE, GO
428 HRRZ C,(C) ; GET OTHER POSSIBLE CODE
431 PUSHJ P,IMPURI ; IMPURIFY FOR SMASH
438 SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG
440 PUSHJ P,NWORDT ; AND STORAGE ALLOCATION
442 GETYP A,(AB) ; GET TYPE OF FIRST ARG
445 CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION
449 JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES
452 CAIN D,0 ; IF GOODIE IS OF TYPE ZERO
453 MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE
456 PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE
458 PUSH TP,D ; TYPE OF GOODIE
462 AOS (TP) ; 1=TYPE LIST, 0=ELSE
464 PUSH TP,2(AB) ; TYPE-WORD
466 PUSH TP,3(AB) ; VALUE-WORD
468 PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO
469 MOVE A,[PUSHJ P,SBSTIR]
470 CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER
471 MOVE A,[PUSHJ P,SBSTIS]
472 MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING
473 PUSHJ P,GCHACK ; DO-IT
476 JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE
478 SBSTIR: CAME D,-2(TP)
479 JRST LSUB ; THIS IS IT
481 JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE
482 JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT
484 MOVEM 0,1(B) ; SMASH IT
485 MOVE 0,-1(TP) ; GET TYPE WORD
486 SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST
487 MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT
489 LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON
490 POPJ P, ; ELSE THATS ALL
491 TLNN B,.LIST. ; SEE IF A LIST
492 POPJ P, ; WELL NO LIST SMASHING THIS TIME
493 HRRZ 0,(B) ; GET ITS LIST POINTER
495 POPJ P, ; THIS ONE DIDNT MATCH
496 MOVE 0,(TP) ; GET THE NEW REST OF THE LIST
497 HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST
500 SBSTIS: CAMN D,-2(TP)
503 SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE
506 MOVEM 0,1(B) ; KLOBBER VALUE CELL
508 HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE
511 SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
512 BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE
514 GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER
515 HRLI E,C ; WILL HAVE TYPE CODE IN C
516 SETOM 1(TP) ; FENCE POST PDL
519 PUSHJ P,FRMUNG ; MUNG CURRENT FRAME
526 ; LOCATION TO REMEMBER PREVIOUS VALUES