<mdl.int>/nfree.mid.53

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