MUDDLE/nagc.17

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