<mdl.int>/utilit.mid.103

   1 TITLE   UTILITY FUNCTIONS FOR MUDDLE
   2
   3 RELOCATABLE
   4
   5 .INSRT MUDDLE >
   6
   7 SYSQ
   8
   9 IFE ITS,[
  10 .INSRT STENEX >
  11 XJRST==JRST 5,
  12 ]
  13
  14 .GLOBAL GODUMP,IPURIF,EGCDUM,EPURIF,LODGC,KILGC,CALER,RBLDM,CPOPJ,C1POPJ,INQAGC,FRETOP
  15 .GLOBAL SAT,PGFIND,PGGIVE,PGTAKE,PINIT,ERRKIL,CKPUR,GCSET,MKTBS,PFLG,NPWRIT,GETNUM
  16 .GLOBAL AGC,AAGC,%CLSM1,%SHWND,IBLOCK,FINAGC,PGINT,CPOPJ1,REHASH,FRMUNG,MAXLEN,TOTCNT
  17 .GLOBAL NWORDT,NWORDS,MSGTYP,IMTYO,MULTSG,MULTI,NOMULT,GCDEBU
  18 .GLOBAL PURCOR,INCORF,BADCHN,INTHLD,%MPIN1,WNDP,WIND,ACCESS,PURTOP,GCPDL,CTIME,P.CORE
  19 .GLOBAL IAGC,IAAGC,TYPVEC,PURBOT,PURTOP,MOVPUR,PURVEC,PMAPB,CURPLN,RFRETP,NOWFRE,FREMIN
  20 .GLOBAL MAXFRE,TPGROW,PDLBUF,CTPMX,PGROW,PDLBUF,CPMX,SAVM,NOWP,NOWTP,MPOPJ,GCFLG,GCDOWN
  21 .GLOBAL GCTIM,NOSHUF,P.TOP,GETPAG,ITEM,INDIC,ASOVEC,ASOLNT,GETBUF,KILBUF,PAT,PATEND
  22 .GLOBAL PATCH,DSTORE,PVSTOR,SPSTOR,SQKIL,IAMSGC,FNMSGC,RNUMSP,NUMSWP,SWAPGC,SAGC,GCSTOP
  23 .GLOBAL ISECGC
  24 .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
  25 .GLOBAL C%M20,C%M30,C%M40,C%M60
  26
  27 FPAG==2000
  28
  29 ; GC-DUMP TAKES AN OBJECT AND MAPS IT INTO A FILE DIRECTLY USING THE GARBAGE
  30 ; COLLECTOR.  ALL OBJECTS HAVE RELATIVIZED POINTERS AND WILL BE SET UP UPON
  31 ; READIN (USING GC-READ).
  32 ; IT TAKES TWO ARGUMENTS. THE FIRST IS THE OBJECT THE SECOND MUST BE A "PRINTB"
  33 ; CHANNEL.
  34
  35 MFUNCTION GCDUMP,SUBR,[GC-DUMP]
  36
  37         ENTRY
  38
  39 IFE ITS,[
  40         PUSH    P,MULTSG
  41         SKIPE   MULTSG                  ; MUST RUN I 0 SEXTION MODE
  42          PUSHJ  P,NOMULT
  43 ]
  44         MOVE    PVP,PVSTOR+1
  45         IRP     AC,,[FRM,P,R,M,TP,TB,AB]
  46         MOVEM   AC,AC!STO"+1(PVP)
  47         TERMIN
  48
  49         SETZM   PURCOR
  50         SETZM   INCORF                  ; SET UP PARAMS
  51         CAML    AB,C%M20                ; CHECK ARGS
  52          JRST   TFA
  53         CAMG    AB,C%M60
  54          JRST   TMA
  55         GETYP   A,2(AB)                 ; SEE WHETHER THE CHANNEL IS A WINNER
  56         CAIN    A,TFALSE                ; SKIP IF NOT FALSE
  57          JRST   UVEARG
  58         CAIE    A,TCHAN
  59          JRST   WTYP2                   ; ITS NOT A CHANNEL. COMPLAIN
  60         MOVE    B,3(AB)                 ; CHECK BITS IN CHANNEL
  61         HRRZ    C,-2(B)
  62         TRC     C,C.PRIN+C.OPN+C.BIN
  63         TRNE    C,C.PRIN+C.OPN+C.BIN
  64          JRST   BADCHN
  65         PUSH    P,1(B)                  ; SAVE CHANNEL NUMBER
  66         CAMGE   AB,C%M40                ; SEE IF THIRD ARG WAS SNUCK IN
  67          JRST   TMA
  68         JRST    IGCDUM
  69
  70 UVEARG: SETOM   INCORF                  ; SET UP FLAG INDICATING UVECTOR
  71         CAML    AB,C%M40                        ; SEE IF THIRD ARG
  72          JRST   IGCDUM
  73         GETYP   A,5(AB)
  74         CAIE    A,TFALSE
  75          SETOM  PURCOR
  76 IGCDUM: SETZM   SWAPGC
  77         PUSHJ   P,LODGC                         ; GET THE GARBAGE COLLECTOR
  78         SETOM   INTHLD
  79         JRST    GODUMP
  80
  81 EGCDUM: PUSH    P,A                             ; SAVE LENGTH
  82         PUSHJ   P,KILGC                         ; KILL THE GARBAGE COLLECTOR
  83         POP     P,A
  84         SETZM   INTHLD
  85         SKIPN   INCORF                          ; SKIP IF TO UVECTOR
  86         JRST    OUTFIL
  87         SKIPN   PURCOR                          ; SKIP IF PURE UVECTOR
  88         JRST    BLTGCD
  89
  90 ; ROUTINE TO CREATE A UVECTOR IN PURE STORAGE CONTAINING GC-DUMPED
  91 ; OBJECTS.
  92
  93         ADDI    A,1777                          ; ROUND
  94         ANDCMI  A,1777
  95         ASH     A,-10.                          ; TO BLOCKS
  96         PUSH    P,A                             ; SAVE IT
  97 TRAGN:  PUSHJ   P,PGFIND                        ; TRY TO GET PAGES
  98         JUMPL   B,GCDPLS                        ; LOSSAGE?
  99         POP     P,A                             ; GET # OF PAGES
 100         PUSH    P,B                             ; SAVE B\r
 101         MOVNS   A                               ; BUILD AOBJN POINTER
 102         HRLZS   A
 103         ADDI    A,FPAG/2000                     ; START
 104         HLL     B,A                             ; SAME # OF PAGES
 105         PUSHJ   P,%MPIN1
 106         POP     P,B                             ; RESTORE # OF FIRST PAGE
 107         ASH     B,10.                           ; TO ADDRESS
 108         POP     P,A                             ; RESTORE LENGTH IN WORDS
 109         MOVNI   A,-2(A)                         ; BUILD AOBJN
 110         HRL     B,A
 111         MOVE    A,$TUVEC                        ; TYPE WORD
 112         JRST    DONDUM                          ; FINISH
 113
 114 ; HERE WHEN EFFORTS TO GE PURE STORAGE FAIL.
 115
 116 GCDPLS: MOVE    A,(P)                           ; GET # OF PAGES
 117         ASH     A,10.                           ; TO WORDS
 118         ADDI    A,1777
 119         ANDCMI  A,1777                          ; ROUND AND TO PAGE
 120         MOVEM   A,GCDOWN
 121         MOVE    C,[13.,,9.]                     ; CAUSE INDICATOR
 122         PUSHJ   P,AGC                           ; CAUSE AGC TO HAPPEN
 123         MOVE    A,(P)                           ; GET # OF PAGES
 124         JRST    TRAGN                           ; TRY AGAIN
 125
 126 ; HERE TO TRANSFER FROM INFERIOR TO THE FILE
 127 OUTFIL: PUSH    P,A                             ; SAVE LENGTH OF FILE
 128         PUSHJ   P,SETBUF
 129         MOVE    A,(P)
 130         ANDCMI  A,1777
 131         ASH     A,-10.                          ; TO PAGES
 132         MOVNS   A                               ; SET UP AOBJN POINTER
 133         HRLZS   A
 134         ADDI    A,1                             ; STARTS ON PAGE ONE
 135         MOVE    C,-1(P)                         ; GET ITS CHANNEL #
 136         MOVE    B,BUFP                          ; WINDOW PAGE
 137         JUMPGE  A,DPGC5
 138 IFN ITS,[
 139 DPGC3:  MOVE    D,BUFL
 140         HRLI    D,-2000                         ; SET UP BUFFER IOT POINTER
 141         PUSHJ   P,%SHWND                        ; SHARE INF PAGE AND WINDOW
 142         DOTCAL  IOT,[C,D]
 143         FATAL GCDUMP-- IOT FAILED
 144         AOBJN   A,DPGC3
 145 ]
 146 IFE ITS,[
 147 DPGC3:  MOVE    B,BUFP
 148         PUSHJ   P,%SHWND
 149         PUSH    P,A                             ; SAVE A
 150         PUSH    P,C                             ; SAVE C
 151         MOVE    A,C                             ; CHANNEL INTO A
 152         MOVE    B,BUFL                          ; SET UP BYTE POINTER
 153         HRLI    B,444400
 154         MOVNI   C,2000
 155         SOUT                                    ; OUT IT GOES
 156         POP     P,C
 157         POP     P,A                             ; RESTORE A
 158         AOBJN   A,DPGC3
 159 ]
 160
 161 DPGC5:  MOVE    D,(P)                           ; CALCULATE AMOUNT LEFT TO SEND OUT
 162         MOVE    0,D
 163         ANDCMI  D,1777                          ; TO PAGE BOUNDRY
 164         SUB     D,0                             ; SET UP AOBJN PTR FOR OUTPUT
 165 IFN ITS,[
 166         HRLZS   D
 167         ADD     D,BUFL
 168         MOVE    B,BUFP                          ; SHARE WINDOW
 169         PUSHJ   P,%SHWND
 170         DOTCAL  IOT,[C,D]
 171         FATAL   GCDUMP-- IOT FAILED
 172 ]
 173 IFE ITS,[
 174         MOVE    B,BUFP                          ; SET UP WINDOW
 175         PUSHJ   P,%SHWND
 176         MOVE    A,C                             ; CHANNEL TO A
 177         MOVE    C,D
 178         MOVE    B,BUFL                          ; SET UP BYTE POINTER
 179         HRLI    B,444400
 180         SOUT
 181 ]       POP     P,D
 182         MOVE    B,3(AB)                         ; GET CHANNEL
 183         ADDM    D,ACCESS(B)
 184
 185         PUSHJ   P,KILBUF
 186         MOVE    A,(AB)                          ; RETURN WHAT IS GIVEN
 187         MOVE    B,1(AB)
 188 DONDUM: PUSH    TP,A                            ; SAVE RETURNS
 189         PUSH    TP,B
 190         PUSHJ   P,%CLSM1
 191         SUB     P,C%11
 192 IFE ITS,[
 193         POP     P,MULTSG
 194         SKIPE   MULTSG
 195          PUSHJ  P,MULTI
 196 ]
 197         POP     TP,B
 198         POP     TP,A
 199         JRST    FINIS
 200
 201
 202 ; HERE TO BLT INTO A UVECTOR IN GCS
 203
 204 BLTGCD: PUSH    P,A                             ; SAVE # OF WORDS
 205         PUSHJ   P,SETBUF
 206         MOVE    A,(P)
 207         PUSHJ   P,IBLOCK                        ; GET THE UVECTOR
 208         PUSH    TP,A                            ; SAVE POINTER TO IT
 209         PUSH    TP,B
 210         MOVE    C,(P)                           ; GET # OF WORDS
 211         ASH     C,-10.                          ; TO PAGES
 212         PUSH    P,C                             ; SAVE C
 213         MOVNS   C
 214         HRLZS   C
 215         ADDI    C,FPAG/2000
 216         MOVE    B,BUFP                          ; WINDOW ACTS AS A BUFFER
 217         HRRZ    D,(TP)                          ; GET PTR TO START OF UVECTOR
 218         JUMPGE  C,DUNBLT                        ; IF < 1 BLOCK
 219 LOPBLT: MOVEI   A,(C)                           ; GET A BLOCK
 220         PUSHJ   P,%SHWND
 221         MOVS    A,BUFL                          ; SET UP TO BLT INTO UVECTOR
 222         HRRI    A,(D)
 223         BLT     A,1777(D)                       ; IN COMES ONE BLOCK
 224         ADDI    D,2000                          ; INCREMENT D
 225         AOBJN   C,LOPBLT                        ; LOOP
 226 DUNBLT: MOVEI   A,(C)                           ; SHARE LAST PAGE
 227         PUSHJ   P,%SHWND
 228         MOVS    A,BUFL                          ; SET UP BLT
 229         HRRI    A,(D)
 230         MOVE    C,-1(P)                         ; GET TOTAL # OF WORDS
 231         MOVE    0,(P)
 232         ASH     0,10.
 233         SUB     C,0                             ; CALCULATE # LEFT TO GO
 234         ADDI    D,-1(C)                         ; END OF UVECTOR
 235         BLT     A,(D)
 236         SUB     P,C%22                  ; CLEAN OFF STACK
 237         PUSHJ   P,KILBUF
 238         POP     TP,B
 239         POP     TP,A
 240         JRST    DONDUM                          ; DONE
 241
 242 SETBUF: MOVEI   A,1
 243         PUSHJ   P,GETBUF
 244         MOVEM   B,BUFL
 245         ASH     B,-10.
 246         MOVEM   B,BUFP
 247         POPJ    P,
 248
 249 \f
 250 ; LITTLE ROUTINES USED ALL OVER THE PLACE
 251
 252 MSGTYP: HRLI    B,440700        ;MAKE BYTE POINTER
 253 MSGTY1: ILDB    A,B             ;GET NEXT CHARACTER
 254         JUMPE   A,CPOPJ         ;NULL ENDS STRING
 255         CAIE    A,177           ; DONT PRINT RUBOUTS
 256         PUSHJ   P,IMTYO
 257         JRST    MSGTY1          ;AND GET NEXT CHARACTER
 258 CPOPJ:  POPJ    P,
 259
 260
 261 ; ROUTINE TO PURIFY A STRUCTURE AND FREEZE ATOMS POINTED TO BY IT.
 262 ; TAKES ONE ARGUMENT, THE ITEM TO PURIFY
 263
 264 MFUNCTION PURIF,SUBR,[PURIFY]
 265
 266         ENTRY
 267
 268         JUMPGE  AB,TFA                  ; CHECK # OF ARGS
 269
 270 IFE ITS,[
 271         PUSH    P,MULTSG
 272         SKIPE   MULTSG                  ; MUST RUN I 0 SEXTION MODE
 273          PUSHJ  P,NOMULT
 274 ]
 275         MOVE    C,AB
 276         PUSH    P,C%0                           ; SLOT TO SEE IF WINNER
 277 PURMO1: HRRZ    0,1(C)
 278         CAML    0,PURTOP
 279         JRST    PURMON                          ; CHECK FOR PURENESS
 280         GETYP   A,(C)                           ; SEE IF ITS MONAD
 281         PUSHJ   P,SAT
 282         ANDI    A,SATMSK
 283         CAIE    A,S1WORD
 284         CAIN    A,SLOCR
 285         JRST    PURMON
 286         CAIN    A,SATOM
 287         JRST    PURMON
 288         SKIPE   1(C)                            ; SKIP IF EMPTY
 289         SETOM   (P)
 290 PURMON: ADD     C,C%22                  ; INC AND GO
 291         JUMPL   C,PURMO1
 292         POP     P,A                             ; GET MARKING
 293         JUMPN   A,PURCON
 294 NPF:    MOVE    A,(AB)                          ; FINISH IF MONAD
 295         MOVE    B,1(AB)
 296 IFE ITS,[
 297         POP     P,MULTSG
 298         SKIPE   MULTSG
 299          PUSHJ  P,MULTI
 300 ]
 301         JRST    FINIS
 302
 303 PURCON: SETZM   SWAPGC
 304         PUSHJ   P,LODGC                         ; LOAD THE GARBAGE COLLECTOR
 305         SETOM   INTHLD
 306         SETOM   NPWRIT
 307         JRST    IPURIF
 308
 309 EPURIF: PUSHJ   P,KILGC
 310         SETZM   INTHLD
 311         SETZM   NPWRIT
 312 IFE ITS,[
 313         SKIPN   MULTSG
 314          JRST   NPF
 315         POP     P,B
 316         HRRI    B,NPF
 317         MOVEI   A,0
 318         XJRST   A
 319 ]
 320 IFN ITS,[
 321         JRST    NPF
 322 ]
 323
 324
 325 \f
 326 ; ROUTINE TO DO A SPECIAL GARBAGE COLLECT, CALLED FOR FREE STORAGE GARBAGE
 327 ;       COLLECTS
 328 ; AND CAN RUN A MARK/SWEEP GARBAGE COLLECT
 329
 330 SAGC:
 331 IFE ITS,[
 332         JRST    @[.+1]                  ; RETURN WITH US NOW TO THE THRILLING
 333                                         ; DAYS OF SEGMENT 0
 334 ]
 335         SOSL    NUMSWP                  ; GET NUMBER OF SWEEP GARBAGE COLLECTS
 336         JRST    MSGC                    ; TRY MARK/SWEEP
 337         MOVE    RNUMSP                  ; MOVE IN RNUMSWP
 338         MOVEM   NUMSWP                  ; SMASH IT IN
 339         JRST    GOGC
 340 MSGC:   SKIPN   PGROW                   ; CHECK FOR STACK OVERFLOW
 341         SKIPE   TPGROW
 342         JRST    AGC                     ; IF SO CAUSE REAL GARBAGE COLLECT
 343         PUSH    P,C
 344         PUSH    P,D
 345         PUSH    P,E
 346         SETOM   SWAPGC                  ; LOAD MARK SWEEP VERSION
 347         PUSHJ   P,AGC1                  ; CAUSE GARBAGE COLLECT
 348         HRRZ    0,MAXLEN                ; SEE IF REQUEST SATISFIED
 349         CAMGE   0,GETNUM
 350         JRST    LOSE1
 351         MOVE    C,FREMIN                ; GET FREMIN
 352         SUB     C,TOTCNT                ; CALCULATE NEEDED
 353         SUB     C,FRETOP
 354         ADD     C,GCSTOP
 355         JUMPL   C,DONE1
 356         JSP     E,CKPUR                 ; GO CHECK FOR SOME STUFF
 357         MOVE    D,PURBOT
 358 IFE ITS,        ANDCMI  D,1777          ; MAKE LIKE AN ITS PAGE
 359         SUB     D,CURPLN                ; CALCULATE PURENESS
 360         SUB     D,P.TOP
 361         CAIG    D,(C)                   ; SEE IF PURENESS EXISTS
 362         JRST    LOSE1
 363         PUSH    P,A
 364         ADD     C,GCSTOP
 365         MOVEI   A,1777(C)
 366         ASH     A,-10.
 367         PUSHJ   P,P.CORE
 368         FATAL   P.CORE FAILED
 369         HRRZ    0,GCSTOP
 370         SETZM   @0
 371         HRLS    0
 372         ADDI    0,1
 373         HRRZ    A,FRETOP
 374         BLT     0,-1(A)
 375         POP     P,A
 376 DONE1:  POP     P,E
 377         POP     P,D
 378         POP     P,C
 379 IFN ITS,        POPJ    P,
 380 IFE ITS,[
 381         SKIPN   MULTSG
 382          POPJ   P,
 383         SETZM   20
 384         POP     P,21                    ; BACK TO CALLING SEGMENT
 385         XJRST   20
 386 ]
 387 LOSE1:  POP     P,E
 388         POP     P,D
 389         POP     P,C
 390 GOGC:
 391
 392
 393 AGC:
 394 IFE ITS,[
 395         SKIPE   MULTSG
 396          SKIPE  GCDEBU
 397           JRST  @[SEC1]
 398         XJRST   .+1
 399                 0
 400                 FSEG,,SEC1
 401 SEC1:
 402 ]
 403          MOVE   0,RNUMSP
 404         MOVEM   0,NUMSWP
 405         SETZM   SWAPGC
 406 AGC1:   SKIPE   NPWRIT
 407         JRST    IAGC
 408         EXCH    P,GCPDL
 409         PUSHJ   P,SVAC                          ; SAVE ACS
 410         PUSHJ   P,SQKIL
 411         PUSHJ   P,CTIME
 412         MOVEM   B,GCTIM
 413         PUSHJ   P,LODGC                         ; LOAD GC
 414         PUSHJ   P,RSAC                          ; RESTORE ACS
 415         EXCH    P,GCPDL
 416         SKIPE   SWAPGC
 417         JRST    IAMSGC
 418         SKIPN   MULTSG
 419         JRST    IAGC
 420         JRST    ISECGC
 421
 422 AAGC:   SETZM   SWAPGC
 423         EXCH    P,GCPDL
 424         PUSHJ   P,SVAC                          ; SAVE ACS
 425         PUSHJ   P,LODGC                         ; LOAD GC
 426         PUSHJ   P,RSAC                          ; RESTORE ACS
 427         EXCH    P,GCPDL
 428         JRST    IAAGC
 429
 430 FNMSGC:
 431 FINAGC: SKIPE   NPWRIT
 432         JRST    FINAGG
 433         PUSHJ   P,SVAC                          ; SAVE ACS
 434         PUSHJ   P,KILGC
 435         PUSHJ   P,RSAC
 436 FINAGG:
 437 IFN ITS,        POPJ    P,
 438 IFE ITS,[
 439         SKIPN   MULTSG
 440          POPJ   P,
 441         SETZM   20
 442         POP     P,21                    ; BACK TO CALLING SEGMENT
 443         XJRST   20
 444 ]
 445
 446 ; ROUTINE TO SAVE THE ACS
 447
 448 SVAC:   EXCH    0,(P)
 449         PUSH    P,A
 450         PUSH    P,B
 451         PUSH    P,C
 452         PUSH    P,D
 453         PUSH    P,E
 454         JRST    @0
 455
 456 ; ROUTINE TO RESTORE THE ACS
 457
 458 RSAC:   POP     P,0
 459         POP     P,E
 460         POP     P,D
 461         POP     P,C
 462         POP     P,B
 463         POP     P,A
 464         EXCH    0,(P)
 465         POPJ    P,
 466
 467
 468 \f
 469
 470 ; INTERNAL FUNCTION TO GET STRAGE ALLOCATION TYPE
 471 ; GETS THE TYPE CODE IN A AND RETURNS SAT IN A.
 472
 473 SAT:    LSH     A,1                             ; TIMES 2 TO REF VECTOR
 474         HRLS    A                               ; TO BOTH HALVES TO HACK AOBJN
 475                                                 ;       POINTER
 476         ADD     A,TYPVEC+1                      ; ACCESS THE VECTOR
 477         HRR     A,(A)                           ; GET PROBABLE SAT
 478         JUMPL   A,.+2                           ; DID WE REALLY HAVE A VALID
 479                                                 ;       TYPE
 480         MOVEI   A,0                             ; NO RETURN 0
 481         ANDI    A,SATMSK
 482         POPJ    P,                              ; AND RETURN
 483
 484 ; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
 485 ; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B
 486 ; RETURN -1 IN REG B IF NONE FOUND
 487
 488 PGFIND:
 489         JUMPLE  A,FPLOSS
 490         CAILE   A,256.
 491         JRST    FPLOSS
 492
 493         PUSHJ   P,PGFND1                        ; SEE IF ALREADY ENOUGH
 494         SKIPN   NOSHUF                          ; CAN'T MOVE PURNESS
 495         SKIPL   B                               ; SKIP IF LOST
 496         POPJ    P,
 497
 498         SUBM    M,(P)
 499         PUSH    P,E
 500         PUSH    P,C
 501         PUSH    P,D
 502 PGFLO4: MOVE    C,PURBOT                        ; CHECK IF ROOM AT ALL
 503                                                 ;       (NOTE POTENTIAL FOR INFINITE LOOP)
 504         SUB     C,P.TOP                         ; TOTAL SPACE
 505         MOVEI   D,(C)                           ; COPY FOR CONVERSION TO PAGES
 506         ASH     D,-10.
 507         CAIGE   D,(A)                           ; SKIP IF COULD WIN
 508         JRST    PGFLO1
 509
 510         MOVNS   A                               ; MOVE PURE AREA DOWN "A" PAGES
 511         PUSHJ   P,MOVPUR
 512         MOVE    B,PURTOP                        ; GET FIRST PAGE ALLOCATED
 513         ASH     B,-10.                          ; TO PAGE #
 514 PGFLOS: POP     P,D
 515         POP     P,C
 516         POP     P,E
 517         PUSHJ   P,RBLDM                         ; GET A NEW VALUE FOR M
 518         JRST    MPOPJ
 519
 520 ; HERE TO SHUFFLE PURE SPACE TO TRY TO FIND PAGES
 521
 522 PGFLO1: SKIPE   GCFLG                           ; SKIP IF NOT IN GC
 523         JRST    PGFLO5                          ; WE LOST
 524         MOVE    C,PURTOP
 525         SUB     C,P.TOP
 526         HRRZ    D,FSAV(TB)                      ; ARE WE IN A PURE RSUBR?
 527         CAIL    D,HIBOT                         ; ARE WE AN RSUBR AT ALL?
 528         JRST    PGFLO2
 529         GETYP   E,(R)                           ; SEE IF PCODE
 530         CAIE    E,TPCODE
 531         JRST    PGFLO2
 532         HLRZ    D,1(R)                          ; GET OFFSET TO PURVEC
 533         ADD     D,PURVEC+1
 534         HRROS   2(D)                            ; MUNG AGE
 535         HLRE    D,1(D)                          ; GET LENGTH
 536         ADD     C,D
 537 PGFLO2: ASH     C,-10.
 538         CAILE   A,(C)
 539         JRST    PGFLO3
 540         PUSH    P,A
 541 IFE ITS,        ASH     A,1                     ; TENEX PAGES ARE HALF SIZE
 542         PUSHJ   P,GETPAG                        ; SHUFFLE THEM AROUND
 543         FATAL   PURE SPACE LOSING
 544         POP     P,A
 545         JRST    PGFLO4
 546
 547 ; HERE TO CAUSE AGC IF PAGES ARE NOT AVAILABLE EVEN AFTER MAPPING OUT THE WORLD
 548
 549
 550 PGFLO3: PUSH    P,A                             ; ASK GC FOR SPACE
 551         ASH     A,10.
 552         MOVEM   A,GCDOWN                        ; REQUEST THOSE PAGES
 553         MOVE    C,[8.,,9.]
 554         PUSHJ   P,AGC                           ; GO GARBAGE COLLECT
 555         POP     P,A
 556         JRST    PGFLO4                          ; GO BACK TO POTENTIAL LOOP
 557
 558
 559 PGFLO5: SETOM   B                               ; -1 TO B
 560         JRST    PGFLOS                          ; INDICATE LOSSAGE
 561
 562 PGFND1: PUSH    P,E
 563         PUSH    P,D
 564         PUSH    P,C
 565         PUSH    P,C%M1          ; POSSIBLE CONTENTS FOR REG B
 566         PUSH    P,A             ; SAVE LENGTH OF BLOCK DESIRED FOR LATER USE
 567         SETZB   B,C             ; INITIAL SECTION AND PAGE NUMBERS
 568         MOVEI   0,0             ; COUNT OF PAGES ALREADY FOUND
 569         PUSHJ   P,PINIT
 570 PLOOP:  TDNE    E,D             ; FREE PAGE ?
 571         JRST    NOTFRE          ; NO
 572         JUMPN   0,NFIRST        ; FIRST FREE PAGE OF A BLOCK ?
 573         MOVEI   A,(B)           ; YES SAVE ADDRESS OF PAGE IN REG A
 574         IMULI   A,16.
 575         ASH     C,-1            ; BACK TO PAGES
 576         ADDI    A,(C)
 577         ASH     C,1             ; FIX IT TO WHAT IT WAS
 578 NFIRST: ADDI    0,1
 579         CAML    0,(P)           ; TEST IF ENOUGH PAGES HAVE BEEN FOUND
 580         JRST    PWIN            ; YES, FINISHED
 581         SKIPA
 582 NOTFRE: MOVEI   0,0             ; RESET COUNT
 583         PUSHJ   P,PNEXT ; NEXT PAGE
 584         JRST    PLOSE           ; NONE--LOSE RETURNING -1 IN REG B
 585         JRST    PLOOP
 586
 587 PWIN:   MOVEI   B,(A)           ; GET WINNING ADDRESS
 588         MOVEM   B,(P)-1         ; RETURN ADDRESS OF WINNING PAGE
 589         MOVE    A,(P)           ; RELOAD LENGTH OF BLOCK OF PAGES
 590         MOVE    0,[TDO E,D]     ; INST TO SET "BUSY" BITS
 591         JRST    ITAKE
 592
 593 ; CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
 594 ; THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B
 595 PGGIVE: MOVE    0,[TDZ E,D]     ; INST TO SET "FREE" BITS
 596         SKIPA
 597 PGTAKE: MOVE    0,[TDO E,D]     ; INST TO SET "BUSY" BITS
 598         JUMPLE  A,FPLOSS
 599         CAIL    B,0
 600         CAILE   B,255.
 601         JRST    FPLOSS
 602         PUSH    P,E
 603         PUSH    P,D
 604         PUSH    P,C
 605         PUSH    P,B
 606         PUSH    P,A
 607 ITAKE:  IDIVI   B,16.
 608         PUSHJ   P,PINIT
 609         SUBI    A,1
 610 RTL:    XCT     0               ; SET APPROPRIATE BIT
 611         PUSHJ   P,PNEXT ; NEXT PAGE'S BIT
 612         JUMPG   A,FPLOSS        ; TOO MANY ?
 613         SOJGE   A,RTL
 614         MOVEM   E,PMAPB(B)      ; REPLACE BIT MASK
 615 PLOSE:  POP     P,A
 616         POP     P,B
 617         POP     P,C
 618         POP     P,D
 619         POP     P,E
 620         POPJ    P,
 621
 622
 623 PINIT:  MOVE    E,PMAPB(B)      ; GET BITS FOR THIS SECTION
 624         HRLZI   D,400000        ; BIT MASK
 625         IMULI   C,2
 626         MOVNS   C
 627         LSH     D,(C)           ; SHIFT TO APPROPRIATE BIT POSITION
 628         MOVNS   C
 629         POPJ    P,
 630
 631 PNEXT:  AOS     (P)             ; FOR SKIP RETURN ON EXPECTED SUCCESS
 632         LSH     D,-2            ; CONSIDER NEXT PAGE
 633         CAIL    C,30.           ; FINISHED WITH THIS SECTION ?
 634         JRST    PNEXT1
 635         AOS     C
 636         AOJA    C,CPOPJ         ; NO, INCREMENT AND CONTINUE
 637 PNEXT1: MOVEM   E,PMAPB(B)      ; REPLACE BIT MASK
 638         SETZ    C,
 639         CAIGE   B,15.           ; LAST SECTION ?
 640         AOJA    B,PINIT         ; NO, INCREMENT AND CONTINUE
 641         SOS     (P)             ; YES, UNDO SKIP RETURN
 642         POPJ    P,
 643
 644 FPLOSS: FATAL PAGE LOSSAGE
 645
 646 PGINT:  MOVEI   B,HIBOT         ; INITIALIZE MUDDLE'S PAGE MAP TABLE
 647         IDIVI   B,2000          ; FIRST PAGE OF PURE CODE
 648         MOVE    C,HITOP
 649         IDIVI   C,2000
 650         MOVEI   A,(C)+1
 651         SUBI    A,(B)           ; NUMBER OF SUCH PAGES
 652         PUSHJ   P,PGTAKE        ; MARK THESE PAGES AS TAKEN
 653         POPJ    P,
 654
 655
 656
 657 \f
 658 ERRKIL: PUSH    P,A
 659         PUSHJ   P,KILGC         ; KILL THE GARBAGE COLLECTOR
 660         POP     P,A
 661         JRST    CALER
 662
 663 ; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU
 664
 665 CKPUR:  HRRZ    A,FSAV(TB)      ; GET NAME OF CURRENT GOODIE
 666         SETZM   CURPLN          ; CLEAR FOR NONE
 667         CAIL    A,HIBOT         ; IF LESS THAN TOP OF PURE ASSUME RSUBR
 668         JRST    (E)
 669         GETYP   0,(A)           ; SEE IF PURE
 670         CAIE    0,TPCODE        ; SKIP IF IT IS
 671         JRST    NPRSUB
 672 NRSB2:  HLRZ    B,1(A)          ; GET SLOT INDICATION
 673         ADD     B,PURVEC+1      ; POINT TO SLOT
 674         HRROS   2(B)            ; MUNG AGE
 675         HLRE    A,1(B)          ; - LENGTH TO A
 676         TRZ     A,777
 677         MOVNM   A,CURPLN        ; AND STORE
 678         JRST    (E)
 679 NPRSUB: SKIPGE  B,1(R)          ; SEE IF PURE RSUBR
 680         JRST    (E)
 681         MOVE    A,R
 682         JRST    NRSB2
 683
 684 ; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE
 685 ; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY
 686 ; THEIR MUDDLE.
 687
 688 GCSET:  MOVE    A,RFRETP        ; COMPUTE FREE SPACE AVAILABLE
 689         SUB     A,PARTOP
 690         MOVEM   A,NOWFRE
 691         CAMLE   A,MAXFRE
 692         MOVEM   A,MAXFRE        ; MODIFY MAXIMUM
 693         HLRE    A,TP            ; FIND THE DOPE WORD OF THE TP STACK
 694         MOVNS   A
 695         ADDI    A,1(TP)         ; CLOSE TO DOPE WORD
 696         CAME    A,TPGROW
 697         ADDI    A,PDLBUF        ; NOW AT REAL DOPE WORD
 698         HLRZ    B,(A)           ; GET LENGTH OF TP-STACK
 699         MOVEM   B,NOWTP
 700         CAMLE   B,CTPMX         ; SEE IF THIS IS THE BIGGEST TP
 701         MOVEM   B,CTPMX
 702         HLRE    B,P             ; FIND DOPE WORD OF P-STACK
 703         MOVNS   B
 704         ADDI    B,1(P)          ; CLOSE TO IT
 705         CAME    B,PGROW         ; SEE IF THE STACK IS BLOWN
 706         ADDI    B,PDLBUF        ; POINTING TO IT
 707         HLRZ    A,(B)           ; GET IN LENGTH
 708         MOVEM   A,NOWP
 709         CAMLE   A,CPMX          ; SEE IF WE HAVE THE BIGGEST P STACK
 710         MOVEM   A,CPMX
 711         POPJ    P,              ; EXIT
 712
 713 RBLDM:  JUMPGE  R,CPOPJ
 714         SKIPGE  M,1(R)          ; SKIP IF FUNNY
 715         JRST    RBLDM1
 716
 717         HLRS    M
 718         ADD     M,PURVEC+1
 719         HLLM    TB,2(M)
 720         SKIPL   M,1(M)
 721         JRST    RBLDM1
 722         PUSH    P,0
 723         HRRZ    0,1(R)
 724         ADD     M,0
 725         POP     P,0
 726 RBLDM1: SKIPN   SAVM            ; SKIP IF FUNNY (M)
 727         POPJ    P,              ; EXIT
 728         MOVEM   M,SAVM
 729         MOVEI   M,0
 730         POPJ    P,
 731 CPOPJ1:
 732 C1POPJ: AOS     (P)
 733         POPJ    P,
 734
 735
 736 \f
 737 ; THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE
 738 FRMUNG: MOVEM   D,PSAV(A)
 739         MOVE    SP,SPSTOR+1
 740         MOVEM   SP,SPSAV(A)
 741         MOVEM   TP,TPSAV(A)     ; SAVE FOR MARKING
 742         POPJ    P,
 743
 744
 745 ; SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
 746
 747 REHASH: MOVE    D,ASOVEC+1      ; GET POINTER TO VECTOR
 748         MOVEI   E,(D)
 749         PUSH    P,E             ; PUSH A POINTER
 750         HLRE    A,D             ; GET -LENGTH
 751         MOVMS   A               ; AND PLUSIFY
 752         PUSH    P,A             ; PUSH IT ALSO
 753
 754 REH3:   HRRZ    C,(D)           ; POINT TO FIRST BUCKKET
 755         HLRZS   (D)             ; MAKE SURE NEW POINTER IS IN RH
 756         JUMPLE  C,REH1          ; BUCKET EMPTY, QUIT
 757
 758 REH2:   MOVEI   E,(C)           ; MAKE A COPY OF THE POINTER
 759         MOVE    A,ITEM(C)       ; START HASHING
 760         TLZ     A,TYPMSK#777777 ; KILL MONITORS
 761         XOR     A,ITEM+1(C)
 762         MOVE    0,INDIC(C)
 763         TLZ     0,TYPMSK#777777
 764         XOR     A,0
 765         XOR     A,INDIC+1(C)
 766         TLZ     A,400000        ; MAKE SURE FINAL HASH IS +
 767         IDIV    A,(P)           ; DIVIDE BY TOTAL LENGTH
 768         ADD     B,-1(P)         ; POINT TO WINNING BUCKET
 769
 770         MOVE    C,[002200,,(B)] ; BYTE POINTER TO RH
 771         CAILE   B,(D)           ; IF PAST CURRENT POINT
 772         MOVE    C,[222200,,(B)] ; USE LH
 773         LDB     A,C             ; GET OLD VALUE
 774         DPB     E,C             ; STORE NEW VALUE
 775         HRRZ    B,ASOLNT-1(E)   ; GET NEXT POINTER
 776         HRRZM   A,ASOLNT-1(E)   ; AND CLOBBER IN NEW NEXT
 777         SKIPE   A               ; SKKIP IF NOTHING PREVIOUSLY IN BUCKET
 778         HRLM    E,ASOLNT-1(A)   ; OTHERWISE CLOBBER
 779         SKIPE   C,B             ; SKIP IF END OF CHAIN
 780         JRST    REH2
 781 REH1:   AOBJN   D,REH3
 782
 783         SUB     P,C%22  ; FLUSH THE JUNK
 784         POPJ    P,
 785 \f
 786 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
 787
 788 NWORDT: PUSHJ   P,SAT           ;GET STORAGE ALLOC TYPE
 789 NWORDS: CAIG    A,NUMSAT        ; TEMPLATE?
 790         SKIPL   MKTBS(A)        ;-ENTRY IN TABLE MEANS 2 NEEDED
 791         SKIPA   A,C%1           ;NEED ONLY 1
 792         MOVEI   A,2             ;NEED 2
 793         POPJ    P,
 794
 795 .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
 796 .GLOBAL LOCMK,BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,OFFSMK
 797
 798 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
 799
 800 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
 801 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
 802 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
 803 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
 804 [SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]
 805 [SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
 806
 807 IMPURE
 808
 809 DSTORE: 0                       ; USED FOR MAPFS AND SEGMENTS
 810 BUFL:   0                       ; BUFFER PAGE (WORDS)
 811 BUFP:   0                       ; BUFFER PAGE (PAGES)
 812 NPWRIT: 0                       ; INDICATION OF PURIFY
 813 RNUMSP: 0                       ; NUMBER OF MARK/SWEEP GARBAGE
 814                                 ; COLLECTS TO REAL GARBAGE COLLECT
 815 NUMSWP: 0                       ; NUMBER MARK SWEEP GARBAGE COLLECTS TO GO
 816 SWAPGC: 0                       ; FLAG INDICATING WHETHER TO LOAD SWAP
 817                                 ;       GC OR NOT
 818 TOTCNT: 0                       ; TOTAL COUNT
 819
 820 PURE
 821
 822 PAT:
 823 PATCH:
 824
 825 BLOCK 400
 826 PATEND:
 827
 828 END
 829 \f