2 TITLE MODIFIED AFREE FOR MUDDLE
8 .GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1
9 .GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP
10 .GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR
15 GETYP A,(AB) ; get type of it
16 PUSH TP,(AB) ; save a copy
18 PUSH P,[0] ; flag for tupel freeze
20 MOVEI B,0 ; final type
21 CAIN A,SNWORD ; check valid types
22 MOVSI B,TUVEC ; use UVECTOR
32 PUSH P,B ; save final type
35 CAME B,$TCHSTR ; special chars hack
37 HRR B,(AB) ; fixup count
40 MOVEI C,(TB) ; point to it
41 PUSHJ P,BYTDOP ; A==> points to dope word
43 SUBI A,1(B) ; A==> length of block
45 MOVEM B,1(TB) ; and save
49 OK.FR: HLRE A,1(TB) ; get length
53 PUSHJ P,CAFREE ; get storage
54 HRLZ B,1(TB) ; set up to BLT
57 ADDI C,(A) ; compute end
59 HLLOS 1(C) ; INDICATION IN RELOCATION FIELD THAT ITS NOT GARBAGE
69 PUSHJ P,ICONS ; get list element
70 PUSH TP,$TLIST ; and save
72 MOVE A,(P) ; restore length
73 ADDI A,2 ; 2 more for dope words
74 PUSHJ P,CAFREE ; get the core and dope words
75 POP P,B ; restore count
76 MOVNS B ; build AOBJN pointer
80 MOVEM B,1(C) ; save on list
81 MOVSI 0,TSTORA ; and type
83 HRRZM C,STOLST+1 ; and save as new list
90 HRROI B,(A) ; pointer to B
95 CAFREE: IRP AC,,[B,C,D,E]
98 SKIPG A ; make sure arg is a winner
99 FATAL BAD CALL TO CAFREE
100 MOVSI A,(A) ; count to left half for search
101 MOVEI B,FLIST ; get first pointer
102 HRRZ C,(B) ; c points to next block
103 CLOOP: CAMG A,(C) ; skip if not big enough
104 JRST CONLIS ; found one
105 MOVEI D,(B) ; save in case fall out
106 MOVEI B,(C) ; point to new previous
107 HRRZ C,(C) ; next block
108 JUMPN C,CLOOP ; go on through loop
109 HLRZ E,A ; count to E
110 CAMGE E,STORIC ; skip if a area or more
111 MOVE E,STORIC ; else use a whole area
112 MOVE C,PARBOT ; foun out if any funny space
113 SUB C,CODTOP ; amount around to C
115 CAMLE C,E ; skip if must GC
116 JRST CHAVIT ; already have it
117 SUBI E,-1(C) ; get needed from agc
118 MOVEM E,PARNEW ; funny arg to AGC
120 MOVE C,[7,,6] ; SET UP AGC INDICATORS
121 SKIPE GPURFL ; DONT GC IF IN DUMPER
123 PUSHJ P,AGC ; collect that garbage
124 SETZM PARNEW ; dont do it again
127 ; Make sure pointers still good after GC
132 HRRZ E,(D) ; next pointer
133 JUMPE E,.+4 ; end of list ok
136 JRST .-4 ; look at next
138 CHAVIT: MOVE E,PARBOT ; find amount obtained
139 SUBI E,1 ; dont use a real pair
140 MOVEI C,(E) ; for reset of CODTOP
142 EXCH C,CODTOP ; store it back
143 CAIE B,(C) ; did we simply grow the last block?
144 JRST CSPLIC ; no, splice it in
145 HLRZ C,(B) ; length of old guy
146 ADDI C,(E) ; total length
147 ADDI B,(E) ; point to new last dope word
148 HRLZM C,(B) ; clobber final length in
149 HRRM B,(D) ; and splice into free list
150 MOVEI C,(B) ; reset acs for reentry into loop
154 ; Here to splice new core onto end of list.
156 CSPLIC: MOVE C,CODTOP ; point to end of new block
157 HRLZM E,(C) ; store length of new block in dope words
158 HRRM C,(D) ; D is old previous, link it up
159 MOVEI B,(D) ; and reset B for reentry into loop
162 ; here if an appropriate block is on the list
164 CONLIS: HLRZS A ; count back to a rh
165 HLRZ D,(C) ; length of proposed block to D
166 CAIN A,(D) ; skip if they are different
167 JRST CEASY ; just splice it out
168 MOVEI B,(C) ; point to block to be chopped up
169 SUBI B,-1(D) ; point to beginning of same
170 SUBI D,(A) ; amount of block to be left to D
171 HRLM D,(C) ; and fix up dope words
172 ADDI B,-1(A) ; point to end of same
174 HRRM B,(B) ; for GC benefit
176 CFREET: CAIE A,1 ; if more than 1
177 SETZM -1(B) ; make tasteful dope worda
180 ACRST: IRP AC,,[E,D,C,B]
185 PURGC: SUB P,[1,,1] ; CLEAN OFF STACK
186 SETOM GCDANG ; INDICATE GC SHOULD HAVE OCCURED
189 CEASY: MOVEI D,(C) ; point to block to return
190 HRRZ C,(C) ; point to next of same
191 HRRM C,(B) ; smash its previous
192 MOVEI B,(D) ; point to block with B
193 HRRM B,(B) ; for GC benefit
196 CAFRET: HRROI B,(B) ; prepare to search list
197 TLC B,-1(A) ; by making an AOBJN pointer
198 HRRZ C,STOLST+1 ; start of list
201 CAFRTL: JUMPE C,CPOPJ ; not founc
202 CAME B,1(C) ; this it?
204 HRRZ C,(C) ; yes splice it out
205 HRRM C,(D) ; smash it
206 CPOPJ: POPJ P, ; dont do anything now
212 ; Here from GC to collect all unused blocks into free list
214 STOGC: SETZB C,E ; zero current length and pointer
215 MOVE A,CODTOP ; get high end of free space
217 STOGCL: CAIG A,STOSTR ; end?
218 JRST STOGCE ; yes, cleanup and leave
220 HLRZ 0,(A) ; get length
222 SKIPGE (A) ; skip if a not used block
223 JRST STOGC1 ; jump if marked
225 ; HERE TO SEE WHETHER AN UNMARKED ITEM IS AN ATOM. IF IT IS IT IS NOT GARBAGE
226 ; AND IT IS PRESERVED WITH ITS VALUE CELLS FLUSHED
228 HLRZ 0,-1(A) ; GET TYPE OF FIRST D.W.
229 ANDI 0,TYPMSK ; FLUSH MONITORS
231 JRST STOGC5 ; NOT AN ATOM COLLECT THE GARBAGE
232 PUSH P,A ; SAVE PTR TO D.W.
234 SUB A,0 ; POINT TO JUST BEFORE ATOM
235 SETZM 1(A) ; ZERO VALUE CELLS
241 JUMPE C,STOGC3 ; jump if no block under construction
242 ADD C,0 ; else add this length to current
245 STOGC3: MOVEI B,(A) ; save pointer
246 MOVE C,0 ; init length
248 STOGC4: SUB A,0 ; point to next block
251 STOGC1: HLLOS (A) ; -1 IS INDICATOR OF FREE SLOT
252 ANDCAM D,(A) ; kill mark bit
253 JUMPE C,STOGC4 ; if no block under cons, dont fix
254 HRLM C,(B) ; store total block length
255 HRRM E,(B) ; next pointer hooked in
256 MOVEI E,(B) ; new next pointer
260 STOGCE: JUMPE C,STGCE1 ; jump if no current block
261 HRLM C,(B) ; smash in count
262 HRRM E,(B) ; smash in next pointer
263 MOVEI E,(B) ; and setup E
265 STGCE1: HRRZM E,FLIST+1 ; final link up