<mdl.int>/utilit.105

   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         PUSHJ   P,RBLDM
 376         POP     P,A
 377 DONE1:  POP     P,E
 378         POP     P,D
 379         POP     P,C
 380 IFN ITS,        POPJ    P,
 381 IFE ITS,[
 382         SKIPN   MULTSG
 383          POPJ   P,
 384         SETZM   20
 385         POP     P,21                    ; BACK TO CALLING SEGMENT
 386         XJRST   20
 387 ]
 388 LOSE1:  POP     P,E
 389         POP     P,D
 390         POP     P,C
 391 GOGC:
 392
 393
 394 AGC:
 395 IFE ITS,[
 396         SKIPE   MULTSG
 397          SKIPE  GCDEBU
 398           JRST  @[SEC1]
 399         XJRST   .+1
 400                 0
 401                 FSEG,,SEC1
 402 SEC1:
 403 ]
 404          MOVE   0,RNUMSP
 405         MOVEM   0,NUMSWP
 406         SETZM   SWAPGC
 407 AGC1:   SKIPE   NPWRIT
 408         JRST    IAGC
 409         EXCH    P,GCPDL
 410         PUSHJ   P,SVAC                          ; SAVE ACS
 411         PUSHJ   P,SQKIL
 412         PUSHJ   P,CTIME
 413         MOVEM   B,GCTIM
 414         PUSHJ   P,LODGC                         ; LOAD GC
 415         PUSHJ   P,RSAC                          ; RESTORE ACS
 416         EXCH    P,GCPDL
 417         SKIPE   SWAPGC
 418         JRST    IAMSGC
 419 IFE ITS,[
 420         SKIPE   MULTSG
 421         JRST    ISECGC
 422 ]
 423         JRST    IAGC
 424
 425 AAGC:   SETZM   SWAPGC
 426         EXCH    P,GCPDL
 427         PUSHJ   P,SVAC                          ; SAVE ACS
 428         PUSHJ   P,LODGC                         ; LOAD GC
 429         PUSHJ   P,RSAC                          ; RESTORE ACS
 430         EXCH    P,GCPDL
 431         JRST    IAAGC
 432
 433 FNMSGC:
 434 FINAGC: SKIPE   NPWRIT
 435         JRST    FINAGG
 436         PUSHJ   P,SVAC                          ; SAVE ACS
 437         PUSHJ   P,KILGC
 438         PUSHJ   P,RSAC
 439 FINAGG:
 440 IFN ITS,        POPJ    P,
 441 IFE ITS,[
 442         SKIPN   MULTSG
 443          POPJ   P,
 444         SETZM   20
 445         POP     P,21                    ; BACK TO CALLING SEGMENT
 446         XJRST   20
 447 ]
 448
 449 ; ROUTINE TO SAVE THE ACS
 450
 451 SVAC:   EXCH    0,(P)
 452         PUSH    P,A
 453         PUSH    P,B
 454         PUSH    P,C
 455         PUSH    P,D
 456         PUSH    P,E
 457         JRST    @0
 458
 459 ; ROUTINE TO RESTORE THE ACS
 460
 461 RSAC:   POP     P,0
 462         POP     P,E
 463         POP     P,D
 464         POP     P,C
 465         POP     P,B
 466         POP     P,A
 467         EXCH    0,(P)
 468         POPJ    P,
 469
 470
 471 \f
 472
 473 ; INTERNAL FUNCTION TO GET STRAGE ALLOCATION TYPE
 474 ; GETS THE TYPE CODE IN A AND RETURNS SAT IN A.
 475
 476 SAT:    LSH     A,1                             ; TIMES 2 TO REF VECTOR
 477         HRLS    A                               ; TO BOTH HALVES TO HACK AOBJN
 478                                                 ;       POINTER
 479         ADD     A,TYPVEC+1                      ; ACCESS THE VECTOR
 480         HRR     A,(A)                           ; GET PROBABLE SAT
 481         JUMPL   A,.+2                           ; DID WE REALLY HAVE A VALID
 482                                                 ;       TYPE
 483         MOVEI   A,0                             ; NO RETURN 0
 484         ANDI    A,SATMSK
 485         POPJ    P,                              ; AND RETURN
 486
 487 ; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
 488 ; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B
 489 ; RETURN -1 IN REG B IF NONE FOUND
 490
 491 PGFIND:
 492         JUMPLE  A,FPLOSS
 493         CAILE   A,256.
 494         JRST    FPLOSS
 495
 496         PUSHJ   P,PGFND1                        ; SEE IF ALREADY ENOUGH
 497         SKIPN   NOSHUF                          ; CAN'T MOVE PURNESS
 498         SKIPL   B                               ; SKIP IF LOST
 499         POPJ    P,
 500
 501         SUBM    M,(P)
 502         PUSH    P,E
 503         PUSH    P,C
 504         PUSH    P,D
 505 PGFLO4: MOVE    C,PURBOT                        ; CHECK IF ROOM AT ALL
 506                                                 ;       (NOTE POTENTIAL FOR INFINITE LOOP)
 507         SUB     C,P.TOP                         ; TOTAL SPACE
 508         MOVEI   D,(C)                           ; COPY FOR CONVERSION TO PAGES
 509         ASH     D,-10.
 510         CAIGE   D,(A)                           ; SKIP IF COULD WIN
 511         JRST    PGFLO1
 512
 513         MOVNS   A                               ; MOVE PURE AREA DOWN "A" PAGES
 514         PUSHJ   P,MOVPUR
 515         MOVE    B,PURTOP                        ; GET FIRST PAGE ALLOCATED
 516         ASH     B,-10.                          ; TO PAGE #
 517 PGFLOS: POP     P,D
 518         POP     P,C
 519         POP     P,E
 520         PUSHJ   P,RBLDM                         ; GET A NEW VALUE FOR M
 521         JRST    MPOPJ
 522
 523 ; HERE TO SHUFFLE PURE SPACE TO TRY TO FIND PAGES
 524
 525 PGFLO1: SKIPE   GCFLG                           ; SKIP IF NOT IN GC
 526         JRST    PGFLO5                          ; WE LOST
 527         MOVE    C,PURTOP
 528         SUB     C,P.TOP
 529         HRRZ    D,FSAV(TB)                      ; ARE WE IN A PURE RSUBR?
 530         CAIL    D,HIBOT                         ; ARE WE AN RSUBR AT ALL?
 531         JRST    PGFLO2
 532         GETYP   E,(R)                           ; SEE IF PCODE
 533         CAIE    E,TPCODE
 534         JRST    PGFLO2
 535         HLRZ    D,1(R)                          ; GET OFFSET TO PURVEC
 536         ADD     D,PURVEC+1
 537         HRROS   2(D)                            ; MUNG AGE
 538         HLRE    D,1(D)                          ; GET LENGTH
 539         ADD     C,D
 540 PGFLO2: ASH     C,-10.
 541         CAILE   A,(C)
 542         JRST    PGFLO3
 543         PUSH    P,A
 544 IFE ITS,        ASH     A,1                     ; TENEX PAGES ARE HALF SIZE
 545         PUSHJ   P,GETPAG                        ; SHUFFLE THEM AROUND
 546         FATAL   PURE SPACE LOSING
 547         POP     P,A
 548         JRST    PGFLO4
 549
 550 ; HERE TO CAUSE AGC IF PAGES ARE NOT AVAILABLE EVEN AFTER MAPPING OUT THE WORLD
 551
 552
 553 PGFLO3: PUSH    P,A                             ; ASK GC FOR SPACE
 554         ASH     A,10.
 555         MOVEM   A,GCDOWN                        ; REQUEST THOSE PAGES
 556         MOVE    C,[8.,,9.]
 557         PUSHJ   P,AGC                           ; GO GARBAGE COLLECT
 558         POP     P,A
 559         JRST    PGFLO4                          ; GO BACK TO POTENTIAL LOOP
 560
 561
 562 PGFLO5: SETOM   B                               ; -1 TO B
 563         JRST    PGFLOS                          ; INDICATE LOSSAGE
 564
 565 PGFND1: PUSH    P,E
 566         PUSH    P,D
 567         PUSH    P,C
 568         PUSH    P,C%M1          ; POSSIBLE CONTENTS FOR REG B
 569         PUSH    P,A             ; SAVE LENGTH OF BLOCK DESIRED FOR LATER USE
 570         SETZB   B,C             ; INITIAL SECTION AND PAGE NUMBERS
 571         MOVEI   0,0             ; COUNT OF PAGES ALREADY FOUND
 572         PUSHJ   P,PINIT
 573 PLOOP:  TDNE    E,D             ; FREE PAGE ?
 574         JRST    NOTFRE          ; NO
 575         JUMPN   0,NFIRST        ; FIRST FREE PAGE OF A BLOCK ?
 576         MOVEI   A,(B)           ; YES SAVE ADDRESS OF PAGE IN REG A
 577         IMULI   A,16.
 578         ASH     C,-1            ; BACK TO PAGES
 579         ADDI    A,(C)
 580         ASH     C,1             ; FIX IT TO WHAT IT WAS
 581 NFIRST: ADDI    0,1
 582         CAML    0,(P)           ; TEST IF ENOUGH PAGES HAVE BEEN FOUND
 583         JRST    PWIN            ; YES, FINISHED
 584         SKIPA
 585 NOTFRE: MOVEI   0,0             ; RESET COUNT
 586         PUSHJ   P,PNEXT ; NEXT PAGE
 587         JRST    PLOSE           ; NONE--LOSE RETURNING -1 IN REG B
 588         JRST    PLOOP
 589
 590 PWIN:   MOVEI   B,(A)           ; GET WINNING ADDRESS
 591         MOVEM   B,(P)-1         ; RETURN ADDRESS OF WINNING PAGE
 592         MOVE    A,(P)           ; RELOAD LENGTH OF BLOCK OF PAGES
 593         MOVE    0,[TDO E,D]     ; INST TO SET "BUSY" BITS
 594         JRST    ITAKE
 595
 596 ; CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
 597 ; THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B
 598 PGGIVE: MOVE    0,[TDZ E,D]     ; INST TO SET "FREE" BITS
 599         SKIPA
 600 PGTAKE: MOVE    0,[TDO E,D]     ; INST TO SET "BUSY" BITS
 601         JUMPLE  A,FPLOSS
 602         CAIL    B,0
 603         CAILE   B,255.
 604         JRST    FPLOSS
 605         PUSH    P,E
 606         PUSH    P,D
 607         PUSH    P,C
 608         PUSH    P,B
 609         PUSH    P,A
 610 ITAKE:  IDIVI   B,16.
 611         PUSHJ   P,PINIT
 612         SUBI    A,1
 613 RTL:    XCT     0               ; SET APPROPRIATE BIT
 614         PUSHJ   P,PNEXT ; NEXT PAGE'S BIT
 615         JUMPG   A,FPLOSS        ; TOO MANY ?
 616         SOJGE   A,RTL
 617         MOVEM   E,PMAPB(B)      ; REPLACE BIT MASK
 618 PLOSE:  POP     P,A
 619         POP     P,B
 620         POP     P,C
 621         POP     P,D
 622         POP     P,E
 623         POPJ    P,
 624
 625
 626 PINIT:  MOVE    E,PMAPB(B)      ; GET BITS FOR THIS SECTION
 627         HRLZI   D,400000        ; BIT MASK
 628         IMULI   C,2
 629         MOVNS   C
 630         LSH     D,(C)           ; SHIFT TO APPROPRIATE BIT POSITION
 631         MOVNS   C
 632         POPJ    P,
 633
 634 PNEXT:  AOS     (P)             ; FOR SKIP RETURN ON EXPECTED SUCCESS
 635         LSH     D,-2            ; CONSIDER NEXT PAGE
 636         CAIL    C,30.           ; FINISHED WITH THIS SECTION ?
 637         JRST    PNEXT1
 638         AOS     C
 639         AOJA    C,CPOPJ         ; NO, INCREMENT AND CONTINUE
 640 PNEXT1: MOVEM   E,PMAPB(B)      ; REPLACE BIT MASK
 641         SETZ    C,
 642         CAIGE   B,15.           ; LAST SECTION ?
 643         AOJA    B,PINIT         ; NO, INCREMENT AND CONTINUE
 644         SOS     (P)             ; YES, UNDO SKIP RETURN
 645         POPJ    P,
 646
 647 FPLOSS: FATAL PAGE LOSSAGE
 648
 649 PGINT:  MOVEI   B,HIBOT         ; INITIALIZE MUDDLE'S PAGE MAP TABLE
 650         IDIVI   B,2000          ; FIRST PAGE OF PURE CODE
 651         MOVE    C,HITOP
 652         IDIVI   C,2000
 653         MOVEI   A,(C)+1
 654         SUBI    A,(B)           ; NUMBER OF SUCH PAGES
 655         PUSHJ   P,PGTAKE        ; MARK THESE PAGES AS TAKEN
 656         POPJ    P,
 657
 658
 659
 660 \f
 661 ERRKIL: PUSH    P,A
 662         PUSHJ   P,KILGC         ; KILL THE GARBAGE COLLECTOR
 663         POP     P,A
 664         JRST    CALER
 665
 666 ; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU
 667
 668 CKPUR:  HRRZ    A,FSAV(TB)      ; GET NAME OF CURRENT GOODIE
 669         SETZM   CURPLN          ; CLEAR FOR NONE
 670         CAIL    A,HIBOT         ; IF LESS THAN TOP OF PURE ASSUME RSUBR
 671         JRST    (E)
 672         GETYP   0,(A)           ; SEE IF PURE
 673         CAIE    0,TPCODE        ; SKIP IF IT IS
 674         JRST    NPRSUB
 675 NRSB2:  HLRZ    B,1(A)          ; GET SLOT INDICATION
 676         ADD     B,PURVEC+1      ; POINT TO SLOT
 677         HRROS   2(B)            ; MUNG AGE
 678         HLRE    A,1(B)          ; - LENGTH TO A
 679         TRZ     A,1777
 680         MOVNM   A,CURPLN        ; AND STORE
 681         JRST    (E)
 682 NPRSUB: SKIPGE  B,1(R)          ; SEE IF PURE RSUBR
 683         JRST    (E)
 684         MOVE    A,R
 685         JRST    NRSB2
 686
 687 ; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE
 688 ; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY
 689 ; THEIR MUDDLE.
 690
 691 GCSET:  MOVE    A,RFRETP        ; COMPUTE FREE SPACE AVAILABLE
 692         SUB     A,PARTOP
 693         MOVEM   A,NOWFRE
 694         CAMLE   A,MAXFRE
 695         MOVEM   A,MAXFRE        ; MODIFY MAXIMUM
 696         HLRE    A,TP            ; FIND THE DOPE WORD OF THE TP STACK
 697         MOVNS   A
 698         ADDI    A,1(TP)         ; CLOSE TO DOPE WORD
 699         CAME    A,TPGROW
 700         ADDI    A,PDLBUF        ; NOW AT REAL DOPE WORD
 701         HLRZ    B,(A)           ; GET LENGTH OF TP-STACK
 702         MOVEM   B,NOWTP
 703         CAMLE   B,CTPMX         ; SEE IF THIS IS THE BIGGEST TP
 704         MOVEM   B,CTPMX
 705         HLRE    B,P             ; FIND DOPE WORD OF P-STACK
 706         MOVNS   B
 707         ADDI    B,1(P)          ; CLOSE TO IT
 708         CAME    B,PGROW         ; SEE IF THE STACK IS BLOWN
 709         ADDI    B,PDLBUF        ; POINTING TO IT
 710         HLRZ    A,(B)           ; GET IN LENGTH
 711         MOVEM   A,NOWP
 712         CAMLE   A,CPMX          ; SEE IF WE HAVE THE BIGGEST P STACK
 713         MOVEM   A,CPMX
 714         POPJ    P,              ; EXIT
 715
 716 RBLDM:  JUMPGE  R,CPOPJ
 717         SKIPGE  M,1(R)          ; SKIP IF FUNNY
 718         JRST    RBLDM1
 719
 720         HLRS    M
 721         ADD     M,PURVEC+1
 722         HLLM    TB,2(M)
 723         SKIPL   M,1(M)
 724         JRST    RBLDM1
 725         PUSH    P,0
 726         HRRZ    0,1(R)
 727         ADD     M,0
 728         POP     P,0
 729 RBLDM1: SKIPN   SAVM            ; SKIP IF FUNNY (M)
 730         POPJ    P,              ; EXIT
 731         MOVEM   M,SAVM
 732         MOVEI   M,0
 733         POPJ    P,
 734 CPOPJ1:
 735 C1POPJ: AOS     (P)
 736         POPJ    P,
 737
 738
 739 \f
 740 ; THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE
 741 FRMUNG: MOVEM   D,PSAV(A)
 742         MOVE    SP,SPSTOR+1
 743         MOVEM   SP,SPSAV(A)
 744         MOVEM   TP,TPSAV(A)     ; SAVE FOR MARKING
 745         POPJ    P,
 746
 747
 748 ; SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
 749
 750 REHASH: MOVE    D,ASOVEC+1      ; GET POINTER TO VECTOR
 751         MOVEI   E,(D)
 752         PUSH    P,E             ; PUSH A POINTER
 753         HLRE    A,D             ; GET -LENGTH
 754         MOVMS   A               ; AND PLUSIFY
 755         PUSH    P,A             ; PUSH IT ALSO
 756
 757 REH3:   HRRZ    C,(D)           ; POINT TO FIRST BUCKKET
 758         HLRZS   (D)             ; MAKE SURE NEW POINTER IS IN RH
 759         JUMPLE  C,REH1          ; BUCKET EMPTY, QUIT
 760
 761 REH2:   MOVEI   E,(C)           ; MAKE A COPY OF THE POINTER
 762         MOVE    A,ITEM(C)       ; START HASHING
 763         TLZ     A,TYPMSK#777777 ; KILL MONITORS
 764         XOR     A,ITEM+1(C)
 765         MOVE    0,INDIC(C)
 766         TLZ     0,TYPMSK#777777
 767         XOR     A,0
 768         XOR     A,INDIC+1(C)
 769         TLZ     A,400000        ; MAKE SURE FINAL HASH IS +
 770         IDIV    A,(P)           ; DIVIDE BY TOTAL LENGTH
 771         ADD     B,-1(P)         ; POINT TO WINNING BUCKET
 772
 773         MOVE    C,[002200,,(B)] ; BYTE POINTER TO RH
 774         CAILE   B,(D)           ; IF PAST CURRENT POINT
 775         MOVE    C,[222200,,(B)] ; USE LH
 776         LDB     A,C             ; GET OLD VALUE
 777         DPB     E,C             ; STORE NEW VALUE
 778         HRRZ    B,ASOLNT-1(E)   ; GET NEXT POINTER
 779         HRRZM   A,ASOLNT-1(E)   ; AND CLOBBER IN NEW NEXT
 780         SKIPE   A               ; SKKIP IF NOTHING PREVIOUSLY IN BUCKET
 781         HRLM    E,ASOLNT-1(A)   ; OTHERWISE CLOBBER
 782         SKIPE   C,B             ; SKIP IF END OF CHAIN
 783         JRST    REH2
 784 REH1:   AOBJN   D,REH3
 785
 786         SUB     P,C%22  ; FLUSH THE JUNK
 787         POPJ    P,
 788 \f
 789 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
 790
 791 NWORDT: PUSHJ   P,SAT           ;GET STORAGE ALLOC TYPE
 792 NWORDS: CAIG    A,NUMSAT        ; TEMPLATE?
 793         SKIPL   MKTBS(A)        ;-ENTRY IN TABLE MEANS 2 NEEDED
 794         SKIPA   A,C%1           ;NEED ONLY 1
 795         MOVEI   A,2             ;NEED 2
 796         POPJ    P,
 797
 798 .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
 799 .GLOBAL LOCMK,BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,OFFSMK
 800
 801 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
 802
 803 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
 804 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
 805 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
 806 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
 807 [SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]
 808 [SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
 809
 810 IMPURE
 811
 812 DSTORE: 0                       ; USED FOR MAPFS AND SEGMENTS
 813 BUFL:   0                       ; BUFFER PAGE (WORDS)
 814 BUFP:   0                       ; BUFFER PAGE (PAGES)
 815 NPWRIT: 0                       ; INDICATION OF PURIFY
 816 RNUMSP: 0                       ; NUMBER OF MARK/SWEEP GARBAGE
 817                                 ; COLLECTS TO REAL GARBAGE COLLECT
 818 NUMSWP: 0                       ; NUMBER MARK SWEEP GARBAGE COLLECTS TO GO
 819 SWAPGC: 0                       ; FLAG INDICATING WHETHER TO LOAD SWAP
 820                                 ;       GC OR NOT
 821 TOTCNT: 0                       ; TOTAL COUNT
 822
 823 PURE
 824
 825 PAT:
 826 PATCH:
 827
 828 BLOCK 400
 829 PATEND:
 830
 831 END
 832 \f