MUDDLE/agc.168

   1 TITLE AGC MUDDLE GARBAGE COLLECTOR
   2 ;SYSTEM WIDE DEFINITIONS GO HERE
   3 .GLOBAL PDLBUF,VECTOP,VECBOT,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,WRONGT
   4 .GLOBAL PGROW,TPGROW,TIMOUT,MAINPR,TMA,TFA,PPGROW
   5
   6 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
   7
   8 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS
   9
  10
  11 PDLBUF=100
  12 TPMAX==5000     ;PDLS LARGER THAN THIS WILL BE SHRUNK
  13 PMAX==1000      ;MAXIMUM PSTACK SIZE
  14 TPMIN==100      ;MINIMUM PDL SIZES
  15 PMIN==100
  16 TPGOOD==2000    ; A GOOD STACK SIZE
  17 PGOOD==1000
  18
  19 RELOCATABLE
  20 .INSRT MUDDLE >
  21
  22 TYPNT=AB        ;SPECIAL AC USAGE DURING GC
  23 F=TP                            ;ALSO SPECIAL DURING GC
  24 LPVP=SP                         ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN
  25
  26 ;FUNCTION TO CONSTRUCT A LIST
  27 MFUNCTION CONS,SUBR
  28         ENTRY   2
  29         HLRZ    A,2(AB)         ;GET TYPE OF 2ND ARG
  30         CAIE    A,TLIST         ;LIST?
  31         JRST    BADTYP          ;NO , COMPLAIN
  32         HLRZ    A,(AB)          ;GET TYPE OF FIRST
  33         PUSHJ   P,NWORDT        ;GET NO. OF WORDS NEEDED FOR DATUM
  34         SOJN    A,CDEFER        ;GREATER THAN 1, MUST MAKE DEFERRED POINTER
  35         MOVEI   A,2             ;SET UP CALL TO CELL
  36         PUSHJ   P,CELL
  37         HLLZ    A,(AB)          ;TYPE OF FIRST ARG
  38         MOVE    C,1(AB)         ;GET DATUM
  39 CFINIS: PUSHJ   P,CLOBIT        ;STORE
  40         JRST    FINIS
  41
  42 ;HERE TO STORE IN PAIR
  43
  44 CLOBIT: HRR     A,3(AB)         ;GET CDR
  45 CLOBT1: MOVEM   A,(B)           ;STORE FIRST
  46         MOVEM   C,1(B)          ;AND SECOND
  47         MOVSI   A,TLIST         ;GET FINAL TYPE
  48         POPJ    P,
  49
  50 ;HERE FOR A DEFERRED CONS
  51
  52 CDEFER: MOVEI   A,4             ;NEED 4 CELLS
  53         PUSHJ   P,CELL
  54         MOVE    A,(AB)          ;GET COMPLETE 1ST WORD
  55         MOVE    C,1(AB)         ;AND SECOND
  56         PUSHJ   P,CLOBT1        ;STORE
  57         MOVE    C,B             ;POINT TO DEFERRED PAIR WITH C
  58         ADDI    B,2             ;POINT TO OTHER PAIR
  59         MOVSI   A,TDEFER        ;GET TYPE
  60         JRST    CFINIS
  61
  62 \f
  63 ;THIS ROUTINE ALLOCATES A CELL
  64 CELL:   MOVE    B,PARTOP        ;GET TOP OF PAIRS
  65         ADD     B,A             ;FIND PROPOSED NEW TOP
  66         CAMLE   B,VECBOT        ;CROSSING INTO VECTORS?
  67         JRST    FULL            ;YES, GO COLLECT GARBAGE
  68         EXCH    B,PARTOP        ;NO, SET NEW TOP AND RETURN POINTER
  69         POPJ    P,
  70
  71 FULL:   MOVEM   A,GETNUM        ;STORE WORDS NEEDED
  72         SETZM   PARNEW          ;NO MOVEMENT NEEDED
  73         PUSHJ   P,AGC           ;COLLECT GARBAGE
  74         JRST    CELL            ;AND TRY AGAIN
  75
  76
  77 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
  78
  79 NWORDT: PUSHJ   P,SAT           ;GET STORAGE ALLOC TYPE
  80 NWORDS: SKIPL   MKTBS(A)        ;-ENTRY IN TABLE MEANS 2 NEEDED
  81         SKIPA   A,[1]           ;NEED ONLY 1
  82         MOVEI   A,2             ;NEED 2
  83         POPJ    P,
  84
  85 \f
  86 ;FUNCTION TO BUILD A LIST OF MANY ELEMENTS
  87
  88 MFUNCTION LIST,SUBR
  89         ENTRY
  90
  91         HLRE    A,AB            ;GET -NUM OF ARGS
  92         MOVNS   A               ;MAKE IT +
  93         JUMPE   A,LISTN         ;JUMP IF 0
  94         PUSHJ   P,CELL          ;GET NUMBER OF CELLS
  95         PUSH    TP,$TLIST       ;SAVE IT
  96         PUSH    TP,B
  97         LSH     A,-1            ;NUMBER OF REAL LIST ELEMENTS
  98
  99 CHAINL: ADDI    B,2             ;LOOP TO CHAIN ELEMENTS
 100         HRRZM   B,-2(B)         ;CHAIN LAST ONE TO NEXT ONE
 101         SOJG    A,.-2           ;LOOP TIL ALL DONE
 102         CLEARM  B,-2(B)         ;SET THE  LAST CDR TO NIL
 103
 104 ; NOW LOBEER THE DATA IN TO THE LIST
 105
 106         MOVE    B,(TP)          ;RESTORE LIS POINTER
 107 LISTLP: HLRZ    A,(AB)          ;GET TYPE
 108         PUSHJ   P,NWORDT        ;GET NUMBER OF WORDS
 109         SOJN    A,LDEFER        ;NEED TO DEFER POINTER
 110         HLLZ    A,(AB)          ;NOW CLOBBER ELEMENTS
 111         HLLM    A,(B)
 112         MOVE    A,1(AB)         ;AND VALUE..
 113         MOVEM   A,1(B)
 114 LISTL2: ADDI    B,2             ;STEP B
 115         ADD     AB,[2,,2]       ;STEP ARGS
 116         JUMPL   AB,LISTLP
 117
 118         POP     TP,B
 119         POP     TP,A
 120         JRST    FINIS
 121
 122 ; MAKE A DEFERRED POINTER
 123
 124 LDEFER: PUSH    TP,$TLIST       ;SAVE CURRENT POINTER
 125         PUSH    TP,B
 126         MOVEI   A,2             ; SET UP TO GET CELLS
 127         PUSHJ   P,CELL
 128         MOVE    A,(AB)          ;GET FULL DATA
 129         MOVE    C,1(AB)
 130         PUSHJ   P,CLOBT1
 131         MOVE    C,(TP)          ;RESTORE LIST POINTER
 132         MOVEM   B,1(C)          ;AND MAKE THIS BE THE VALUE
 133         MOVSI   A,TDEFER
 134         HLLM    A,(C)           ;AND STORE IT
 135         MOVE    B,C
 136         SUB     TP,[2,,2]
 137         JRST    LISTL2
 138
 139 LISTN:  MOVEI   B,0
 140         MOVSI   A,TLIST
 141         JRST    FINIS
 142 \fBADTYP:        PUSH    TP,$TATOM       ;ARGUMENT OF TYPE ATOM
 143         PUSH    TP,MQUOTE 2ND-ARGUMENT-NOT-A-LIST
 144         JRST    CALER1          ;OFF TO ERROR HANDLER
 145
 146
 147 \f;FUNCTION WHICH CONSES ITS ARGUMENT WITH NIL
 148 MFUNCTION NCONS,SUBR
 149         ENTRY   1
 150         PUSH    TP,(AB)         ;SET UP CONS CALL
 151         PUSH    TP,1(AB)
 152         PUSH    TP,$TLIST
 153         PUSH    TP,[0]
 154         MCALL   2,CONS
 155         JRST    FINIS
 156
 157 \f;FUNCTION TO GENERATE A VECTOR IN VECTOR SPACE
 158 ;CALLED WITH ONE FIXNUM ARGUMENT, WHICH IS THE NUMBER OF ELEMENTS DESIRED.
 159
 160 MFUNCTION VECTOR,SUBR
 161         ENTRY
 162         MOVEI   C,1             ;THIS IS A GENERAL VECTOR
 163 VECTO3: JUMPGE  AB,TFA          ;TOO FEW ARGS
 164         CAMGE   AB,[-4,,0]      ;ASSURE NOT TOO MANY
 165         JRST    TMA
 166         HLRZ    A,(AB)          ;GET TYPE OF ARGUMENT
 167         CAIE    A,TFIX          ;IS IT A FIXED NUMBER?
 168         JRST    BDTYPV          ;NO,  GO COMPLAIN
 169         SKIPGE  A,1(AB)         ;GET LENGTH
 170         JRST    BADNUM          ;LOSING NUMBER
 171         ASH     A,(C)           ;TIMES TWO FOR NUMBER OF WORDS IF GENERAL
 172         ADDI    A,2             ;PLUS TWO FOR DOPEWDS
 173 VECTO2: MOVE    B,VECBOT        ;GET CURRENT BOTTOM OF VECTORS
 174         SUB     B,A             ;AND SUBTRACT THE WORDS IN THIS VECTOR
 175         CAMGE   B,PARTOP        ;HAVE WE BUMPED INTO PAIR SPACE?
 176         JRST    VECTO1          ;YES, GO GARBAGE COLLECT
 177         EXCH    B,VECBOT        ;UPDATE VECBOT, GET OLD POINTER
 178         HRLZM   A,-1(B)         ;PUT LENGTH IN DOPE WORD FIELD.
 179         MOVSI   D,400000        ;PREPARE TO SET NONUNIFORM BIT
 180         JUMPE   C,.+2           ;DONT SET IF UNIFORM
 181         MOVEM   D,-2(B)         ;CLOBBER IT IN
 182         HRRO    B,VECBOT        ;AND GET TOP OF VECTOR IN RH, -1 IN LH.
 183         TLC     B,-3(A)         ;SET LH OF ANSWER TO NEGATIVE COUNT
 184         MOVSI   A,TVEC          ;AND GET TYPE VECTOR TO MARK B AS AN AOBJN POINTER TO A VECTOR
 185         CAML    AB,[-2,,0]      ;SKIP IF 2 ARGS SUPPLIED
 186         JRST    VFINIS          ;ONLY ONE, LEAVE
 187         JUMPE   C,UINIT         ;JUMP IF NOT GENERAL VECTOR
 188
 189         JUMPGE  B,FINIS         ;ZERO LENGTH, DONT INIT
 190         PUSH    TP,A
 191         PUSH    TP,B
 192         PUSH    TP,A
 193         PUSH    TP,B            ;SAVE THE VECTOR
 194
 195 INLP:   PUSH    TP,2(AB)
 196         PUSH    TP,3(AB)                ;PUSH FORM TO BE EVALLED
 197         MCALL   1,EVAL
 198         MOVE    C,(TP)          ;RESTORE VECTOR
 199         MOVEM   A,(C)
 200         MOVEM   B,1(C)          ;CLOBBER
 201         ADD     C,[2,,2]
 202         MOVEM   C,(TP)
 203         JUMPL   C,INLP          ;JUMP TO DO NEXT
 204
 205 GETVEC: MOVE    A,-3(TP)
 206         MOVE    B,-2(TP)
 207         SUB     TP,[4,,4]       ;GC TP
 208         JRST    FINIS
 209
 210 UINIT:  PUSH    TP,$TUVEC
 211         PUSH    TP,B
 212         PUSH    TP,$TUVEC
 213         PUSH    TP,B
 214         PUSH    P,[-1]          ;WILL HOLD TYPE
 215
 216 UINLP:  PUSH    TP,2(AB)
 217         PUSH    TP,3(AB)
 218         MCALL   1,EVAL
 219         HLRZS   A               ;TYPE TO RH
 220         SKIPGE  (P)             ;SKIP IF 1ST SEEN
 221         JRST    SET1ST
 222         CAME    A,(P)
 223         JRST    WRNGUT
 224 UINLP1: MOVE    C,(TP)
 225         MOVEM   B,(C)
 226         AOBJP   C,.+3
 227         MOVEM   C,(TP)
 228         JRST    UINLP           ;AND CONTINUE
 229
 230         POP     P,A             ;RESTORE TYPE
 231         HRLZM   A,(C)           ;CLOBBER UNIFORM TYPE
 232         JRST    GETVEC
 233
 234 SET1ST: MOVEM   A,(P)
 235         PUSHJ   P,NWORDT
 236         SOJN    A,CANTUN
 237         JRST    UINLP1
 238
 239 VFINIS: JUMPN   C,FINIS
 240         MOVSI   A,TUVEC
 241         JRST    FINIS
 242
 243
 244 ;FUNCTION TO GENERATE A UNIFOM VECTOR
 245
 246 MFUNCTION UVECTOR,SUBR
 247
 248         MOVEI   C,0             ;SET FOR A UNIFORM HACK
 249         JRST    VECTO3
 250
 251 BADNUM: PUSH    TP,$TATOM       ;COMPLAIN
 252         PUSH    TP,MQUOTE NEGATIVE-ARGUMENT
 253         JRST    CALER1
 254 \fBDTYPV:        PUSH    TP,$TATOM
 255         PUSH    TP,MQUOTE NON-INTEGER-ARGUMENT
 256         JRST    CALER1
 257
 258 VECTO1: SETZM   PARNEW          ;CLEAR RELOCATION OF PAIR SPACE
 259         MOVEM   A,GETNUM        ;SAVE NUMBER OF WORDS TO GET
 260         PUSHJ   P,AGC           ;GARBAGE COLLECT
 261         JRST    VECTO3          ;AND TRY AGAIN
 262
 263 MFUNCTION EVECTOR,SUBR
 264         ENTRY
 265         HLRE    A,AB
 266         MOVNS   A
 267         PUSH    P,A             ;SAVE NUMBER OF WORDS
 268         ASH     A,-1            ;FOR VECTOR TO WIN NEED NO. OF ELEMENTS
 269         PUSH    TP,$TFIX
 270         PUSH    TP,A
 271         MCALL   1,VECTOR
 272
 273         POP     P,D             ;RESTORE NUMBER OF WORDS
 274         HRLI    C,(AB)          ;START BUILDING BLT POINTER
 275         HRRI    C,(B)           ;TO ADDRESS
 276         ADDI    D,(B)-1         ;SET D TO FINAL ADDRESS
 277         BLT     C,(D)
 278         JRST    FINIS
 279
 280 ;EXPLICIT VECTORS FOR THE UNIFORM CSE
 281
 282 MFUNCTION EUVECTOR,SUBR
 283
 284         ENTRY
 285         HLRE    A,AB            ;-NUM OF ARGS
 286         MOVNS   A
 287         ASH     A,-1            ;NEED HALF AS MANY WORDS
 288         PUSH    TP,$TFIX
 289         PUSH    TP,A
 290         GETYP   A,(AB)          ;GET FIRST ARG
 291         PUSHJ   P,NWORDT                ;SEE IF NEEDS EXTRA WORDS
 292         SOJN    A,CANTUN
 293         MCALL   1,UVECTOR               ;GET THE VECTOR
 294
 295         GETYP   C,(AB)          ;GET THE FIRST TYPE
 296         MOVE    D,AB            ;COPY THE ARG POINTER
 297         MOVE    E,B             ;COPY OF RESULT
 298
 299 EUVLP:  GETYP   0,(D)           ;GET A TYPE
 300         CAIE    0,(C)           ;SAME?
 301         JRST    WRNGUT          ;NO , LOSE
 302         MOVE    0,1(D)          ;GET GOODIE
 303         MOVEM   0,(E)           ;CLOBBER
 304         ADD     D,[2,,2]        ;BUMP ARGS POINTER
 305         AOBJN   E,EUVLP
 306
 307         HRLM    C,(E)           ;CLOBBER UNIFORM TYPE IN
 308         JRST    FINIS
 309
 310 WRNGUT: PUSH    TP,$TATOM
 311         PUSH    TP,MQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR
 312         JRST    CALER1
 313
 314 CANTUN: PUSH    TP,$TATOM
 315         PUSH    TP,MQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR
 316         JRST    CALER1
 317
 318 \f
 319 ; FUNCTION TO GROW A VECTOR
 320
 321 MFUNCTION GROW,SUBR
 322
 323         ENTRY   3
 324
 325         MOVEI   D,0             ;STACK HACKING FLAG
 326         HLRZ    A,(AB)          ;FIRST TYPE
 327         PUSHJ   P,SAT           ;GET STORAGE TYPE
 328         HLRZ    B,2(AB)         ;2ND ARG
 329         CAIE    A,STPSTK        ;IS IT ASTACK
 330         CAIN    A,SPSTK
 331         AOJA    D,GRSTCK        ;YES, WIN
 332         CAIE    A,SNWORD        ;UNIFORM VECTOR
 333         CAIN    A,S2NWORD       ;OR GENERAL
 334 GRSTCK: CAIE    B,TFIX          ;IS 2ND FIXED
 335         JRST    WRONGT          ;COMPLAIN
 336         HLRZ    B,4(AB)
 337         CAIE    B,TFIX          ;3RD ARG
 338         JRST    WRONGT          ;LOSE
 339
 340         MOVEI   E,1             ;UNIFORM/GENERAL FLAG
 341         CAIE    A,SNWORD        ;SKIP IF UNIFORM
 342         CAIN    A,SPSTK         ;DONT SKIP IF UNIFORM PDL
 343         MOVEI   E,0
 344
 345         HRRZ    B,1(AB)         ;POINT TO START
 346         HLRE    A,1(AB)         ;GET -LENGTH
 347         SUB     B,A             ;POINT TO DOPE WORD
 348         SKIPE   D               ;SKIP IF NOT STACK
 349         ADDI    B,PDLBUF        ;FUDGE FOR PDL
 350         HLLZS   (B)             ;ZERO OUT GROWTH SPECS
 351         SKIPN   A,3(AB)         ;ANY TOP GROWTH?
 352         JRST    GROW1           ;NO, LOOK FOR BOTTOM GROWTH
 353         ASH     A,(E)           ;MULT BY 2 IF GENERAL
 354         ADDI    A,77            ;ROUND TO NEAREST BLOCK
 355         ANDCMI  A,77            ;CLEAR LOW ORDER BITS
 356         ASH     A,9-6           ;DIVIDE BY 100 AND SHIFT TO POSTION
 357         TRZE    A,400000        ;CONVERT TO SIGN MAGNITUDE
 358         MOVNS   A
 359         TLNE    A,-1            ;SKIP IF NOT TOO BIG
 360         JRST    GTOBIG          ;ERROR
 361 GROW1:  SKIPN   C,5(AB)         ;CHECK LOW GROWTH
 362         JRST    GROW4           ;NONE, SKIP
 363         ASH     C,(E)           ;GENRAL FUDGE
 364         ADDI    C,77            ;ROUND
 365         ANDCMI  C,77            ;FUDGE FOR VALUE RETURN
 366         PUSH    P,C             ;AND SAVE
 367         ASH     C,-6            ;DIVIDE BY 100
 368         TRZE    C,400           ;CONVERT TO SIGN MAGNITUDE
 369         MOVNS   C
 370         TDNE    C,[-1,,777000]  ;CHECK FOR OVERFLOW
 371         JRST    GTOBIG
 372 GROW2:  HLRZ    E,1(B)          ;GET TOTAL LENGTH OF VECTOR
 373         SUBI    E,2             ;FUDGE FOR DOPE WORDS
 374         MOVNS   E
 375         HRLI    E,-1(E)         ;TO BOTH HALVES
 376         ADDI    E,(B)           ;POINTS TO TOP
 377         SKIPE   D               ;STACK?
 378         ADD     E,[PDLBUF,,0]   ;YES, FUDGE LENGTH
 379         SKIPL   D,(P)           ;SHRINKAGE?
 380         JRST    GROW3           ;NO, CONTINUE
 381         MOVNS   D               ;PLUSIFY
 382         HRLI    D,(D)           ;TO BOTH HALVES
 383         ADD     E,D             ;POINT TO NEW LOW ADDR
 384 GROW3:  IORI    A,(C)           ;OR TOGETHER
 385         HRRM    A,(B)           ;DEPOSIT INTO DOPEWORD
 386         PUSH    TP,(AB)         ;PUSH TYPE
 387         PUSH    TP,E            ;AND VALUE
 388         SKIPE   A               ;DON'T GC FOR NOTHING
 389         PUSHJ   P,AGC
 390         POP     P,C             ;RESTORE GROWTH
 391         HRLI    C,(C)
 392         POP     TP,B            ;GET VECTOR POINTER
 393         SUB     B,C             ;POINT TO NEW TOP
 394         POP     TP,A
 395         JRST    FINIS
 396
 397 GTOBIG: PUSH    TP,$TATOM
 398         PUSH    TP,MQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH
 399         JRST    CALER1
 400 GROW4:  PUSH    P,[0]           ;0 BOTTOM GROWTH
 401         JRST    GROW2
 402 \f
 403 ; SUBROUTINE TO BUILD CHARACTER STRING GOODIES
 404
 405 MFUNCTION STRING,SUBR
 406
 407         ENTRY
 408
 409         MOVE    B,AB            ;COPY ARG POINTER
 410         MOVEI   C,0             ;INITIALIZE COUNTER
 411         PUSH    TP,$TAB         ;SAVE A COPY
 412         PUSH    TP,B
 413         JUMPGE  B,MAKSTR                ;ZERO LENGTH
 414
 415 STRIN2: GETYP   D,(B)           ;GET TYPE CODE
 416         CAIN    D,TCHRS         ;SINGLE CHARACTER?
 417         AOJA    C,STRIN1
 418         CAIE    D,TCHSTR        ;OR STRING
 419         JRST    WRONGT          ;NEITHER
 420
 421         MOVEM   B,(TP)          ;SAVE CURRENT POINTER
 422         PUSH    TP,(B)
 423         PUSH    TP,1(B)
 424         PUSH    P,C             ;SAVE CURRENT COUNT
 425         MCALL   1,LENGTH                ;FIND THE LENGTH
 426         POP     P,C
 427         ADDI    C,(B)           ;BUMP COUNT
 428         MOVE    B,(TP)          ;RESTORE
 429
 430 STRIN1: ADD     B,[2,,2]
 431         JUMPL   B,STRIN2
 432
 433 ; NOW GET THE NECESSARY VECTOR
 434
 435 MAKSTR: PUSH    TP,$TFIX
 436         ADDI    C,4             ;COMPUTE NEEDED WORDS
 437         IDIVI   C,5
 438         PUSH    TP,C
 439         MCALL   1,UVECTOR               ;GET THE VECTOR
 440
 441         HRLI    B,440700                ;CONVERT B TO A BYTE POINTER
 442         SKIPL   C,AB            ;ANY ARGS?
 443         JRST    DONEC
 444
 445 NXTRG1: GETYP   D,(C)           ;GET AN ARG
 446         CAIE    D,TCHRS
 447         JRST    TRYSTR
 448         LDB     D,[350700,,1(C)]        ;GET IT
 449         IDPB    D,B             ;AND DEPOSIT IT
 450         JRST    NXTARG
 451
 452 TRYSTR: MOVE    E,1(C)          ;GET BYTER
 453         HRRZ    0,(C)           ;AND DOPE WORD POINTER
 454         LDB     D,E             ;GET 1ST CHAR
 455 NXTCHR: CAIG    0,1(E)          ;STILL WINNING?
 456         JRST    NXTARG          ;NO, GET NEXT ARG
 457         JUMPE   D,NXTARG        ;HIT 0, QUIT
 458         IDPB    D,B             ;INSERT
 459         ILDB    D,E             ;AND GET NEXT
 460         JRST    NXTCHR
 461
 462 NXTARG: ADD     C,[2,,2]        ;BUMP ARG POINTER
 463         JUMPL   C,NXTRG1
 464         ADDI    B,1
 465
 466 DONEC:  MOVSI   C,TCHRS
 467         HLLM    C,(B)           ;AND CLOBBER AWAY
 468         HLRZ    C,1(B)          ;GET LENGTH BACK
 469         MOVEI   A,1(B)          ;POINT TO DOPE WORD
 470         HRLI    A,TCHSTR
 471         SUBI    B,-2(C)
 472         HRLI    B,350700                ;MAKE A BYTE POINTER
 473         JRST    FINIS
 474 \f
 475 AGC":
 476 ;SET FLAG FOR INTERRUPT HANDLER
 477
 478         SETOM   GCFLG
 479
 480 ;SAVE AC'S
 481         IRP     AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,TVP,PP,PVP]
 482         MOVEM   AC,AC!STO"+1(PVP)
 483         TERMIN
 484
 485 ;SET UP E TO POINT TO TYPE VECTOR
 486         HLRZ    E,TYPVEC(TVP)
 487         CAIE    E,TVEC
 488         JRST    AGCE1
 489         HRRZ    TYPNT,TYPVEC+1(TVP)
 490         HRLI    TYPNT,B
 491
 492 ;DECIDE WHETHER TO SWITCH TO GC PDL
 493
 494         MOVEI   A,(P)           ;POINNT TO PDL
 495         HRRZ    B,GCPDL         ;POINT TO BASE OF GC PDL
 496         CAIG    A,(B)           ;SKIP IF MUST CHANGE
 497         JRST    CHPDL
 498         HLRE    C,GCPDL         ;-LENGTH OF GC'S PDL
 499         SUB     B,C             ;POINT TO END OF GC'S PDL
 500         CAILE   A,(B)           ;SKIP IF WITHIN GCPDL
 501 CHPDL:  MOVE    P,GCPDL         ;GET GC'S PDL
 502
 503 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
 504
 505         MOVEI   A,(TB)          ;POINT TO CURRENT FRAME IN PROCESS
 506         PUSHJ   P,FRMUNG        ;AND MUNG IT
 507         MOVE    A,TP            ;THEN TEMPORARY PDL
 508         PUSHJ   P,PDLCHK
 509         MOVE    A,PP            ;GET PLANNER PDL
 510         PUSHJ   P,PDLCHK        ;AND CHECK IT FOR GROWTH
 511         MOVE    A,PSTO+1(PVP)   ;AND UNMARKED P STACK
 512         CAMN    P,GCPDL         ;DID PDLS CHANGE
 513         PUSHJ   P,PDLCHP
 514 \f;MARK PHASE: MARK ALL LISTS AND VECTORS
 515 ;POINTED TO WITH ONE BIT IN SIGN BIT
 516 ;START AT TRANSFER VECTOR
 517
 518         SETZB   LPVP,VECNUM     ;CLEAR NUMBER OF VECTOR WORDS
 519         SETZM   PARNUM          ;CLEAR NUMBER OF PAIRS
 520         MOVSI   D,400000        ;SIGN BIT FOR MARKING
 521         MOVE    A,ASOVEC+1(TVP) ;MARK ASSOC. VECTOR NOW
 522         HLRE    B,A
 523         SUBI    A,(B)           ;POINT TO DOPE WORD
 524         IORM    D,1(A)          ;AND MARK
 525         MOVE    A,PVP           ;START AT PROCESS VECTOR
 526         MOVEI   B,TPVP          ;IT IS A PROCESS VECTOR
 527         PUSHJ   P,MARK          ;AND MARK THIS VECTOR
 528
 529 ; ASSOCIATION FLUSHING PHASE
 530
 531         MOVE    A,ASOVEC+1(TVP) ;GET POINTER TO VECTOR
 532         PUSHJ   P,ASOMRK        ;MARK AND FLUSH
 533
 534 ;OPTIONAL RETIMING PHASE
 535
 536         SKIPE   A,TIMOUT        ;ANY TIME OVERFLOWS
 537         PUSHJ   P,RETIME        ;YES, RE-CALIBRATE THEM
 538
 539 ;CORE ADJUSTMENT PHASE
 540         SETZM   CORSET          ;CLEAR LATER CORE SETTING
 541         PUSHJ   P,CORADJ        ;AND MAKE CORE ADJUSTMENTS
 542
 543 ;RELOCATION ESTABLISHMENT PHASE
 544 ;1 -- IN PAIR SPACE, SWAP LOW GARBAGE WITH HIGHER NON GARBAGE
 545         MOVE    A,PARBOT"       ;ONE POINTER TO BOTTOM OF PAIR SPACE
 546         MOVE    B,PARTOP"       ;AND ANOTHER TO TOP.
 547         PUSHJ   P,PARREL        ;AND ESTABLISH THE PAIR RELOCATION
 548         MOVEM   B,PARTOP        ;ESTABLISH NEW TOP OF PAIRS HERE
 549
 550 ;2 -- IN VECTOR SPACE, ESTABLISH POINTERS TO TOP OF CORE
 551         MOVE    A,VECTOP"       ;START AT TOP OF VECTOR SPACE
 552         MOVE    B,VECNEW"       ;AND SET TO INITIAL OFFSET
 553         SUBI    A,1             ;POINT TO DOPE WORDS
 554         PUSHJ   P,VECREL        ;AND ESTABLISH RELOCATION FOR VECTORS
 555         MOVEM   B,VECNEW        ;SAVE FINAL OFFSET
 556
 557 \f;POINTER UPDATE PHASE
 558 ;1 -- UPDATE ALL PAIR POINTERS
 559         MOVE    A,PARBOT        ;START AT BOTTOM OF PAIR SPACE
 560         PUSHJ   P,PARUPD        ;AND UPDATE ALL PAIR POINTERS
 561
 562 ;2 -- UPDATE ALL VECTORS
 563         MOVE    A,VECTOP        ;START AT TOP OF VECTOR SPACE
 564         PUSHJ   P,VECUPD        ;AND UPDATE THE POINTERS
 565
 566 ;3 -- UPDATE THE PVP AC
 567         MOVEI   A,PVP-1         ;SET LOC TO POINT TO PVP
 568         MOVE    C,PVP           ;GET THE DATUM
 569         PUSHJ   P,NWRDUP        ;AND UPDATE THIS VALUE
 570 ;4 -- UPDATE THE MAIN PROCESS POINTER
 571         MOVEI   A,MAINPR-1      ;POINT TO MAIN PROCESS POINTER
 572         MOVE    C,MAINPR        ;GET CONTENTS IN C
 573         PUSHJ   P,NWRDUP        ;AND UPDATE IT
 574 ;DATA MOVEMMENT ANDCLEANUP PHASE
 575
 576 ;1 -- ADJUST FOR SHRINKING VECTORS
 577         MOVE    A,VECTOP        ;VECTOR SHRINKING PHASE
 578         PUSHJ   P,VECSH         ;GO SHRINK ANY SHRINKERS
 579
 580 ;2 -- MOVE VECTORS (AND LIST ELEMENTS)
 581         MOVE    A,VECTOP        ;START AT TOP OF VECTOR SPACE
 582         PUSHJ   P,VECMOVE       ;AND MOVE THE VECTORS
 583         MOVE    A,VECNEW        ;GET FINAL CHANGE TO VECBOT
 584         ADDM    A,VECBOT        ;OFFSET VECBOT TO ITS NEW PLACE
 585         MOVE    A,CORTOP        ;GET NEW VALUE FOR TOP OF VECTOR SPACE
 586         MOVEM   A,VECTOP        ;AND UPDATE VECTOP
 587
 588 ;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP)
 589
 590         PUSHJ   P,VECZER        ;
 591
 592 ;GARBAGE ZEROING PHASE
 593 GARZER: MOVE    A,PARTOP        ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE
 594         HRLS    A               ;GET FIRST ADDRESS IN LEFT HALF
 595         MOVE    B,VECBOT        ;LAST ADDRESS OF GARBAGE + 1
 596         CLEARM  (A)             ;ZERO   THE FIRST WORD
 597         ADDI    A,1             ;MAKE A A BLT POINTER
 598         BLT     A,-1(B)         ;AND COPY ZEROES INTO REST OF AREA
 599
 600 ;FINAL CORE ADJUSTMENT
 601         SKIPE   A,CORSET        ;IFLESS CORE NEEDED
 602         PUSHJ   P,CORADL        ;GIVE SOME AWAY.
 603
 604 ;NOW REHASH THE ASSOCIATIONS BASED ON NEW VALUES
 605
 606         PUSHJ   P,REHASH
 607
 608 ;RESTORE AC'S
 609         IRP     AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,PP,PVP,TVP]
 610         MOVE    AC,AC!STO+1(PVP)
 611         TERMIN
 612
 613         SETZM   PARNEW          ;CLEAR FOR NEXT AGC CALL
 614         SETZM   GETNUM          ;ALSO CLEAR THIS
 615         SETZM   GCFLG
 616
 617
 618 CPOPJ:  POPJ    P,
 619
 620
 621 AGCE1:  MOVEI   B,[ASCIZ /TYPVEC IS NOT OF TYPE VECTOR
 622 /]
 623 TYPSTP: PUSHJ   P,MSGTYP"       ;TYPE OUT A HOPELESSMESSAGE
 624         .VALUE          ;AND GIVE UP
 625
 626
 627 \f
 628 ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
 629
 630 PDLCHK: JUMPGE  A,CPOPJ
 631         HLRE    B,A             ;GET NEGATIVE COUNT
 632         MOVE    C,A             ;SAVE A COPY OF PDL POINTER
 633         SUBI    A,-1(B)         ;LOCATE DOPE WORD PAIR
 634         HRRZS   A               ; ISOLATE POINTER
 635         CAME    A,TPGROW        ;GROWING?
 636         CAMN    A,PPGROW                ;OR PLANNER PDL
 637         JRST    .+2
 638         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
 639         HLRZ    D,(A)           ;GET COUNT FROM DOPE WORD
 640         MOVNS   B               ;GET POSITIVE AMOUNT LEFT
 641         SUBI    D,2(B)          ; PDL FULL?
 642         JUMPE   D,NOFENC        ;YES NO FENCE POSTING
 643         SETOM   1(C)            ;CLOBBER TOP WORD
 644         SOJE    D,NOFENC        ;STILL MORE?
 645         MOVSI   D,1(C)          ;YES, SET UP TO BLT FENCE POSTS
 646         HRRI    D,2(C)
 647         BLT     D,-2(A)         ;FENCE POST ALL EXCEPT DOPE WORDS
 648
 649
 650 NOFENC: CAIG    B,TPMAX         ;NOW CHECK SIZE
 651         CAIG    B,TPMIN
 652         JRST    MUNGTP          ;TOO BIG OR TOO SMALL
 653         POPJ    P,
 654
 655 MUNGTP: SUBI    B,TPGOOD        ;FIND DELTA TP
 656 MUNG3:  MOVE    C,-1(A)         ;IS GROWTH ALREADY SPECIFIED
 657         TRNE    C,777000        ;SKIP IF NOT
 658         POPJ    P,              ;ASSUME GROWTH GIVEN WILL WIN
 659
 660         ASH     B,-6            ;CONVERT TO NUMBER OF BLOCKS
 661         JUMPL   B,MUNGT1
 662         TRO     B,400           ;TURN ON SHRINK BIT
 663         JRST    MUNGT2
 664 MUNGT1: MOVMS   B
 665         ANDI    B,377
 666 MUNGT2: DPB     B,[111100,,-1(A)]       ;STORE IN DOPE WORD
 667         POPJ    P,
 668
 669 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
 670
 671 PDLCHP: HLRE    B,A             ;-LENGTH TO B
 672         SUBI    A,-1(B)         ;POINT TO DOPE WORD
 673         HRRZS   A               ;ISOLATE POINTER
 674         CAME    A,PGROW         ;GROWING?
 675         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
 676         MOVMS   B               ;PLUS LENGTH
 677
 678         CAIG    B,PMAX          ;TOO BIG?
 679         CAIG    B,PMIN          ;OR TOO LITTLE
 680         JRST    .+2             ;YES, MUNG IT
 681         POPJ    P,
 682         SUBI    B,PGOOD
 683         JRST    MUNG3
 684
 685 ;THIS ROUTINE CLOBBERS USELESS STUFF IN CURRENT FRAME
 686
 687 FRMUNG: SETZM   PCSAV(A)
 688         SETZM   PSAV(A)
 689         SETZM   SPSAV(A)
 690         SETZM   PPSAV(A)
 691         MOVEM   TP,TPSAV(A)     ;SAVE FOR MARKING
 692         POPJ    P,
 693 \f
 694 ;GENERAL MARK SUBROUTINE.  CALLED TO MARK ALL THINGS
 695 ; A/ GOODIE TO MARK FROM
 696 ; B/ TYPE OF A (IN RH)
 697 ; C/ TYPE,DATUM PAIR POINTER
 698
 699 MARK2:  HLRZ    B,(C)           ;GET TYPE
 700 MARK1:  MOVE    A,1(C)          ;GET GOODIE
 701 MARK:   JUMPE   A,CPOPJ         ; NEVER MARK 0
 702         PUSH    P,A             ;SAVE GOODIE
 703         HRLM    C,-1(P)         ;AND POINTER TO IT
 704         LSH     B,1             ;TIMES 2 TO GET SAT
 705         HRRZ    B,@TYPNT        ;GET SAT
 706         JRST    @MKTBS(B)       ;AND GO MARK
 707
 708 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
 709
 710 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK]
 711 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK]
 712 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK]
 713 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK]]
 714
 715
 716 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
 717
 718 DEFMK:  TLOA    TYPNT,400000    ;USE SIGN BIT AS FLAG
 719
 720 ;HERE TO MARK LIST ELEMENTS
 721
 722 PAIRMK: TLZ     TYPNT,400000    ;TURN OF DEFER BIT
 723         MOVEI   C,(A)           ;POINT TO LIST
 724 PAIRM1: CAMGE   C,PARTOP        ;CHECK FOR BEING IN BOUNDS
 725         CAMGE   C,PARBOT
 726         JRST    BDPAIR          ;OUT OF BOUNDS,COMPLAIN
 727         SKIPGE  B,(C)           ;SKIP IF NOT MARKED
 728         JRST    GCRET           ;ALREADY MARKED, RETURN
 729         IORM    D,(C)           ;MARK IT
 730         AOS     PARNUM
 731         HLRZS   B               ;TYPE TO RH OF B
 732         MOVE    A,1(C)          ;DATUM TO A
 733         JUMPL   TYPNT,DEFDO     ;GO HANDLE DEFERRED POINTER
 734         PUSHJ   P,MARK          ;MARK THIS DATUM
 735         HRRZ    C,(C)           ;GET CDR OF LIST
 736         JUMPN   C,PAIRM1        ;IF NOT NIL, MARK IT
 737
 738 GCRET:  TLZ     TYPNT,400000    ;FOR PAIRMKS BENEFIT
 739         HLRZ    C,-1(P)         ;RESTORE C
 740         POP     P,A
 741         POPJ    P,              ;AND RETURN TO CALLER
 742
 743 ;HERE TO SQUAWK WHEN A PAIR POINTER IS BAD
 744
 745 BDPAIR: MOVEI   B,[ASCIZ /AGC -- MARKED PAIR POINTS OUTSIDE PAIR SPACE
 746 /]
 747
 748         PUSHJ   P,MSGTYP
 749         .VALUE  0
 750
 751 ;HERE TO MARK DEFERRED POINTER
 752
 753 DEFDO:  PUSHJ   P,MARK          ;MARK THE DATUM
 754         JRST    GCRET           ;AND RETURN
 755
 756 \f
 757 ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
 758
 759 TPMK:   TLOA    TYPNT,400000    ;SET TP MARK FLAG
 760 VECTMK: TLZ     TYPNT,400000
 761         MOVEI   E,(A)           ;SAVE A POINTER TO THE VECTOR
 762         HLRE    B,A             ;GET -LNTH
 763         SUB     A,B             ;LOCATE DOPE WORD
 764         MOVEI   A,1(A)          ;ZERO LH AND POINT TO 2ND DOPE WORD
 765         CAMGE   A,VECTOP        ;CHECK BOUNDS
 766         CAMGE   A,VECBOT
 767         JRST    VECTB1          ;LOSE, COMPLAIN
 768
 769         JUMPGE  TYPNT,NOBUFR    ;IF A VECTOR, NO BUFFER CHECK
 770         CAMN    A,PPGROW        ;CHECK PLANNER PDL
 771         JRST    NOBUFR
 772         CAME    A,PGROW         ;IS THIS THE BLOWN P
 773         CAMN    A,TPGROW        ;IS THIS THE GROWING PDL
 774         JRST    NOBUFR          ;YES, DONT ADD BUFFER
 775         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
 776         MOVSI   0,-PDLBUF       ;ALSO FIX UP POINTER
 777         ADDM    0,1(C)
 778
 779 NOBUFR: HLRZ    B,(A)           ;GET LENGTH FROM DOPE WORD
 780         ANDI    B,377777        ;CLOBBER POSSIBLE MARK BIT
 781         MOVEI   F,(A)           ;SAVE A POINTER TO DOPE WORD
 782         SUBI    F,1(B)          ;F POINTS TO START OF VECTOR
 783         HRRZ    0,-1(A)         ;SEE IF GROWTH SPECIFIED
 784         JUMPE   0,NOCHNG        ;NONE, JUST CHECK CURRENT SIZES
 785
 786         LDB     B,[001100,,0]   ;GET GROWTH FACTOR
 787         TRZE    B,400           ;KILL SIGN BIT AND SKIP IF +
 788         MOVNS   B               ;NEGATE
 789         ASH     B,6             ;CONVERT TO NUMBER OF WORDS
 790         SUB     F,B             ;BOTTOM IS LOWER IN CORE
 791         LDB     0,[111100,,0]   ;GET TOP GROWTH
 792         TRZE    0,400           ;HACK SIGN BIT
 793         MOVNS   0
 794         ASH     0,6             ;CONVERT TO WORDS
 795         ADD     B,0             ;TOTAL GROWTH TO B
 796         ADD     A,0             ;DOPE WORD IS HIGHER
 797 NOCHNG: SKIPGE  TYPNT           ;IS THIS A PDL?
 798         SUBI    F,1             ;YES, POINTER MAY POINT OUTSIDE
 799
 800         CAIG    E,(A)           ;IS E IN BOUNDS?
 801         CAIG    E,(F)
 802         JRST    VECLOS          ;NO, CLOBBER POINTER TO IT
 803
 804 VECOK:  SUB     A,0             ;A POINTS TO DOPW WORD AGAIN
 805         HLRE    E,(A)           ;GET LENGTH AND MARKING
 806         MOVEI   F,(E)           ;SAVE A COPY
 807         ADD     F,B             ;ADD GROWTH
 808         SUBI    E,2             ;- DOPE WORD LENGTH
 809         IORM    D,(A)           ;MAKE SURE NOW MARKED
 810         JUMPLE  E,GCRET         ;ALREADY MARKED OR ZERO LENGTH, LEAVE
 811
 812         SKIPGE  B,-1(A)         ;SKIP IF UNIFORM
 813         TLNE    B,377777        ;SKIP IF NOT SPECIAL
 814         JUMPGE  TYPNT,NOTGEN    ;JUMP IF NOT A GENERAL VECTOR
 815
 816 GENRAL: HLRZ    0,B             ;CHECK FOR PSTACK
 817         JUMPE   0,NOTGEN        ;IT ISN'T GENERAL
 818         SUBI    A,1(E)          ;POINT TO FIRST ELEMENT
 819         ADDM    F,VECNUM        ;AND UPDATE VECNUM
 820         MOVEI   C,(A)           ;POINT TO FIRST ELEMENT WITH C
 821 \f
 822 ; LOOP TO MARK ELEMENTS IN A GENRAL VECTOR
 823
 824 VECTM2: HLRE    B,(C)           ;GET TYPE AND MARKING
 825         JUMPL   B,GCRET         ;RETURN, (EITHER DOPE WORD OR FENCE POST)
 826         MOVE    A,1(C)          ;DATUM TO A
 827         CAIN    B,TENTRY        ;IS THIS A STACK FRAME
 828         JRST    MFRAME          ;YES, MARK IT
 829         CAIN    B,TBIND         ;OR A BINDING BLOCK
 830         JRST    MBIND
 831
 832 VECTM3: PUSHJ   P,MARK          ;MARK DATUM
 833         ADDI    C,2
 834         JRST    VECTM2
 835
 836 MFRAME: HRROI   C,FRAMLN+SPSAV-1(C)     ;POINT TO SAVED SP
 837         MOVEI   B,TSP
 838         PUSHJ   P,MARK1         ;MARK THE GOODIE
 839         HRROI   C,PSAV-SPSAV(C) ;POINT TO SAVED P
 840         MOVEI   B,TPDL
 841         PUSHJ   P,MARK1         ;AND MARK IT
 842         HRROI   C,TPSAV-PSAV(C) ;POINT TO SAVED TP
 843         MOVEI   B,TTP
 844         PUSHJ   P,MARK1         ;MARK IT ALS
 845         MOVEI   C,PPSAV-TPSAV(C)        ;POINT SAVED PP
 846         MOVEI   B,TPP
 847         PUSHJ   P,MARK1
 848         MOVEI   C,-PPSAV+1(C)   ;POINT PAST THE FRAME
 849         JRST    VECTM2          ;AND DO MORE MARKING
 850
 851
 852 MBIND:  MOVEI   B,TATOM         ;FIRST MARK ATOM
 853         JRST    VECTM3
 854
 855 VECLOS: JUMPL   C,CCRET         ;JUMP IF CAN'T MUNG TYPE
 856         HLLZ    0,(C)           ;GET TYPE
 857         MOVEI   B,TILLEG        ;GET ILLEGAL TYPE
 858         HRLM    B,(C)
 859         MOVEM   0,1(C)          ;AND STORE OLD TYPE AS VALUE
 860         JRST    GCRET           ;RETURN WITHOUT MARKING VECTOR
 861
 862 CCRET:  CLEARM  1(C)            ;CLOBBER THE DATUM
 863         JRST    GCRET
 864 \f
 865 ; SUBROUTINE TO CHECK THE TIME FOR LOCIDS,ARGS AND FRAMES
 866 ; A/ POINT TO FRAME C/GOODIE B/ITS TIME
 867
 868 TIMECH: HLRZ    0,OTBSAV(A)     ;GET THE FRAMES TIME
 869         CAIN    0,(B)           ;SAME?
 870         POPJ    P,              ;YES, WIN
 871         SUB     P,[1,,1]        ;NO, REMOVE  RETLOC
 872 BADARG:
 873 TIMLOS: HLLZ    0,(C)           ;GET OLD TYPE
 874         MOVSI   B,TILLEG        ;ILLEGAL TYPE
 875         MOVEM   B,(C)           ;AND STORE IT
 876         MOVEM   0,1(C)          ;USE OLD TYPE AS DATUM
 877         JRST    GCRET           ;AND STOP MARKING FROM THE LOSER
 878
 879 ; MARK ARG POINTERS (SABASE AND SARGS)
 880
 881 ARGMK:  HLRE    B,A             ;-LENGTH TO B
 882         SUBI    A,(B)           ;POINT TO FRAME OR FRAME POINTER
 883         HLRZ    E,(A)           ;GET TYPE
 884         CAIE    E,TENTRY        ;IS TJHIS A FRAME
 885         JRST    ARGMK2          ;NO, CHECK OTHER
 886         MOVEI   A,FRAMLN(A)     ;POINT ABOVE FRAME
 887 ARGMK3: HRRZ    B,(C)           ;GET TIME
 888         PUSHJ   P,TIMECH
 889         JRST    GCRET           ;DONE
 890
 891
 892 ARGMK2: CAIE    E,TTB           ;BASE POINTER?
 893         JRST    BADARG          ;LOSE
 894         HRRZ    A,1(A)          ;POINT TO FRAME
 895         JRST    ARGMK3          ;AND MARK IT AS SUCH
 896
 897 ; MARK FRAME POINTERS
 898
 899 FRMK:   HLRZ    B,A             ;GET TIME IN B
 900         PUSHJ   P,TIMECH        ;CHECK ITS TIME
 901         SUBI    C,1             ;PREPARE TO MARK PROCESS VECTOR
 902         HRRZ    A,1(C)          ;USE AS DATUM
 903         SUBI    A,1             ;FUDGE FOR VECTMK
 904         MOVEI   B,TPVP          ;IT IS A VECTRO
 905         PUSHJ   P,MARK          ;MARK IT
 906         JRST    GCRET
 907
 908 ; MARK BYTE POINTER
 909
 910 BYTMK:  HRRZ    A,(C)           ;POINT TO DOPE WD
 911         SOJG    A,VECTMK        ;FUDGE DOPE WORD POINTER FOR VECTMK
 912
 913
 914         MOVEI   B,[ASCIZ /AGC -- BYTE POINTER WITH ZERO DOPE WORD POINTER
 915 /]
 916         PUSHJ   P,MSGTYP
 917         .VALUE
 918
 919 \f
 920 ; MARK ATOMS
 921
 922 ATOMK:  PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
 923         MOVEI   C,(A)
 924         HLRZ    B,(C)           ;GET TYPE
 925         MOVE    A,1(C)          ;AND VALUE
 926 ;******FUDGE UNTIL MIRE WINNAGE******
 927
 928         HRRZ    E,(C)           ;GOBBLE PROCESS ID
 929         CAIN    B,TUNBOUND      ;IF NOT UNBOUND
 930         JRST    GCRET           ;IS UNVOUND, IGNORE
 931         SKIPN   E               ;SKIP IF NOT GLOBAL PROCESS
 932         MOVEI   B,TVEC          ;IS GLOBAL, MARK AS A VECTOR
 933         PUSHJ   P,MARK          ;AND MARK IT
 934         JRST    GCRET           ;AND LEAVE
 935
 936 GETLNT: HLRE    B,A             ;GET -LNTH
 937         SUB     A,B             ;POINT TO 1ST DOPE WORD
 938         MOVEI   A,1(A)          ;POINT TO 2ND DOPE WORD
 939         CAMGE   A,VECTOP        ;CHECK BOUNDS
 940         CAMGE   A,VECBOT
 941         JRST    VECTB1          ;BAD VECTOR, COMPLAIN
 942
 943         HLRE    B,(A)           ;GET LENGTH AND MARKING
 944         IORM    D,(A)           ;MAKE SURE MARKED
 945         JUMPL   B,GCRET1        ;MARKED ALREADY, QUIT
 946         SUBI    A,-1(B)         ;POINT TO TOP OF ATOM
 947         ADDM    B,VECNUM        ;UPDATE VECNUM
 948         POPJ    P,              ;AND RETURN
 949
 950 GCRET1: SUB     P,[1,,1]        ;FLUSH RETURN ADDRESS
 951         JRST    GCRET
 952
 953 ; MARK NON-GENERAL VECTORS
 954
 955 NOTGEN: CAMN    B,[GENERAL+<SPVP,,0>]   ;PROCESS VECTOR?
 956         JRST    GENRAL          ;YES, MARK AS A VECTOR
 957         JUMPL   B,SPECLS        ; COMPLAIN IF A SPECIAL HACK
 958         SUBI    A,1(E)          ;POINT TO TOP OF A UNIFORM VECTOR
 959         ADDM    F,VECNUM        ;INCREASE VECNUM
 960         HLRZS   B               ;ISOLATE TYPE
 961         MOVE    F,B             ; AND COPY IT
 962         LSH     B,1             ;FIND OUT WHERE IT WILL GO
 963         HRRZ    B,@TYPNT        ;GET SAT IN B
 964         MOVEI   C,@MKTBS(B)     ;POINT TO MARK SR
 965         CAIN    C,GCRET         ;IF NOT A MARKED FROM GOODIE, IGNORE
 966         JRST    GCRET
 967         MOVEI   C,-1(A)         ;POINT 1 PRIOR TO VECTOR START
 968         PUSH    P,E             ;SAVE NUMBER OF ELEMENTS
 969         PUSH    P,F             ;AND UNIFORM TYPE
 970
 971 UNLOOP: MOVE    B,(P)           ;GET TYPE
 972         MOVE    A,1(C)          ;AND GOODIE
 973         TLO     C,400000        ;CAN'T MUNG TYPE
 974         PUSHJ   P,MARK          ;MARK THIS ONE
 975         SOSE    -1(P)           ;COUNT
 976         AOJA    C,UNLOOP        ;IF MORE, DO NEXT
 977
 978         SUB     P,[2,,2]        ;REMOVE STACK CRAP
 979         JRST    GCRET
 980
 981
 982 SPECLS: MOVEI   B,[ASCIZ /AGC -- UNRECOGNIZED SPECIAL VECTOR
 983 /]
 984         PUSHJ   P,MSGTYP
 985         .VALUE
 986 \f
 987 ;MARK LOCID TYPE GOODIES
 988
 989 LOCMK:  HRRZ    B,(C)           ;GET TIME
 990         JUMPE   B,GLBSP         ;IF TIME IS 0, THIS IS THE GLOBAL SP
 991         HRRZ    0,2(A)          ;GET TIME
 992         CAIE    0,(B)           ;EQUAL?
 993         JRST    TIMLOS          ;NO, LOSE
 994         MOVE    A,3(A)          ;GOBBLE SP POINTER
 995         JRST    TPMK
 996
 997
 998 GLBSP:  MOVE    A,1(C)          ;MARK LIKE A VECTOR
 999         JRST    VECTMK
1000
1001
1002 ; MARK ASSOCIATION BLOCKS
1003
1004 ASMRK:  HRLI    A,-ASOLNT       ;LOOK LIKE A VECTOR POINTER
1005         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
1006         GETYP   B,(A)           ;CHECK TYPE OF FIRST
1007         CAIN    B,TTP
1008         JRST    GCRET           ;THIS IS THE DUMMY
1009         MOVEI   C,(A)           ;COPY POINTER
1010         PUSHJ   P,MARK2         ;MARK ITEM CELL
1011         ADDI    C,INDIC-ITEM    ;POINT TO INDICATOR
1012         PUSHJ   P,MARK2
1013         ADDI    C,VAL-INDIC
1014         PUSHJ   P,MARK2
1015         ADDI    C,NODPNT-VAL-1  ;POINT TO NODE CHAIN
1016         HRRZ    A,1(C)          ;DOES IT EXIST
1017         JUMPE   A,GCRET
1018         MOVEI   B,TASOC
1019         PUSHJ   P,MARK          ;AND MARK IT
1020         JRST    GCRET
1021
1022 \f;HERE WHEN A VECTOR POINTER IS BAD
1023
1024 VECTB1: MOVEI   B,[ASCIZ /AGC -- VECTOR POINTS OUTSIDE VECTOR SPACE
1025 /]
1026         PUSHJ   P,MSGTYP
1027         .VALUE  0
1028
1029
1030 \f
1031 ; THIS PHASE REMOVES ANY UNWANTED ASSOCIATIONS ALSO PRESERVES DATA POINTED TO ONLY BY ASSOCIATIONS
1032 ; RECEIVES POINTER TO ASSOCIATION VECTOR IN A
1033
1034 ASOMRK: SKIPN   C,(A)           ;DOES BUCKET CONTAIN ANYTHING
1035         JRST    ASOM3           ;NO, ;IGNORE
1036
1037 ASOM2:  HRRE    0,ASOLNT+1(C)   ;CHECK FOR CIRCULARITY
1038         AOJE    0,ASOM6         ;ALREADY MARKED, LOSE
1039         HLLOS   ASOLNT+1(C)
1040
1041         SKIPGE  ASOLNT+1(C)     ;IS THIS ONE POINTED AT?
1042         JRST    ASOM4           ;YES, GOODIES ALREADY MARKED
1043         PUSHJ   P,MARKQ         ;SEE IF ITS ITEM IS MARKED
1044         JRST    ASOFLS          ;NO, FLUSH THIS ASSOCIATION
1045         MOVEI   E,MARKQ         ;POINT TO QUESTIONER
1046         SKIPE   NODPNT(C)       ;SKIP IF NOT ON A CHAIN
1047         MOVEI   E,MARK23        ;ON CHAIN, MARK THE INDICATOR
1048         MOVEI   C,INDIC(C)              ;POINT TO INDICATOR
1049         PUSHJ   P,(E)
1050         JRST    ASOFL7          ;INDICATOR NOT MARKED
1051         MOVEI   C,-INDIC(C)             ;POINT BACK TO START
1052
1053 ASOM1:  PUSH    P,C             ;ITEM IS MARKED, MARK INDIC AND VAL AND ASSOC
1054         PUSH    P,A
1055         ADDI    C,VAL   ;POINT TO VAL
1056         PUSHJ   P,MARK2
1057         IORM    D,ASOLNT+1-VAL(C)       ;MARK THE ASSOCIATION BLOCK
1058         POP     P,A
1059         POP     P,C
1060
1061 ASOM4:  MOVEI   E,(C)           ;INCASE NEED TO FLUSH CIRCULARITY
1062         HRRZ    C,ASOLNT-1(C)   ;POINT TO NEXT IN CHAIN
1063         JUMPN   C,ASOM2         ;GO MARKK IT
1064
1065
1066 ASOM3:  AOBJN   A,ASOMRK        ;GO ONTO NEXT BUCKET
1067         POPJ    P,              ;ALL MARKED, QUIT
1068
1069 ;HERE TO FLUSH AN ASSOCIATION
1070
1071 ASOFLS: HRRZ    B,ASOLNT-1(C)   ;GET FORWARD AND BACKWARD POINTERS
1072         HLRZ    E,ASOLNT-1(C)
1073         JUMPN   E,ASOFL1        ;JUMP IF PREV EXISTS
1074         HRRZM   B,(A)           ;CLOBBER VECTOR ENTRY
1075         JRST    .+2
1076
1077 ASOFL1: HRRM    B,ASOLNT-1(E)   ;CLOBBER PREVIOUS BLOCKKS NEXT
1078         JUMPE   B,ASOM4         ;IF NEXT IS 0, DONE
1079         HRLM    E,ASOLNT-1(B)   ;ELSE CLOBBER NEXT'S PREVIOUS
1080         JRST    ASOM4
1081
1082 ASOM6:  HLLZS   (E)             ;FORCE CIRCULARITY AWAY
1083         HRRZS   (C)             ;AND THE OTHERS PREV
1084         JRST    ASOM3           ;AND FINISH THIS BUCKET
1085
1086 MARK23: PUSH    P,A
1087         PUSHJ   P,MARK2 ;MARK IT
1088         POP     P,A             ;RESTORE A
1089         JRST    MKD             ;MUST SKIP
1090
1091 ASOFL7: MOVEI   C,ITEM-INDIC(C) ;RESET C
1092         JRST    ASOFLS          ;AND FLUSH
1093 \f
1094 ;SUBROUTINE TO SEE IF A GOODIE IS MARKED
1095 ;RECEIVES POINTER IN C
1096 ;SKIPS IF MARKED NOT OTHERWISE
1097
1098 MARKQ:  MOVE    E,1(C)          ;DATUM TO C
1099         HLRZ    B,(C)           ;TYPE TO B
1100         LSH     B,1
1101         HRRZ    B,@TYPNT        ;GOBBLE SAT
1102         JRST    @MQTBS(B)       ;DISPATCH
1103
1104
1105 DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
1106 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMK]
1107 [SATOM,VECMQ],[SPVP,VECMQ],[SLOCID,VECMQ],[SCHSTR,BYTMQ]]
1108
1109 PAIRMQ: SKIPGE  (E)             ;SKIP IF NOT MARKED
1110 MKD:    AOS     (P)
1111         POPJ    P,
1112
1113 BYTMQ:  HRRZ    E,(C)           ;GET DOPE WORD POINTER
1114         SOJA    E,VECMQ1        ;TREAT LIKE VECTOR
1115
1116 ARGMQ:  HLRE    F,E             ;CHECK AM ARG POINTER
1117         SUB     E,F             ;POINT TO END OF ARG BLOCK
1118         HLRZ    B,(E)           ;GET TYPE
1119         CAIN    B,TENTRY        ;IS IT AN ENTRY
1120         MOVEI   E,FRAMLN+1(E)   ;MAKE INTO FRAME POINTER
1121         CAIN    B,TTB           ;IS IT A FRAME POINTER
1122         HRRZ    E,1(E)          ;PICK IT UP
1123
1124 FRMQ:   MOVE    E,TPSAV(E)      ;PICK UP A STACK POINTER
1125
1126 VECMQ:  HLRE    F,E             ;GET LENGTH
1127         SUB     E,F             ;POINT TO DOPE WORDS
1128
1129 VECMQ1: SKIPGE  1(E)            ;SKIP IF NOT MARKED
1130         AOS     (P)             ;MARKED, CAUSE SKIP RETURN
1131         POPJ    P,
1132
1133
1134 \f
1135
1136
1137 ;RETIME PHASE -- CALLED IFF A FRAME TIME HAS OVERFLOWED
1138 ;RECEIVES POINTER TO STACK TO BE RECALIBRATED IN A
1139 ;LEAVES HIGHEST TIME IN TIMOUT
1140
1141 RETIME: HLRE    B,A             ;GET LENGTH IN B
1142         SUB     A,B             ;COMPUTE DOPE WORD LOCATION
1143         MOVEI   A,1(A)          ;POINT TO 2D DOPE WORD AND CLEAR LH
1144         CAME    A,TPGROW        ;IS THIS ONE BLOWN?
1145         ADDI    A,PDLBUF        ;NO, POINT TO DOPE WORD
1146         LDB     B,[222100,,(A)] ;GET LENGTH FIELD (IGNOREING MARK BIT
1147         SUBI    A,-1(B)         ;POINT TO PDLS BASE
1148         MOVEI   C,1             ;INITIALIZE NEW TIMES
1149
1150 RETIM1: SKIPGE  B,(A)           ;IF <0, HIT DOPE WORD OR FENCE POST
1151         JRST    RETIM3
1152         HLRZS   B               ;ISOLATE TYPE
1153         CAIE    B,TENTRY        ;FRAME START?
1154         AOJA    A,RETIM2        ;NO, TRY BINDING
1155         HRLM    C,FRAMLN+OTBSAV(A)      ;STORE NEW TIME
1156         ADDI    A,FRAMLN        ;POINT TO NEXT ELEMENT
1157         AOJA    C,RETIM1        ;BUMP TIME AND MOVE ON
1158
1159 RETIM2: CAIN    B,TBIND         ;BINDING?
1160         HRRM    C,3(A)          ;YES, STORE CURRENT TIME
1161         AOJA    A,RETIM1        ;AND GO ON
1162
1163 RETIM3: MOVEM   C,TIMOUT        ;SAVE TIME
1164         POPJ    P,              ;RETURN
1165
1166 \f;CORE ADJUSTMENT PHASE -- SETS TOP OF CORE
1167 ;AND TOP OF VECTOR SPACE TO SIZE NEEDED FOR SUFFICIENT FREE SPACE TO BE ADDED TO
1168 ;ALLOW FOR "EFFICIENT" PROCESSING
1169
1170 CORADJ: .SUSET  [.RMEMT,,CORTOP]        ;SET CORTOP FROM SYSTEM
1171         MOVE    A,PARBOT        ;GET ADDRESS OF BOTTOM OF MOVABLE CORE
1172         ADD     A,PARNEW        ;AND ADDJUST TO WHERE IT WILL BE
1173         ADD     A,PARNUM        ;ADD NUMBER OF PAIRS
1174         ADD     A,PARNUM        ;TWICE TO GET TOP OF PAIR SPACE.
1175         ADD     A,VECNUM        ;ADD NUMBER OF VECTOR WORDS
1176         ADD     A,GETNUM        ;AND NUMBER OF WORDS TO BE GOTTEN THIS TIME
1177         ADD     A,FREMIN        ;AND NUMBER OF FREE WORDS MINIMUM
1178         SUB     A,CORTOP        ;LESS CURRENT TOP OF CORE
1179         JUMPG   A,CORAD2        ;IF GREATER THAN ZERO, MORE CORE NEEDED
1180         ADD     A,FREDIF        ;ADD IN DIFFERENCE BETWEEEN FREE AND GOT
1181         ADDI    A,1777          ;ROUND UP TO NEXT BLOCK
1182         ANDCMI  A,1777          ;AND DOWN TO A BLOCK BOUNDARY
1183         JUMPGE  A,CORAD1        ;IF POSITIVE, NO CORE ADJUSTMENT NEEDED
1184         ADDB    A,CORTOP        ;CALCULATE NEG TOP OF CORE
1185         ASH     A,-10.          ;CONVERT TO BLOCKS
1186         MOVEM   A,CORSET        ;AND SET NUMBER OF BLOCKS
1187 CORAD1: MOVE    A,CORTOP        ;CALCU;ATE NEW TOP OF CORE
1188         SUB     A,VECTOP        ;FIND OFFSET FROM CURRENT VECTOR TOP
1189         MOVEM   A,VECNEW        ;AND SAVE AS NEW HOME OF VECTORS
1190         POPJ    P,
1191
1192 \f;HERE IF MORE CORE NEEDED, NO OF WDS IN A
1193
1194 CORAD2: ADD     A,CORTOP        ;FIND TOP OF CORE
1195         ADDI    A,1777          ;AND ROUND UPWARDS
1196         ASH     A,-10.          ;AND CONVERT TO NUMBER OF BLOCKS
1197         CAMLE   A,SYSMAX        ;COMPARE TO MAXIMUM ALLOWED
1198         PUSHJ   P,CORAD3
1199         .CORE   (A)             ;ASK OFR THE NEW SIZE
1200         PUSHJ   P,CORAD4        ;FAILURE, GO COMPLAIN
1201         JRST    CORADJ          ;OK TRY AGAIN
1202
1203
1204 CORAD3: SKIPA   B,[[ASCIZ /ATTEMPT TO EXPAND PAST MUDDLE LIMIT/]]
1205 CORAD4: MOVEI   B,[ASCIZ /NO CORE AVAILABLE/]
1206         PUSH    P,A             ;SAVE AMOUNT ASKED FOR
1207         PUSHJ   P,MSGTYP
1208         MOVEI   B,[ASCIZ /PROCEED?/]
1209         PUSHJ   P,MSGTYP
1210         PUSHJ   P,TYI"
1211         CAIN    A,"Y
1212         JRST    .+2
1213         .VALUE
1214         POP     P,A             ;RESTORE AMOUNT
1215         POPJ    P,              ;AND GO BACK
1216
1217
1218 CORADL: .CORE   (A)             ;SET TO NEW CORE VALUE
1219         .VALUE
1220         POPJ    P,
1221 \f
1222 ;PARREL -- PAIR RELOCATION ESTABLISMENT
1223 ;ESTABLISH PAIR RELOCATION. CALLED WITH
1224 ;BOTTOM IN AC A, AND TOP IN AC B.
1225
1226 PARRE0: SUBI    B,2             ;MOVE POINTER BACK
1227         IORM    D,(B)           ;MARK THIS PAIR AS JUNK
1228 PARREL: CAIG    B,(A)           ;HAVE THE POINTERS MET?
1229         POPJ    P,              ;YES -- RETURN WITH NEW PARTOP IN B
1230         SKIPL   C,-2(B)         ;MARKED PAIR ON BOTTOM?
1231         JRST    PARRE0          ;NO -- MOVE TOWARD BOTTOM
1232 PARRE1: SKIPGE  (A)             ;JUNK ON BOTTOM?
1233         JRST    PARRE2          ;NO -- MOVE FORWARD
1234         MOVEM   C,(A)           ;STORE PAIR IN NEW LOCATION
1235         MOVE    C,-1(B)         ;GET DATUM
1236         MOVEM   C,1(A)          ;AND STORE IN NEW HOME
1237         HRROM   A,-2(B)         ;SET "BROKEN HEART" TO NEW HOME
1238         JRST    PARRE0          ;AND CONTINUE
1239 PARRE2: ANDCAM  D,(A)           ;UNMARK PAIR
1240         ADDI    A,2             ;GO ON TO NEXT PAIR
1241         CAIG    B,(A)           ;TEST TO SEE IF POINTERS MET
1242         POPJ    P,              ;YES -- DONE
1243         JRST    PARRE1          ;KEEP LOOKING FORWARD
1244
1245 \f;VECTOR RELOCATE --GETS VECTOP IN A
1246 ;AND VECNEW IN B
1247 ;FILLS IN RELOCATION FIELDS OF MARKED VECTORS
1248 ;AND REUTRNS FINAL VECNEW IN B
1249
1250 VECREL: CAMG    A,VECBOT        ;PROCESSED TO BOTTOM OF VECTOR SPACE?
1251         POPJ    P,              ;YES, RETURN
1252         HLRE    C,(A)           ;GET COUNT FROM DOPE WD, EXTEND MARK BIT
1253         JUMPL   C,VECRE1        ;IF MARKED GO PROCESS
1254         HLLZS   (A)             ;CLEAR RELOC FIELD
1255         ADDI    B,(C)           ;INCREMENT OFFSET
1256         SUBI    A,(C)           ;MOVE ON TO NEXT VECTOR
1257         SOJG    C,VECREL        ;AND KEEP SCANNING
1258         JSP     D,VCMLOS        ;LOSER, LEAVE TRACKS AS TO WHO LOST
1259
1260 VECRE1: HRRZ    E,-1(A)         ;GOBBLE THE GROWTH FILEDS
1261         HRRM    B,(A)           ;STORE RELOCATION
1262         JUMPE   E,VECRE2        ;NO GROWTH (OR SHRINKAGE), GO AWAY
1263         LDB     F,[111100,,E]   ;GET TOP GROWTH IN F
1264         TRZN    F,400           ;CHECK AND FLUSH SIGN
1265         MOVNS   F               ;WAS ON, NEGATE
1266         ASH     F,6             ;CONVERT TO WORDS
1267         ADD     B,F             ;UPDATE RELOCATION
1268         HRRM    B,(A)           ;AND STORE IT
1269         ANDI    E,777           ;ISOLATE BOTTOM GROWTH
1270         TRZN    E,400           ;CHECK AND CLEAR SIGN
1271         MOVNS   E
1272         ASH     E,6             ;CONVERT TO WORDS
1273         ADD     B,E             ;UPDATE FUTURE RELOCATIONS
1274 VECRE2: SUBI    A,400000(C)     ;AND MOVE ON TO NEXT VECTOR
1275         ANDI    C,377777        ;KILL MARK
1276         SOJG    C,VECREL        ;AND KEEP GOING
1277         JSP     D,VCMLOS        ;LOSES, LEAVE TRACKS
1278
1279 ;PAIR SPACE UPDATE
1280
1281 ;GETS PARBOT IN AC A
1282 ;UPDATES VALUES AND CDRS UP TO PARTOP
1283
1284 PARUPD: CAML    A,PARTOP        ;ARE THERE MORE PAIRS TO PROCESS
1285         POPJ    P,              ;NO -- RETURN
1286         HRRZ    C,(A)           ;GET CURRENT CDR
1287         HLRZ    B,(A)           ;GET TYPE
1288         LSH     B,1             ;TIMES 2
1289         HRRZ    B,@TYPNT        ;NOW GET SAT
1290         SKIPGE  MKTBS(B)        ;SKIP IF IT HAS A CDR
1291         JRST    PARUP1          ;NO CDR, DON'T UPDATE IT
1292         JUMPE   C,PARUP1        ;IF NIL, DON'T UPDATE
1293         SKIPGE  B,(C)           ;GET POINTER UPDATE AND SKIP IF THIS IS NOT A BROKEN HEART
1294         HRRM    B,(A)           ;IT WAS, STORE NEW POINTER
1295         SKIPE   B,PARNEW        ;IF LIST SPACE IS MOVING,
1296         ADDM    B,(A)           ;THEN ADD OFFSET TO CDR
1297
1298 ;UPDATE VALUE CELL
1299 PARUP1: HLRZ    B,(A)           ;SET RH OF B TO TYPE
1300         MOVE    C,1(A)          ;SET C TO VALUE
1301         PUSHJ   P,VALUPD        ;UPDATE THIS VALUE
1302         ADDI    A,2             ;MOVE ON TO NEXT PAIR
1303         JRST    PARUPD          ;AND CONTINUE
1304
1305 \f;VECTOR SPACE UPDATE
1306 ;GETS VECTOP IN A
1307 ;UPDATES ALL VALUE CELLS IN MARKED VECTORS
1308 ;ESCAPES WHEN IT GETS TO VECBOT
1309
1310 VECUPD: SUBI    A,1             ;MAKE A POINT TO LAST DOPE WD
1311 VECUP1: CAMG    A,VECBOT        ;ANY MORE VECTORS TO PROCESS?
1312         JRST    ENHACK          ;PROCESS ALL ENTRY BLOCKS NOW
1313         SKIPGE  B,(A)           ;IS DOPE WORD MARKED?
1314         JRST    VECUP2          ;YES -- GO PROCESS VALUES IN THIS VECTOR
1315         HLLZS   -1(A)           ;MAKE SURE NO GROWTH ATTEMPTS
1316         HLRZS   B               ;NO -- SET RH OF B TO SIZE OF VECTOR
1317 VECUP5: SUB     A,B             ;SET A TO POINT TO DOPE WD OF NEXT VECTOR
1318         JRST    VECUP1          ;AND CONTINUE
1319
1320 VECUP2: PUSH    P,A             ;SAVE DOPE WORD POINTER
1321         HLRZ    B,(A)           ;GET LENGTH OF THIS VECTOR
1322 VECU11: ANDI    B,377777        ;TURN OFF MARK BIT
1323         SKIPGE  E,-1(A)         ;CHECK FOR UNIFORM OR SPECIAL
1324         TLNE    E,377777        ;SKIP IF GENERAL
1325         JRST    VECUP6          ;UNIFORM OR SPECIAL, GO DO IT
1326 VECU10: SUB     A,B             ;SET AC A TO NEXT DOPE WORD
1327         ADDI    A,1             ;AND ADVANCE TO FIRST ELEMENT OF THIS VECTOR
1328 VECUP3: HLRZ    B,(A)           ;GET TYPE
1329         TRNE    B,400000        ;IF MARK BIT SET
1330         JRST    VECUP4          ;DONE WITH THIS VECTOR
1331         CAIN    B,TENTRY        ;SPECIAL HACK FOR ENTRY
1332         JRST    ENTRUP
1333         CAIE    B,TBVL          ;VECTOR BINDING?
1334         CAIN    B,TBIND         ;AND BINDING BLOCK
1335         JRST    BINDUP
1336 VECU15: MOVE    C,1(A)          ;GET VALUE
1337         PUSHJ   P,VALUPD        ;UPDATE THIS VALUE
1338 VECU12: ADDI    A,2             ;GO ON TO NEXT VECTOR
1339         JRST    VECUP3          ;AND CONTINUE
1340
1341 VECUP4: POP     P,A             ;SET TO OLD DOPE WORD
1342         ANDCAM  D,(A)           ;TURN OFF MARK BIT
1343         HLRZ    B,(A)           ;GET LENGTH
1344         JRST    VECUP5          ;GO ON TO NEXT VECTOR
1345
1346 \f
1347 ; ENTRY PART OF THE STACK UPDATER
1348
1349 ENTRUP: ADDI    A,FRAMLN-2      ;POINT PAST FRAME
1350         JRST    VECU12          ;NOW REJOIN VECTOR UPDATE
1351
1352 ; UPDATE A BINDING BLOCK
1353
1354 BINDUP: HRRZ    C,(A)           ;POINT TO CHAIN
1355         JUMPE   C,NONEXT        ;JUMP IF NO NEXT BINDING IN CHAIN
1356         ADD     C,@(P)          ;ADD RELOCATION OF SELF
1357         HRRM    C,(A)           ;AND STORE IT BACK
1358 NONEXT: CAIE    B,TBIND         ;SKIP IF VAR BINDING
1359         JRST    VECU14          ;NO, MUST BE A VECTOR BIND
1360         MOVEI   B,TATOM         ;UPDATE ATOM POINTER
1361         PUSHJ   P,VALPD1
1362         ADDI    A,2
1363         HLRZ    B,(A)           ;TYPE OF VALUE
1364         PUSHJ   P,VALPD1
1365         ADDI    A,2             ;POINT TO LOCATIVE POINTER
1366         HLRZ    B,(A)           ;GET TYPE
1367         PUSHJ   P,VALPD1
1368         JRST    VECU12
1369
1370 VECU14: MOVEI   B,TVEC          ;NOW TREAT LIKE A VECTOR
1371         JRST    VECU15
1372
1373 ; NOW SAFE TO UPDATE ALL ENTRY BLOCKS
1374
1375 ENHACK: HRRZ    F,TBSTO(LPVP)   ;GET POINTER TO TOP FRAME
1376         HLLZS   TBSTO(LPVP)     ;CLEAR FIELD
1377         JUMPE   F,LSTFRM        ;FINISHED
1378
1379 ENHCK1: MOVEI   A,OTBSAV-1(F)   ;POINT PRIOR TO SAVED TB
1380         HRRZ    F,1(A)          ;POINT TO PRIOR FRAME
1381         MOVEI   B,TTB           ;MARK  SAVED TB
1382         PUSHJ   P,VALPD1
1383         MOVEI   B,TAB           ;MARK ARG POINTER
1384         PUSHJ   P,[AOJA A,VALPD1]
1385         MOVEI   B,TSP           ;SAVED SP
1386         PUSHJ   P,[AOJA A,VALPD1]
1387         MOVEI   B,TPDL          ;SAVED P STACK
1388         PUSHJ   P,[AOJA A,VALPD1]
1389         MOVEI   B,TTP           ;SAVED TP
1390         PUSHJ   P,[AOJA A,VALPD1]
1391         MOVEI   B,TPP
1392         PUSHJ   P,[AOJA A,VALPD1]       ;MARK THE PP
1393         JUMPN   F,ENHCK1        ;MARK NEXT ONE IF IT EXISTS
1394
1395 LSTFRM: HRRZ    A,PROCID(LPVP)  ;NEXT PROCESS
1396         HLLZS   PROCID(LPVP)    ;CLOBBER
1397         MOVEI   LPVP,(A)
1398         JUMPN   LPVP,ENHACK     ;DO NEXT PROCESS
1399         POPJ    P,              ;ALL DONE
1400 \f
1401 ; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS
1402
1403 VECUP6: JUMPL   E,VECUP7        ;JUMP IF  SPECIAL
1404         HLRZS   E               ;ISOLATE TYPE
1405         EXCH    E,B             ;TYPE TO B AND LENGTH TO E
1406         SUBI    A,(E)           ;POINT TO NEXT DOPE WORD
1407         LSH     B,1             ;FIND SAT
1408         HRRZ    B,@TYPNT
1409         MOVE    B,UPDTBS(B)     ;FIND WHERE POINTS
1410         CAIN    B,CPOPJ         ;UNMARKED?
1411         JRST    VECUP4          ;YES, GO ON TO NEXT VECTOR
1412         PUSH    P,B             ;SAVE SR POINTER
1413         SUBI    E,2             ;DON'T COUNT DOPE WORDS
1414
1415 VECUP8: SKIPE   C,1(A)          ;GET GOODIE
1416         PUSHJ   P,@(P)          ;CALL UPDATE ROUTINE
1417         ADDI    A,1
1418         SOJG    E,VECUP8        ;LOOP FOR ALL ELEMNTS
1419
1420         SUB     P,[1,,1]        ;REMOVE RANDOMNESS
1421         JRST    VECUP4
1422
1423 ; SPECIAL VECTOR UPDATE
1424
1425 VECUP7: HLRZS   E               ;ISOLATE SPECIAL TYPE
1426         CAIN    E,SATOM+400000  ;ATOM?
1427         JRST    ATOMUP          ;YES, GO DO IT
1428         CAIN    E,STPSTK+400000 ;STACK
1429         JRST    VECU10          ;TREAT LIKE A VECTOR
1430         CAIN    E,SPVP+400000   ;PROCESS VECTOR
1431         JRST    PVPUP           ;DO SPECIAL STUFF
1432         CAIN    E,SASOC+400000
1433         JRST    ASOUP           ;UPDATE ASSOCIATION BLOCK
1434
1435         MOVEI   B,[ASCIZ /VECTOR UPDATE, ENCOUNTERED FUNNY SPECIAL VECTOR
1436 /]
1437         PUSHJ   P,MSGTYP
1438         .VALUE
1439
1440 ; UPDATE ATOM VALUE CELLS
1441
1442 ATOMUP: SUBI    A,-1(B)         ; POINT TO VALUE CELL
1443         HLRZ    B,(A)
1444         HRRZ    0,(A)           ;GOBBLE PROCID
1445         JUMPN   0,.+3           ;NOT GLOBAL
1446         CAIN    B,TLOCI         ;IS IT A LOCATIVE?
1447         MOVEI   B,TVEC          ;MARK AS A VECTOR
1448         PUSHJ   P,VALPD1        ;UPDATE IT
1449         JRST    VECUP4
1450
1451 ; UPDATE PROCESS VECTOR
1452
1453 PVPUP:  SUBI    A,-1(B)         ;POINT TO TOP
1454         HRRM    LPVP,PROCID(A)  ;CHAIN ALL PROCESSES TOGETHER
1455         MOVEI   LPVP,(A)
1456         HRRZ    0,TBSTO+1(A)    ;POINT TO CURRENT FRAME
1457         HRRM    0,TBSTO(A)      ;SAVE
1458         JRST    VECUP3
1459
1460 \f
1461 ;THIS SUBROUTINE TAKES CARE OF UPDATING ASSOCIATION BLOCKS
1462
1463 ASOUP:  SUBI    A,-1(B)         ;POINT TO START OF BLOCK
1464         HRRZ    B,ASOLNT-1(A)   ;POINT TO NEXT
1465         JUMPE   B,ASOUP1
1466         HRRE    C,ASOLNT+1(B)   ;AND GET ITS RELOC IN C
1467         ADDM    C,ASOLNT-1(A)   ;C NOW HAS UPDATED PONTER
1468 ASOUP1: HLRZ    B,ASOLNT-1(A)   ;GET PREV BLOCK POINTER
1469         JUMPE   B,ASOUP2
1470         HRLZ    F,ASOLNT+1(B)   ;AND ITS RELOCATION
1471         ADDM    F,ASOLNT-1(A)   ;RELOCATE
1472 ASOUP2: HRRZ    B,NODPNT(A)             ;UPDATE NODE CHAIN
1473         JUMPE   B,ASOUP4
1474         HRRE    C,ASOLNT+1(B)           ;GET RELOC
1475         ADDM    C,NODPNT(A)     ;ANID UPDATE
1476 ASOUP4: HLRZ    B,NODPNT(A)     ;GET PREV POINTER
1477         JUMPE   B,ASOUP5
1478         HRLZ    F,ASOLNT+1(B)   ;RELOC
1479         ADDM    F,NODPNT(A)
1480 ASOUP5: HRLI    A,-3            ;SET TO UPDATE OTHER CONTENTS
1481
1482 ASOUP3: HLRZ    B,(A)           ;GET TYPE
1483         PUSHJ   P,VALPD1        ;UPDATE
1484         ADD     A,[1,,2]        ;MOVE POINTER
1485         JUMPL   A,ASOUP3
1486         JRST    VECUP4          ;AND QUIT
1487
1488 \f;VALUPD UPDATES A SINLE VALUE FROM EITHER PAIR SPACE OR VECTOR SPACE
1489 ;GETS POINTER TO TYPE CELL IN RH OF A
1490 ;TYPE IN RH OF B (LH MUST BE 0)
1491 ;VALUE IN C
1492
1493 VALPD1: MOVE    C,1(A)          ;GET VALUE TO UPDATE
1494 VALUPD: TRNN    C,-1            ;ANY POINTER PART?
1495         JRST    CPOPJ           ;NO, LEAVE
1496         LSH     B,1             ;SET TYPE TIMES 2
1497         HRRZ    B,@TYPNT        ;GET STORAGE ALLOCATION TYPE
1498         JRST    @UPDTBS(B)      ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE
1499
1500 ;SAT DISPATCH TABLE
1501
1502 DISTBS UPDTBS,CPOPJ,[[S2WORD,2WDUP],[S2DEFR,2WDUP],[SNWORD,NWRDUP],[STPSTK,STCKUP]
1503 [SFRAME,FRAMUP],[STBASE,TBUP],[SARGS,ARGUP],[SBYTE,BYTUP],[SATOM,NWRDUP],[SPSTK,STCKUP]
1504 [SLOCID,LOCUP],[SPVP,NWRDUP],[S2NWORD,NWRDUP],[SABASE,ABUP],[SCHSTR,BYTUP],[SASOC,ASUP]]
1505
1506
1507
1508
1509 ;PAIR POINTER UPDATE
1510 2WDUP:  TRNN    C,-1            ;POINT TO NIL?
1511         POPJ    P,              ;YES -- NO UPDATE NEEDED
1512         SKIPGE  B,(C)           ;NO -- IS THIS A BROKEN HEART
1513         HRRM    B,1(A)          ;YESS -- STORE NEW VALUE
1514         SKIPE   B,PARNEW        ;IF LIST SPACE IS MOVING
1515         ADDM    B,1(A)          ;THEN ADD OFFSET TO VALUE
1516         POPJ    P,              ;FINISHED
1517
1518
1519 ; HERE TO UPDATE ASSOCIATIONS
1520
1521 ASUP:   HRLI    C,-ASOLNT       ;MAKE INTO VECTOR POINTER
1522         JRST    NWRDUP
1523 \f;VECTOR, ATOM, STACK, AND BASE POINTER UPDATE
1524
1525 LOCUP:  HRRZ    B,(A)           ;CHECK IF IT IS TIMED
1526         JUMPN   B,LOCUP1        ;JUMP IF TIMED, OTHERWISE TREAT LIKE VECTORE
1527
1528 NWRDUP: HLRE    B,C             ;EXTEND COUNT IN B
1529         SUBI    C,-1(B)         ;SET C TO POINT TO DOPE WORD
1530         HRRE    B,(C)           ;EXTEND RELOCATION IN B
1531         ADDM    B,1(A)          ;AND ADD RELOCATION TO STORED DATUM
1532         HRRZ    C,-1(C)         ;GET GROWTH SPECS
1533         JUMPE   C,CPOPJ         ;NO GROWTH, LEAVE
1534         LDB     C,[111100,,C]   ;GET UPWORD GROWTH
1535         TRZN    C,400           ;FLUSH SIGN AN NEGATR DIRECTION
1536         MOVNS   C
1537         ASH     C,6+18.         ;TO LH AND TIMES 100(8)
1538         ADDM    C,1(A)          ;UPDATE POINTER
1539         POPJ    P,
1540
1541
1542 LOCUP1: HRRZ    B,2(C)          ;GET TIME FROM STACK
1543         HRRM    B,(A)           ;AND USE IT
1544
1545 STCKUP: MOVSI   B,PDLBUF        ;GET OFFSET FOR PDLS
1546         ADDM    B,1(A)          ;AND ADD TO COUNT
1547         JRST    NWRDUP          ;NOW TREAT LIKE VECTOR
1548
1549 BYTUP:  HRRZ    C,(A)           ;SET C TO POINT TO DOPE WD
1550         HRRE    B,(C)           ;SET B TO RELOCATION FOR THIS VEC
1551         ADDM    B,(A)           ;UPDATE DOPE WD POINTER
1552         ADDM    B,1(A)          ;AND UPDATE VALUE
1553         POPJ    P,              ;DONE WITH UPDATE
1554
1555 ARGUP:  TLOA    TYPNT,400000    ;FLAG AS AN ARGS POINTER
1556 ABUP:   TLZ     TYPNT,400000    ;FLAG AS NOT ARGS POINTER
1557         HLRE    B,C             ;GET LENGTH
1558         SUB     C,B             ;POINT TO FRAME
1559         HLRZ    B,(C)           ;GET TYPE OF NEXT GOODIE
1560         CAIE    B,TENTRY        ;IS IT A FRAME
1561         HRRZ    C,1(C)          ;NO, POINT TO FRAME
1562         CAIN    B,TENTRY        ;IF IT IS A FRAME
1563         ADDI    C,FRAMLN        ;POINT TO ITS BASE
1564         TLZN    TYPNT,400000    ;SKIP IF ARGS BLOCK
1565         JRST    TBUP            ;NO, JUST AN AB
1566         HLRZ    B,OTBSAV(C)     ;GET TIME
1567         HRRM    B,(A)           ;AND CLOBBER IT AWAY
1568 TBUP:   MOVE    C,TPSAV(C)      ;GET A ASTACK POINTER TO FIND DOPE WORD
1569         HLRE    B,C             ;UPDATE BASED ON THIS POINTER
1570         SUBI    C,(B)
1571         HRRE    B,1(C)          ;GET RELOCATION
1572         ADDM    B,1(A)          ;AND MUNG POINTER
1573         POPJ    P,
1574
1575 FRAMUP: HRRZ    B,(A)           ;GET PROCESS POINTER
1576         HRRE    B,(B)           ;GET    ITS RELOCATION
1577         ADDM    B,(A)
1578         HLLZ    B,OTBSAV(C)     ;GET FRAMES TIME
1579         HLLM    B,1(A)          ;AND STORE IN FRAME POINTER
1580         JRST    TBUP            ;AND CONTINUE UPDATING
1581 \f
1582 ;VECTOR SHRINKING PHASE
1583
1584 VECSH:  SUBI    A,1             ;POOINT TO 1ST DOPE WORD
1585 VECSH1: CAMGE   A,VECBOT        ;FINISHED
1586         POPJ    P,              ;YES, QUIT
1587         HRRZ    B,-1(A)         ;GET A SPEC
1588         JUMPE   B,NXTSHN        ;IGNORE IF NONE
1589         PUSHJ   P,GETGRO        ;GET THE SPECS
1590         JUMPGE  C,SHRNBT        ;SHRINKIGN AT BOTTOM
1591         MOVEI   E,(A)           ;COPY POINTER
1592         ADD     A,C             ;POINT TO NEW DOPE LOCATION WITH E
1593         MOVE    F,-1(E)         ;GET OLD DOPE
1594         ANDCMI  F,777000        ;KILL THIS SPEC
1595         MOVEM   F,-1(A)         ;STORE
1596         MOVE    F,(E)           ;OTHER DOPE WORD
1597         HRLZI   C,(C)           ;TO LH
1598         ADD     F,C             ;CHANGE LENGTH
1599         MOVEM   F,(A)           ;AND STORE
1600         MOVMS   C               ;PLUSIFY
1601         HLLZM   C,(E)           ;AND STORE
1602         SETZM   -1(E)
1603 SHRNBT: JUMPGE  B,NXTSHN        ;GROWTH, IGNOORE
1604         MOVM    E,B             ;GET A POSITIVE COPY
1605         HRLZI   B,(B)           ;TO LH
1606         ADDM    B,(A)           ;ADD INTO DOPE WORD
1607         MOVEI   0,777           ;SET TO CLOBBER GROWTH
1608         ANDCAM  0,-1(A)         ;CLOBBER
1609         HLRZ    B,(A)           ;GET NEW LENGTH
1610         SUBI    A,(B)           ;POINT TO LOW END
1611         HRLZM   E,(A)           ;STORE
1612         SETZM   -1(A)
1613
1614 NXTSHN: HLRZ    B,(A)           ;GET LENGTH
1615         JUMPE   B,VCMLOS        ;LOOSE
1616         SUBI    A,(B)           ;STEP
1617         JRST    VECSH1
1618
1619 GETGRO: LDB     C,[111100,,B]   ;GET UPWARD GROWTH
1620         TRZE    C,400           ;CHECK AND MUNG SIGN
1621         MOVNS   C
1622         ASH     C,6             ;?IMES 100
1623         ANDI    B,777           ;AND GET DOWN GROWTH
1624         TRZE    B,400           ;CHECK AND MUNG SIGN
1625         MOVNS   B
1626         ASH     B,6
1627         POPJ    P,
1628 \f;VECMOV -- MOVES VECTOR DATA TO WHERE RELOC FIELDS OF
1629 ;VECTORS INDICATE.  MOVES DOPEWDS UP FOR VECTORS GROWING AT
1630 ;THE END.
1631 ;CALLED WITH VECTOP IN A.  CALLS PARMOV TO MOVE PAIRS
1632
1633 VECMOV: SUBI    A,1             ;SET A TO ADDR OF TOP DOPE WD
1634         MOVSI   D,400000        ;NEGATIVE D MARKS END OF BACK CHAIN
1635         MOVEI   TYPNT,0         ;CLEAR ON GOING ADDRESS FOR FORWARD RESUME
1636 VECMO1: CAMGE   A,VECBOT        ;GOT TO BOTTOM OF VECTORS
1637         JRST    PARMOV          ;YES, MOVE LIST ELEMENTS AND RETURN
1638         MOVEI   C,(A)           ;NO, COPY ADDR OF THIS DOPEWD
1639         HRRE    B,(A)           ;GET RELOCATION OF THIS VECTOR
1640         JUMPL   B,VECMO5        ;IF MOVING DOWNWARD, MAKE BACK CHAIN
1641         JUMPE   B,VECMO4        ;IF NON MOVER, JUST ADJUST DOPW AND MOVE ON
1642
1643         ADDI    C,(B)           ;SET ADDR OF LAST DESTINATION WD
1644         HRLI    B,A             ;MAKE B INDEX ON A
1645         HLL     A,(A)           ;COUNT TO A LEFT HALF
1646
1647         POP     A,@B            ;MOVE A WORD
1648         TLNE    A,-1            ;REACHED END OF MOVING
1649         JRST    .-2             ;NO, REPEAT
1650                 ;YES, NOTE A HAS ADDR OF NEXT DOPEWD
1651 ;HERE TO ADJUST LOCATION OF DOPEWDS FOR GROWTH (FORWARDLY)
1652 VECMO2: LDB     B,[111100,,-1(C)]               ;GET HIGH GROWTH FIELD
1653         JUMPE   B,VECMO3        ;IF NO GROWTH, DONT MOVE
1654         ASH     B,6             ;EXPRESS GROWTH IN WORDS
1655         HRLI    C,2             ;SET COUNT FOR POPPING 2 DOPEWDS
1656         HRLI    B,C             ;MAKE B INDEX ON C
1657         POP     C,@B            ;MOVE PRIME DOPEWD
1658         POP     C,@B            ;MOVE AUX DOPEWD
1659 VECMO3: JUMPL   D,VECMO1        ;IF NO BACK CHAIN THEN MOVE ON
1660         JRST    VECMO6          ;YES, BACKCHAINING, CONTINUE SAME
1661
1662 ;HERE TO SKIP OVER STILL VECTORS (FORWARDLY)
1663 VECMO4: HLRZ    B,(A)           ;GET SIZE OF UNMOVER
1664         SUBI    A,(B)           ;UPDATE A TO NEXT VECTOR
1665         JRST    VECMO2          ;AND GO CLEAN UP GROWTH
1666 \f;HERE TO ESTABLISH A BACKWARDS CHAIN
1667 VECMO5: EXCH    D,(A)           ;CHAIN FORWARD
1668         HLRZ    B,D             ;GET SIZE
1669         SUBI    A,(B)           ;GO ON TO NEXT VECOTR
1670         CAMGE   A,VECBOT        ;HAVE WE GOT TO END OF VECTORS?
1671         JRST    VECMO7          ;YES, GO MOVE PAIRS AND UNCHAIN
1672         HRRE    B,(A)           ;GET RELOCATION OF THIS VECTOR
1673         JUMPLE  B,VECMO5        ;IF NOT POSITIVE, CONTINUE CHAINING
1674         MOVEM   A,TYPNT         ;SAVE ADDR FOR FORWARD RESUME
1675
1676 ;HERE TO UNCHAIN A VECTOR, MOVE IT, AND ADJUST DOPEWDS
1677 VECMO6: HLRZ    B,D             ;GET SIZE
1678         MOVEI   F,1(A)          ;GET A COPY OF BEGINNING OF VECTOR
1679         ADDI    A,(B)           ;SET TO POINT TO ADDR OF DOPEWD CURRENTLY IN D
1680         EXCH    D,(A)           ;AND UNCHAIN
1681         HRRE    B,(A)           ;GET RELOCATION FOR THIS VECTOR
1682         MOVEI   C,(A)           ;COPY A POINTER TO DOPEW
1683         SKIPGE  D               ;HAVE WE REACHED THE TOP OF THE CHAIN?
1684         MOVE    A,TYPNT         ;YES,   RESTORE FORWARD MOVE RESUME ADDR
1685         JUMPE   B,VECMO2        ;IF STILL VECTOR,GO ADJUST DOPEWDS
1686         ADDI    C,(B)           ;MAKE C POINT TO NEW DOPEW ADDR
1687         ADDI    B,(F)           ;B RH NEW 1ST WORD
1688         HRLI    B,(F)           ;B LH OLD 1ST WD ADDR
1689         BLT     B,(C)           ;COPY THE DATA
1690         JRST    VECMO2          ;AND GO ADJUST DOPEWDS
1691
1692 ;HERE TO STOP CHAINING BECAUSE OF BOTTOM OF VECTOR SPACE
1693 VECMO7: MOVEM   A,TYPNT
1694         PUSH    P,D
1695         PUSHJ   P,PARMOV
1696         POP     P,D
1697         MOVE    A,TYPNT
1698         JRST    VECMO6
1699 \f;PAIR MOVEMENT PHASE -- USES PARNEW,PARBOT, AND PARTOP TO MOVE PAIRS
1700 ;TO NEW HOMES
1701
1702 PARMOV: SKIPN   A,PARNEW        ;IS THERE ANY PAIR MOVEMENT?
1703         POPJ    P,              ;NO, RETURN
1704         JUMPL   A,PARMO2        ;YES -- IF MOVING DOWNWARDS, GO DO A BLT
1705         HRLI    A,B             ;MOVING UPWARDS SETAC A TO INDEX OFF AC B
1706         MOVE    B,PARTOP        ;GET HIGH PAIR ADDREESS
1707         SUB     B,PARBOT        ;AND SUBTRACT BOTTOM TO GET NUMBER OF PAIRS
1708         HRLZS   B               ;PUT COUNT IN LEFT HALF
1709         HRR     B,PARTOP        ;GET HIGH ADDRESS PLUS ONE IN RH
1710         SUBI    B,1             ;AND SUBTRACT ONE TO POINT TO LAST WORD TO BE MOVED
1711
1712 PARMO1: TLNN    B,-1            ;HAS COUNT REACHED ZERO?
1713         JRST    PARMO3          ;YES -- FINISH UP
1714         POP     B,@A            ;NO -- TRANSFER2Y\eU NEXT WORD
1715         JRST    PARMO1          ;AND REPEAT
1716
1717 PARMO2: MOVE    B,PARBOT        ;GET ADDRESS OF FIRST SOURCE WD
1718         HRLS    B               ;IN BOTH HALVES OF AC B
1719         ADD     B,A             ;MAKE RH OF B POINT TO FIRST DESTINATION WORD
1720         ADD     A,PARTOP        ;MAKE RH OF A POINT TO LAST DESTINATION WORD PLUS ONE
1721         BLT     B,-1(A)         ;AND TRANSFER THE BLOCK OF PAIRS
1722
1723 PARMO3: MOVE    A,PARNEW        ;GET OFFSET FOR PAIR SPACE
1724         ADDM    A,PARBOT        ;AND CORRECT BOTTOM
1725         ADDM    A,PARTOP        ;AND CORRECT TOP.
1726         SETZM   PARNEW          ;CLEAR SO IF CALLED TWICE, NO LOSSAGE
1727         POPJ    P,
1728 \f;VECZER -- CLEARS DATA IN AREAS JUST GROWN
1729 ;UPDATES SIZE OF VECTORS
1730 ;CLEARS RELOCATION AND GROWTH FIELDS IN DOPEWDS
1731 ;CALLED WITH NEW VECTOP IN A (VECBOT SHOULD BE NEW TOO)
1732
1733 VECZER: SUBI    A,1             ;MAKE A POINT TO HIGH VECTORS
1734 VECZE1: CAMGE   A,VECBOT        ;REACHED BOTTOM OF VECTORS?
1735         POPJ    P,              ;YES, RETURN
1736         HLLZS   F,(A)           ;NO, CLEAR RELOCATION GET SIZE
1737         HLRZS   F               ;AND PUT SIZE IN RH OF F
1738         HRRZ    B,-1(A)         ;GET GROWTH INTO B
1739         JUMPN   B,VECZE3        ;IF THERE IS SOME GROWTH, GO DO IT
1740 VECZE2: SUBI    A,(F)           ;GROWTH DONE, MOVE ON TO NEXT VECTOR
1741         JRST    VECZE1          ;AND REPEAT
1742
1743 VECZE3: HLLZS   -1(A)           ;CLEAR GROWTH IN THE VECTOR
1744         LDB     C,[111100,,B]           ;GET HIGH ORDER GROWTH IN C
1745         ANDI    B,777           ;AND LIMIT B TO LOW SIDE
1746         ASHC    B,6             ;EXPRESS GROWTH IN WORDS
1747         JUMPE   C,VECZE4        ;IF NO HIGH GROWTH SKIP TO LOW GROWTH
1748         ADDI    F,(C)           ;ADD HIGH GROWTH TO SIZE
1749         SUBM    A,C             ;GET ADDR OF 2ND WD TO BE ZEROED
1750         SETZM   -1(C)           ;CLEAR 1ST WORD
1751         HRLI    C,-1(C)         ;MAKE C A CLEARING BLT POINTER
1752         BLT     C,-2(A)         ;AND CLEAR HIGH END DATA
1753 \rVECZE4:        JUMPE   B,VECZE5        ;IF NO LOW GROWTH SKIP TO SIZE UPDATE
1754         MOVNI   C,(F)           ;GET NEGATIVE SIZE SO FAR
1755         ADDI    C,(A)           ;AND MAKE C POINT TO LAST WORD OF STUFF TO BE CLEARED
1756         ADDI    F,(B)           ;UPDATE SIZE
1757         SUBM    C,B             ;MAKE B POINT TO LAST WD OF NEXT VECT
1758         ADDI    B,2             ;AND NOW TO 2ND DATA WD TO BE CLEARED
1759         SETZM   -1(B)           ;CLEAR 1ST DATA WD
1760         HRLI    B,-1(B)         ;MAKE B A CLEARING BLT POINTER
1761         BLT     B,(C)           ;AND CLEAR THE LOW DATA
1762 \rVECZE5:        HRLZM   F,(A)           ;STORE THE NEW SIZE IN DOPEWD
1763         JRST    VECZE2
1764 \f
1765 ;SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
1766
1767 REHASH: MOVE    TVP,TVPSTO+1(PVP)       ;RESTORE TV POINTER
1768         MOVE    D,ASOVEC+1(TVP) ;GET POINTER TO VECTOR
1769         MOVEI   E,(D)
1770         PUSH    P,E             ;PUSH A POINTER
1771         HLRE    A,D             ;GET -LENGTH
1772         MOVMS   A               ;AND PLUSIFY
1773         PUSH    P,A             ;PUSH IT ALSO
1774
1775 REH3:   HRRZ    C,(D)           ;POINT TO FIRST BUCKKET
1776         HLRZS   (D)             ;MAKE SURE NEW POINTER IS IN RH
1777         JUMPE   C,REH1          ;B\0UCKET EMPTY, QUIT
1778
1779 REH2:   MOVEI   E,(C)           ;MAKE A COPY OF THE POINTER
1780         MOVE    A,ITEM(C)       ;START HASHING
1781         XOR     A,ITEM+1(C)
1782         XOR     A,INDIC(C)
1783         XOR     A,INDIC+1(C)
1784         MOVMS   A               ;MAKE SURE FINAL HASH IS +
1785         IDIV    A,(P)           ;DIVIDE BY TOTAL LENGTH
1786         ADD     B,-1(P)         ;POINT TO WINNING BUCKET
1787
1788         MOVE    C,[002200,,(B)] ;BYTE POINTER TO RH
1789         CAILE   B,(D)           ;IF PAST CURRENT POINT
1790         MOVE    C,[222200,,(B)] ;USE LH
1791         LDB     A,C             ;GET OLD VALUE
1792         DPB     E,C             ;STORE NEW VALUE
1793         HRRZ    B,ASOLNT-1(E)   ;GET NEXT POINTER
1794         HRRZM   A,ASOLNT-1(E)   ;AND CLOBBER IN NEW NEXT
1795         SKIPE   A               ;SKKIP IF NOTHING PREVIOUSLY IN BUCKET
1796         HRLM    E,ASOLNT-1(A)   ;OTHERWISE CLOBBER
1797         SKIPE   C,B             ;SKIP IF END OF CHAIN
1798         JRST    REH2
1799 REH1:   AOBJN   D,REH3
1800
1801         SUB     P,[2,,2]        ;FLUSH THE JUNK
1802         POPJ    P,
1803 \fVCMLOS:        MOVEI   B,[ASCIZ /AGC -- VECTOR WITH ZERO IN DOPE WORD LENGTH
1804 /]
1805         PUSHJ   P,MSGTYP
1806         .VALUE
1807 ;LOCAL VARIABLES
1808
1809 GETNUM: 0                       ;NO OF WORDS TO GET
1810 PARNUM: 0                       ;NO OF PAIRS MARKED
1811 VECNUM: 0                       ;NO OF WORDS IN MARKED VECTORS
1812 CORSET: 0                       ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
1813 CORTOP: 0                       ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
1814
1815 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
1816 ;AND WHEN IT WILL GET UNHAPPY
1817
1818 SYSMAX: 50.                     ;MAXIMUM SIZE OF MUDDLE
1819 FREMIN: 1000                    ;MINIMUM FREE WORDS
1820 FREDIF: 10000                   ;DIFFERENCE BETWEEN FREMIN AND MAXIMUM NUMBER OF FREE WORDS
1821 ;POINTER TO GROWING PDL
1822
1823 TPGROW: 0                       ;POINTS TO A BLOWN TP
1824 PPGROW: 0                       ;POINTS TO A BLOWN PP
1825 TIMOUT: 0                       ;POINTS TO TIMED OUT PDL
1826 PGROW:  0                       ;POINTS TO A BLOWN P
1827
1828 ;IN GC FLAG
1829
1830 GCFLG:  0
1831
1832
1833 END
1834 \f\ 3\f