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