<mdl.int>/nfree.53

   1
   2 TITLE MODIFIED AFREE FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 .INSRT MUDDLE >
   7 SYSQ
   8
   9 .GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1
  10 .GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP
  11 .GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR
  12 .GLOBAL %CLNCO
  13
  14 MFUNCTION FREEZE,SUBR
  15
  16         ENTRY   1
  17
  18         GETYP   A,(AB)          ; get type of it
  19         PUSH    TP,(AB)         ; save a copy
  20         PUSH    TP,1(AB)
  21         PUSH    P,[0]           ; flag for tupel freeze
  22         PUSHJ   P,SAT           ; to SAT
  23         MOVEI   B,0             ; final type
  24         CAIN    A,SNWORD        ; check valid types
  25         MOVSI   B,TUVEC         ; use UVECTOR
  26         CAIN    A,S2NWOR
  27         MOVSI   B,TVEC
  28         CAIN    A,SARGS
  29         MOVSI   B,TVEC
  30         CAIN    A,SCHSTR
  31         MOVSI   B,TCHSTR
  32         CAIN    A,SBYTE
  33         MOVEI   B,TBYTE
  34         JUMPE   B,WTYP1
  35         PUSH    P,B             ; save final type
  36         CAMN    B,$TBYTE
  37         JRST    .+3
  38         CAME    B,$TCHSTR       ; special chars hack
  39         JRST    OK.FR
  40         HRR     B,(AB)          ; fixup count
  41         MOVEM   B,(P)
  42
  43         MOVEI   C,(TB)          ; point to it
  44         PUSHJ   P,BYTDOP        ; A==> points to dope word
  45         HRRO    B,1(TB)
  46         SUBI    A,1(B)          ; A==> length of block
  47         TLC     B,-1(A)
  48         MOVEM   B,1(TB)         ; and save
  49         MOVSI   0,TUVEC
  50         MOVEM   0,(TB)
  51
  52 OK.FR:  HLRE    A,1(TB)         ; get length
  53         MOVNS   A
  54         PUSH    P,A
  55         ADDI    A,2
  56         PUSHJ   P,CAFREE        ; get storage
  57         HRLZ    B,1(TB)         ; set up to BLT
  58         HRRI    B,(A)
  59         POP     P,C
  60         ADDI    C,(A)           ; compute end
  61         BLT     B,(C)
  62         HLLOS   1(C)            ; INDICATION IN RELOCATION FIELD THAT ITS NOT GARBAGE
  63         MOVEI   B,(A)
  64         HLL     B,1(AB)
  65         POP     P,A
  66         JRST    FINIS
  67
  68
  69 CAFRE:  PUSH    P,A
  70         HRRZ    E,STOLST+1
  71         SETZB   C,D
  72         PUSHJ   P,ICONS         ; get list element
  73         PUSH    TP,$TLIST       ; and save
  74         PUSH    TP,B
  75         MOVE    A,(P)           ; restore length
  76         ADDI    A,2             ; 2 more for dope words
  77         PUSHJ   P,CAFREE        ; get the core and dope words
  78         POP     P,B             ; restore count
  79         MOVNS   B               ; build AOBJN pointer
  80         MOVSI   B,(B)
  81         HRRI    B,(A)
  82         MOVE    C,(TP)
  83         MOVEM   B,1(C)          ; save on list
  84         MOVSI   0,TSTORA        ; and type
  85         HLLM    0,(C)
  86         HRRZM   C,STOLST+1      ; and save as new list
  87         SUB     TP,[2,,2]
  88         POPJ    P,
  89
  90 CAFRE1: PUSH    P,A
  91         ADDI    A,2
  92         PUSHJ   P,CAFREE
  93         HRROI   B,(A)           ; pointer to B
  94         POP     P,A             ; length back
  95         TLC     B,-1(A)
  96         POPJ    P,
  97
  98 CAFREE: IRP     AC,,[B,C,D,E]
  99         PUSH    P,AC
 100         TERMIN
 101         SKIPG   A               ; make sure arg is a winner
 102         FATAL BAD CALL TO CAFREE
 103         MOVSI   A,(A)           ; count to left half for search
 104         MOVEI   B,FLIST         ; get first pointer
 105         HRRZ    C,(B)           ; c points to next block
 106 CLOOP:  CAMG    A,(C)           ; skip if not big enough
 107         JRST    CONLIS          ; found one
 108         MOVEI   D,(B)           ; save in case fall out
 109         MOVEI   B,(C)           ; point to new previous
 110         HRRZ    C,(C)           ; next block
 111         JUMPN   C,CLOOP         ; go on through loop
 112         HLRZ    E,A             ; count to E
 113         CAMGE   E,STORIC        ; skip if a area or more
 114         MOVE    E,STORIC        ; else use a whole area
 115         MOVE    C,PARBOT        ; found out if any funny space
 116         SUB     C,CODTOP        ; amount around to C
 117         EXCH    B,D
 118         CAMLE   C,E             ; skip if must GC
 119         JRST    CHAVIT          ; already have it
 120         SUBI    E,-1(C)         ; get needed from agc
 121         MOVEM   E,PARNEW        ; funny arg to AGC
 122         PUSH    P,A
 123         MOVE    C,[7,,6]        ; SET UP AGC INDICATORS
 124         SKIPE   GPURFL          ; DONT GC IF IN DUMPER
 125         JRST    PURGC
 126         PUSHJ   P,AGC           ; collect that garbage
 127         SETZM   PARNEW          ; dont do it again
 128         POP     P,A
 129
 130 ; Make sure pointers still good after GC
 131
 132         MOVEI   B,FLIST
 133         HRRZ    D,(B)
 134
 135         HRRZ    E,(D)           ; next pointer
 136         JUMPE   E,.+4           ; end of list ok
 137         MOVEI   B,(D)
 138         MOVEI   D,(E)
 139         JRST    .-4             ; look at next
 140
 141 CHAVIT: MOVE    C,CODTOP
 142         MOVE    E,PARBOT
 143 IFE ITS,        PUSHJ   P,%CLNCO        ; flush extra pages
 144         MOVE    E,PARBOT        ; find amount obtained
 145         SUBI    E,1             ; dont use a real pair
 146         MOVEI   C,(E)           ; for reset of CODTOP
 147         SUB     E,CODTOP
 148         EXCH    C,CODTOP        ; store it back
 149         CAIE    B,(C)           ; did we simply grow the last block?
 150         JRST    CSPLIC          ; no, splice it in
 151         HLRZ    C,(B)           ; length of old guy
 152         ADDI    C,(E)           ; total length
 153         ADDI    B,(E)           ; point to new last dope word
 154         HRLZM   C,(B)           ; clobber final length in
 155         HRRM    B,(D)           ; and splice into free list
 156         MOVEI   C,(B)           ; reset acs for reentry into loop
 157         MOVEI   B,(D)
 158         JRST    CLOOP
 159
 160 ; Here to splice new core onto end of list.
 161
 162 CSPLIC: MOVE    C,CODTOP        ; point to end of new block
 163         HRLZM   E,(C)           ; store length of new block in dope words
 164         HRRM    C,(D)           ; D is old previous, link it up
 165         MOVEI   B,(D)           ; and reset B for reentry into loop
 166         JRST    CLOOP
 167
 168 ; here if an appropriate block is on the list
 169
 170 CONLIS: HLRZS   A               ; count back to a rh
 171         HLRZ    D,(C)           ; length of proposed block to D
 172         CAIN    A,(D)           ; skip if they are different
 173         JRST    CEASY           ; just splice it out
 174         MOVEI   B,(C)           ; point to block to be chopped up
 175         SUBI    B,-1(D)         ; point to beginning of same
 176         SUBI    D,(A)           ; amount of block to be left to D
 177         HRLM    D,(C)           ; and fix up dope words
 178         ADDI    B,-1(A)         ; point to end of same
 179         HRLZM   A,(B)
 180         HRRM    B,(B)           ; for GC benefit
 181
 182 CFREET: CAIE    A,1             ; if more than 1
 183         SETZM   -1(B)           ; make tasteful dope worda
 184         SUBI    B,-1(A)
 185         MOVEI   A,(B)
 186 ACRST:  IRP     AC,,[E,D,C,B]
 187         POP     P,AC
 188         TERMIN
 189         POPJ    P,
 190
 191 PURGC:  SUB     P,[1,,1]        ; CLEAN OFF STACK
 192         SETOM   GCDANG          ; INDICATE GC SHOULD HAVE OCCURED
 193         JRST    ACRST
 194
 195 CEASY:  MOVEI   D,(C)           ; point to block to return
 196         HRRZ    C,(C)           ; point to next of same
 197         HRRM    C,(B)           ; smash its previous
 198         MOVEI   B,(D)           ; point to block with B
 199         HRRM    B,(B)           ; for GC benefit
 200         JRST    CFREET
 201
 202 CAFRET: HRROI   B,(B)           ; prepare to search list
 203         TLC     B,-1(A)         ; by making an AOBJN pointer
 204         HRRZ    C,STOLST+1      ; start of list
 205         MOVEI   D,STOLST+1
 206
 207 CAFRTL: JUMPE   C,CPOPJ         ; not founc
 208         CAME    B,1(C)          ; this it?
 209         JRST    CAFRT1
 210         HRRZ    C,(C)           ; yes splice it out
 211         HRRM    C,(D)           ; smash it
 212 CPOPJ:  POPJ    P,              ; dont do anything now
 213
 214 CAFRT1: MOVEI   D,(C)
 215         HRRZ    C,(C)
 216         JRST    CAFRTL
 217
 218 ; Here from GC to collect all unused blocks into free list
 219
 220 STOGC:  SETZB   C,E             ; zero current length and pointer
 221         MOVE    A,CODTOP        ; get high end of free space
 222
 223 STOGCL: CAIG    A,STOSTR        ; end?
 224         JRST    STOGCE          ; yes, cleanup and leave
 225
 226         HLRZ    0,(A)           ; get length
 227         ANDI    0,377777
 228         SKIPGE  (A)             ; skip if a not used block
 229         JRST    STOGC1          ; jump if marked
 230
 231 ; HERE TO SEE WHETHER AN UNMARKED ITEM IS AN ATOM. IF IT IS IT IS NOT GARBAGE
 232 ; AND IT IS PRESERVED WITH ITS VALUE CELLS FLUSHED
 233
 234         HLRZ    0,-1(A)         ; GET TYPE OF FIRST D.W.
 235         ANDI    0,TYPMSK        ; FLUSH MONITORS
 236         CAIE    0,SATOM
 237         JRST    STOGC5          ; NOT AN ATOM COLLECT THE GARBAGE
 238         PUSH    P,A             ; SAVE PTR TO D.W.
 239         HLRZ    0,(A)
 240         SUB     A,0             ; POINT TO JUST BEFORE ATOM
 241         SETZM   1(A)            ; ZERO VALUE CELLS
 242         SETZM   2(A)
 243         POP     P,A             ; RESTORE A
 244         JRST    STOGC1
 245
 246 STOGC5: HLRZ    0,(A)
 247         JUMPE   C,STOGC3        ; jump if no block under construction
 248         ADD     C,0             ; else add this length to current
 249         JRST    STOGC4
 250
 251 STOGC3: MOVEI   B,(A)           ; save pointer
 252         MOVE    C,0             ; init length
 253
 254 STOGC4: SUB     A,0             ; point to next block
 255         JRST    STOGCL
 256
 257 STOGC1: HLLOS   (A)             ; -1 IS INDICATOR OF FREE SLOT
 258         ANDCAM  D,(A)           ; kill mark bit
 259         JUMPE   C,STOGC4        ; if no block under cons, dont fix
 260         HRLM    C,(B)           ; store total block length
 261         HRRM    E,(B)           ; next pointer hooked in
 262         MOVEI   E,(B)           ; new next pointer
 263         MOVEI   C,0
 264         JRST    STOGC4
 265
 266 STOGCE: JUMPE   C,STGCE1        ; jump if no current block
 267         HRLM    C,(B)           ; smash in count
 268         HRRM    E,(B)           ; smash in next pointer
 269         MOVEI   E,(B)           ; and setup E
 270
 271 STGCE1: HRRZM   E,FLIST+1       ; final link up
 272         POPJ    P,
 273
 274 IMPURE
 275
 276 FLIST:  .+1
 277         ISTOST
 278
 279 PURE
 280
 281 END
 282 \f