sumex/agc.mcr273

   1 TITLE AGC MUDDLE GARBAGE COLLECTOR\r
   2 \r
   3 ;SYSTEM WIDE DEFINITIONS GO HERE\r
   4 \r
   5 .GLOBAL RCL,VECTOP,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG\r
   6 .GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR\r
   7 .GLOBAL PGROW,TPGROW,TIMOUT,MAINPR,%SLEEP,MSGTYP,PURTOP,PURBOT,STOSTR\r
   8 .GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,SYSMAX,FREDIF,FREMIN,GCHAPN,INTFLG\r
   9 .GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2\r
  10 .GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS\r
  11 .GLOBAL SPBASE,OUTRNG,CISTNG,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1\r
  12 .GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,%GCJOB,%SHWND,%SHFNT,%INFMP,%GETIP\r
  13 .GLOBAL TD.PUT,TD.GET,TD.LNT\r
  14 .GLOBAL CTIME,MTYO,ILOC,GCRSET\r
  15 .GLOBAL GCTIM,GCCAUS,GCCALL,AAGC,LVLINC,STORIC,GVLINC,TYPIC\r
  16 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR\r
  17 \r
  18 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS\r
  19 .GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE\r
  20 \r
  21 .GLOBAL P.TOP,P.CORE,PMAP\r
  22 \r
  23 NGCS==8         ; AFTER NGCS, DO HAIRY VAL/ASSOC FLUSH\r
  24 PDLBUF=100\r
  25 TPMAX==20000    ;PDLS LARGER THAN THIS WILL BE SHRUNK\r
  26 PMAX==4000      ;MAXIMUM PSTACK SIZE\r
  27 TPMIN==1000     ;MINIMUM PDL SIZES\r
  28 PMIN==400\r
  29 TPGOOD==10000   ; A GOOD STACK SIZE\r
  30 PGOOD==1000\r
  31 .ATOM.==200000  ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC)\r
  32 \r
  33 GCHN==0         ; CHANNEL FOR FUNNNY INFERIOR\r
  34 STATNO==19.     ; # OF STATISTICS FOR BLOAT-STAT\r
  35 STATGC==8.      ; # OF GC-STATISTICS FOR BLOAT-STAT\r
  36 \r
  37 \r
  38 RELOCATABLE\r
  39 .INSRT MUDDLE >\r
  40 \r
  41 TYPNT=AB        ;SPECIAL AC USAGE DURING GC\r
  42 F=TP                            ;ALSO SPECIAL DURING GC\r
  43 LPVP=SP                         ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN\r
  44 FPTR=TB                         ; POINT TO CURRENT FRONTIER OF INFERIOR\r
  45 \r
  46 \r
  47 ; WINDOW AND FRONTIER PAGES\r
  48 \r
  49 FRONT==776000           ; PAGE 255. IS FRONTIER\r
  50 WIND==774000            ; PAGE 254. IS WINDOW\r
  51 FRNP==FRONT/2000\r
  52 WNDP==WIND/2000\r
  53 \r
  54 \r
  55 \r
  56 \r
  57 \r
  58 \f\r
  59 .GLOBAL FLIST\r
  60 \r
  61 MFUNCTION BLOATSTAT,SUBR,[BLOAT-STAT]\r
  62 \r
  63 ENTRY\r
  64 \r
  65         JUMPGE  AB,GETUVC       ; SEE IF THERE IS AN ARGUMENT\r
  66         GETYP   A,(AB)\r
  67         CAIE    A,TUVEC         ; SEE IF THE ARGUMENT IS A UVECTOR\r
  68         JRST    WTYP1           ; IF NOT COMPLAIN\r
  69         HLRE    0,1(AB)\r
  70         MOVNS   0\r
  71         CAIGE   0,STATNO+STATGC ; SEE IF UVECTOR IS RIGHT LENGTH\r
  72         JRST    WTYP1\r
  73         CAMGE   AB,[-2,,0]      ; SEE IF THERE ARE TOO MANY ARGUMENTS\r
  74         JRST    TMA\r
  75         MOVE    A,(AB)          ; GET THE UVECTOR\r
  76         MOVE    B,1(AB)\r
  77         JRST    SETUV           ; CONTINUE\r
  78 GETUVC: MOVEI   A,STATNO+STATGC ; CREATE A UVECTOR\r
  79         PUSHJ   P,IBLOCK\r
  80 SETUV:  PUSH    P,A             ; SAVE UVECTOR\r
  81         PUSH    P,B\r
  82         MOVE    0,NOWFRE        ; COMPUTE FREE STORAGE USED SINCE LAST GC\r
  83         SUB     0,VECBOT\r
  84         ADD     0,PARTOP\r
  85         MOVEM   0,CURFRE\r
  86         HLRE    0,TP            ; COMPUTE STACK SPACE USED UP\r
  87         ADD     0,NOWTP\r
  88         SUBI    0,PDLBUF\r
  89         MOVEM   0,CURTP\r
  90         MOVE    B,IMQUOTE THIS-PROCESS\r
  91         PUSHJ   P,ILOC\r
  92         HRRZS   B\r
  93         HRRZ    C,TPBASE+1(PVP) ; CALCULATE # OF ATOM SLOTS\r
  94         MOVE    0,B\r
  95         HRRZ    D,SPBASE+1(PVP)         ; COMPUTE CURRENT # OF BINDINGS\r
  96         SUB     0,D\r
  97         IDIVI   0,6\r
  98         MOVEM   0,CURLVL\r
  99         SUB     B,C             ; TOTAL WORDS ATOM STORAGE\r
 100         IDIVI   B,6             ; COMPUTE # OF SLOTS\r
 101         MOVEM   B,NOWLVL\r
 102         HRRZ    A,GLOBASE+1(TVP)        ; COMPUTE TOTAL # OF GLOBAL SLOTS\r
 103         HLRE    0,GLOBASE+1(TVP)\r
 104         SUB     A,0             ; POINT TO DOPE WORD\r
 105         HLRZ    B,1(A)\r
 106         ASH     B,-2            ; # OF GVAL SLOTS\r
 107         MOVEM   B,NOWGVL\r
 108         HRRZ    0,GLOBASE+1(TVP)        ; COMPUTE # OF GVAL SLOTS IN USE\r
 109         HRRZ    A,GLOBSP+1(TVP)\r
 110         SUB     A,0\r
 111         ASH     A,-2            ; NEGATIVE # OF SLOTS USED\r
 112         SUBI    B,(A)\r
 113         MOVEM   B,CURGVL\r
 114         HRRZ    A,TYPBOT+1(TVP) ; GET LENGTH OF TYPE VECTOR\r
 115         HLRE    0,TYPBOT+1(TVP)\r
 116         SUB     A,0\r
 117         HLRZ    B,1(A)          ; # OF WORDS IN TYPE-VECTOR\r
 118         IDIVI   B,2             ; CONVERT TO # OF TYPES\r
 119         MOVEM   B,NOWTYP\r
 120         HLRE    0,TYPVEC+1(TVP) ; LENGTH OF VISABLE TYPE-VECTOR\r
 121         MOVNS   0\r
 122         IDIVI   0,2             ; GET # OF TYPES\r
 123         MOVEM   0,CURTYP\r
 124         MOVE    0,CODTOP        ; GET LENGTH OF STATIONARY IMPURE STORAGE\r
 125         MOVEM   0,NOWSTO\r
 126         SETZB   B,D             ; ZERO OUT MAXIMUM\r
 127         HRRZ    C,FLIST\r
 128 LOOPC:  HLRZ    0,(C)           ; GET BLK LENGTH\r
 129         ADD     D,0             ; ADD # OF WORDS IN BLOCK\r
 130         CAMGE   B,0             ; SEE IF NEW MAXIMUM\r
 131         MOVE    B,0\r
 132         HRRZ    C,(C)           ; POINT TO NEXT BLOCK\r
 133         JUMPN   C,LOOPC         ; REPEAT\r
 134         MOVEM   D,CURSTO\r
 135         MOVEM   B,CURMAX\r
 136         HLRE    0,P             ; GET AMOUNT OF ROOM LEFT ON P\r
 137         ADD     0,NOWP\r
 138         SUBI    0,PDLBUF\r
 139         MOVEM   0,CURP\r
 140         PUSHJ   P,GCSET         ; FIX UP BLOAT-STAT PARAMETERS\r
 141         MOVSI   C,BSTGC         ; SET UP BLT FOR GC FIGURES\r
 142         HRRZ    B,(P)           ; RESTORE B\r
 143         HRR     C,B\r
 144         BLT     C,(B)STATGC-1\r
 145         HRLI    C,BSTAT         ; MODIFY BLT FOR STATS\r
 146         ADDI    C,STATGC                ; B HAS ELEMENTS\r
 147         BLT     C,(B)STATGC+STATNO-1\r
 148         MOVEI   0,TFIX\r
 149         HRLM    0,(B)STATNO+STATGC      ; MOVE IN UTYPE\r
 150         POP     P,B\r
 151         POP     P,A             ; RESTORE TYPE-WORD\r
 152         JRST    FINIS\r
 153 \r
 154 \r
 155 ; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE\r
 156 ; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY\r
 157 ; THEIR MUDDLE.\r
 158 \r
 159 GCRSET: SETZM   GCNO            ; CALL FROM INIT, ZAP ALL 1ST\r
 160         MOVE    0,[GCNO,,GCNO+1]\r
 161         BLT     0,GCCALL\r
 162 \r
 163 GCSET:  MOVE    A,VECBOT        ; COMPUTE FREE SPACE AVAILABLE\r
 164         SUB     A,PARTOP\r
 165         MOVEM   A,NOWFRE\r
 166         CAMLE   A,MAXFRE\r
 167         MOVEM   A,MAXFRE        ; MODIFY MAXIMUM\r
 168         HLRE    A,TP            ; FIND THE DOPE WORD OF THE TP STACK\r
 169         MOVNS   A\r
 170         ADDI    A,1(TP)         ; CLOSE TO DOPE WORD\r
 171         CAME    A,TPGROW\r
 172         ADDI    A,PDLBUF        ; NOW AT REAL DOPE WORD\r
 173         HLRZ    B,(A)           ; GET LENGTH OF TP-STACK\r
 174         MOVEM   B,NOWTP\r
 175         CAMLE   B,CTPMX         ; SEE IF THIS IS THE BIGGEST TP\r
 176         MOVEM   B,CTPMX\r
 177         HLRE    B,P             ; FIND DOPE WORD OF P-STACK\r
 178         MOVNS   B\r
 179         ADDI    B,1(P)          ; CLOSE TO IT\r
 180         CAME    B,PGROW         ; SEE IF THE STACK IS BLOWN\r
 181         ADDI    B,PDLBUF        ; POINTING TO IT\r
 182         HLRZ    A,(B)           ; GET IN LENGTH\r
 183         MOVEM   A,NOWP\r
 184         CAMLE   A,CPMX          ; SEE IF WE HAVE THE BIGGEST P STACK\r
 185         MOVEM   A,CPMX\r
 186         POPJ    P,              ; EXIT\r
 187 \r
 188 \r
 189 .GLOBAL PGFIND,PGGIVE,PGTAKE,PGINT\r
 190 \r
 191 ; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A\r
 192 ; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B\r
 193 ; RETURN -1 IN REG B IF NONE FOUND\r
 194 \r
 195 PGFIND:\r
 196         JUMPLE  A,FPLOSS\r
 197         PUSHJ   P,PGFND1        ; SEE IF ALREADY ENOUGH\r
 198         SKIPL   B               ; SKIP IF LOST\r
 199         POPJ    P,\r
 200 \r
 201         SUBM    M,(P)\r
 202         PUSH    P,E\r
 203         PUSH    P,C\r
 204         PUSH    P,D\r
 205         MOVE    C,PURBOT        ; CHECK IF ROOM AT ALL\r
 206         SUB     C,P.TOP         ; TOTAL SPACE\r
 207         MOVEI   D,(C)           ; COPY FOR CONVERSION TO PAGES\r
 208         ASH     D,-10.\r
 209         CAIGE   C,(A)           ; SKIP IF COULD WIN\r
 210         JRST    PGFLOS\r
 211 \r
 212         MOVNS   A               ; MOVE PURE AREA DOWN "A" PAGES\r
 213         PUSHJ   P,MOVPUR\r
 214         MOVE    B,PURTOP        ; GET FIRST PAGE ALLOCATED\r
 215         ASH     B,-10.          ; TO PAGE #\r
 216 PGFLOS: POP     P,D\r
 217         POP     P,C\r
 218         POP     P,E\r
 219         PUSHJ   P,RBLDM         ; GET A NEW VALUE FOR M\r
 220         JRST    MPOPJ\r
 221 \r
 222 PGFND1: PUSH    P,E\r
 223         PUSH    P,D\r
 224         PUSH    P,C\r
 225         PUSH    P,[-1]          ;POSSIBLE CONTENTS FOR REG B\r
 226         PUSH    P,A             ;SAVE LENGTH OF BLOCK DESIRED FOR LATER USE\r
 227         SETZB   B,C             ;INITIAL SECTION AND PAGE NUMBERS\r
 228         MOVEI   0,0             ;COUNT OF PAGES ALREADY FOUND\r
 229         PUSHJ   P,PINIT\r
 230 PLOOP:  TDNE    E,D             ;FREE PAGE ?\r
 231         JRST    NOTFRE          ;NO\r
 232         JUMPN   0,NFIRST        ;FIRST FREE PAGE OF A BLOCK ?\r
 233         MOVEI   A,(B)           ;YES SAVE ADDRESS OF PAGE IN REG A\r
 234         IMULI   A,32.\r
 235         ADDI    A,(C)\r
 236 NFIRST: ADDI    0,1\r
 237         CAML    0,(P)           ;TEST IF ENOUGH PAGES HAVE BEEN FOUND\r
 238         JRST    PWIN            ;YES, FINISHED\r
 239         SKIPA   \r
 240 NOTFRE: MOVEI   0,0             ;RESET COUNT\r
 241         PUSHJ   P,PNEXT ;NEXT PAGE\r
 242         JRST    PLOSE           ;NONE--LOSE RETURNING -1 IN REG B\r
 243         JRST    PLOOP\r
 244 \r
 245 PWIN:   MOVEI   B,(A)           ;GET WINNING ADDRESS\r
 246         MOVEM   B,(P)-1         ;RETURN ADDRESS OF WINNING PAGE\r
 247         MOVE    A,(P)           ;RELOAD LENGTH OF BLOCK OF PAGES\r
 248         MOVE    0,[TDO E,D]     ;INST TO SET "BUSY" BITS\r
 249         JRST    ITAKE\r
 250 \r
 251 ;CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A\r
 252 ;THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B\r
 253 PGGIVE: MOVE    0,[TDZ E,D]     ;INST TO SET "FREE" BITS\r
 254         SKIPA\r
 255 PGTAKE: MOVE    0,[TDO E,D]     ;INST TO SET "BUSY" BITS\r
 256         JUMPLE  A,FPLOSS\r
 257         CAIL    B,0\r
 258         CAILE   B,255.\r
 259         JRST    FPLOSS\r
 260         PUSH    P,E\r
 261         PUSH    P,D\r
 262         PUSH    P,C\r
 263         PUSH    P,B\r
 264         PUSH    P,A\r
 265 ITAKE:  IDIVI   B,32.\r
 266         PUSHJ   P,PINIT\r
 267         SUBI    A,1\r
 268 RTL:    XCT     0               ;SET APPROPRIATE BIT\r
 269         PUSHJ   P,PNEXT ;NEXT PAGE'S BIT\r
 270         JUMPG   A,FPLOSS        ;TOO MANY ?\r
 271         SOJGE   A,RTL\r
 272         MOVEM   E,PMAP(B)       ;REPLACE BIT MASK\r
 273 PLOSE:  POP     P,A\r
 274         POP     P,B\r
 275         POP     P,C\r
 276         POP     P,D\r
 277         POP     P,E\r
 278         POPJ    P,\r
 279 \r
 280 \r
 281 PINIT:  MOVE    E,PMAP(B)       ;GET BITS FOR THIS SECTION\r
 282         HRLZI   D,400000        ;BIT MASK\r
 283         MOVNS   C\r
 284         LSH     D,(C)           ;SHIFT TO APPROPRIATE BIT POSITION\r
 285         MOVNS   C\r
 286         POPJ    P,\r
 287 \r
 288 PNEXT:  AOS     (P)             ;FOR SKIP RETURN ON EXPECTED SUCCESS\r
 289         LSH     D,-1            ;CONSIDER NEXT PAGE\r
 290         CAIGE   C,31.           ;FINISHED WITH THIS SECTION ?\r
 291         AOJA    C,CPOPJ         ;NO, INCREMENT AND CONTINUE\r
 292         MOVEM   E,PMAP(B)       ;REPLACE BIT MASK\r
 293         SETZ    C,\r
 294         CAIGE   B,7.            ;LAST SECTION ?\r
 295         AOJA    B,PINIT         ;NO, INCREMENT AND CONTINUE\r
 296         SOS     (P)             ;YES, UNDO SKIP RETURN\r
 297         POPJ    P,\r
 298 \r
 299 FPLOSS: FATAL PAGE LOSSAGE\r
 300 \r
 301 PGINT:  MOVEI   B,HIBOT         ;INITIALIZE MUDDLE'S PAGE MAP TABLE\r
 302         IDIVI   B,2000          ;FIRST PAGE OF PURE CODE\r
 303         MOVE    C,HITOP\r
 304         IDIVI   C,2000\r
 305         MOVEI   A,(C)+1\r
 306         SUBI    A,(B)           ;NUMBER OF SUCH PAGES\r
 307         PUSHJ   P,PGTAKE        ;MARK THESE PAGES AS TAKEN\r
 308         POPJ    P,\r
 309 ; USER GARBAGE COLLECTOR INTERFACE\r
 310 \r
 311 MFUNCTION GC,SUBR\r
 312         ENTRY\r
 313 \r
 314         JUMPGE  AB,GC1\r
 315         CAMGE   AB,[-4,,0]\r
 316         JRST    TMA\r
 317         PUSHJ   P,GETFIX        ; GET FREEE MIN IF GIVEN\r
 318         MOVEM   A,FREMIN\r
 319         ADD     AB,[2,,2]       ; NEXT ARG\r
 320         JUMPGE  AB,GC1          ; NOT SUPPLIED\r
 321         PUSHJ   P,GETFIX        ; GET FREDIF\r
 322         MOVEM   A,FREDIF\r
 323 GC1:    PUSHJ   P,COMPRM        ; GET CURRENT USED CORE\r
 324         PUSH    P,A\r
 325         MOVEI   A,1\r
 326         MOVEM   A,GCHAIR        ; FORCE FLUSH OF VALS ASSOCS\r
 327         MOVE    C,[11,,0]       ; INDICATOR FOR AGC\r
 328         PUSHJ   P,AGC           ; COLLECT THAT TRASH\r
 329         SKIPGE  A               ; SKIP IF OK\r
 330         PUSHJ   P,FULLOS        ; COMPLAIN ABOUT LACK OF SPACE\r
 331         PUSHJ   P,COMPRM        ; HOW MUCH ROOM NOW?\r
 332         POP     P,B             ; RETURN AMOUNT\r
 333         SUB     B,A\r
 334         MOVSI   A,TFIX\r
 335         JRST    FINIS\r
 336 \r
 337 \r
 338 COMPRM: MOVE    A,PARTOP        ; USED SPACE\r
 339         SUB     A,PARBOT\r
 340         ADD     A,VECTOP\r
 341         SUB     A,VECBOT\r
 342         POPJ    P,\r
 343 \r
 344 MFUNCTION GCDMON,SUBR,[GC-MON]\r
 345 \r
 346         ENTRY   1\r
 347 \r
 348         SETZM   GCMONF          ; ASSUME FALSE\r
 349         GETYP   0,(AB)\r
 350         CAIE    0,TFALSE\r
 351         SETOM   GCMONF\r
 352         MOVE    A,(AB)\r
 353         MOVE    B,1(AB)\r
 354         JRST    FINIS\r
 355 .GLOBAL EVATYP,APLTYP,PRNTYP\r
 356 \r
 357 \fMFUNCTION BLOAT,SUBR\r
 358         ENTRY\r
 359 \r
 360         MOVEI   C,0             ; FLAG TO SAY WHETHER NEED A GC\r
 361         MOVSI   E,-NBLO         ; AOBJN TO BLOATER TABLE\r
 362 \r
 363 BLOAT2: JUMPGE  AB,BLOAT1       ; ALL DONE?\r
 364         PUSHJ   P,NXTFIX        ; GET NEXT BLOAT PARAM\r
 365         PUSHJ   P,@BLOATER(E)   ; DISPATCH\r
 366         AOBJN   E,BLOAT2        ; COUNT PARAMS SET\r
 367 \r
 368         JUMPL   AB,TMA          ; ANY LEFT...ERROR\r
 369 BLOAT1: JUMPE   C,BLOATD        ; DONE, NO GC NEEDED\r
 370         MOVEI   0,1\r
 371         MOVEM   0,GCHAIR        ; FORCE HAIR TO OCCUR\r
 372         MOVE    C,E             ; MOVE IN INDICATOR\r
 373         HRLI    C,1             ; INDICATE THAT IT COMES FROM BLOAT\r
 374         PUSHJ   P,AGC           ; DO ONE\r
 375         SKIPGE  A\r
 376         PUSHJ   P,FULLOS        ; NO CORE LEFT\r
 377         SKIPE   A,TPBINC        ; SMASH POINNTERS\r
 378         ADDM    A,TPBASE+1(PVP)\r
 379         SKIPE   A,GLBINC        ; GLOBAL SP\r
 380         ADDM    A,GLOBASE+1(TVP)\r
 381         SKIPE   A,TYPINC\r
 382         ADDM    A,TYPBOT+1(TVP)\r
 383         SETZM   TPBINC          ; RESET PARAMS\r
 384         SETZM   GLBINC\r
 385         SETZM   TYPINC\r
 386 \r
 387 BLOATD: MOVE    B,VECBOT\r
 388         SUB     B,PARTOP\r
 389         MOVSI   A,TFIX          ; RETURN CORE FOUND\r
 390         JRST    FINIS\r
 391 \r
 392 ; TABLE OF BLOAT ROUTINES\r
 393 \r
 394 BLOATER:\r
 395         MAINB\r
 396         TPBLO\r
 397         LOBLO\r
 398         GLBLO\r
 399         TYBLO\r
 400         STBLO\r
 401         PBLO\r
 402         SFREM\r
 403         SFRED\r
 404         SLVL\r
 405         SGVL\r
 406         STYP\r
 407         SSTO\r
 408         NBLO==.-BLOATER\r
 409 \r
 410 ; BLOAT MAIN STORAGE AREA\r
 411 \r
 412 MAINB:  MOVE    D,VECBOT        ; COMPUTE CURRENT ROOM\r
 413         SUB     D,PARTOP\r
 414         CAMGE   A,D             ; NEED MORE?\r
 415         POPJ    P,              ; NO, LEAVE\r
 416         MOVEM   A,GETNUM                ; SAVE\r
 417         AOJA    C,CPOPJ         ; LEAVE SETTING C\r
 418 \r
 419 ; BLOAT TP STACK (AT TOP)\r
 420 \r
 421 TPBLO:  HLRE    D,TP            ; GET -SIZE\r
 422         MOVNS   B,D\r
 423         ADDI    D,1(TP)         ; POINT TO DOPE (ALMOST)\r
 424         CAME    D,TPGROW        ; BLOWN?\r
 425         ADDI    D,PDLBUF        ; POINT TO REAL DOPE WORD\r
 426         CAMG    A,B             ; SKIP IF GROWTH NEEDED\r
 427         POPJ    P,\r
 428         ASH     A,-6            ; CONVERT TO 64 WD BLOCKS\r
 429         CAILE   A,377\r
 430         JRST    OUTRNG\r
 431         DPB     A,[111100,,-1(D)]       ; SMASH SPECS IN\r
 432         AOJA    C,CPOPJ\r
 433 \r
 434 ; BLOAT TOP LEVEL LOCALS\r
 435 \r
 436 LOBLO:  IMULI   A,6             ; 6 WORDS PER BINDING\r
 437         HRRZ    0,TPBASE+1(PVP)\r
 438         HRRZ    B,SPBASE+1(PVP) ; ROOM AVAIL TO E\r
 439         SUB     B,0\r
 440         SUBI    A,(B)           ; HOW MUCH MORE?\r
 441         JUMPLE  A,CPOPJ         ; NONE NEEDED\r
 442         MOVEI   B,TPBINC\r
 443         PUSHJ   P,NUMADJ\r
 444         DPB     A,[1100,,-1(D)] ; SMASH\r
 445         AOJA    C,CPOPJ\r
 446 \r
 447 ; GLOBAL SLOT GROWER\r
 448 \r
 449 GLBLO:  ASH     A,2             ; 4 WORDS PER VAR\r
 450         MOVE    D,GLOBASE+1(TVP)        ; CURRENT LIMITS\r
 451         HRRZ    B,GLOBSP+1(TVP)\r
 452         SUBI    B,(D)\r
 453         SUBI    A,(B)           ; NEW AMOUNT NEEDED\r
 454         JUMPLE  A,CPOPJ\r
 455         MOVEI   B,GLBINC        ; WHERE TO KEEP UPDATE\r
 456         PUSHJ   P,NUMADJ        ; FIX NUMBER\r
 457         HLRE    0,D\r
 458         SUB     D,0             ; POINT TO DOPE\r
 459         DPB     A,[1100,,(D)]   ; AND SMASH\r
 460         AOJA    C,CPOPJ\r
 461 \r
 462 ; HERE TO GROW TYPE VECTOR (AND FRIENDS)\r
 463 \r
 464 TYBLO:  ASH     A,1             ; TWO WORD PER TYPE\r
 465         HRRZ    B,TYPBOT+1(TVP) ; FIND CURRENT ROOM\r
 466         MOVE    D,TYPVEC+1(TVP)\r
 467         SUBI    B,(D)\r
 468         SUBI    A,(B)           ; EXTRA NEEDED TO A\r
 469         JUMPLE  A,CPOPJ         ; NONE NEEDED, LEAVE\r
 470         MOVEI   B,TYPINC        ; WHERE TO STASH SPEC\r
 471         PUSHJ   P,NUMADJ        ; FIX NUMBER\r
 472         HLRE    0,D             ; POINT TO DOPE\r
 473         SUB     D,0\r
 474         DPB     A,[1100,,(D)]\r
 475         SKIPE   D,EVATYP+1(TVP) ; GROW AUX TYPE VECS IF NEEDED\r
 476         PUSHJ   P,SGROW1\r
 477         SKIPE   D,APLTYP+1(TVP)\r
 478         PUSHJ   P,SGROW1\r
 479         SKIPE   D,PRNTYP+1(TVP)\r
 480         PUSHJ   P,SGROW1\r
 481         AOJA    C,CPOPJ\r
 482 \r
 483 ; HERE TO CREATE STORAGE SPACE\r
 484 \r
 485 STBLO:  MOVE    D,PARBOT        ; HOW MUCH NOW HERE\r
 486         SUB     D,CODTOP\r
 487         SUBI    A,(D)           ; MORE NEEDED?\r
 488         JUMPLE  A,CPOPJ\r
 489         MOVEM   A,PARNEW        ; FORCE PAIR SPACE TO MOVE ON OUT\r
 490         AOJA    C,CPOPJ\r
 491 \r
 492 ; BLOAT P STACK\r
 493 \r
 494 PBLO:   HLRE    D,P\r
 495         MOVNS   B,D\r
 496         SUBI    D,5             ; FUDGE FOR THIS CALL\r
 497         SUBI    A,(D)\r
 498         JUMPLE  A,CPOPJ\r
 499         ADDI    B,1(P)          ; POINT TO DOPE\r
 500         CAME    B,PGROW         ; BLOWN?\r
 501         ADDI    B,PDLBUF        ; NOPE, POIN TO REAL D.W.\r
 502         ASH     A,-6            ; TO 64 WRD BLOCKS\r
 503         CAILE   A,377           ; IN RANGE?\r
 504         JRST    OUTRNG\r
 505         DPB     A,[111100,,-1(B)]\r
 506         AOJA    C,CPOPJ\r
 507                         \r
 508 ; SET FREMIN\r
 509 \r
 510 SFREM:  MOVEM   A,FREMIN\r
 511         POPJ    P,\r
 512 \r
 513 ; SET FREDIF\r
 514 \r
 515 SFRED:  MOVEM   A,FREDIF\r
 516         POPJ    P,\r
 517 \r
 518 ; SET LVAL INCREMENT\r
 519 \r
 520 SLVL:   IMULI   A,6             ; CALCULATE AMOUNT TO GROW B\r
 521         IDIVI   A,64.           ; # OF  GROW BLOCKS NEEDED\r
 522         CAIE    B,0             ; DOES B HAVE A REMAINDER\r
 523         ADDI    A,1             ; IF SO ADD A BLOCK\r
 524         MOVEM   A,LVLINC\r
 525         POPJ P,\r
 526 \r
 527 ; SET GVAL INCREMENT\r
 528 \r
 529 SGVL:   IDIVI   A,16.           ; CALCULATE NUMBER OF GROW BLOCKS NEEDED\r
 530         CAIE    B,0\r
 531         ADDI    A,1             ; COMPENSATE FOR EXTRA\r
 532         MOVEM   A,GVLINC\r
 533         POPJ    P,\r
 534 \r
 535 ; SET TYPE INCREMENT\r
 536 \r
 537 STYP:   IDIVI   A,32.           ; CALCULATE NUMBER OF GROW BLOCKS NEEDED\r
 538         CAIE    B,0\r
 539         ADDI    A,1             ; COMPENSATE FOR EXTRA\r
 540         MOVEM   A,TYPIC\r
 541         POPJ    P,\r
 542 \r
 543 ; SET STORAGE INCREMENT\r
 544 \r
 545 SSTO:   IDIVI   A,2000          ; # OF BLOCKS\r
 546         CAIE    B,0             ; REMAINDER?\r
 547         ADDI    A,1\r
 548         IMULI   A,2000          ; CONVERT BACK TO WORDS\r
 549         MOVEM   A,STORIC\r
 550         POPJ P,\r
 551 \r
 552 \r
 553 ; GET NEXT (FIX) ARG\r
 554 \r
 555 NXTFIX: PUSHJ   P,GETFIX\r
 556         ADD     AB,[2,,2]\r
 557         POPJ    P,\r
 558 \r
 559 ; ROUTINE TO GET POS FIXED ARG\r
 560 \r
 561 GETFIX: GETYP   A,(AB)\r
 562         CAIE    A,TFIX\r
 563         JRST    WRONGT\r
 564         SKIPGE  A,1(AB)\r
 565         JRST    BADNUM\r
 566         POPJ    P,\r
 567 \r
 568 \r
 569 ; GET NUMBERS FIXED UP FOR GROWTH FIELDS\r
 570 \r
 571 NUMADJ: ADDI    A,77            ; ROUND UP\r
 572         ANDCMI  A,77            ; KILL CRAP\r
 573         MOVE    0,A\r
 574         MOVNS   A               ; COMPUTE ADD FACTOR FOR SPEC. POINTER UPDATE\r
 575         HRLI    A,-1(A)\r
 576         MOVEM   A,(B)           ; AND STASH IT\r
 577         MOVE    A,0\r
 578         ASH     A,-6            ; TO 64 WD BLOCKS\r
 579         CAILE   A,377           ; CHECK FIT\r
 580         JRST    OUTRNG\r
 581         POPJ    P,\r
 582 \r
 583 ; DO SYMPATHETIC GROWTHS\r
 584 \r
 585 SGROW1: HLRE    0,D\r
 586         SUB     D,0\r
 587         DPB     A,[111100,,(D)]\r
 588         POPJ    P,\r
 589 \r
 590 \f;FUNCTION TO CONSTRUCT A LIST\r
 591 \r
 592 MFUNCTION CONS,SUBR\r
 593 \r
 594         ENTRY   2\r
 595         GETYP   A,2(AB)         ;GET TYPE OF 2ND ARG\r
 596         CAIE    A,TLIST         ;LIST?\r
 597         JRST    WTYP2           ;NO , COMPLAIN\r
 598         MOVE    C,(AB)          ; GET THING TO CONS IN\r
 599         MOVE    D,1(AB)\r
 600         HRRZ    E,3(AB)         ; AND LIST\r
 601         PUSHJ   P,ICONS         ; INTERNAL CONS\r
 602         JRST    FINIS\r
 603 \r
 604 ; COMPILER CALL TO CONS\r
 605 \r
 606 CICONS: SUBM    M,(P)\r
 607         PUSHJ   P,ICONS\r
 608 MPOPJ:  SUBM    M,(P)\r
 609         POPJ    P,\r
 610 \r
 611 ; INTERNAL CONS TO NIL--INCONS\r
 612 \r
 613 INCONS: MOVEI   E,0\r
 614 \r
 615 ; INTERNAL CONS--ICONS;  C,D VALUE, E CDR\r
 616 \r
 617 ICONS:  GETYP   A,C             ; CHECK TYPE OF VAL\r
 618         PUSHJ   P,NWORDT        ; # OF WORDS\r
 619         SOJN    A,ICONS1        ; JUMP IF DEFERMENT NEEDED\r
 620         PUSHJ   P,ICELL2        ; NO DEFER, GET 2 WORDS FROM PAIR SPACE\r
 621         JRST    ICONS2          ; NO CORE, GO GC\r
 622         HRRI    C,(E)           ; SET UP CDR\r
 623 ICONS3: MOVEM   C,(B)           ; AND STORE\r
 624         MOVEM   D,1(B)\r
 625 TLPOPJ: MOVSI   A,TLIST\r
 626         POPJ    P,\r
 627 \r
 628 ; HERE IF CONSING DEFERRED\r
 629 \r
 630 ICONS1: MOVEI   A,4             ; NEED 4 WORDS\r
 631         PUSHJ   P,ICELL         ; GO GET 'EM\r
 632         JRST    ICONS2          ; NOT THERE, GC\r
 633         HRLI    E,TDEFER        ; CDR AND DEFER\r
 634         MOVEM   E,(B)           ; STORE\r
 635         MOVEI   E,2(B)          ; POINT E TO VAL CELL\r
 636         HRRZM   E,1(B)\r
 637         MOVEM   C,(E)           ; STORE VALUE\r
 638         MOVEM   D,1(E)\r
 639         JRST    TLPOPJ\r
 640 \r
 641 \r
 642 \r
 643 ; HERE TO GC ON A CONS\r
 644 \r
 645 ICONS2: PUSH    TP,C            ; SAVE VAL\r
 646         PUSH    TP,D\r
 647         PUSH    TP,$TLIST\r
 648         PUSH    TP,E            ; SAVE VITAL STUFF\r
 649         MOVEM   A,GETNUM        ; AMOUNT NEEDED\r
 650         MOVE    C,[3,,1]        ; INDICATOR FOR AGC\r
 651         PUSHJ   P,AGC           ; ATTEMPT TO WIN\r
 652         SKIPGE  A               ; SKIP IF WON\r
 653         PUSHJ   P,FULLOS\r
 654         MOVE    D,-2(TP)        ; RESTORE VOLATILE STUFF\r
 655         MOVE    C,-3(TP)\r
 656         MOVE    E,(TP)\r
 657         SUB     TP,[4,,4]\r
 658         JRST    ICONS           ; BACK TO DRAWING BOARD\r
 659 \r
 660 ; SUBROUTINE TO ALLOCATE WORDS IN PAIR SPACE.  CALLS AGC IF NEEDED\r
 661 \r
 662 CELL2:  MOVEI   A,2             ; USUAL CASE\r
 663 CELL:   PUSHJ   P,ICELL         ; INTERNAL\r
 664         JRST    .+2             ; LOSER\r
 665         POPJ    P,\r
 666 \r
 667         MOVEM   A,GETNUM        ; AMOUNT REQUIRED\r
 668         PUSH    P,A             ; PREVENT AGC DESTRUCTION\r
 669         MOVE    C,[3,,1]        ; INDICATOR FOR AGC\r
 670         PUSHJ   P,AGC\r
 671         SKIPGE  A               ; SKIP IF WINNER\r
 672         PUSHJ   P,FULLOS        ; REPORT TROUBLE\r
 673         POP     P,A\r
 674         JRST    CELL            ; AND TRY AGAIN\r
 675 \r
 676 ; INTERNAL CELL GETTER, SKIPS IF ROO EXISTS, ELSE DOESN'T\r
 677 \r
 678 ICELL2: MOVEI   A,2             ; MOST LIKELY CAE\r
 679 ICELL:  SKIPE   B,RCL\r
 680         JRST    ICELRC          ;SEE IF WE CAN RE-USE A RECYCLE CELL\r
 681         MOVE    B,PARTOP        ; GET TOP OF PAIRS\r
 682         ADDI    B,(A)           ; BUMP\r
 683         CAMLE   B,VECBOT        ; SKIP IF OK.\r
 684         POPJ    P,              ; LOSE\r
 685         EXCH    B,PARTOP        ; SETUP NEW PARTOP AND RETURN POINTER\r
 686         PUSH    P,B             ; MODIFY TOTAL # OF FREE WORDS\r
 687         MOVE    B,USEFRE\r
 688         ADDI    B,(A)\r
 689         MOVEM   B,USEFRE\r
 690         POP     P,B\r
 691         JRST    CPOPJ1          ; SKIP RETURN\r
 692 \r
 693 ICELRC: CAIE    A,2\r
 694         JRST    ICELL+2         ;IF HE DOESNT WANT TWO, USE OLD METHOD\r
 695         PUSH    P,A\r
 696         MOVE    A,(B)\r
 697         HRRZM   A,RCL\r
 698         POP     P,A\r
 699         SETZM   (B)             ;GIVE HIM A CLEAN RECYCLED CELL\r
 700         SETZM   1(B)\r
 701         JRST    CPOPJ           ;THAT IT\r
 702 \r
 703 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT\r
 704 \r
 705 NWORDT: PUSHJ   P,SAT           ;GET STORAGE ALLOC TYPE\r
 706 NWORDS: CAIG    A,NUMSAT        ; TEMPLATE?\r
 707         SKIPL   MKTBS(A)        ;-ENTRY IN TABLE MEANS 2 NEEDED\r
 708         SKIPA   A,[1]           ;NEED ONLY 1\r
 709         MOVEI   A,2             ;NEED 2\r
 710         POPJ    P,\r
 711 \r
 712 \f;FUNCTION TO BUILD A LIST OF MANY ELEMENTS\r
 713 \r
 714 MFUNCTION LIST,SUBR\r
 715         ENTRY\r
 716 \r
 717         PUSH    P,$TLIST\r
 718 LIST12: HLRE    A,AB            ;GET -NUM OF ARGS\r
 719         SKIPE   RCL             ;SEE IF WE WANT TO DO ONE AT A TIME\r
 720         JRST    LST12R          ;TO GET RECYCLED CELLS\r
 721         MOVNS   A               ;MAKE IT +\r
 722         JUMPE   A,LISTN         ;JUMP IF 0\r
 723         PUSHJ   P,CELL          ;GET NUMBER OF CELLS\r
 724         PUSH    TP,$TAB\r
 725         PUSH    TP,AB\r
 726         PUSH    TP,(P)  ;SAVE IT\r
 727         PUSH    TP,B\r
 728         SUB     P,[1,,1]\r
 729         LSH     A,-1            ;NUMBER OF REAL LIST ELEMENTS\r
 730 \r
 731 CHAINL: ADDI    B,2             ;LOOP TO CHAIN ELEMENTS\r
 732         HRRZM   B,-2(B)         ;CHAIN LAST ONE TO NEXT ONE\r
 733         SOJG    A,.-2           ;LOOP TIL ALL DONE\r
 734         CLEARM  B,-2(B)         ;SET THE  LAST CDR TO NIL\r
 735 \r
 736 ; NOW LOBEER THE DATA IN TO THE LIST\r
 737 \r
 738         MOVE    D,AB            ; COPY OF ARG POINTER\r
 739         MOVE    B,(TP)          ;RESTORE LIS POINTER\r
 740 LISTLP: GETYP   A,(D)           ;GET TYPE\r
 741         PUSHJ   P,NWORDT        ;GET NUMBER OF WORDS\r
 742         SOJN    A,LDEFER        ;NEED TO DEFER POINTER\r
 743         GETYP   A,(D)           ;NOW CLOBBER ELEMENTS\r
 744         HRLM    A,(B)\r
 745         MOVE    A,1(D)          ;AND VALUE..\r
 746         MOVEM   A,1(B)\r
 747 LISTL2: HRRZ    B,(B)           ;REST B\r
 748         ADD     D,[2,,2]        ;STEP ARGS\r
 749         JUMPL   D,LISTLP\r
 750 \r
 751         POP     TP,B\r
 752         POP     TP,A\r
 753         SUB     TP,[2,,2]       ; CLEANUP STACK\r
 754         JRST    FINIS\r
 755 \r
 756 \r
 757 LST12R: ASH     A,-1            ;ONE AT A TIME TO GET RECYCLED CELLS\r
 758         JUMPE   A,LISTN\r
 759         PUSH    P,A             ;SAVE COUNT ON STACK\r
 760         SETZB   C,D\r
 761         SETZM   E\r
 762         PUSHJ   P,ICONS\r
 763         MOVE    E,B             ;LOOP AND CHAIN TOGETHER\r
 764         AOSGE   (P)\r
 765         JRST    .-3\r
 766         PUSH    TP,-1(P)        ;PUSH ON THE TYPE WE WANT\r
 767         PUSH    TP,B\r
 768         SUB     P,[2,,2]        ;CLEAN UP AFTER OURSELVES\r
 769         JRST    LISTLP-2        ;AND REJOIN MAIN STREAM\r
 770 \r
 771 \r
 772 ; MAKE A DEFERRED POINTER\r
 773 \r
 774 LDEFER: PUSH    TP,$TLIST       ;SAVE CURRENT POINTER\r
 775         PUSH    TP,B\r
 776         MOVEM   D,1(TB)         ; SAVE ARG HACKER\r
 777         PUSHJ   P,CELL2\r
 778         MOVE    D,1(TB)\r
 779         GETYPF  A,(D)           ;GET FULL DATA\r
 780         MOVE    C,1(D)\r
 781         MOVEM   A,(B)\r
 782         MOVEM   C,1(B)\r
 783         MOVE    C,(TP)          ;RESTORE LIST POINTER\r
 784         MOVEM   B,1(C)          ;AND MAKE THIS BE THE VALUE\r
 785         MOVSI   A,TDEFER\r
 786         HLLM    A,(C)           ;AND STORE IT\r
 787         MOVE    B,C\r
 788         SUB     TP,[2,,2]\r
 789         JRST    LISTL2\r
 790 \r
 791 LISTN:  MOVEI   B,0\r
 792         POP     P,A\r
 793         JRST    FINIS\r
 794 \r
 795 ; BUILD A FORM\r
 796 \r
 797 MFUNCTION FORM,SUBR\r
 798 \r
 799         ENTRY\r
 800 \r
 801         PUSH    P,$TFORM\r
 802         JRST    LIST12\r
 803 \r
 804 \f; COMPILERS CALLS TO FORM AND LIST A/ COUNT ELEMENTS ON STACK\r
 805 \r
 806 IILIST: SUBM    M,(P)\r
 807         PUSHJ   P,IILST\r
 808         MOVSI   A,TLIST\r
 809         JRST    MPOPJ\r
 810 \r
 811 IIFORM: SUBM    M,(P)\r
 812         PUSHJ   P,IILST\r
 813         MOVSI   A,TFORM\r
 814         JRST    MPOPJ\r
 815 \r
 816 IILST:  JUMPE   A,IILST0        ; NIL WHATSIT\r
 817         PUSH    P,A\r
 818         MOVEI   E,0\r
 819 IILST1: POP     TP,D\r
 820         POP     TP,C\r
 821         PUSHJ   P,ICONS         ; CONS 'EM UP\r
 822         MOVEI   E,(B)\r
 823         SOSE    (P)             ; COUNT\r
 824         JRST    IILST1\r
 825 \r
 826         SUB     P,[1,,1]\r
 827         POPJ    P,\r
 828 \r
 829 IILST0: MOVEI   B,0\r
 830         POPJ    P,\r
 831 \r
 832 \f;FUNCTION TO BUILD AN IMPLICIT LIST\r
 833 \r
 834 MFUNCTION ILIST,SUBR\r
 835         ENTRY\r
 836         PUSH    P,$TLIST\r
 837 ILIST2: JUMPGE  AB,TFA          ;NEED AT LEAST ONE ARG\r
 838         CAMGE   AB,[-4,,0]      ;NO MORE THAN TWO ARGS\r
 839         JRST    TMA\r
 840         PUSHJ   P,GETFIX        ; GET POS FIX #\r
 841         JUMPE   A,LISTN         ;EMPTY LIST ?\r
 842         CAML    AB,[-2,,0]      ;ONLY ONE ARG?\r
 843         JRST    LOSEL           ;YES\r
 844         PUSH    P,A             ;SAVE THE CURRENT VALUE OF LENGTH FOR LOOP ITERATION\r
 845 ILIST0: PUSH    TP,2(AB)\r
 846         PUSH    TP,(AB)3\r
 847         MCALL   1,EVAL\r
 848         PUSH    TP,A\r
 849         PUSH    TP,B\r
 850         SOSLE   (P)\r
 851         JRST    ILIST0\r
 852         POP     P,C\r
 853 ILIST1: MOVE    C,(AB)+1        ;REGOBBLE LENGTH\r
 854         ACALL   C,LIST\r
 855 ILIST3: POP     P,A             ; GET FINAL TYPE\r
 856         JRST    FINIS\r
 857 \r
 858 \r
 859 LOSEL:  PUSH    P,A             ; SAVE COUNT\r
 860         MOVEI   E,0\r
 861 \r
 862 LOSEL1: SETZB   C,D             ; TLOSE,,0\r
 863         PUSHJ   P,ICONS\r
 864         MOVEI   E,(B)\r
 865         SOSLE   (P)\r
 866         JRST    LOSEL1\r
 867 \r
 868         SUB     P,[1,,1]\r
 869         JRST    ILIST3\r
 870 \r
 871 ; IMPLICIT FORM\r
 872 \r
 873 MFUNCTION IFORM,SUBR\r
 874 \r
 875         ENTRY\r
 876         PUSH    P,$TFORM\r
 877         JRST    ILIST2\r
 878 \r
 879 \f; IVECTOR AND IUVECTOR--GET VECTOR AND UVECTOR OF COMPUTED VALUES\r
 880 \r
 881 MFUNCTION VECTOR,SUBR,[IVECTOR]\r
 882 \r
 883         MOVEI   C,1\r
 884         JRST    VECTO3\r
 885 \r
 886 MFUNCTION UVECTOR,SUBR,[IUVECTOR]\r
 887 \r
 888         MOVEI   C,0\r
 889 VECTO3: ENTRY\r
 890         JUMPGE  AB,TFA          ; AT LEAST ONE ARG\r
 891         CAMGE   AB,[-4,,0]      ; NOT MORE THAN 2\r
 892         JRST    TMA\r
 893         PUSHJ   P,GETFIX        ; GET A POS FIXED NUMBER\r
 894         LSH     A,(C)           ; A-> NUMBER OF WORDS\r
 895         PUSH    P,C             ; SAVE FOR LATER\r
 896         PUSHJ   P,IBLOCK        ; GET BLOCK (TURN ON BIT APPROPRIATELY)\r
 897         POP     P,C\r
 898         HLRE    A,B             ; START TO\r
 899         SUBM    B,A             ; FIND DOPE WORD\r
 900         JUMPE   C,VECTO4\r
 901         MOVSI   D,400000        ; GET NOT UNIFORM BIT\r
 902         MOVEM   D,(A)           ; INTO DOPE WORD\r
 903         SKIPA   A,$TVEC         ; GET TYPE\r
 904 VECTO4: MOVSI   A,TUVEC\r
 905         CAML    AB,[-2,,0]      ; SKIP IF ARGS NEED TO BE HACKED\r
 906         JRST    FINIS\r
 907         JUMPGE  B,FINIS         ; DON'T EVAL FOR EMPTY CASE\r
 908 \r
 909         PUSH    TP,A            ; SAVE THE VECTOR\r
 910         PUSH    TP,B\r
 911         PUSH    TP,A\r
 912         PUSH    TP,B\r
 913 \r
 914         JUMPE   C,UINIT\r
 915         JUMPGE  B,FINIS         ; EMPTY VECTOR, LEAVE\r
 916 INLP:   PUSHJ   P,IEVAL         ; EVAL EXPR\r
 917         MOVEM   A,(C)\r
 918         MOVEM   B,1(C)\r
 919         ADD     C,[2,,2]        ; BUMP VECTOR\r
 920         MOVEM   C,(TP)\r
 921         JUMPL   C,INLP          ; IF MORE DO IT\r
 922 \r
 923 GETVEC: MOVE    A,-3(TP)\r
 924         MOVE    B,-2(TP)\r
 925         SUB     TP,[4,,4]\r
 926         JRST    FINIS\r
 927 \r
 928 ; HERE TO FILL UP A UVECTOR\r
 929 \r
 930 UINIT:  PUSHJ   P,IEVAL         ; HACK THE 1ST VALUE\r
 931         GETYP   A,A             ; GET TYPE\r
 932         PUSH    P,A             ; SAVE TYPE\r
 933         PUSHJ   P,NWORDT        ; SEE IF IT CAN BE UNIFORMED\r
 934         SOJN    A,CANTUN        ; COMPLAIN\r
 935 STJOIN: MOVE    C,(TP)          ; RESTORE POINTER\r
 936         ADD     C,1(AB)         ; POINT TO DOPE WORD\r
 937         MOVE    A,(P)           ; GET TYPE\r
 938         HRLZM   A,(C)           ; STORE IN D.W.\r
 939         MOVE    C,(TP)          ; GET BACK VECTOR\r
 940         SKIPE   1(AB)\r
 941         JRST    UINLP1          ; START FILLING UV\r
 942         JRST    GETVE1\r
 943 \r
 944 UINLP:  MOVEM   C,(TP)          ; SAVE PNTR\r
 945         PUSHJ   P,IEVAL         ; EVAL THE EXPR\r
 946         GETYP   A,A             ; GET EVALED TYPE\r
 947         CAIE    A,@(P)          ; WINNER?\r
 948         JRST    WRNGSU          ; SERVICE ERROR FOR UVECTOR,STORAGE\r
 949 UINLP1: MOVEM   B,(C)           ; STORE\r
 950         AOBJN   C,UINLP\r
 951 GETVE1: SUB     P,[1,,1]\r
 952         JRST    GETVEC          ; AND RETURN VECTOR\r
 953 \r
 954 IEVAL:  PUSH    TP,2(AB)\r
 955         PUSH    TP,3(AB)\r
 956         MCALL   1,EVAL\r
 957         MOVE    C,(TP)\r
 958         POPJ    P,\r
 959 \r
 960 ; ISTORAGE -- GET STORAGE OF COMPUTED VALUES\r
 961 \r
 962 MFUNCTION ISTORAGE,SUBR\r
 963         ENTRY\r
 964         JUMPGE  AB,TFA\r
 965         CAMGE   AB,[-4,,0]      ; AT LEAST ONE ARG\r
 966         JRST    TMA\r
 967         PUSHJ   P,GETFIX        ; POSITIVE COUNT FIRST ARG\r
 968         PUSHJ   P,CAFRE ; GET CORE\r
 969         MOVN    B,1(AB) ; -COUNT\r
 970         HRL     A,B     ; PUT IN LHW (A)\r
 971         MOVM    B,B     ; +COUNT\r
 972         HRLI    B,2(B)  ; LENGTH + 2\r
 973         ADDI    B,(A)   ; MAKE POINTER TO DOPE WORDS\r
 974         HLLZM   B,1(B)  ; PUT TOTAL LENGTH IN 2ND DOPE\r
 975         HRRM    A,1(B)  ; PUT ADDRESS IN RHW (STORE DOES THIS TOO).\r
 976         MOVE    B,A\r
 977         MOVSI   A,TSTORAGE\r
 978         CAML    AB,[-2,,0]      ; SECOND ARG TO EVAL?\r
 979         JRST FINIS      ; IF NOT, RETURN EMPTY\r
 980         PUSH    TP,A\r
 981         PUSH    TP,B\r
 982         PUSH    TP,A\r
 983         PUSH    TP,B\r
 984         PUSHJ   P,IEVAL ; EVALUATE FOR FIRST VALUE\r
 985         GETYP   A,A\r
 986         PUSH    P,A     ; FOR COMPARISON LATER\r
 987         PUSHJ   P,SAT\r
 988         CAIN    A,S1WORD\r
 989         JRST    STJOIN  ;TREAT LIKE A UVECTOR\r
 990         ; IF NOT 1-WORD TYPES, CANNOT STORE, SO COMPLAIN\r
 991         PUSHJ   P,FREESV        ; FREE STORAGE VECTOR\r
 992         PUSH    TP,$TATOM\r
 993         PUSH    TP,EQUOTE DATA-CAN'T-GO-IN-STORAGE\r
 994         JRST    CALER1\r
 995 \r
 996 ; FOR STORAGE, MUST FREE THE CORE ELSE IT IS LOST (NO GC)\r
 997 FREESV: MOVE    A,1(AB) ; GET COUNT\r
 998         ADDI    A,2     ; FOR DOPE\r
 999         HRRZ    B,(TP)  ; GET ADDRESS\r
1000         PUSHJ   P,CAFRET        ; FREE THE CORE\r
1001         POPJ    P,\r
1002 \r
1003 \f; INTERNAL VECTOR ALLOCATOR.  A/SIZE OF VECTOR (NOT INCLUDING DOPE WORDS)\r
1004 \r
1005 IBLOK1: ASH     A,1             ; TIMES 2\r
1006 GIBLOK: TLOA    A,400000        ; FUNNY BIT\r
1007 IBLOCK: TLZ     A,400000        ; NO BIT ON\r
1008         ADDI    A,2             ; COMPENSATE FOR DOPE WORDS\r
1009 IBLOK2: MOVE    B,VECBOT        ; POINT TO BOTTOM OF SPACE\r
1010         SUBI    B,(A)           ; SUBTRACT NEEDED AMOUNT\r
1011         CAMGE   B,PARTOP        ; SKIP IF NO GC NEEDED\r
1012         JRST    IVECT1\r
1013         EXCH    B,VECBOT        ; WIN, GET POINTER TO BLOCK AND UPDATE VECBOT\r
1014         PUSH    P,B\r
1015         MOVE    B,USEFRE\r
1016         ADDI    B,(A)\r
1017         MOVEM   B,USEFRE\r
1018         POP     P,B\r
1019         HRLZM   A,-1(B)         ; STORE LENGTH IN DOPE WORD\r
1020         HLLZM   A,-2(B)         ; AND BIT\r
1021         HRRO    B,VECBOT        ; POINT TO START OF VECTOR\r
1022         TLC     B,-3(A)         ; SETUP COUNT\r
1023         HRRI    A,TVEC\r
1024         SKIPL   A\r
1025         HRRI    A,TUVEC\r
1026         MOVSI   A,(A)\r
1027         POPJ    P,\r
1028 \r
1029 ; HERE TO DO A GC ON A VECTOR ALLOCATION\r
1030 \r
1031 IVECT1: PUSH    P,A             ; SAVE DESIRED LENGTH\r
1032         HRRZM   A,GETNUM        ; AND STORE AS DESIRED AMOUNT\r
1033         MOVE    C,[4,,1]        ; GET INDICATOR FOR AGC\r
1034         PUSHJ   P,AGC\r
1035         SKIPGE  A\r
1036         PUSHJ   P,FULLOS        ; LOST, COMPLAIN\r
1037         POP     P,A\r
1038         JRST    IBLOK2\r
1039 \r
1040 \r
1041 ; INTERNAL EVECTOR (CALLED FROM READ) A/ #OF THINGS\r
1042 ; ITEMS ON TOP OF STACK\r
1043 \r
1044 IEVECT: ASH     A,1             ; TO NUMBER OF WORDS\r
1045         PUSH    P,A\r
1046         PUSHJ   P,IBLOCK        ; GET VECTOR\r
1047         HLRE    D,B             ; FIND DW\r
1048         SUBM    B,D             ; A POINTS TO DW\r
1049         MOVSI   0,400000\r
1050         MOVEM   0,(D)           ; CLOBBER NON UNIF BIT\r
1051         POP     P,A             ; RESTORE COUNT\r
1052         JUMPE   A,IVEC1         ; 0 LNTH, DONE\r
1053         MOVEI   C,(TP)          ; BUILD BLT\r
1054         SUBI    C,(A)-1         ; C POINTS TO 1ST ITEM ON STACK\r
1055         MOVSI   C,(C)\r
1056         HRRI    C,(B)           ; B/ SOURCE,,DEST\r
1057         BLT     C,-1(D)         ; XFER THE DATA\r
1058         HRLI    A,(A)\r
1059         SUB     TP,A            ; FLUSH STACKAGE\r
1060 IVEC1:  MOVSI   A,TVEC\r
1061         POPJ    P,\r
1062         \r
1063 \r
1064 ; COMPILERS CALL\r
1065 \r
1066 CIVEC:  SUBM    M,(P)\r
1067         PUSHJ   P,IEVECT\r
1068         JRST    MPOPJ\r
1069 \r
1070 \r
1071 \f; INTERNAL CALL TO EUVECTOR\r
1072 \r
1073 IEUVEC: PUSH    P,A             ; SAVE LENGTH\r
1074         PUSHJ   P,IBLOCK\r
1075         MOVE    A,(P)\r
1076         JUMPE   A,IEUVE1        ; EMPTY, LEAVE\r
1077         ASH     A,1             ; NOW FIND STACK POSITION\r
1078         MOVEI   C,(TP)          ; POINT TO TOP\r
1079         MOVE    D,B             ; COPY VEC POINTER\r
1080         SUBI    C,-1(A)         ; POINT TO 1ST DATUM\r
1081         GETYP   A,(C)           ; CHECK IT\r
1082         PUSHJ   P,NWORDT\r
1083         SOJN    A,CANTUN        ; WONT FIT\r
1084         GETYP   E,(C)\r
1085 \r
1086 IEUVE2: GETYP   0,(C)           ; TYPE OF EL\r
1087         CAIE    0,(E)           ; MATCH?\r
1088         JRST    WRNGUT\r
1089         MOVE    0,1(C)\r
1090         MOVEM   0,(D)           ; CLOBBER\r
1091         ADDI    C,2\r
1092         AOBJN   D,IEUVE2        ; LOOP\r
1093         HRLZM   E,(D)           ; STORE UTYPE\r
1094 IEUVE1: POP     P,A             ; GET COUNY\r
1095         ASH     A,1             ; MUST FLUSH 2 TIMES # OF ELEMENTS\r
1096         HRLI    A,(A)\r
1097         SUB     TP,A            ; CLEAN UP STACK\r
1098         MOVSI   A,TUVEC\r
1099         POPJ    P,\r
1100 \r
1101 ; COMPILER'S CALL\r
1102 \r
1103 CIUVEC: SUBM    M,(P)\r
1104         PUSHJ   P,IEUVEC\r
1105         JRST    MPOPJ\r
1106 \r
1107 MFUNCTION EVECTOR,SUBR,[VECTOR]\r
1108         ENTRY\r
1109         HLRE    A,AB\r
1110         MOVNS   A\r
1111         PUSH    P,A             ;SAVE NUMBER OF WORDS\r
1112         PUSHJ   P,IBLOCK        ; GET WORDS\r
1113         MOVEI   D,-1(B)         ; SETUP FOR BLT AND DOPE CLOBBER\r
1114         JUMPGE  B,FINISV                ;DONT COPY A ZERO LENGTH VECTOR\r
1115 \r
1116         HRLI    C,(AB)          ;START BUILDING BLT POINTER\r
1117         HRRI    C,(B)           ;TO ADDRESS\r
1118         ADDI    D,@(P)          ;SET D TO FINAL ADDRESS\r
1119         BLT     C,(D)\r
1120 FINISV: MOVSI   0,400000\r
1121         MOVEM   0,1(D)          ; MARK AS GENERAL\r
1122         SUB     P,[1,,1]\r
1123         MOVSI   A,TVEC\r
1124         JRST    FINIS\r
1125 \r
1126 \r
1127 \r
1128 \f;EXPLICIT VECTORS FOR THE UNIFORM CSE\r
1129 \r
1130 MFUNCTION EUVECTOR,SUBR,[UVECTOR]\r
1131 \r
1132         ENTRY\r
1133         HLRE    A,AB            ;-NUM OF ARGS\r
1134         MOVNS   A\r
1135         ASH     A,-1            ;NEED HALF AS MANY WORDS\r
1136         PUSH    P,A\r
1137         JUMPGE  AB,EUV1         ; DONT CHECK FOR EMPTY\r
1138         GETYP   A,(AB)          ;GET FIRST ARG\r
1139         PUSHJ   P,NWORDT                ;SEE IF NEEDS EXTRA WORDS\r
1140         SOJN    A,CANTUN\r
1141 EUV1:   POP     P,A\r
1142         PUSHJ   P,IBLOCK        ; GET VECT\r
1143         JUMPGE  B,FINISU\r
1144 \r
1145         GETYP   C,(AB)          ;GET THE FIRST TYPE\r
1146         MOVE    D,AB            ;COPY THE ARG POINTER\r
1147         MOVE    E,B             ;COPY OF RESULT\r
1148 \r
1149 EUVLP:  GETYP   0,(D)           ;GET A TYPE\r
1150         CAIE    0,(C)           ;SAME?\r
1151         JRST    WRNGUT          ;NO , LOSE\r
1152         MOVE    0,1(D)          ;GET GOODIE\r
1153         MOVEM   0,(E)           ;CLOBBER\r
1154         ADD     D,[2,,2]        ;BUMP ARGS POINTER\r
1155         AOBJN   E,EUVLP\r
1156 \r
1157         HRLM    C,(E)           ;CLOBBER UNIFORM TYPE IN\r
1158 FINISU: MOVSI   A,TUVEC\r
1159         JRST    FINIS\r
1160 \r
1161 WRNGSU: GETYP   A,-1(TP)\r
1162         CAIE    A,TSTORAGE\r
1163         JRST    WRNGUT  ;IF UVECTOR\r
1164         PUSHJ   P,FREESV        ;FREE STORAGE VECTOR\r
1165         PUSH    TP,$TATOM\r
1166         PUSH    TP,EQUOTE TYPES-DIFFER-IN-STORAGE-OBJECT\r
1167         JRST    CALER1\r
1168 \r
1169         \r
1170 WRNGUT: PUSH    TP,$TATOM\r
1171         PUSH    TP,EQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR\r
1172         JRST    CALER1\r
1173 \r
1174 CANTUN: PUSH    TP,$TATOM\r
1175         PUSH    TP,EQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR\r
1176         JRST    CALER1\r
1177 \r
1178 BADNUM: PUSH    TP,$TATOM\r
1179         PUSH    TP,EQUOTE NEGATIVE-ARGUMENT\r
1180         JRST    CALER1\r
1181 \f; FUNCTION TO GROW A VECTOR\r
1182 \r
1183 MFUNCTION GROW,SUBR\r
1184 \r
1185         ENTRY   3\r
1186 \r
1187         MOVEI   D,0             ;STACK HACKING FLAG\r
1188         GETYP   A,(AB)          ;FIRST TYPE\r
1189         PUSHJ   P,SAT           ;GET STORAGE TYPE\r
1190         GETYP   B,2(AB)         ;2ND ARG\r
1191         CAIE    A,STPSTK        ;IS IT ASTACK\r
1192         CAIN    A,SPSTK\r
1193         AOJA    D,GRSTCK        ;YES, WIN\r
1194         CAIE    A,SNWORD        ;UNIFORM VECTOR\r
1195         CAIN    A,S2NWORD       ;OR GENERAL\r
1196 GRSTCK: CAIE    B,TFIX          ;IS 2ND FIXED\r
1197         JRST    WTYP2           ;COMPLAIN\r
1198         GETYP   B,4(AB)\r
1199         CAIE    B,TFIX          ;3RD ARG\r
1200         JRST    WTYP3           ;LOSE\r
1201 \r
1202         MOVEI   E,1             ;UNIFORM/GENERAL FLAG\r
1203         CAIE    A,SNWORD        ;SKIP IF UNIFORM\r
1204         CAIN    A,SPSTK         ;DONT SKIP IF UNIFORM PDL\r
1205         MOVEI   E,0\r
1206 \r
1207         HRRZ    B,1(AB)         ;POINT TO START\r
1208         HLRE    A,1(AB)         ;GET -LENGTH\r
1209         SUB     B,A             ;POINT TO DOPE WORD\r
1210         SKIPE   D               ;SKIP IF NOT STACK\r
1211         ADDI    B,PDLBUF        ;FUDGE FOR PDL\r
1212         HLLZS   (B)             ;ZERO OUT GROWTH SPECS\r
1213         SKIPN   A,3(AB)         ;ANY TOP GROWTH?\r
1214         JRST    GROW1           ;NO, LOOK FOR BOTTOM GROWTH\r
1215         ASH     A,(E)           ;MULT BY 2 IF GENERAL\r
1216         ADDI    A,77            ;ROUND TO NEAREST BLOCK\r
1217         ANDCMI  A,77            ;CLEAR LOW ORDER BITS\r
1218         ASH     A,9-6           ;DIVIDE BY 100 AND SHIFT TO POSTION\r
1219         TRZE    A,400000        ;CONVERT TO SIGN MAGNITUDE\r
1220         MOVNS   A\r
1221         TLNE    A,-1            ;SKIP IF NOT TOO BIG\r
1222         JRST    GTOBIG          ;ERROR\r
1223 GROW1:  SKIPN   C,5(AB)         ;CHECK LOW GROWTH\r
1224         JRST    GROW4           ;NONE, SKIP\r
1225         ASH     C,(E)           ;GENRAL FUDGE\r
1226         ADDI    C,77            ;ROUND\r
1227         ANDCMI  C,77            ;FUDGE FOR VALUE RETURN\r
1228         PUSH    P,C             ;AND SAVE\r
1229         ASH     C,-6            ;DIVIDE BY 100\r
1230         TRZE    C,400           ;CONVERT TO SIGN MAGNITUDE\r
1231         MOVNS   C\r
1232         TDNE    C,[-1,,777000]  ;CHECK FOR OVERFLOW\r
1233         JRST    GTOBIG\r
1234 GROW2:  HLRZ    E,1(B)          ;GET TOTAL LENGTH OF VECTOR\r
1235         MOVNI   E,-1(E)\r
1236         HRLI    E,(E)           ;TO BOTH HALVES\r
1237         ADDI    E,1(B)          ;POINTS TO TOP\r
1238         SKIPE   D               ;STACK?\r
1239         ADD     E,[PDLBUF,,0]   ;YES, FUDGE LENGTH\r
1240         SKIPL   D,(P)           ;SHRINKAGE?\r
1241         JRST    GROW3           ;NO, CONTINUE\r
1242         MOVNS   D               ;PLUSIFY\r
1243         HRLI    D,(D)           ;TO BOTH HALVES\r
1244         ADD     E,D             ;POINT TO NEW LOW ADDR\r
1245 GROW3:  IORI    A,(C)           ;OR TOGETHER\r
1246         HRRM    A,(B)           ;DEPOSIT INTO DOPEWORD\r
1247         PUSH    TP,(AB)         ;PUSH TYPE\r
1248         PUSH    TP,E            ;AND VALUE\r
1249         JUMPE   A,.+3           ;DON'T GC FOR NOTHING\r
1250         MOVE    C,[2,,0]        ; GET INDICATOR FOR AGC\r
1251         PUSHJ   P,AGC\r
1252         JUMPL   A,GROFUL\r
1253         POP     P,C             ;RESTORE GROWTH\r
1254         HRLI    C,(C)\r
1255         POP     TP,B            ;GET VECTOR POINTER\r
1256         SUB     B,C             ;POINT TO NEW TOP\r
1257         POP     TP,A\r
1258         JRST    FINIS\r
1259 \r
1260 GROFUL: SUB     P,[1,,1]        ; CLEAN UP STACK\r
1261         SUB     TP,[2,,2]\r
1262         PUSHJ   P,FULLOS\r
1263         JRST    GROW\r
1264 \r
1265 GTOBIG: PUSH    TP,$TATOM\r
1266         PUSH    TP,EQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH\r
1267         JRST    CALER1\r
1268 GROW4:  PUSH    P,[0]           ;0 BOTTOM GROWTH\r
1269         JRST    GROW2\r
1270 \r
1271 FULLOS: PUSH    TP,$TATOM       ; GENERATE ERROR\r
1272         PUSH    TP,@ERRTB(A)\r
1273         AOJL    A,CALER1        ; IF BAD, CALL ERROR\r
1274         SKIPN   GCMONF\r
1275         POPJ    P,\r
1276         PUSH    TP,TTOCHN(TVP)  ; FORCE MESSAGES TO TTY\r
1277         PUSH    TP,TTOCHN+1(TVP)\r
1278         PUSH    TP,TTOCHN(TVP)  ; FORCE MESSAGES TO TTY\r
1279         PUSH    TP,TTOCHN+1(TVP)\r
1280         MCALL   1,TERPRI        ; JUST PRINT MESSAGE\r
1281         MCALL   2,PRINC\r
1282         POPJ    P,\r
1283 \r
1284 \r
1285         EQUOTE  STILL-NO-STORAGE\r
1286         EQUOTE  NO-STORAGE\r
1287         EQUOTE  STORAGE-LOW\r
1288 ERRTB==.\r
1289 \f; SUBROUTINE TO BUILD CHARACTER STRING GOODIES\r
1290 \r
1291 MFUNCTION STRING,SUBR\r
1292 \r
1293         ENTRY\r
1294 \r
1295         MOVE    B,AB            ;COPY ARG POINTER\r
1296         MOVEI   C,0             ;INITIALIZE COUNTER\r
1297         PUSH    TP,$TAB         ;SAVE A COPY\r
1298         PUSH    TP,B\r
1299         HLRE    A,B             ; GET # OF ARGS\r
1300         MOVNS   A\r
1301         ASH     A,-1            ; 1/2 FOR # OF ARGS\r
1302         PUSHJ   P,IISTRN\r
1303         JRST    FINIS\r
1304 \r
1305 IISTRN: SKIPN   E,A             ; SKIP IF ARGS EXIST\r
1306         JRST    MAKSTR          ; ALL DONE\r
1307 \r
1308 STRIN2: GETYP   D,(B)           ;GET TYPE CODE\r
1309         CAIN    D,TCHRS         ;SINGLE CHARACTER?\r
1310         AOJA    C,STRIN1\r
1311         CAIE    D,TCHSTR        ;OR STRING\r
1312         JRST    WRONGT          ;NEITHER\r
1313         HRRZ    D,(B)           ; GET CHAR COUNT\r
1314         ADDI    C,(D)           ; AND BUMP\r
1315 \r
1316 STRIN1: ADD     B,[2,,2]\r
1317         SOJG    A,STRIN2\r
1318 \r
1319 ; NOW GET THE NECESSARY VECTOR\r
1320 \r
1321 MAKSTR: PUSH    P,C             ; SAVE CHAR COUNT\r
1322         PUSH    P,E             ; SAVE ARG COUNT\r
1323         MOVEI   A,4(C)          ; LNTH+4 TO A\r
1324         IDIVI   A,5\r
1325         PUSHJ   P,IBLOCK\r
1326 \r
1327         POP     P,A\r
1328         JUMPGE  B,DONEC         ; 0 LENGTH, NO STRING\r
1329         HRLI    B,440700        ;CONVERT B TO A BYTE POINTER\r
1330         MOVE    C,(TP)          ; POINT TO ARGS AGAIN\r
1331 \r
1332 NXTRG1: GETYP   D,(C)           ;GET AN ARG\r
1333         CAIE    D,TCHRS\r
1334         JRST    TRYSTR\r
1335         MOVE    D,1(C)                  ; GET IT\r
1336         IDPB    D,B             ;AND DEPOSIT IT\r
1337         JRST    NXTARG\r
1338 \r
1339 TRYSTR: MOVE    E,1(C)          ;GET BYTER\r
1340         HRRZ    0,(C)           ;AND COUNT\r
1341 NXTCHR: SOJL    0,NXTARG        ; IF RUNOUT, GET NEXT ARG\r
1342         ILDB    D,E             ;AND GET NEXT\r
1343         IDPB    D,B             ; AND DEPOSIT SAME\r
1344         JRST    NXTCHR\r
1345 \r
1346 NXTARG: ADD     C,[2,,2]        ;BUMP ARG POINTER\r
1347         SOJG    A,NXTRG1\r
1348         ADDI    B,1\r
1349 \r
1350 DONEC:  MOVSI   C,TCHRS\r
1351         HLLM    C,(B)           ;AND CLOBBER AWAY\r
1352         HLRZ    C,1(B)          ;GET LENGTH BACK\r
1353         POP     P,A\r
1354         HRLI    A,TCHSTR\r
1355         SUBI    B,-2(C)\r
1356         HRLI    B,440700                ;MAKE A BYTE POINTER\r
1357         POPJ    P,\r
1358 \r
1359 ; COMPILER'S CALL TO MAKE A STRING\r
1360 \r
1361 CISTNG: SUBM    M,(P)\r
1362         MOVEI   C,0             ; INIT CHAR COUNTER\r
1363         MOVEI   B,(A)           ; SET UP STACK POINTER\r
1364         ASH     B,1             ; * 2 FOR NO. OF SLOTS\r
1365         HRLI    B,(B)\r
1366         SUBM    TP,B            ; B POINTS TO ARGS\r
1367         ADD     B,[1,,1]\r
1368         PUSH    TP,$TTP\r
1369         PUSH    TP,B\r
1370         PUSHJ   P,IISTRN        ; MAKE IT HAPPEN\r
1371         POP     TP,TP           ; FLUSH ARGS\r
1372         SUB     TP,[1,,1]\r
1373         JRST    MPOPJ\r
1374 \f;BUILD IMPLICT STRING\r
1375 \r
1376 MFUNCTION ISTRING,SUBR\r
1377 \r
1378         ENTRY\r
1379         JUMPGE  AB,TFA          ; TOO FEW ARGS\r
1380         CAMGE   AB,[-4,,0]      ; VERIFY NOT TOO MANY ARGS\r
1381         JRST    TMA\r
1382         PUSHJ   P,GETFIX\r
1383         ADDI    A,4\r
1384         IDIVI   A,5             ; # OF WORDS NEEDED TO A\r
1385         PUSH    TP,$TFIX\r
1386         PUSH    TP,A\r
1387         MCALL   1,UVECTOR       ; GET SAME\r
1388         HLRE    C,B             ; -LENGTH TO C\r
1389         SUBM    B,C             ; LOCN OF DOPE WORD TO C\r
1390         HRLI    D,TCHRS         ; CLOBBER ITS TYPE\r
1391         HLLM    D,(C)\r
1392         MOVSI   A,TCHSTR\r
1393         HRR     A,1(AB)         ; SETUP TYPE'S RH\r
1394         HRLI    B,440700        ; AND BYTE POINTER\r
1395         SKIPE   (AB)+1          ; SKIP IF NO CHARACTERS TO DEPOSIT\r
1396         CAML    AB,[-2,,0]      ; SKIP IF 2 ARGS GIVEN\r
1397         JRST    FINIS\r
1398         PUSH    TP,A            ;SAVE OUR STRING\r
1399         PUSH    TP,B\r
1400         PUSH    TP,A            ;SAVE A TEMPORARY CLOBBER POINTER\r
1401         PUSH    TP,B\r
1402         PUSH    P,(AB)1         ;SAVE COUNT\r
1403 CLOBST: PUSH    TP,(AB)+2\r
1404         PUSH    TP,(AB)+3\r
1405         MCALL   1,EVAL\r
1406         GETYP   C,A             ; CHECK IT\r
1407         CAIE    C,TCHRS         ; MUST BE A CHARACTER\r
1408         JRST    WTYP2\r
1409         IDPB    B,(TP)          ;CLOBBER\r
1410         SOSLE   (P)             ;FINISHED?\r
1411         JRST    CLOBST          ;NO\r
1412         SUB     P,[1,,1]\r
1413         SUB     TP,[4,,4]\r
1414         MOVE    A,(TP)+1\r
1415         MOVE    B,(TP)+2\r
1416         JRST    FINIS\r
1417 \r
1418 \r
1419 \fAGC":\r
1420 ;SET FLAG FOR INTERRUPT HANDLER\r
1421 \r
1422         SETZB   M,RCL           ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR\r
1423         PUSH    P,B\r
1424         PUSH    P,A\r
1425         PUSH    P,C             ; SAVE C\r
1426         PUSHJ   P,CTIME         ; GET TIME FOR GIN-GOUT\r
1427         MOVEM   B,GCTIM         ; SAVE FOR LATER\r
1428         MOVEI   B,[ASCIZ /GIN /]\r
1429         SKIPE   GCMONF\r
1430         PUSHJ   P,MSGTYP\r
1431 NOMON1: HRRZ    C,(P)           ; GET CAUSE OF GC INDICATOR\r
1432         MOVE    B,GCNO(C)       ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON\r
1433         ADDI    B,1\r
1434         MOVEM   B,GCNO(C)\r
1435         MOVEM   C,GCCAUS        ; SAVE CAUSE OF GC\r
1436         SKIPN   GCMONF          ; MONITORING\r
1437         JRST    NOMON2\r
1438         MOVE    B,MSGGCT(C)     ; GET CAUSE MESSAGE\r
1439         PUSHJ   P,MSGTYP\r
1440 NOMON2: HLRZ    C,(P)           ; FIND OUT WHO CAUSED THE GC\r
1441         MOVEM   C,GCCALL        ; SAVE CALLER OF GC\r
1442         SKIPN   GCMONF          ; MONITORING\r
1443         JRST    NOMON3\r
1444         MOVE    B,MSGGFT(C)\r
1445         PUSHJ   P,MSGTYP\r
1446 NOMON3: SUB     P,[1,,1]        ; POP OFF C\r
1447         POP     P,A\r
1448         POP     P,B\r
1449         JRST    .+1\r
1450 AAGC:   SETZB   M,RCL           ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION\r
1451 INITGC: SETOM   GCFLG\r
1452 \r
1453 ;SAVE AC'S\r
1454         IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,PVP]\r
1455         MOVEM   AC,AC!STO"+1(PVP)\r
1456         TERMIN\r
1457 \r
1458 ; FUDGE NOWFRE FOR LATER WINNING\r
1459 \r
1460         MOVE    0,NOWFRE\r
1461         SUB     0,VECBOT\r
1462         ADD     0,PARTOP\r
1463         MOVEM   0,NOWFRE\r
1464 \r
1465 ; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU\r
1466 \r
1467         HRRZ    A,FSAV(TB)      ; GET NAME OF CURRENT GOODIE\r
1468         SETZM   CURPLN          ; CLEAR FOR NONE\r
1469         CAML    A,PURTOP        ; IF LESS THAN TOP OF PURE ASSUME RSUBR\r
1470         JRST    NRSUBR\r
1471         GETYP   0,(A)           ; SEE IF PURE\r
1472         CAIE    0,TPCODE        ; SKIP IF IT IS\r
1473         JRST    NRSUBR\r
1474         HLRZ    B,1(A)          ; GET SLOT INDICATION\r
1475         ADD     B,PURVEC+1(TVP) ; POINT TO SLOT\r
1476         HRROS   2(B)            ; MUNG AGE\r
1477         HLRE    A,1(B)          ; - LENGTH TO A\r
1478         MOVNM   A,CURPLN        ; AND STORE\r
1479 NRSUBR:\r
1480 \r
1481 ;SET UP E TO POINT TO TYPE VECTOR\r
1482         GETYP   E,TYPVEC(TVP)\r
1483         CAIE    E,TVEC\r
1484         JRST    AGCE1\r
1485         HRRZ    TYPNT,TYPVEC+1(TVP)\r
1486         HRLI    TYPNT,B\r
1487 \r
1488 CHPDL:  MOVE    D,P             ; SAVE FOR LATER\r
1489         MOVE    P,GCPDL         ;GET GC'S PDL\r
1490 CORGET: MOVE    A,P.TOP         ; UPDATE CORTOP\r
1491         MOVEM   A,CORTOP\r
1492         MOVE    A,VECTOP        ; ROOM BETWEEN CORTOP AND VECTOP IS GC MARK PDL\r
1493         SUB     A,CORTOP\r
1494         MOVSS   A       ; BUILD A PDL POINTER\r
1495         ADD     A,VECTOP\r
1496         JUMPGE  A,TRYCOR        ; NO ROOM, GO GET SOME\r
1497         MOVE    P,A             ; SET UP PDL POINTER\r
1498 \r
1499 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK\r
1500 \r
1501         MOVEI   A,(TB)          ;POINT TO CURRENT FRAME IN PROCESS\r
1502         PUSHJ   P,FRMUNG        ;AND MUNG IT\r
1503         MOVE    A,TP            ;THEN TEMPORARY PDL\r
1504         PUSHJ   P,PDLCHK\r
1505         MOVE    A,PSTO+1(PVP)   ;AND UNMARKED P STACK\r
1506         PUSHJ   P,PDLCHP\r
1507 \r
1508 \f; FIRST CREATE INFERIOR TO HOLD NEW PAGES\r
1509 \r
1510 INFCRT: MOVE    A,PARBOT        ; GENERATE NEW PARBOT AND PARNEW\r
1511         ADD     A,PARNEW\r
1512         ADDI    A,1777\r
1513         ANDCMI  A,1777          ; EVEN PAGE BOUNDARY\r
1514         HRRM    A,BOTNEW        ; INTO POINTER WORD\r
1515         MOVEM   A,WNDBOT\r
1516         MOVEI   0,2000(A)       ; BOUNDS OF WINDOW\r
1517         MOVEM   0,WNDTOP\r
1518         SUB     A,PARBOT\r
1519         MOVEM   A,PARNEW        ; FIXED UP PARNEW\r
1520         HRRZ    A,BOTNEW        ; GET PAGE TO START INF AT\r
1521         ASH     A,-10.          ; TO PAGES\r
1522         PUSHJ   P,%GCJOB        ; GET PAGE HOLDER\r
1523         MOVSI   FPTR,-2000      ; FIX UP FRONTIER POINTER\r
1524 \r
1525 ;MARK PHASE: MARK ALL LISTS AND VECTORS\r
1526 ;POINTED TO WITH ONE BIT IN SIGN BIT\r
1527 ;START AT TRANSFER VECTOR\r
1528 \r
1529         SETZB   LPVP,VECNUM     ;CLEAR NUMBER OF VECTOR WORDS\r
1530         SETZB   PARNUM  ;CLEAR NUMBER OF PAIRS\r
1531         MOVEI   0,NGCS          ; SEE IF NEED HAIR\r
1532         SOSGE   GCHAIR\r
1533         MOVEM   0,GCHAIR        ; RESUME COUNTING\r
1534         SETZM   GREW            ; ASSUME NO GROW/SHRINK\r
1535         SETZM   SHRUNK\r
1536         MOVSI   D,400000        ;SIGN BIT FOR MARKING\r
1537         MOVE    A,ASOVEC+1(TVP) ;MARK ASSOC. VECTOR NOW\r
1538         PUSHJ   P,PRMRK         ; PRE-MARK\r
1539         MOVE    A,GLOBSP+1(TVP)\r
1540         PUSHJ   P,PRMRK\r
1541 \r
1542 ; HAIR TO DO AUTO CHANNEL CLOSE\r
1543 \r
1544         MOVEI   0,N.CHNS-1      ; NUMBER OF CHANNELS\r
1545         MOVEI   A,CHNL1(TVP)    ; 1ST SLOT\r
1546 \r
1547         SKIPE   1(A)            ; NOW A CHANNEL?\r
1548         SETZM   (A)             ; DON'T MARK AS CHANNELS\r
1549         ADDI    A,2\r
1550         SOJG    0,.-3\r
1551 \r
1552         MOVE    A,PVP           ;START AT PROCESS VECTOR\r
1553         MOVEI   B,TPVP          ;IT IS A PROCESS VECTOR\r
1554         PUSHJ   P,MARK          ;AND MARK THIS VECTOR\r
1555         MOVEI   B,TPVP\r
1556         MOVE    A,MAINPR        ; MARK MAIN PROCES EVEN IF SWAPPED OUT\r
1557         PUSHJ   P,MARK\r
1558 \r
1559 ; ASSOCIATION AND VALUE FLUSHING PHASE\r
1560 \r
1561         SKIPN   GCHAIR          ; ONLY IF HAIR\r
1562         PUSHJ   P,VALFLS\r
1563 \r
1564         SKIPE   GCHAIR          ; IF NOT HAIR, DO CHANNELS NOW\r
1565         PUSHJ   P,CHNFLS\r
1566 \r
1567 ;OPTIONAL RETIMING PHASE\r
1568 ;THIS HAS BEEN FLUSHED BECAUSE OF PLANNER\r
1569         REPEAT 0,[\r
1570         SKIPE   A,TIMOUT        ;ANY TIME OVERFLOWS\r
1571         PUSHJ   P,RETIME        ;YES, RE-CALIBRATE THEM\r
1572 ]\r
1573 ;UPDATE PARTOP\r
1574 \r
1575         MOVEI   A,@BOTNEW\r
1576         SUB     A,PARNEW\r
1577         MOVEM   A,PARTOP\r
1578 \r
1579 ;CORE ADJUSTMENT PHASE\r
1580         MOVE    P,GCPDL ; GET A PDL\r
1581         SETZM   CORSET          ;CLEAR LATER CORE SETTING\r
1582         PUSHJ   P,CORADJ        ;AND MAKE CORE ADJUSTMENTS\r
1583 \r
1584 ;RELOCATION ESTABLISHMENT PHASE\r
1585 ;1 -- IN VECTOR SPACE, ESTABLISH POINTERS TO TOP OF CORE\r
1586         MOVE    A,VECTOP"       ;START AT TOP OF VECTOR SPACE\r
1587         MOVE    B,VECNEW"       ;AND SET TO INITIAL OFFSET\r
1588         SUBI    A,1             ;POINT TO DOPE WORDS\r
1589         ADDI    B,(A)           ; WHERE TOP VECTOR WILL GO\r
1590         PUSHJ   P,VECREL        ;AND ESTABLISH RELOCATION FOR VECTORS\r
1591         SUBI    B,(A)           ; RE-RELATIVIZE VECNEW\r
1592         MOVEM   B,VECNEW        ;SAVE FINAL OFFSET\r
1593 \r
1594 \r
1595 \f; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE\r
1596 \r
1597         MOVE    B,PARTOP        ; POINT TO TOP OF PAIRS\r
1598         ADDI    B,2000\r
1599         ANDCMI  B,1777\r
1600         CAMGE   B,VECBOT        ; OVERLAP VECTORS\r
1601         JRST    DOMAP\r
1602         MOVE    C,VECBOT\r
1603         ANDI    C,1777          ; REL TO PAGE\r
1604         ADDI    C,FRONT         ; 1ST DEST WORD\r
1605         HRL     C,VECBOT\r
1606         BLT     C,FRONT+1777    ; MUNG IT\r
1607 \r
1608 DOMAP:  ASH     B,-10.          ; TO PAGES\r
1609         MOVE    A,PARBOT\r
1610         MOVEI   C,(A)           ; COMPUTE HIS TOP\r
1611         ADD     C,PARNEW\r
1612         ASH     C,-10.\r
1613         ASH     A,-10.\r
1614         SUBM    A,B             ; B==> - # OF PAGES\r
1615         HRLI    A,(B)           ; AOBJN TO SOURCE AND DEST\r
1616         MOVE    B,A             ; IN CASE OF FUNNY\r
1617         HRRI    B,(C)           ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES\r
1618         PUSHJ   P,%INFMP        ; NOW FLUSH INF AND MAKE HIS CORE MINE\r
1619 \r
1620 \f;POINTER UPDATE PHASE\r
1621 ;1 -- UPDATE ALL PAIR POINTERS\r
1622         MOVE    A,PARBOT        ;START AT BOTTOM OF PAIR SPACE\r
1623         PUSHJ   P,PARUPD        ;AND UPDATE ALL PAIR POINTERS\r
1624 \r
1625 ;2 -- UPDATE ALL VECTORS\r
1626         MOVE    A,VECTOP        ;START AT TOP OF VECTOR SPACE\r
1627         PUSHJ   P,VECUPD        ;AND UPDATE THE POINTERS\r
1628         MOVE    A,CODTOP        ; NOW UPDATE STORAGE STUFF\r
1629         MOVEI   D,0             ; FAKE OUT TO NOT UNMARK\r
1630         PUSHJ   P,STOUP\r
1631         MOVSI   D,400000\r
1632 \r
1633 ;3 -- UPDATE THE PVP AC\r
1634         MOVEI   A,PVP-1         ;SET LOC TO POINT TO PVP\r
1635         MOVE    C,PVP           ;GET THE DATUM\r
1636         PUSHJ   P,NWRDUP        ;AND UPDATE THIS VALUE\r
1637 ;4 -- UPDATE THE MAIN PROCESS POINTER\r
1638         MOVEI   A,MAINPR-1      ;POINT TO MAIN PROCESS POINTER\r
1639         MOVE    C,MAINPR        ;GET CONTENTS IN C\r
1640         PUSHJ   P,NWRDUP        ;AND UPDATE IT\r
1641 ;DATA MOVEMMENT ANDCLEANUP PHASE\r
1642 \r
1643 ;1 -- ADJUST FOR SHRINKING VECTORS\r
1644         MOVE    A,VECTOP        ;VECTOR SHRINKING PHASE\r
1645         SKIPE   SHRUNK          ; SKIP IF NO SHRINKERS\r
1646         PUSHJ   P,VECSH         ;GO SHRINK ANY SHRINKERS\r
1647 \r
1648 ;2 -- MOVE VECTORS (AND LIST ELEMENTS)\r
1649         MOVE    A,VECTOP        ;START AT TOP OF VECTOR SPACE\r
1650         PUSHJ   P,VECMOVE       ;AND MOVE THE VECTORS\r
1651         MOVE    A,VECNEW        ;GET FINAL CHANGE TO VECBOT\r
1652         ADDM    A,VECBOT        ;OFFSET VECBOT TO ITS NEW PLACE\r
1653         MOVE    A,CORTOP        ;GET NEW VALUE FOR TOP OF VECTOR SPACE\r
1654         SUBI    A,2000          ; FUDGE FOR MARK PDL\r
1655         MOVEM   A,VECTOP        ;AND UPDATE VECTOP\r
1656 \r
1657 ;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP)\r
1658 \r
1659         SKIPE   GREW            ; SKIP IF NO GROWERS\r
1660         PUSHJ   P,VECZER        ;\r
1661         PUSHJ   P,STOGC\r
1662 \r
1663 ;GARBAGE ZEROING PHASE\r
1664 GARZER: MOVE    A,PARTOP        ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE\r
1665         HRLS    A               ;GET FIRST ADDRESS IN LEFT HALF\r
1666         MOVE    B,VECBOT        ;LAST ADDRESS OF GARBAGE + 1\r
1667         CLEARM  (A)             ;ZERO   THE FIRST WORD\r
1668         ADDI    A,1             ;MAKE A A BLT POINTER\r
1669         BLT     A,-1(B)         ;AND COPY ZEROES INTO REST OF AREA\r
1670 \r
1671 ;FINAL CORE ADJUSTMENT\r
1672         SKIPE   A,CORSET        ;IFLESS CORE NEEDED\r
1673         PUSHJ   P,CORADL        ;GIVE SOME AWAY.\r
1674 \r
1675 ;NOW REHASH THE ASSOCIATIONS BASED ON NEW VALUES\r
1676 \r
1677         PUSHJ   P,REHASH\r
1678 \r
1679 \f;RESTORE AC'S\r
1680 TRYCOX: MOVE    0,VECBOT\r
1681         SUB     0,PARTOP\r
1682         ADDM    0,NOWFRE\r
1683         SKIPN   GCMONF\r
1684         JRST    NOMONO\r
1685         MOVEI   B,[ASCIZ /GOUT /]\r
1686         PUSHJ   P,MSGTYP\r
1687 NOMONO: IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,PVP,TVP]\r
1688         MOVE    AC,AC!STO+1(PVP)\r
1689         TERMIN\r
1690 ; CLOSING ROUTINE FOR G-C\r
1691         PUSH    P,A             ; SAVE AC'C\r
1692         PUSH    P,B\r
1693         PUSH    P,C\r
1694         PUSH    P,D\r
1695         PUSHJ   P,CTIME\r
1696         PUSHJ   P,FIXSEN        ; OUTPUT TIME\r
1697         SKIPN   GCMONF\r
1698         JRST    GCCONT\r
1699         MOVEI   A,15            ; OUTPUT C/R LINE-FEED\r
1700         PUSHJ   P,MTYO\r
1701         MOVEI   A,12\r
1702         PUSHJ   P,MTYO\r
1703 GCCONT: POP     P,D             ; RESTORE AC'C\r
1704         POP     P,C\r
1705         POP     P,B\r
1706         POP     P,A\r
1707         MOVE    A,GCDANG        ; ERROR LEVELS TO ACS\r
1708         ADD     A,GCDNTG\r
1709         SETZM   GCDANG          ; NOW CLEAR SAME\r
1710         SETZM   GCDNTG\r
1711         JUMPGE  A,AGCWIN\r
1712         SKIPN   GCHAIR          ; WAS IT A FLUSHER?\r
1713         JRST    AGCWIN          ; YES, NO MORE AVAILABLE\r
1714         MOVEI   A,1\r
1715         MOVEM   A,GCHAIR        ; RE-DO WITH HAIR\r
1716         MOVE    A,SPARNW        ; RESET PARNEW\r
1717         MOVEM   A,PARNEW\r
1718         SETZM   SPARNW\r
1719         MOVE    C,[11,10.]      ; INDICATOR FOR AGC\r
1720         JRST    AGC             ; TRY ONCE MORE\r
1721 \r
1722 AGCWIN: SETZM   PARNEW          ;CLEAR FOR NEXT AGC CALL\r
1723         SETZM   GETNUM          ;ALSO CLEAR THIS\r
1724         SETZM   GCFLG\r
1725 \r
1726         JUMPGE  P,RBLDM         ; DONT LOSE ON BLOWN PDLS\r
1727         JUMPGE  TP,RBLDM\r
1728         CAMGE   A,[-1]          ; SKIP IF GOOD NEWS\r
1729         JRST    RBLDM\r
1730         SETZM   PGROW           ; CLEAR GROWTH\r
1731         SETZM   TPGROW\r
1732         SETOM   GCHAPN          ; INDICATE A GC HAS HAPPENED\r
1733         SETOM   INTFLG          ; AND REQUEST AN INTERRUPT\r
1734         SETZM   GCDOWN\r
1735 \r
1736 RBLDM:  JUMPGE  R,CPOPJ\r
1737         SKIPGE  M,1(R)          ; SKIP IF FUNNY\r
1738         POPJ    P,\r
1739 \r
1740         HLRS    M\r
1741         ADD     M,PURVEC+1(TVP)\r
1742         SKIPL   M,1(M)\r
1743         POPJ    P,\r
1744         PUSH    P,0\r
1745         HRRZ    0,1(R)\r
1746         ADD     M,0\r
1747         POP     P,0\r
1748 CPOPJ:  POPJ    P,\r
1749 \r
1750 \r
1751 AGCE1:  FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR\r
1752 \r
1753 \f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL\r
1754 ; POINT.\r
1755 \r
1756 FIXSEN: PUSH    P,B             ; SAVE TIME\r
1757         MOVEI   B,[ASCIZ /TIME= /]\r
1758         SKIPE   GCMONF\r
1759         PUSHJ   P,MSGTYP        ; PRINT OUT MESSAGE\r
1760         POP     P,B             ; RESTORE B\r
1761         FSBR    B,GCTIM         ; GET TIME ELAPSED\r
1762         MOVEM   B,GCTIM         ; SAVE ELAPSED TIME FOR INT-HANDLER\r
1763         SKIPN   GCMONF\r
1764         POPJ    P,\r
1765         FMPRI   B,(100.0)       ; CONVERT TO FIX\r
1766         MULI    B,400\r
1767         TSC     B,B\r
1768         ASH     C,-163.(B)\r
1769         MOVEI   A,1             ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME\r
1770         PUSH    P,C\r
1771         IDIVI   C,10.           ; START COUNTING\r
1772         JUMPLE  C,.+2\r
1773         AOJA    A,.-2\r
1774         POP     P,C\r
1775         CAIN    A,1             ; SEE IF THERE IS ONLY ONE CHARACTER\r
1776         JRST    DOT1\r
1777 FIXOUT: IDIVI   C,10.           ; RECOVER NUMBER\r
1778         HRLM    D,(P)\r
1779         SKIPE   C\r
1780         PUSHJ   P,FIXOUT\r
1781         PUSH    P,A             ; SAVE A\r
1782         CAIN    A,2             ; DECIMAL POINT HERE?\r
1783         JRST    DOT2\r
1784 FIX1:   HLRZ    A,(P)-1         ; GET NUMBER\r
1785         ADDI    A,60            ; MAKE IT A CHARACTER\r
1786         PUSHJ   P,MTYO          ; OUT IT GOES\r
1787         POP     P,A\r
1788         SOJ     A,\r
1789         POPJ    P,\r
1790 DOT1:   MOVEI   A,".            ; OUTPUT DECIMAL POINT AND PADDING 0\r
1791         PUSHJ   P,MTYO\r
1792         MOVEI   A,"0\r
1793         PUSHJ   P,MTYO\r
1794         JRST    FIXOUT          ; CONTINUE\r
1795 DOT2:   MOVEI   A,".            ; OUTPUT DECIMAL POINT\r
1796         PUSHJ   P,MTYO\r
1797         JRST    FIX1\r
1798 \r
1799 \f; INITIAL CORE ADJUSTMENT TO OBTAIN SPACE\r
1800 ; FOR MARK PHASE PDL\r
1801 \r
1802 TRYCOR: MOVEI   A,2000\r
1803         ADDB    A,CORTOP        ; TRY AND GET 1 BLOCK\r
1804         ASH     A,-10.\r
1805         MOVEI   E,(A)           ; SAVE FOR LOOPER\r
1806         PUSHJ   P,P.CORE        ; GET CORE\r
1807         JRST    TRYCO2          ; FAILED, TAKE MORE ACTION\r
1808         JRST    CORGET\r
1809 \r
1810 TRYCO2: MOVNI   A,2000          ; FIXUP CORTOP\r
1811         ADDM    A,CORTOP\r
1812 TRYCO3: MOVE    0,TPGROW\r
1813         ADD     0,PGROW         ; 0/ NEQ 0 IF STACK BLEW\r
1814         SKIPGE  TP              ; SKIP IF TP BLOWN\r
1815         SKIPL   PSTO+1(PVP)     ; SKIP IF P WINS\r
1816         MOVEI   0,1\r
1817         SKIPN   0\r
1818         MOVEI   B,[ASCIZ /\r
1819 CORE NEEDED:\r
1820         TYPE C TO KEEP TRYING\r
1821         TYPE N TO GET MUDDLE ERROR\r
1822         TYPE V TO RETURN TO MONITOR\r
1823 /]\r
1824         SKIPE   0\r
1825         MOVEI   B,[ASCIZ /\r
1826 CORE NEEDED:\r
1827         TYPE C TO KEEP TRYING\r
1828         TYPE V TO RETURN TO MONITOR\r
1829 /]\r
1830         PUSH    P,0\r
1831         PUSHJ   P,MSGTYP\r
1832         SETOM   GCFLCH          ; TELL INTERRUPT HANDLER TO .ITYIC\r
1833         PUSHJ   P,MTYI\r
1834         PUSHJ   P,UPLO          ; IN CASE LOWER CASE TYPED\r
1835         SETZM   GCFLCH\r
1836         POP     P,0\r
1837         CAIN    A,"C\r
1838         JRST    TRYCO4\r
1839         CAIN    A,"N\r
1840         JUMPE   0,TRYCO5\r
1841         CAIN    A,"V\r
1842         FATAL CORE LOSSAGE\r
1843         JRST    TRYCO3\r
1844 \r
1845 UPLO:   CAIL    A,"a\r
1846         CAILE   A,"z\r
1847         POPJ    P,\r
1848         SUBI    A,40\r
1849         POPJ    P,\r
1850 \r
1851 TRYCO4: MOVEI   A,(E)\r
1852 TRYCO9: MOVEI   B,1             ; SLEEP AND CORE UNTIL WINNAGE\r
1853         EXCH    A,B\r
1854         PUSHJ   P,%SLEEP        ; SLEEP A WHILE\r
1855         EXCH    A,B\r
1856         PUSHJ   P,P.CORE\r
1857         JRST    TRYCO9\r
1858 \r
1859         MOVEI   B,[ASCIZ /\r
1860 WIN!\r
1861 /]\r
1862         PUSHJ   P,MSGTYP\r
1863         JRST    CORGET\r
1864 \r
1865 TRYCO5: MOVNI   A,3             ; GIVE WORST ERROR RETURN\r
1866         MOVEM   A,GCDANG\r
1867         JRST    TRYCOX\r
1868 \r
1869 \r
1870 \f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING\r
1871 \r
1872 PDLCHK: JUMPGE  A,CPOPJ\r
1873         HLRE    B,A             ;GET NEGATIVE COUNT\r
1874         MOVE    C,A             ;SAVE A COPY OF PDL POINTER\r
1875         SUBI    A,-1(B)         ;LOCATE DOPE WORD PAIR\r
1876         HRRZS   A               ; ISOLATE POINTER\r
1877         CAME    A,TPGROW        ;GROWING?\r
1878         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD\r
1879         HLRZ    D,(A)           ;GET COUNT FROM DOPE WORD\r
1880         MOVNS   B               ;GET POSITIVE AMOUNT LEFT\r
1881         SUBI    D,2(B)          ; PDL FULL?\r
1882         JUMPE   D,NOFENC        ;YES NO FENCE POSTING\r
1883         SETOM   1(C)            ;CLOBBER TOP WORD\r
1884         SOJE    D,NOFENC        ;STILL MORE?\r
1885         MOVSI   D,1(C)          ;YES, SET UP TO BLT FENCE POSTS\r
1886         HRRI    D,2(C)\r
1887         BLT     D,-2(A)         ;FENCE POST ALL EXCEPT DOPE WORDS\r
1888 \r
1889 \r
1890 NOFENC: CAIG    B,TPMAX         ;NOW CHECK SIZE\r
1891         CAIG    B,TPMIN\r
1892         JRST    MUNGTP          ;TOO BIG OR TOO SMALL\r
1893         POPJ    P,\r
1894 \r
1895 MUNGTP: SUBI    B,TPGOOD        ;FIND DELTA TP\r
1896 MUNG3:  MOVE    C,-1(A)         ;IS GROWTH ALREADY SPECIFIED\r
1897         TRNE    C,777000        ;SKIP IF NOT\r
1898         POPJ    P,              ;ASSUME GROWTH GIVEN WILL WIN\r
1899 \r
1900         ASH     B,-6            ;CONVERT TO NUMBER OF BLOCKS\r
1901         JUMPLE  B,MUNGT1\r
1902         CAILE   B,377           ; SKIP IF BELOW MAX\r
1903         MOVEI   B,377           ; ELSE USE MAX\r
1904         TRO     B,400           ;TURN ON SHRINK BIT\r
1905         JRST    MUNGT2\r
1906 MUNGT1: MOVMS   B\r
1907         ANDI    B,377\r
1908 MUNGT2: DPB     B,[111100,,-1(A)]       ;STORE IN DOPE WORD\r
1909         POPJ    P,\r
1910 \r
1911 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)\r
1912 \r
1913 PDLCHP: HLRE    B,A             ;-LENGTH TO B\r
1914         MOVE    C,A\r
1915         SUBI    A,-1(B)         ;POINT TO DOPE WORD\r
1916         HRRZS   A               ;ISOLATE POINTER\r
1917         CAME    A,PGROW         ;GROWING?\r
1918         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD\r
1919         MOVMS   B               ;PLUS LENGTH\r
1920         HLRZ    D,(A)           ; D.W. LENGTH\r
1921         SUBI    D,2(B)          ; PDL FULL\r
1922         JUMPE   D,NOPF\r
1923         SETOM   1(C)            ; START FENECE POST\r
1924         SOJE    D,NOPF          ; 1 WORD?\r
1925         MOVSI   D,1(C)\r
1926         HRRI    D,2(C)\r
1927         BLT     D,-2(A)\r
1928 \r
1929 NOPF:   CAIG    B,PMAX          ;TOO BIG?\r
1930         CAIG    B,PMIN          ;OR TOO LITTLE\r
1931         JRST    .+2             ;YES, MUNG IT\r
1932         POPJ    P,\r
1933         SUBI    B,PGOOD\r
1934         JRST    MUNG3\r
1935 \r
1936 ;THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE\r
1937 FRMUNG: MOVEM   D,PSAV(A)\r
1938         MOVEM   SP,SPSAV(A)\r
1939         MOVEM   TP,TPSAV(A)     ;SAVE FOR MARKING\r
1940         POPJ    P,\r
1941 \r
1942 ; ROUTINE TO PRE MARK SPECIAL HACKS\r
1943 \r
1944 PRMRK:  SKIPE   GCHAIR          ; FLUSH IF NO HAIR\r
1945         POPJ    P,\r
1946         HLRE    B,A\r
1947         SUBI    A,(B)           ;POINT TO DOPE WORD\r
1948         HLRZ    B,1(A)          ; GET LNTH\r
1949         ADDM    B,VECNUM        ; AND UPDATE VECNUM\r
1950         LDB     B,[111100,,(A)] ; GET GROWTHS\r
1951         TRZE    B,400           ; SIGN HACK\r
1952         MOVNS   B\r
1953         ASH     B,6             ; TO WORDS\r
1954         ADDM    B,VECNUM\r
1955         LDB     0,[001100,,(A)]\r
1956         TRZE    0,400\r
1957         MOVNS   0\r
1958         ASH     0,6\r
1959         ADDM    0,VECNUM\r
1960         PUSHJ   P,GSHFLG                ; SET GROW FLAGS\r
1961         IORM    D,1(A)          ;AND MARK\r
1962         POPJ    P,\r
1963 \r
1964 ; SET UP FLAGS FOR OPTIOANAL GROW/SHRINK PHASES\r
1965 \r
1966 GSHFLG: SKIPG   B\r
1967         SKIPLE  0\r
1968         SETOM   GREW\r
1969         SKIPL   B\r
1970         SKIPGE  0\r
1971         SETOM   SHRUNK\r
1972         POPJ    P,\r
1973 \r
1974 \f;GENERAL MARK SUBROUTINE.  CALLED TO MARK ALL THINGS\r
1975 ; A/ GOODIE TO MARK FROM\r
1976 ; B/ TYPE OF A (IN RH)\r
1977 ; C/ TYPE,DATUM PAIR POINTER\r
1978 \r
1979 MARK2:  HLRZ    B,(C)           ;GET TYPE\r
1980 MARK1:  MOVE    A,1(C)          ;GET GOODIE\r
1981 MARK:   JUMPE   A,CPOPJ         ; NEVER MARK 0\r
1982         MOVEI   0,(A)\r
1983         CAIL    0,@PURBOT       ; DONT MARK PURE STUFF\r
1984         POPJ    P,\r
1985         PUSH    P,A             ;SAVE GOODIE\r
1986         HRLM    C,-1(P)         ;AND POINTER TO IT\r
1987         ANDI    B,TYPMSK        ; FLUSH MONITORS\r
1988         LSH     B,1             ;TIMES 2 TO GET SAT\r
1989         HRRZ    B,@TYPNT        ;GET SAT\r
1990         ANDI    B,SATMSK\r
1991         CAIG    B,NUMSAT        ; SKIP IF TEMPLATE DATA\r
1992         JRST    @MKTBS(B)       ;AND GO MARK\r
1993         JRST    TD.MRK\r
1994 \r
1995 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)\r
1996 \r
1997 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK]\r
1998 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]\r
1999 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]\r
2000 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK]\r
2001 [SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]]\r
2002 \r
2003 \r
2004 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER\r
2005 \r
2006 DEFMK:  TLOA    TYPNT,400000    ;USE SIGN BIT AS FLAG\r
2007 \r
2008 ;HERE TO MARK LIST ELEMENTS\r
2009 \r
2010 PAIRMK: TLZ     TYPNT,400000    ;TURN OF DEFER BIT\r
2011         PUSH    P,[0]           ; WILL HOLD BACK PNTR\r
2012         MOVEI   C,(A)           ;POINT TO LIST\r
2013 PAIRM1: CAMGE   C,PARTOP        ;CHECK FOR BEING IN BOUNDS\r
2014         CAMGE   C,PARBOT\r
2015         FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE\r
2016         SKIPGE  B,(C)           ;SKIP IF NOT MARKED\r
2017         JRST    RETNEW          ;ALREADY MARKED, RETURN\r
2018         IORM    D,(C)           ;MARK IT\r
2019         AOS     PARNUM\r
2020         MOVEM   B,FRONT(FPTR)   ; STORE 1ST WORD\r
2021         MOVE    0,1(C)          ; AND 2D\r
2022         MOVEM   0,FRONT+1(FPTR)\r
2023         ADD     FPTR,[2,,2]             ; MOVE ALONG IN FRONTIER\r
2024         JUMPL   FPTR,PAIRM2     ; NOD NEED FOR NEW CORE\r
2025 \r
2026 ; HERE TO EXTEND THE FRONTIER\r
2027 \r
2028         HRRZ    A,BOTNEW        ; CURRENT BOTTOM OF WINDOW IN INF\r
2029         ADDI    A,2000          ; MOVE IT UP\r
2030         HRRM    A,BOTNEW\r
2031         ASH     A,-10.          ; TO PAGES\r
2032 SYSLO1: PUSHJ   P,%GETIP        ; GET PAGE\r
2033         PUSHJ   P,%SHFNT        ; AND SHARE IT\r
2034         MOVSI   FPTR,-2000\r
2035 \r
2036 PAIRM2: MOVEI   A,@BOTNEW       ; GET INF ADDR\r
2037         SUBI    A,2\r
2038         HRRM    A,(C)           ; LEAVE A POINTER TO NEW HOME\r
2039         HRRZ    E,(P)           ; GET BACK POINTER\r
2040         JUMPE   E,PAIRM7        ; 1ST ONE, NEW FIXUP\r
2041         MOVSI   0,(HRRM)        ; INS FOR CLOBBER\r
2042         PUSHJ   P,SMINF         ; SMASH INF'S CORE IMAGE\r
2043 PAIRM4: MOVEM   A,(P)           ; NEW BACK POINTER\r
2044         JUMPL   TYPNT,DEFDO     ;GO HANDLE DEFERRED POINTER\r
2045         HRLM    B,(P)           ; SAVE OLD CDR\r
2046         PUSHJ   P,MARK2         ;MARK THIS DATUM\r
2047         HRRZ    E,(P)           ; SMASH CAR IN CASE CHANGED\r
2048         ADDI    E,1\r
2049         MOVSI   0,(MOVEM)\r
2050         PUSHJ   P,SMINF\r
2051         HLRZ    C,(P)           ;GET CDR OF LIST\r
2052         CAIGE   C,@PURBOT       ; SKIP IF PURE (I.E. DONT MARK)\r
2053         JUMPN   C,PAIRM1        ;IF NOT NIL, MARK IT\r
2054 GCRETP: SUB     P,[1,,1]\r
2055 \r
2056 GCRET:  TLZ     TYPNT,400000    ;FOR PAIRMKS BENEFIT\r
2057         HLRZ    C,-1(P)         ;RESTORE C\r
2058         POP     P,A\r
2059         POPJ    P,              ;AND RETURN TO CALLER\r
2060 \r
2061 ;HERE TO MARK DEFERRED POINTER\r
2062 \r
2063 DEFDO:  PUSH    P,B             ; PUSH OLD PAIR ON STACK\r
2064         PUSH    P,1(C)\r
2065         MOVEI   C,-1(P)         ; USE AS NEW DATUM\r
2066         PUSHJ   P,MARK2         ;MARK THE DATUM\r
2067         HRRZ    E,-2(P)         ; GET POINTER IN INF CORE\r
2068         ADDI    E,1\r
2069         MOVSI   0,(MOVEM)\r
2070         PUSHJ   P,SMINF         ; AND CLOBBER\r
2071         SUB     P,[3,,3]\r
2072         JRST    GCRET           ;AND RETURN\r
2073 \r
2074 \r
2075 PAIRM7: MOVEM   A,-1(P)         ; SAVE NEW VAL FOR RETURN\r
2076         JRST    PAIRM4\r
2077 \r
2078 RETNEW: HRRZ    A,(C)           ; POINT TO NEW WORLD LOCN\r
2079         HRRZ    E,(P)           ; BACK POINTER\r
2080         JUMPE   E,RETNW1        ; NONE\r
2081         MOVSI   0,(HRRM)\r
2082         PUSHJ   P,SMINF\r
2083         JRST    GCRETP\r
2084 \r
2085 RETNW1: MOVEM   A,-1(P)\r
2086         JRST    GCRETP\r
2087 \r
2088 ; ROUTINE TO SMASH INFERIORS PPAGES\r
2089 ; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE\r
2090 \r
2091 SMINF:  CAML    E,WNDBOT        ; SEE IF IN WINDOW\r
2092         CAML    E,WNDTOP\r
2093         JRST    SMINF1          ; NO TRY FRONTIER\r
2094 SMINF3: SUB     E,WNDBOT        ; FIX UP\r
2095         IOR     0,[0 A,WIND(E)] ; FIX INS\r
2096         XCT     0\r
2097         POPJ    P,\r
2098 \r
2099 SMINF1: PUSH    P,0\r
2100         HRRZ    0,BOTNEW        ; GET FRONTIER RANGE\r
2101         CAML    E,0             ; SKIP IF BELOW\r
2102         CAIL    E,@BOTNEW\r
2103         JRST    SMINF2\r
2104         SUB     E,0             ; FIXUP E\r
2105         POP     P,0\r
2106         IOR     0,[0 A,FRONT(E)]\r
2107         XCT     0\r
2108         POPJ    P,\r
2109 \r
2110 SMINF2: PUSH    P,A\r
2111         MOVE    A,E\r
2112         ASH     A,-10.          ; TO PAGES\r
2113         PUSHJ   P,%SHWND\r
2114         ASH     A,10.           ; BACK TO WORDS\r
2115         MOVEM   A,WNDBOT\r
2116         ADDI    A,2000\r
2117         MOVEM   A,WNDTOP\r
2118         POP     P,A\r
2119         POP     P,0             ; RESTORE INS OF INTEREST\r
2120         JRST    SMINF3\r
2121         \r
2122 \r
2123 \f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE\r
2124 \r
2125 TPMK:   TLOA    TYPNT,400000    ;SET TP MARK FLAG\r
2126 VECTMK: TLZ     TYPNT,400000\r
2127         MOVEI   E,(A)           ;SAVE A POINTER TO THE VECTOR\r
2128         HLRE    B,A             ;GET -LNTH\r
2129         SUB     A,B             ;LOCATE DOPE WORD\r
2130         MOVEI   A,1(A)          ;ZERO LH AND POINT TO 2ND DOPE WORD\r
2131         PUSHJ   P,VECBND        ; CHECK IN VECTOR SPACE\r
2132         JRST    VECTB1          ;LOSE, COMPLAIN\r
2133 \r
2134         JUMPGE  TYPNT,NOBUFR    ;IF A VECTOR, NO BUFFER CHECK\r
2135         CAME    A,PGROW         ;IS THIS THE BLOWN P\r
2136         CAMN    A,TPGROW        ;IS THIS THE GROWING PDL\r
2137         JRST    NOBUFR          ;YES, DONT ADD BUFFER\r
2138         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD\r
2139         MOVSI   0,-PDLBUF       ;ALSO FIX UP POINTER\r
2140         ADDB    0,1(C)\r
2141         MOVEM   0,(P)           ; FIXUP RET'D PNTR\r
2142 \r
2143 NOBUFR: HLRE    B,(A)           ;GET LENGTH FROM DOPE WORD\r
2144         JUMPL   B,GCRET         ; MARKED, LEAVE\r
2145         ANDI    B,377777        ;CLOBBER POSSIBLE MARK BIT\r
2146         MOVEI   F,(A)           ;SAVE A POINTER TO DOPE WORD\r
2147         SUBI    F,1(B)          ;F POINTS TO START OF VECTOR\r
2148         HRRZ    0,-1(A)         ;SEE IF GROWTH SPECIFIED\r
2149         MOVEI   B,0             ; SET GROWTH 0\r
2150         JUMPE   0,NOCHNG        ;NONE, JUST CHECK CURRENT SIZES\r
2151 \r
2152         LDB     B,[001100,,0]   ;GET GROWTH FACTOR\r
2153         TRZE    B,400           ;KILL SIGN BIT AND SKIP IF +\r
2154         MOVNS   B               ;NEGATE\r
2155         ASH     B,6             ;CONVERT TO NUMBER OF WORDS\r
2156         SUB     F,B             ;BOTTOM IS LOWER IN CORE\r
2157         LDB     0,[111100,,0]   ;GET TOP GROWTH\r
2158         TRZE    0,400           ;HACK SIGN BIT\r
2159         MOVNS   0\r
2160         ASH     0,6             ;CONVERT TO WORDS\r
2161         PUSHJ   P,GSHFLG        ; HACK FLAGS FOR GROW/SHRINK\r
2162         ADD     B,0             ;TOTAL GROWTH TO B\r
2163 NOCHNG:\r
2164 VECOK:  HLRE    E,(A)           ;GET LENGTH AND MARKING\r
2165         MOVEI   F,(E)           ;SAVE A COPY\r
2166         ADD     F,B             ;ADD GROWTH\r
2167         SUBI    E,2             ;- DOPE WORD LENGTH\r
2168         IORM    D,(A)           ;MAKE SURE NOW MARKED\r
2169         CAML    A,VECBOT        ; ONLY IF REALLY IN VEC SPACE\r
2170         ADDM    F,VECNUM        ; ADD LENGTH OF VECTOR\r
2171         JUMPLE  E,GCRET         ;ALREADY MARKED OR ZERO LENGTH, LEAVE\r
2172 \r
2173         SKIPGE  B,-1(A)         ;SKIP IF UNIFORM\r
2174         TLNE    B,377777        ;SKIP IF NOT SPECIAL\r
2175         JUMPGE  TYPNT,NOTGEN    ;JUMP IF NOT A GENERAL VECTOR\r
2176 \r
2177 GENRAL: HLRZ    0,B             ;CHECK FOR PSTACK\r
2178         JUMPE   0,NOTGEN        ;IT ISN'T GENERAL\r
2179         SUBI    A,1(E)          ;POINT TO FIRST ELEMENT\r
2180         MOVEI   C,(A)           ;POINT TO FIRST ELEMENT WITH C\r
2181 \r
2182 \f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR\r
2183         PUSH    P,[0]\r
2184 VECTM2: HLRE    B,(C)           ;GET TYPE AND MARKING\r
2185         JUMPL   B,GCRET1                ;RETURN, (EITHER DOPE WORD OR FENCE POST)\r
2186         MOVE    A,1(C)          ;DATUM TO A\r
2187         ANDI    B,TYPMSK        ; FLUSH MONITORS\r
2188         CAIE    B,TCBLK         ;IS THIS A SAVED FRAME?\r
2189         CAIN    B,TENTRY        ;IS THIS A STACK FRAME\r
2190         JRST    MFRAME          ;YES, MARK IT\r
2191         CAIE    B,TUBIND                ; BIND\r
2192         CAIN    B,TBIND         ;OR A BINDING BLOCK\r
2193         JRST    MBIND\r
2194 \r
2195 VECTM3: PUSHJ   P,MARK          ;MARK DATUM\r
2196         MOVEM   A,1(C)          ; IN CASE WAS FIXED\r
2197 VECTM4: ADDI    C,2\r
2198         JRST    VECTM2\r
2199 \r
2200 MFRAME: HRROI   C,FRAMLN+FSAV-1(C)      ;POINT TO FUNCTION\r
2201         HRRZ    A,1(C)          ; GET IT\r
2202         PUSHJ   P,VECBND        ; CHECK IN VECTOR SPACE\r
2203         JRST    MFRAM1          ; IGNORE, NOT IN VECTOR SPACE\r
2204         HRL     A,(A)           ; GET LENGTH\r
2205         MOVEI   B,TVEC\r
2206         PUSHJ   P,MARK          ; AND MARK IT\r
2207 MFRAM1: HRROI   C,SPSAV-FSAV(C) ;POINT TO SAVED SP\r
2208         MOVEI   B,TSP\r
2209         PUSHJ   P,MARK1         ;MARK THE GOODIE\r
2210         HRROI   C,PSAV-SPSAV(C) ;POINT TO SAVED P\r
2211         MOVEI   B,TPDL\r
2212         PUSHJ   P,MARK1         ;AND MARK IT\r
2213         HRROI   C,TPSAV-PSAV(C) ;POINT TO SAVED TP\r
2214         MOVEI   B,TTP\r
2215         PUSHJ   P,MARK1         ;MARK IT ALS\r
2216         MOVEI   C,-TPSAV+1(C)   ;POINT PAST THE FRAME\r
2217         JRST    VECTM2          ;AND DO MORE MARKING\r
2218 \r
2219 \r
2220 MBIND:  MOVEI   B,TATOM         ;FIRST MARK ATOM\r
2221         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL NOW\r
2222         SKIPE   (P)             ; PASSED MARKER, IF SO DONT SKIP\r
2223         JRST    MBIND2          ; GO MARK\r
2224         CAME    A,IMQUOTE THIS-PROCESS\r
2225         JRST    MBIND1          ; NOT IT, CONTINUE SKIPPING\r
2226         HRRM    LPVP,2(C)       ; SAVE IN RH OF TPVP,,0\r
2227         MOVEI   LPVP,(C)        ; POINT\r
2228         SETOM   (P)             ; INDICATE PASSAGE\r
2229 MBIND1: ADDI    C,6             ; SKIP BINDING\r
2230         JRST    VECTM2\r
2231 \r
2232 MBIND2: PUSHJ   P,MARK1         ; MARK ATOM\r
2233         ADDI    C,2             ; POINT TO VAL\r
2234         PUSHJ   P,MARK2         ; AND MARK IT\r
2235         MOVEM   A,1(C)\r
2236         ADDI    C,2\r
2237         MOVEI   B,TLIST         ; POINT TO DECL SPECS\r
2238         HLRZ    A,(C)\r
2239         PUSHJ   P,MARK          ; AND MARK IT\r
2240         HRLM    A,(C)           ; LIST FIX UP\r
2241         MOVEI   B,TLOCI         ; NOW MARK LOCATIVE\r
2242         MOVE    A,1(C)\r
2243         JRST    VECTM3\r
2244 \r
2245 VECLOS: JUMPL   C,CCRET         ;JUMP IF CAN'T MUNG TYPE\r
2246         HLLZ    0,(C)           ;GET TYPE\r
2247         MOVEI   B,TILLEG        ;GET ILLEGAL TYPE\r
2248         HRLM    B,(C)\r
2249         MOVEM   0,1(C)          ;AND STORE OLD TYPE AS VALUE\r
2250         JRST    GCRET           ;RETURN WITHOUT MARKING VECTOR\r
2251 \r
2252 CCRET:  CLEARM  1(C)            ;CLOBBER THE DATUM\r
2253         JRST    GCRET\r
2254 \r
2255 \r
2256 IGBLK:  HRRZ    B,(C)           ;SKIP TO END OF PP BLOCK\r
2257         ADDI    C,3(B)\r
2258         JRST    VECTM2\r
2259 \f; MARK ARG POINTERS\r
2260 \r
2261 ARGMK:  HRRZ    A,1(C)          ; GET POINTER\r
2262         HLRE    B,1(C)          ; AND LNTH\r
2263         SUB     A,B             ; POINT TO BASE\r
2264         PUSHJ   P,VECBND\r
2265         JRST    ARGMK0\r
2266         HLRZ    0,(A)           ; GET TYPE\r
2267         ANDI    0,TYPMSK\r
2268         CAIN    0,TCBLK\r
2269         JRST    ARGMK1\r
2270         CAIE    0,TENTRY        ; IS NEXT A WINNER?\r
2271         CAIN    0,TINFO\r
2272         JRST    ARGMK1          ; YES, GO ON TO WIN CODE\r
2273 \r
2274 ARGMK0: SETZB   A,1(C)          ; CLOBBER THE CELL\r
2275         SETZM   (P)             ; AND SAVED COPY\r
2276         JRST    GCRET\r
2277 \r
2278 ARGMK1: MOVE    B,1(A)          ; ASSUME TTB\r
2279         ADDI    B,(A)           ; POINT TO FRAME\r
2280         CAIE    0,TINFO         ; IS IT?\r
2281         MOVEI   B,FRAMLN(A)     ; NO, USE OTHER GOODIE\r
2282         HLRZ    0,OTBSAV(B)     ; GET TIME\r
2283         HRRZ    A,(C)           ; AND FROM POINTER\r
2284         CAIE    0,(A)           ; SKIP IF WINNER\r
2285         JRST    ARGMK0\r
2286         HRROI   C,TPSAV-1(B)    ; MARK FROM TP SLOT\r
2287         MOVEI   B,TTP\r
2288         MOVE    A,1(C)\r
2289 ;       PUSHJ   P,MARK          ; WILL PUT BACK WHEN KNOWN HOW!\r
2290         JRST    GCRET\r
2291 \r
2292 ; MARK FRAME POINTERS\r
2293 \r
2294 FRMK:   SUBI    C,1             ;PREPARE TO MARK PROCESS VECTOR\r
2295         HRRZ    A,1(C)          ;USE AS DATUM\r
2296         SUBI    A,1             ;FUDGE FOR VECTMK\r
2297         MOVEI   B,TPVP          ;IT IS A VECTRO\r
2298         PUSHJ   P,MARK          ;MARK IT\r
2299         JRST    GCRET\r
2300 \r
2301 ; MARK BYTE POINTER\r
2302 \r
2303 BYTMK:  PUSHJ   P,BYTDOP        ; GET DOPE WORD IN A\r
2304         SOJG    A,VECTMK        ;FUDGE DOPE WORD POINTER FOR VECTMK\r
2305 \r
2306         FATAL AGC--BYTE POINTER WITH ZERO DOPE WORD POINTER\r
2307 \r
2308 \f; MARK ATOMS IN GVAL STACK\r
2309 \r
2310 GATOMK: HRRZ    B,(C)           ; POINT TO POSSIBLE GDECL\r
2311         JUMPE   B,ATOMK\r
2312         CAIN    B,-1\r
2313         JRST    ATOMK\r
2314         MOVEI   A,(B)           ; POINT TO DECL FOR MARK\r
2315         MOVEI   B,TLIST\r
2316         MOVEI   C,0\r
2317         PUSHJ   P,MARK\r
2318         HLRZ    C,-1(P)         ; RESTORE HOME POINTER\r
2319         HRRM    A,(C)           ; CLOBBER UPDATED LIST IN\r
2320         MOVE    A,1(C)          ; RESTORE ATOM POINTER\r
2321 \r
2322 ; MARK ATOMS\r
2323 \r
2324 ATOMK:\r
2325 REPEAT 0,[\r
2326         TLO     TYPNT,.ATOM.    ; SAY ATOM WAS MARKED\r
2327         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS\r
2328         HRRZ    C,(A)           ; IF UNBOUND OR  GLOBAL\r
2329         JUMPE   C,MRKOBL        ; SKIP\r
2330         HRRZ    C,1(A)          ; DONT MARK BUT UPDATE BASED ON TPGROW\r
2331         HLRE    B,1(A)\r
2332         SUB     C,B             ; POINT TO DOPE WORD\r
2333         MOVEI   C,1(C)          ; POINT TO 2D DOPE WORD\r
2334         MOVSI   B,-PDLBUF       ; IN CASE UPDATE\r
2335         CAME    C,TPGROW        ; SKIP IF GROWER\r
2336         ADDM    B,1(A)          ; OTHERWISE UPDATE\r
2337 MRKOBL: MOVEI   C,1(A)          ; POINT TO OBLIST SLOT\r
2338 ]\r
2339         TLO     TYPNT,.ATOM.    ; SAY ATOM WAS MARKED\r
2340         MOVEI   C,1(A)\r
2341         HRRZ    0,(A)\r
2342         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS\r
2343         JUMPE   0,MRKOBL\r
2344         HRRZ    B,(C)\r
2345         HLRE    0,(C)\r
2346         SUB     B,0\r
2347         MOVEI   B,1(B)\r
2348         MOVSI   0,-PDLBUF\r
2349         CAME    B,TPGROW\r
2350         ADDM    0,(C)\r
2351 MRKOBL: MOVEI   B,TOBLS\r
2352         SKIPGE  1(C)            ; IF > 0, NOT OBL\r
2353         PUSHJ   P,MARK1         ; AND MARK IT\r
2354         JRST    GCRET           ;AND LEAVE\r
2355 \r
2356 GETLNT: HLRE    B,A             ;GET -LNTH\r
2357         SUB     A,B             ;POINT TO 1ST DOPE WORD\r
2358         MOVEI   A,1(A)          ;POINT TO 2ND DOPE WORD\r
2359         PUSHJ   P,VECBND\r
2360         JRST    VECTB1          ;BAD VECTOR, COMPLAIN\r
2361 \r
2362         HLRE    B,(A)           ;GET LENGTH AND MARKING\r
2363         IORM    D,(A)           ;MAKE SURE MARKED\r
2364         JUMPL   B,GCRET1        ;MARKED ALREADY, QUIT\r
2365         SUBI    A,-1(B)         ;POINT TO TOP OF ATOM\r
2366         CAML    A,VECBOT        ; DONT COUNT STORAGE\r
2367         ADDM    B,VECNUM        ;UPDATE VECNUM\r
2368         POPJ    P,              ;AND RETURN\r
2369 \r
2370 GCRET1: SUB     P,[1,,1]        ;FLUSH RETURN ADDRESS\r
2371         JRST    GCRET\r
2372 \r
2373 VECBND: CAMGE   A,VECTOP\r
2374         CAMGE   A,VECBOT\r
2375         JRST    .+2\r
2376         JRST    CPOPJ1\r
2377 \r
2378         CAMG    A,CODTOP\r
2379         CAIGE   A,STOSTR\r
2380         POPJ    P,\r
2381         JRST    CPOPJ1\r
2382 \r
2383 ; MARK NON-GENERAL VECTORS\r
2384 \r
2385 NOTGEN: CAMN    B,[GENERAL+<SPVP,,0>]   ;PROCESS VECTOR?\r
2386         JRST    GENRAL          ;YES, MARK AS A VECTOR\r
2387         JUMPL   B,SPECLS        ; COMPLAIN IF A SPECIAL HACK\r
2388         SUBI    A,1(E)          ;POINT TO TOP OF A UNIFORM VECTOR\r
2389         HLRZS   B               ;ISOLATE TYPE\r
2390         ANDI    E,TYPMSK\r
2391         MOVE    F,B             ; AND COPY IT\r
2392         LSH     B,1             ;FIND OUT WHERE IT WILL GO\r
2393         HRRZ    B,@TYPNT        ;GET SAT IN B\r
2394         ANDI    B,SATMSK\r
2395         MOVEI   C,@MKTBS(B)     ;POINT TO MARK SR\r
2396         CAIN    C,GCRET         ;IF NOT A MARKED FROM GOODIE, IGNORE\r
2397         JRST    GCRET\r
2398         MOVEI   C,-1(A)         ;POINT 1 PRIOR TO VECTOR START\r
2399         PUSH    P,E             ;SAVE NUMBER OF ELEMENTS\r
2400         PUSH    P,F             ;AND UNIFORM TYPE\r
2401 \r
2402 UNLOOP: MOVE    B,(P)           ;GET TYPE\r
2403         MOVE    A,1(C)          ;AND GOODIE\r
2404         TLO     C,400000        ;CAN'T MUNG TYPE\r
2405         PUSHJ   P,MARK          ;MARK THIS ONE\r
2406         MOVEM   A,1(C)          ; LIST FIXUP\r
2407         SOSE    -1(P)           ;COUNT\r
2408         AOJA    C,UNLOOP        ;IF MORE, DO NEXT\r
2409 \r
2410         SUB     P,[2,,2]        ;REMOVE STACK CRAP\r
2411         JRST    GCRET\r
2412 \r
2413 \r
2414 SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR\r
2415 \r
2416 \f;MARK LOCID TYPE GOODIES\r
2417 \r
2418 LOCMK:  HRRZ    B,(C)           ;GET TIME\r
2419         JUMPE   B,LOCMK1        ; SKIP LEGAL CHECK FOR GLOBAL\r
2420         HRRZ    0,2(A)          ; GET OTHER TIME\r
2421         CAIE    0,(B)           ; SAME?\r
2422         SETZB   A,1(C)          ; NO, SMASH LOCATIVE\r
2423         JUMPE   A,GCRET         ; LEAVE IF DONE\r
2424 LOCMK1: PUSH    P,C\r
2425         MOVEI   B,TATOM         ; MARK ATOM\r
2426         MOVEI   C,-2(A)         ; POINT TO ATOM\r
2427         PUSHJ   P,MARK1         ; LET LOCATIVE SAVE THE ATOM\r
2428         POP     P,C\r
2429         HRRZ    B,(C)           ; TIME BACK\r
2430         MOVE    A,1(C)          ; RESTORE POINTER TO STACK\r
2431         JUMPE   B,VECTMK        ;IF ZERO, GLOBAL\r
2432         JRST    TPMK            ;ELSE, ON TP\r
2433 \r
2434 ; MARK ASSOCIATION BLOCKS\r
2435 \r
2436 ASMRK:  HRLI    A,-ASOLNT       ;LOOK LIKE A VECTOR POINTER\r
2437         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS\r
2438         MOVEI   C,(A)           ;COPY POINTER\r
2439         PUSHJ   P,MARK2         ;MARK ITEM CELL\r
2440         MOVEM   A,1(C)\r
2441         ADDI    C,INDIC-ITEM    ;POINT TO INDICATOR\r
2442         PUSHJ   P,MARK2\r
2443         MOVEM   A,1(C)\r
2444         ADDI    C,VAL-INDIC\r
2445         PUSHJ   P,MARK2\r
2446         MOVEM   A,1(C)\r
2447         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL FRIENDS\r
2448         JRST    GCRET\r
2449         HRRZ    A,NODPNT-VAL(C) ; NEXT\r
2450         JUMPN   A,ASMRK         ; IF EXISTS, GO\r
2451         JRST    GCRET\r
2452 \r
2453 \r
2454 \r
2455 ;HERE WHEN A VECTOR POINTER IS BAD\r
2456 \r
2457 VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE\r
2458 \r
2459 \f; HERE TO MARK TEMPLATE DATA STRUCTURES\r
2460 \r
2461 TD.MRK: HLRZ    B,(A)           ; GET REAL SPEC TYPE\r
2462         ANDI    B,377777        ; KILL SIGN BIT\r
2463         MOVEI   E,-NUMSAT-1(B)  ; GET REL POINTER TO TABLE\r
2464         HRLI    E,(E)\r
2465         ADD     E,TD.LNT+1(TVP)\r
2466         HRRZS   C,A             ; FLUSH COUNT AND SAVE\r
2467         SKIPL   E               ; WITHIN BOUNDS\r
2468         FATAL   BAD SAT IN AGC\r
2469         PUSHJ   P,GETLNT        ; GOODIE IS NOW MARKED\r
2470 \r
2471         XCT     (E)             ; RET # OF ELEMENTS IN B\r
2472 \r
2473         HLRZ    D,B             ; GET POSSIBLE "BASIC LENGTH" FOR RESTS\r
2474         PUSH    P,[0]           ; TEMP USED IF RESTS EXIST\r
2475         PUSH    P,D\r
2476         MOVEI   B,(B)           ; ZAP TO ONLY LENGTH\r
2477         PUSH    P,C             ; SAVE POINTER TO TEMPLATE STRUCTURE\r
2478         PUSH    P,[0]           ; HOME FOR VALUES\r
2479         PUSH    P,[0]           ; SLOT FOR TEMP\r
2480         PUSH    P,B             ; SAVE\r
2481         SUB     E,TD.LNT+1(TVP)\r
2482         PUSH    P,E             ; SAVE FOR FINDING OTHER TABLES\r
2483         JUMPE   D,TD.MR2        ; NO REPEATING SEQ\r
2484         ADD     E,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
2485         HLRE    E,(E)           ; E ==> - LNTH OF TEMPLATE\r
2486         ADDI    E,(D)           ; E ==> -LENGTH OF REP SEQ\r
2487         MOVNS   E\r
2488         HRLM    E,-5(P)         ; SAVE IT AND BASIC\r
2489 \r
2490 TD.MR2: SKIPG   D,-1(P)         ; ANY LEFT?\r
2491         JRST    TD.MR1\r
2492 \r
2493         MOVE    E,TD.GET+1(TVP)\r
2494         ADD     E,(P)\r
2495         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
2496         MOVEM   D,-6(P)         ; SAVE ELMENT #\r
2497         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST\r
2498         SOJA    D,TD.MR3\r
2499 \r
2500         MOVEI   0,(B)           ; BASIC LNT TO 0\r
2501         SUBI    0,(D)           ; SEE IF PAST BASIC\r
2502         JUMPGE  0,.-3           ; JUMP IF O.K.\r
2503         MOVSS   B               ; REP LNT TO RH, BASIC TO LH\r
2504         IDIVI   0,(B)           ; A==> -WHICH REPEATER\r
2505         MOVNS   A\r
2506         ADD     A,-5(P)         ; PLUS BASIC\r
2507         ADDI    A,1             ; AND FUDGE\r
2508         MOVEM   A,-6(P)         ; SAVE FOR PUTTER\r
2509         ADDI    E,-1(A)         ; POINT\r
2510         SOJA    D,.+2\r
2511 \r
2512 TD.MR3: ADDI    E,(D)           ; POINT TO SLOT\r
2513         XCT     (E)             ; GET THIS ELEMENT INTO A AND B\r
2514         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT\r
2515         MOVEM   B,-2(P)\r
2516         EXCH    A,B             ; REARRANGE\r
2517         GETYP   B,B\r
2518         MOVEI   C,-3(P)         ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG\r
2519         MOVSI   D,400000        ; RESET FOR MARK\r
2520         PUSHJ   P,MARK          ; AND MARK THIS GUY (RET FIXED POINTER IN A)\r
2521         MOVE    C,-4(P)         ; REGOBBLE POINTER TO TEMPLATE\r
2522         MOVE    E,TD.PUT+1(TVP)\r
2523         MOVE    B,-6(P)         ; RESTORE COUNT\r
2524         ADD     E,(P)\r
2525         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
2526         ADDI    E,(B)-1         ; POINT TO SLOT\r
2527         MOVE    B,-3(P)         ; RESTORE TYPE WORD\r
2528         EXCH    A,B\r
2529         SOS     D,-1(P)         ; GET ELEMENT #\r
2530         XCT     (E)             ; SMASH IT BACK\r
2531         FATAL TEMPLATE LOSSAGE\r
2532         MOVE    C,-4(P)         ; RESTORE POINTER IN CASE MUNGED\r
2533         JRST    TD.MR2\r
2534 \r
2535 TD.MR1: SUB     P,[7,,7]\r
2536         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT\r
2537         JRST    GCRET\r
2538 \r
2539 ;  This phase attempts to remove any unwanted associations.  The program\r
2540 ; loops through the structure marking values of associations.  It can only\r
2541 ; stop when no new values (potential items and/or indicators) are marked.\r
2542 \r
2543 VALFLS: PUSH    P,[0]           ; INDICATE WHETHER ANY ON THIS PASS\r
2544         PUSH    P,[0]           ; OR THIS BUCKET\r
2545 ASOMK1: MOVE    A,ASOVEC+1(TVP) ; GET VECTOR POINTER\r
2546         SETOM   -1(P)           ; INITIALIZE FLAG\r
2547 \r
2548 ASOM6:  SKIPG   C,(A)           ; SKIP IF BUCKET TO BE SCANNED\r
2549         JRST    ASOM1\r
2550         SETOM   (P)             ; SAY BUCKET NOT CHANGED\r
2551 \r
2552 ASOM2:  MOVEI   F,(C)           ; COPY POINTER\r
2553         SKIPG   ASOLNT+1(C)     ; SKIP IF NOT ALREADY MARKED\r
2554         JRST    ASOM4           ; MARKED, GO ON\r
2555         PUSHJ   P,MARKQ         ; SEE IF ITEM IS MARKED\r
2556         JRST    ASOM3           ; IT IS NOT, IGNORE IT\r
2557         MOVEI   F,(C)           ; IN CASE CLOBBERED BY MARK2\r
2558         MOVEI   C,INDIC(C)              ; POINT TO INDICATOR SLOT\r
2559         PUSHJ   P,MARKQ\r
2560         JRST    ASOM3           ; NOT MARKED\r
2561 \r
2562         PUSH    P,A             ; HERE TO MARK VALUE\r
2563         PUSH    P,F\r
2564         HLRE    F,ASOLNT-INDIC+1(C)     ; GET LENGTH\r
2565         JUMPL   F,.+3           ; SKIP IF MARKED\r
2566         CAML    C,VECBOT        ; SKIP IF IN NOT VECT SPACE\r
2567         ADDM    F,VECNUM\r
2568         PUSHJ   P,MARK2         ; AND MARK\r
2569         MOVEM   A,1(C)          ; LIST FIX UP\r
2570         ADDI    C,ITEM-INDIC    ; POINT TO ITEM\r
2571         PUSHJ   P,MARK2\r
2572         MOVEM   A,1(C)\r
2573         ADDI    C,VAL-ITEM      ; POINT TO VALUE\r
2574         PUSHJ   P,MARK2\r
2575         MOVEM   A,1(C)\r
2576         IORM    D,ASOLNT-VAL+1(C)       ; MARK ASOC BLOCK\r
2577         POP     P,F\r
2578         POP     P,A\r
2579         AOSA    -1(P)           ; INDICATE A MARK TOOK PLACE\r
2580 \r
2581 ASOM3:  AOS     (P)             ; INDICATE AN UNMARKED IN THIS BUCKET\r
2582 ASOM4:  HRRZ    C,ASOLNT-1(F)   ; POINT TO NEXT IN BUCKET\r
2583         JUMPN   C,ASOM2         ; IF NOT EMPTY, CONTINUE\r
2584         SKIPGE  (P)             ; SKIP IF ANY NOT MARKED\r
2585         HRROS   (A)             ; MARK BUCKET AS NOT INTERESTING\r
2586 ASOM1:  AOBJN   A,ASOM6         ; GO TO NEXT BUCKET\r
2587         TLZE    TYPNT,.ATOM.    ; ANY ATOMS MARKED?\r
2588         JRST    VALFLA          ; YES, CHECK VALUES\r
2589 VALFL8:\r
2590 \r
2591 ; NOW SEE WHICH CHANNELS STILL POINTED TO\r
2592 \r
2593 CHNFL3: MOVEI   0,N.CHNS-1\r
2594         MOVEI   A,CHNL1(TVP)    ; SLOTS\r
2595         HRLI    A,TCHAN         ; TYPE HERE TOO\r
2596 \r
2597 CHNFL2: SKIPN   B,1(A)\r
2598         JRST    CHNFL1\r
2599         HLRE    C,B\r
2600         SUBI    B,(C)           ; POINT TO DOPE\r
2601         HLLM    A,(A)           ; PUT TYPE BACK\r
2602         SKIPGE  1(B)\r
2603         JRST    CHNFL1\r
2604         HLLOS   (A)             ; MARK AS A LOSER\r
2605         PUSH    P,A\r
2606         PUSH    P,0\r
2607         MOVEI   C,(A)\r
2608         PUSHJ   P,MARK2\r
2609         POP     P,0\r
2610         POP     P,A\r
2611         SETZM   -1(P)           ; SAY MARKED\r
2612 CHNFL1: ADDI    A,2\r
2613         SOJG    0,CHNFL2\r
2614 \r
2615         SKIPE   GCHAIR          ; IF NOT HAIRY CASE\r
2616         POPJ    P,              ; LEAVE\r
2617 \r
2618         SKIPL   -1(P)           ; SKIP IF NOTHING NEW MARKED\r
2619         JRST    ASOMK1\r
2620 \r
2621         SUB     P,[2,,2]        ; REMOVE FLAGS\r
2622 \r
2623 \r
2624 \r
2625 \f; HERE TO REEMOVE UNUSED ASSOCIATIONS\r
2626 \r
2627         MOVE    A,ASOVEC+1(TVP) ; GET ASOVEC BACK FOR FLUSHES\r
2628 \r
2629 ASOFL1: SKIPN   C,(A)           ; SKIP IF BUCKET NOT EMPTY\r
2630         JRST    ASOFL2          ; EMPTY BUCKET, IGNORE\r
2631         HRRZS   (A)             ; UNDO DAMAGE OF BEFORE\r
2632 \r
2633 ASOFL5: SKIPGE  ASOLNT+1(C)     ; SKIP IF UNMARKED\r
2634         JRST    ASOFL3          ; MARKED, DONT FLUSH\r
2635 \r
2636         HRRZ    B,ASOLNT-1(C)   ; GET FORWARD POINTER\r
2637         HLRZ    E,ASOLNT-1(C)   ; AND BACK POINTER\r
2638         JUMPN   E,ASOFL4        ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)\r
2639         HRRZM   B,(A)           ; FIX BUCKET\r
2640         JRST    .+2\r
2641 \r
2642 ASOFL4: HRRM    B,ASOLNT-1(E)   ; FIX UP PREVIOUS\r
2643         JUMPE   B,.+2           ; JUMP IF NO NEXT POINTER\r
2644         HRLM    E,ASOLNT-1(B)   ; FIX NEXT'S BACK POINTER\r
2645         HRRZ    B,NODPNT(C)     ; SPLICE OUT THRAD\r
2646         HLRZ    E,NODPNT(C)\r
2647         SKIPE   E\r
2648         HRRM    B,NODPNT(E)\r
2649         SKIPE   B\r
2650         HRLM    E,NODPNT(B)\r
2651 \r
2652 ASOFL3: HRRZ    C,ASOLNT-1(C)   ; GO TO NEXT\r
2653         JUMPN   C,ASOFL5\r
2654 ASOFL2: AOBJN   A,ASOFL1\r
2655 \r
2656 ; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES\r
2657 \r
2658         MOVE    A,GLOBSP+1(TVP) ; GET GLOBAL PDL\r
2659 \r
2660 GLOFLS: SKIPGE  (A)             ; SKIP IF NOT ALREADY MARKED\r
2661         JRST    .+3             ; VIOLATE CARDINAL RULE #69\r
2662         MOVSI   B,-3\r
2663         PUSHJ   P,ZERSLT        ; CLOBBER THE SLOT\r
2664         ANDCAM  D,(A)           ; UNMARK\r
2665         ADD     A,[4,,4]\r
2666         JUMPL   A,GLOFLS        ; MORE?, KEEP LOOPING\r
2667 \r
2668 LOCFL1: HRRZ    A,(LPVP)        ; NOW CLOBBER LOCAL SLOTS\r
2669         HRRZ    C,2(LPVP)\r
2670         HLLZS   2(LPVP)         ; NOW CLEAR\r
2671         MOVEI   LPVP,(C)\r
2672         JUMPE   A,LOCFL2        ; NONE TO FLUSH\r
2673 \r
2674 LOCFLS: SKIPGE  (A)             ; MARKDE?\r
2675         JRST    .+3\r
2676         MOVSI   B,-5\r
2677         PUSHJ   P,ZERSLT\r
2678         ANDCAM  D,(A)           ;UNMARK\r
2679         HRRZ    A,(A)           ; GO ON\r
2680         JUMPN   A,LOCFLS\r
2681 LOCFL2: JUMPN   LPVP,LOCFL1     ; JUMP IF MORE PROCESS\r
2682         POPJ    P,\r
2683 \r
2684 \r
2685 \r
2686 MARK23: PUSH    P,A             ; SAVE BUCKET POINTER\r
2687         PUSH    P,F\r
2688         PUSHJ   P,MARK2\r
2689         MOVEM   A,1(C)\r
2690         POP     P,F\r
2691         POP     P,A\r
2692         AOS     -2(P)           ; MARKING HAS OCCURRED\r
2693         IORM    D,ASOLNT+1(C)   ; MARK IT\r
2694         JRST    MKD\r
2695 \r
2696 \f; CHANNEL FLUSHER FOR NON HAIRY GC\r
2697 \r
2698 CHNFLS: PUSH    P,[-1]\r
2699         SETOM   (P)             ; RESET FOR RETRY\r
2700         PUSHJ   P,CHNFL3\r
2701         SKIPL   (P)\r
2702         JRST    .-3             ; REDO\r
2703         SUB     P,[1,,1]\r
2704         POPJ    P,\r
2705 \r
2706 ; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP\r
2707 \r
2708 VALFLA: MOVE    C,GLOBSP+1(TVP)\r
2709 \r
2710 VALFL1: SKIPL   (C)             ; SKIP IF NOT MARKED\r
2711         PUSHJ   P,MARKQ         ; SEE IF ATOM IS MARKED\r
2712         JRST    VALFL2\r
2713         IORM    D,(C)\r
2714         AOS     -1(P)           ; INDICATE MARK OCCURRED\r
2715         PUSH    P,C\r
2716         HRRZ    B,(C)           ; GET POSSIBLE GDECL\r
2717         JUMPE   B,VLFL10        ; NONE\r
2718         CAIN    B,-1            ; MAINFIFEST\r
2719         JRST    VLFL10\r
2720         MOVEI   A,(B)\r
2721         MOVEI   B,TLIST\r
2722         MOVEI   C,0\r
2723         PUSHJ   P,MARK          ; MARK IT\r
2724         MOVE    C,(P)           ; POINT\r
2725         HRRM    A,(C)           ; CLOBBER UPDATE IN\r
2726 VLFL10: ADD     C,[2,,2]        ; BUMP TO VALUE\r
2727         PUSHJ   P,MARK2         ; MARK VALUE\r
2728         MOVEM   A,1(C)\r
2729         POP     P,C\r
2730 VALFL2: ADD     C,[4,,4]\r
2731         JUMPL   C,VALFL1        ; JUMP IF MORE\r
2732 \r
2733         HRLM    LPVP,(P)        ; SAVE POINTER\r
2734 VALFL7: MOVEI   C,(LPVP)\r
2735         MOVEI   LPVP,0\r
2736 VALFL6: HRRM    C,(P)\r
2737 \r
2738 VALFL5: HRRZ    C,(C)           ; CHAIN\r
2739         JUMPE   C,VALFL4\r
2740         MOVEI   B,TATOM         ; TREAT LIKE AN ATOM\r
2741         SKIPL   (C)             ; MARKED?\r
2742         PUSHJ   P,MARKQ1        ; NO, SEE\r
2743         JRST    VALFL5          ; LOOP\r
2744         AOS     -1(P)           ; MARK WILL OCCUR\r
2745         IORM    D,(C)\r
2746         ADD     C,[2,,2]        ; POINT TO VALUE\r
2747         PUSHJ   P,MARK2         ; MARK VALUE\r
2748         MOVEM   A,1(C)\r
2749         SUBI    C,2\r
2750         JRST    VALFL5\r
2751 \r
2752 VALFL4: HRRZ    C,(P)           ; GET SAVED LPVP\r
2753         MOVEI   A,(C)\r
2754         HRRZ    C,2(C)          ; POINT TO NEXT\r
2755         JUMPN   C,VALFL6\r
2756         JUMPE   LPVP,VALFL9\r
2757 \r
2758         HRRM    LPVP,2(A)       ; NEW PROCESS WAS MARKED\r
2759         JRST    VALFL7\r
2760 \r
2761 ZERSLT: HRRI    B,(A)           ; COPY POINTER\r
2762         SETZM   1(B)\r
2763         AOBJN   B,.-1\r
2764         POPJ    P,\r
2765 \r
2766 VALFL9: HLRZ    LPVP,(P)        ; RESTORE CHAIN\r
2767         JRST    VALFL8\r
2768 \r
2769 \r
2770 \f;SUBROUTINE TO SEE IF A GOODIE IS MARKED\r
2771 ;RECEIVES POINTER IN C\r
2772 ;SKIPS IF MARKED NOT OTHERWISE\r
2773 \r
2774 MARKQ:  HLRZ    B,(C)           ;TYPE TO B\r
2775 MARKQ1: MOVE    E,1(C)          ;DATUM TO C\r
2776         MOVEI   0,(E)\r
2777         CAIL    0,@PURBOT       ; DONT CHACK PURE\r
2778         JRST    MKD             ; ALWAYS MARKED\r
2779         ANDI    B,TYPMSK        ; FLUSH MONITORS\r
2780         LSH     B,1\r
2781         HRRZ    B,@TYPNT        ;GOBBLE SAT\r
2782         ANDI    B,SATMSK\r
2783         CAIG    B,NUMSAT        ; SKIP FOR TEMPLATE\r
2784         JRST    @MQTBS(B)       ;DISPATCH\r
2785         ANDI    E,-1            ; FLUSH REST HACKS\r
2786         JRST    VECMQ\r
2787 \r
2788 \r
2789 DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]\r
2790 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMQ],[SLOCID,LOCMQ]\r
2791 [SATOM,VECMQ],[SPVP,VECMQ],[SLOCID,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]\r
2792 [SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,VECMQ]]\r
2793 \r
2794 PAIRMQ: JUMPE   E,MKD           ; NIL ALWAYS MARKED\r
2795         SKIPL   (E)             ; SKIP IF MARKED\r
2796         POPJ    P,\r
2797 CPOPJ1:\r
2798 ARGMQ:\r
2799 MKD:    AOS     (P)\r
2800         POPJ    P,\r
2801 \r
2802 BYTMQ:  HRRZ    E,(C)           ;GET DOPE WORD POINTER\r
2803         SOJA    E,VECMQ1        ;TREAT LIKE VECTOR\r
2804 \r
2805 FRMQ:   HRRZ    E,(C)           ; POINT TO PV DOPE WORD\r
2806         SOJA    E,VECMQ1\r
2807 \r
2808 \r
2809 VECMQ:  HLRE    0,E             ;GET LENGTH\r
2810         SUB     E,0             ;POINT TO DOPE WORDS\r
2811 \r
2812 VECMQ1: SKIPGE  1(E)            ;SKIP IF NOT MARKED\r
2813         AOS     (P)             ;MARKED, CAUSE SKIP RETURN\r
2814         POPJ    P,\r
2815 \r
2816 ASMQ:   SUBI    E,ASOLNT\r
2817         JRST    VECMQ1\r
2818 \r
2819 LOCMQ:  HRRZ    0,(C)           ; GET TIME\r
2820         JUMPE   0,VECMQ         ; GLOBAL, LIKE VECTOR\r
2821         HLRE    0,E             ; FIND DOPE\r
2822         SUB     E,0\r
2823         MOVEI   E,1(E)          ; POINT TO LAST DOPE\r
2824         CAMN    E,TPGROW                ; GROWING?\r
2825         SOJA    E,VECMQ1        ; YES, CHECK\r
2826         ADDI    E,PDLBUF        ; FUDGE\r
2827         MOVSI   0,-PDLBUF\r
2828         ADDM    0,1(C)\r
2829         SOJA    E,VECMQ1\r
2830 \fREPEAT 0,[\r
2831 \r
2832 \r
2833 \r
2834 ;RETIME PHASE -- CALLED IFF A FRAME TIME HAS OVERFLOWED\r
2835 ;RECEIVES POINTER TO STACK TO BE RECALIBRATED IN A\r
2836 ;LEAVES HIGHEST TIME IN TIMOUT\r
2837 \r
2838 RETIME: HLRE    B,A             ;GET LENGTH IN B\r
2839         SUB     A,B             ;COMPUTE DOPE WORD LOCATION\r
2840         MOVEI   A,1(A)          ;POINT TO 2D DOPE WORD AND CLEAR LH\r
2841         CAME    A,TPGROW        ;IS THIS ONE BLOWN?\r
2842         ADDI    A,PDLBUF        ;NO, POINT TO DOPE WORD\r
2843         LDB     B,[222100,,(A)] ;GET LENGTH FIELD (IGNOREING MARK BIT\r
2844         SUBI    A,-1(B)         ;POINT TO PDLS BASE\r
2845         MOVEI   C,1             ;INITIALIZE NEW TIMES\r
2846 \r
2847 RETIM1: SKIPGE  B,(A)           ;IF <0, HIT DOPE WORD OR FENCE POST\r
2848         JRST    RETIM3\r
2849         HLRZS   B               ;ISOLATE TYPE\r
2850         CAIE    B,TENTRY        ;FRAME START?\r
2851         AOJA    A,RETIM2        ;NO, TRY BINDING\r
2852         HRLM    C,FRAMLN+OTBSAV(A)      ;STORE NEW TIME\r
2853         ADDI    A,FRAMLN        ;POINT TO NEXT ELEMENT\r
2854         AOJA    C,RETIM1        ;BUMP TIME AND MOVE ON\r
2855 \r
2856 RETIM2: CAIE    B,TUBIND\r
2857         CAIN    B,TBIND         ;BINDING?\r
2858         HRRM    C,3(A)          ;YES, STORE CURRENT TIME\r
2859         AOJA    A,RETIM1        ;AND GO ON\r
2860 \r
2861 RETIM3: MOVEM   C,TIMOUT        ;SAVE TIME\r
2862         POPJ    P,              ;RETURN\r
2863 \r
2864 \r
2865 ]\r
2866 \r
2867 \f; Core adjustment phase, try to win in all obscure cases!\r
2868 \r
2869 CORADJ: MOVE    A,P.TOP         ; update AGCs core top\r
2870         MOVEM   A,CORTOP\r
2871         MOVE    A,PARBOT        ; figure out all the core needed\r
2872         ADD     A,PARNEW\r
2873         ADD     A,PARNUM\r
2874         ADD     A,PARNUM\r
2875         ADD     A,VECNUM\r
2876         ADDI    A,3777          ; account for gc pdl and round to block\r
2877         ANDCMI  A,1777\r
2878 \r
2879 CORAD3: CAMG    A,PURTOP        ; any way of winning at all?\r
2880         JRST    CORAD1          ; yes, go try\r
2881 CORA33: SETOM   GCDNTG          ; no, can't even grow something\r
2882         SETOM   GCDANG          ; or get current request\r
2883         SKIPL   C,PARNEW        ; or move pairs up\r
2884         SETZM   PARNEW\r
2885         MOVEM   C,SPARNW        ; save attempt in case of retry\r
2886 \r
2887 CORAD6: MOVE    A,CORTOP        ; update core gotton with needed\r
2888         ASH     A,-10.          ; to blocks\r
2889         PUSHJ   P,P.CORE        ; try to get it (any lossage will retry)\r
2890         PUSHJ   P,SLPM1\r
2891 CORA11: MOVE    A,CORTOP        ; compute new home for vectors\r
2892         SUB     A,VECTOP\r
2893         SUBI    A,2000          ; remember gc pdl\r
2894         MOVEM   A,VECNEW\r
2895         POPJ    P,              ; return to main GC loop\r
2896 \r
2897 ; Here if at least enough for growers\r
2898 \r
2899 CORAD1: SKIPN   B,GCDOWN        ; skip if were called to get pure space\r
2900         JRST    CORAD2\r
2901         ADDI    A,2000(B)       ; A/ enough for move down and minimum free\r
2902         CAMG    A,PURTOP        ; any chance of winning?\r
2903         JRST    CORAD4          ; yes, go win some\r
2904 \r
2905 ; Here if cant move down\r
2906 \r
2907         SETOM   GCDANG          ; complain upon return\r
2908         SUBI    A,2000(B)       ; reset for re-entry into loop\r
2909         CAMLE   A,PURTOP        ; win?\r
2910         JRST    CORA33\r
2911 \r
2912 ; Here if may be able to grant current request\r
2913 \r
2914 CORAD2: ADD     A,GETNUM        ; A/  total neede including request\r
2915         ADD     A,CURPLN        ; dont give self away or something\r
2916         ADDI    A,3777          ; at least one free block and round\r
2917         ANDCMI  A,1777          ;   to block boundary\r
2918         CAMG    A,PURTOP        ; any hope of this?\r
2919         JRST    CORAD5          ; yes, now see if some slop space can appear\r
2920 \r
2921         SETOM   GCDANG          ; tell caller we lost\r
2922         MOVE    A,PURTOP        ; try to get as much as possible anyway\r
2923         SUB     A,PURBOT\r
2924         SUB     A,CURPLN\r
2925 CORAD8: ASH     A,-10.          ; to pages\r
2926         PUSHJ   P,GETPAG\r
2927         FATAL   PAGES NOT AVAILABLE\r
2928         MOVSI   D,400000        ; wipes out D\r
2929         MOVE    A,PURBOT        ; and use current PURBOT as new core top\r
2930         SUBI    A,2000          ; for gc pdl\r
2931         MOVEM   A,CORTOP\r
2932         JRST    CORAD6          ; and allocate necessary pages\r
2933 \r
2934 ; Here if real necessities taken care of, try for slop space\r
2935 \r
2936 CORAD5: ADD     A,FREMIN        ; try for minimum\r
2937         SUBI    A,2000-1777     ; round and flush min 2000 of before\r
2938         ANDCMI  A,1777          ; round to block boundary\r
2939         CAMG    A,PURTOP        ; again, do we win?\r
2940         JRST    CORAD7          ; yes, we win totally\r
2941 \r
2942 ; Here if cant get desired free but get some\r
2943 \r
2944         MOVE    A,PURTOP        ; compute pages to flush\r
2945         SUB     A,CURPLN        ; again dont flush current prog\r
2946         SUB     A,PURBOT        ; A/ words to get\r
2947         JRST    CORAD8          ; go do it\r
2948 \r
2949 ; Here if can get all the free we want\r
2950 \r
2951 CORAD7: SUB     A,CURPLN\r
2952         CAMG    A,PURBOT        ; do any pages get the ax?\r
2953         JRST    CORAD9          ; no, see if can give core back!\r
2954         SUB     A,PURBOT        ; words to get purely\r
2955         JRST    CORAD8\r
2956 \r
2957 CORAD9: CAMG    A,CORTOP        ; skip if must get core\r
2958         JRST    CORA10\r
2959         MOVEM   A,CORTOP\r
2960         JRST    CORAD6          ; and go get it\r
2961 \r
2962 ; Here if still may have to give it back\r
2963 \r
2964 CORA10: MOVE    B,CORTOP\r
2965         SUB     B,A\r
2966         CAMG    B,FREDIF        ; skip if giving awy\r
2967         JRST    CORA11\r
2968 \r
2969 CORA12: MOVEM   A,CORTOP\r
2970         ASH     A,-10.\r
2971         MOVEM   A,CORSET        ; leave to shrink later\r
2972         JRST    CORA11\r
2973 \r
2974 ; Here if going down to also get free space\r
2975 \r
2976 CORAD4: SUBI    A,2000          ; uncompensate for min\r
2977         ADD     A,FREMIN\r
2978         CAML    A,CORTOP        ; skip if ok for max\r
2979         MOVE    A,CORTOP        ; else use up to pure\r
2980         SUB     A,GCDOWN        ; new CORTOP to A\r
2981         JRST    CORA12          ; go set up final shrink\r
2982 \r
2983 ; routine to wait for core\r
2984 \r
2985 SLPM1:  MOVEI   0,1\r
2986         .SLEEP  0,\r
2987         SOS     (P)\r
2988         SOS     (P)             ; ret to prev ins\r
2989         POPJ    P,\r
2990 \r
2991 CORADL: PUSHJ   P,P.CORE        ;SET TO NEW CORE VALUE\r
2992         FATAL AGC--CANT CORE DOWN\r
2993         POPJ    P,\r
2994 \f;VECTOR RELOCATE --GETS VECTOP IN A\r
2995 ;AND VECNEW IN B\r
2996 ;FILLS IN RELOCATION FIELDS OF MARKED VECTORS\r
2997 ;AND REUTRNS FINAL VECNEW IN B\r
2998 \r
2999 VECREL: CAMG    A,VECBOT        ;PROCESSED TO BOTTOM OF VECTOR SPACE?\r
3000         POPJ    P,              ;YES, RETURN\r
3001         HLRE    C,(A)           ;GET COUNT FROM DOPE WD, EXTEND MARK BIT\r
3002         JUMPL   C,VECRE1        ;IF MARKED GO PROCESS\r
3003         HRRM    A,(A)           ; INDICATE NON-MOVE BY LEAVING SAME\r
3004         SUBI    A,(C)           ;MOVE ON TO NEXT VECTOR\r
3005         SOJG    C,VECREL        ;AND KEEP SCANNING\r
3006         JSP     D,VCMLOS        ;LOSER, LEAVE TRACKS AS TO WHO LOST\r
3007 \r
3008 VECRE1: HRRZ    E,-1(A)         ;GOBBLE THE GROWTH FILEDS\r
3009         HRRM    B,(A)           ;STORE RELOCATION\r
3010         JUMPE   E,VECRE2        ;NO GROWTH (OR SHRINKAGE), GO AWAY\r
3011         LDB     F,[111100,,E]   ;GET TOP GROWTH IN F\r
3012         TRZN    F,400           ;CHECK AND FLUSH SIGN\r
3013         MOVNS   F               ;WAS ON, NEGATE\r
3014         SKIPE   GCDNTG          ; SKIP IF GROWTH OK\r
3015         JUMPL   F,VECRE3        ; DONT ALLOW POSITIVE GROWTH\r
3016         ASH     F,6             ;CONVERT TO WORDS\r
3017         ADD     B,F             ;UPDATE RELOCATION\r
3018         HRRM    B,(A)           ;AND STORE IT\r
3019 VECRE3: ANDI    E,777           ;ISOLATE BOTTOM GROWTH\r
3020         TRZN    E,400           ;CHECK AND CLEAR SIGN\r
3021         MOVNS   E\r
3022         SKIPE   GCDNTG          ; SKIP IF GROWTH OK\r
3023         JUMPL   E,VECRE2\r
3024         ASH     E,6             ;CONVERT TO WORDS\r
3025         ADD     B,E             ;UPDATE FUTURE RELOCATIONS\r
3026 VECRE2: SUBI    A,400000(C)     ;AND MOVE ON TO NEXT VECTOR\r
3027         ANDI    C,377777        ;KILL MARK\r
3028         SUBI    B,(C)           ; UPDATE WHERE TO GO LOCN\r
3029         SOJG    C,VECREL        ;AND KEEP GOING\r
3030         JSP     D,VCMLOS        ;LOSES, LEAVE TRACKS\r
3031 \r
3032 ;PAIR SPACE UPDATE\r
3033 \r
3034 ;GETS PARBOT IN AC A\r
3035 ;UPDATES VALUES AND CDRS UP TO PARTOP\r
3036 \r
3037 PARUPD: CAML    A,PARTOP        ;ARE THERE MORE PAIRS TO PROCESS\r
3038         POPJ    P,              ;NO -- RETURN\r
3039 \r
3040 ;UPDATE VALUE CELL\r
3041 PARUP1: ANDCAM  D,(A)           ; KILL MARK BIT\r
3042         HLRZ    B,(A)           ;SET RH OF B TO TYPE\r
3043         MOVE    C,1(A)          ;SET C TO VALUE\r
3044         PUSHJ   P,VALUPD        ;UPDATE THIS VALUE\r
3045         ADDI    A,2             ;MOVE ON TO NEXT PAIR\r
3046         JRST    PARUPD          ;AND CONTINUE\r
3047 \r
3048 \r
3049 \f;VECTOR SPACE UPDATE\r
3050 ;GETS VECTOP IN A\r
3051 ;UPDATES ALL VALUE CELLS IN MARKED VECTORS\r
3052 ;ESCAPES WHEN IT GETS TO VECBOT\r
3053 \r
3054 VECUPD: SUBI    A,1             ;MAKE A POINT TO LAST DOPE WD\r
3055         PUSH    P,VECBOT\r
3056         PUSHJ   P,UPD1\r
3057         SUB     P,[1,,1]\r
3058         POPJ    P,\r
3059 \r
3060 ; STORAGE SPACE UPDATE\r
3061 \r
3062 STOUP:  PUSH    P,[STOSTR]\r
3063         PUSHJ   P,UPD1\r
3064         SUB     P,[1,,1]\r
3065         JRST    ENHACK\r
3066 UPD1:\r
3067 VECUP1: CAMG    A,-1(P)         ;ANY MORE VECTORS TO PROCESS?\r
3068         POPJ    P,\r
3069         SKIPGE  B,(A)           ;IS DOPE WORD MARKED?\r
3070         JRST    VECUP2          ;YES -- GO PROCESS VALUES IN THIS VECTOR\r
3071         HLLZS   -1(A)           ;MAKE SURE NO GROWTH ATTEMPTS\r
3072         HLRZS   B               ;NO -- SET RH OF B TO SIZE OF VECTOR\r
3073 VECUP5: SUB     A,B             ;SET A TO POINT TO DOPE WD OF NEXT VECTOR\r
3074         JRST    VECUP1          ;AND CONTINUE\r
3075 \r
3076 VECUP2: PUSH    P,A             ;SAVE DOPE WORD POINTER\r
3077         HLRZ    B,(A)           ;GET LENGTH OF THIS VECTOR\r
3078 VECU11: ANDI    B,377777        ;TURN OFF MARK BIT\r
3079         SKIPGE  E,-1(A)         ;CHECK FOR UNIFORM OR SPECIAL\r
3080         TLNE    E,377777        ;SKIP IF GENERAL\r
3081         JRST    VECUP6          ;UNIFORM OR SPECIAL, GO DO IT\r
3082 VECU10: SUB     A,B             ;SET AC A TO NEXT DOPE WORD\r
3083         ADDI    A,1             ;AND ADVANCE TO FIRST ELEMENT OF THIS VECTOR\r
3084 VECUP3: HLRZ    B,(A)           ;GET TYPE\r
3085         TRNE    B,400000        ;IF MARK BIT SET\r
3086         JRST    VECUP4          ;DONE WITH THIS VECTOR\r
3087         ANDI    B,TYPMSK\r
3088         CAIE    B,TCBLK\r
3089         CAIN    B,TENTRY        ;SPECIAL HACK FOR ENTRY\r
3090         JRST    ENTRUP\r
3091         CAIE    B,TUNWIN\r
3092         CAIN    B,TSKIP         ; SKIP POINTER\r
3093         JRST    BINDUP          ; HACK APPROPRAITELY\r
3094         CAIE    B,TBVL          ;VECTOR BINDING?\r
3095         CAIN    B,TBIND         ;AND BINDING BLOCK\r
3096         JRST    BINDUP\r
3097         CAIN    B,TUBIND\r
3098         JRST    BINDUP\r
3099 VECU15: MOVE    C,1(A)          ;GET VALUE\r
3100         PUSHJ   P,VALUPD        ;UPDATE THIS VALUE\r
3101 VECU12: ADDI    A,2             ;GO ON TO NEXT VECTOR\r
3102         JRST    VECUP3          ;AND CONTINUE\r
3103 \r
3104 VECUP4: POP     P,A             ;SET TO OLD DOPE WORD\r
3105         ANDCAM  D,(A)           ;TURN OFF MARK BIT\r
3106         HLRZ    B,(A)           ;GET LENGTH\r
3107         ANDI    B,377777        ; IN CASE DING STORAGE\r
3108         JRST    VECUP5          ;GO ON TO NEXT VECTOR\r
3109 \r
3110 \r
3111 \r
3112 ;UPDATE A SAVED SAVE BLOCK\r
3113 ENTSUP: MOVEI   A,FRAMLN+SPSAV-1(A)     ;A POINTS BEFORE SAVED SP\r
3114         MOVEI   B,TSP\r
3115         PUSHJ   P,VALPD1                ;UPDATE SPSAV\r
3116         MOVEI   A,PSAV-SPSAV(A)\r
3117         MOVEI   B,TPDL\r
3118         PUSHJ   P,VALPD1                ;UPDATE PSAV\r
3119         MOVEI   A,TPSAV-PSAV(A)\r
3120         MOVEI   B,TTP\r
3121         PUSHJ   P,VALPD1                ;UPDATE TPSAV\r
3122 ;SKIP TO END OF BLOCK\r
3123         SUBI    A,PSAV-1\r
3124         JRST    VECUP3\r
3125 \r
3126 ;IGNORE A BLOCK\r
3127 IGBLK2: HRRZ    B,(A)           ;GET DISPLACEMENT\r
3128         ADDI    A,3(B)          ;USE IT\r
3129         JRST    VECUP3          ;GO\r
3130 \r
3131 \f; ENTRY PART OF THE STACK UPDATER\r
3132 \r
3133 ENTRUP: ADDI    A,FRAMLN-2      ;POINT PAST FRAME\r
3134         JRST    VECU12          ;NOW REJOIN VECTOR UPDATE\r
3135 \r
3136 ; UPDATE A BINDING BLOCK\r
3137 \r
3138 BINDUP: HRRZ    C,(A)           ;POINT TO CHAIN\r
3139         JUMPE   C,NONEXT        ;JUMP IF NO NEXT BINDING IN CHAIN\r
3140         HRRZ    0,@(P)          ; GET OWN DESTINATION\r
3141         SUBI    0,@(P)          ; RELATIVIZE\r
3142         ADD     C,0             ; AND UPDATE\r
3143         HRRM    C,(A)           ;AND STORE IT BACK\r
3144 NONEXT: CAIN    B,TUBIND\r
3145         JRST    .+3\r
3146         CAIE    B,TBIND         ;SKIP IF VAR BINDING\r
3147         JRST    VECU14          ;NO, MUST BE A VECTOR BIND\r
3148         MOVEI   B,TATOM         ;UPDATE ATOM POINTER\r
3149         PUSHJ   P,VALPD1\r
3150         ADDI    A,2\r
3151         HLRZ    B,(A)           ;TYPE OF VALUE\r
3152         PUSHJ   P,VALPD1\r
3153         ADDI    A,2             ; POINT TO PREV LOCATIVE\r
3154 VECU16: MOVEI   B,TLOCI\r
3155         SKIPN   1(A)            ; IF NO LOCATIVE,\r
3156         MOVEI   B,TUNBOU        ; SAY UNBOUND\r
3157         PUSHJ   P,VALPD1\r
3158         JRST    VECU12\r
3159 \r
3160 VECU14: CAIN    B,TBVL          ; CHANGE BVL TO VEC\r
3161         MOVEI   B,TVEC          ;NOW TREAT LIKE A VECTOR\r
3162         JRST    VECU15\r
3163 \r
3164 ; NOW SAFE TO UPDATE ALL ENTRY BLOCKS\r
3165 \r
3166 ENHACK: HRRZ    F,TBSTO(LPVP)   ;GET POINTER TO TOP FRAME\r
3167         HLLZS   TBSTO(LPVP)     ;CLEAR FIELD\r
3168         HLLZS   TPSTO(LPVP)\r
3169         JUMPE   F,LSTFRM        ;FINISHED\r
3170 \r
3171 ENHCK1: MOVEI   A,FSAV-1(F)     ;POINT PRIOR TO SAVED FUNCTION\r
3172         HRRZ    C,1(A)          ; GET POINTER TO FCN\r
3173         CAML    C,VECBOT        ; SKIP IF A LOSER\r
3174         CAMLE   C,VECTOP        ; SKIP IF A WINNER\r
3175         JRST    ENHCK2\r
3176         HRL     C,(C)           ; MAKE INTO AOBJN\r
3177         MOVEI   B,TVEC\r
3178         PUSHJ   P,VALUPD        ; AND UPDATE\r
3179 ENHCK2: HRRZ    F,2(A)          ;POINT TO PRIOR FRAME\r
3180         MOVEI   B,TTB           ;MARK  SAVED TB\r
3181         PUSHJ   P,[AOJA A,VALPD1]\r
3182         MOVEI   B,TAB           ;MARK ARG POINTER\r
3183         PUSHJ   P,[AOJA A,VALPD1]\r
3184         MOVEI   B,TSP           ;SAVED SP\r
3185         PUSHJ   P,[AOJA A,VALPD1]\r
3186         MOVEI   B,TPDL          ;SAVED P STACK\r
3187         PUSHJ   P,[AOJA A,VALPD1]\r
3188         MOVEI   B,TTP           ;SAVED TP\r
3189         PUSHJ   P,[AOJA A,VALPD1]\r
3190         JUMPN   F,ENHCK1        ;MARK NEXT ONE IF IT EXISTS\r
3191 \r
3192 LSTFRM: HRRZ    A,BINDID(LPVP)  ;NEXT PROCESS\r
3193         HLLZS   BINDID(LPVP)    ;CLOBBER\r
3194         MOVEI   LPVP,(A)\r
3195         JUMPN   LPVP,ENHACK     ;DO NEXT PROCESS\r
3196         POPJ    P,\r
3197 \r
3198 \f; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS\r
3199 \r
3200 VECUP6: JUMPL   E,VECUP7        ;JUMP IF  SPECIAL\r
3201         CAIG    B,2             ;EMPTY UVECTOR ?\r
3202         JRST    VECUP4          ;YES, NOTHING TO UPDATE\r
3203         HLRZS   E               ;ISOLATE TYPE\r
3204         ANDI    E,37777\r
3205         EXCH    E,B             ;TYPE TO B AND LENGTH TO E\r
3206         SUBI    A,(E)           ;POINT TO NEXT DOPE WORD\r
3207         LSH     B,1             ;FIND SAT\r
3208         HRRZ    B,@TYPNT\r
3209         ANDI    B,SATMSK\r
3210         MOVE    B,UPDTBS(B)     ;FIND WHERE POINTS\r
3211         CAIN    B,CPOPJ         ;UNMARKED?\r
3212         JRST    VECUP4          ;YES, GO ON TO NEXT VECTOR\r
3213         PUSH    P,B             ;SAVE SR POINTER\r
3214         SUBI    E,2             ;DON'T COUNT DOPE WORDS\r
3215 \r
3216 VECUP8: MOVE    C,1(A)          ;GET GOODIE\r
3217         MOVEI   0,(C)           ; ISOLATE ADDR\r
3218         JUMPE   0,.+3           ; NEVER 0 PNTR\r
3219         CAIGE   0,@PURBOT       ; OR IF PURE\r
3220         PUSHJ   P,@(P)          ;CALL UPDATE ROUTINE\r
3221         ADDI    A,1\r
3222         SOJG    E,VECUP8        ;LOOP FOR ALL ELEMNTS\r
3223 \r
3224         SUB     P,[1,,1]        ;REMOVE RANDOMNESS\r
3225         JRST    VECUP4\r
3226 \r
3227 ; SPECIAL VECTOR UPDATE\r
3228 \r
3229 VECUP7: HLRZS   E               ;ISOLATE SPECIAL TYPE\r
3230         CAIN    E,SATOM+400000  ;ATOM?\r
3231         JRST    ATOMUP          ;YES, GO DO IT\r
3232         CAIN    E,STPSTK+400000 ;STACK\r
3233         JRST    VECU10          ;TREAT LIKE A VECTOR\r
3234         CAIN    E,SPVP+400000   ;PROCESS VECTOR\r
3235         JRST    PVPUP           ;DO SPECIAL STUFF\r
3236         CAIN    E,SASOC+400000\r
3237         JRST    ASOUP           ;UPDATE ASSOCIATION BLOCK\r
3238 \r
3239         TRZ     E,400000        ; CHECK FOR TEMPLATE VECTOR\r
3240         CAIG    E,NUMSAT        ; SKIP IF POSSIBLE\r
3241         FATAL AGC--UNRECOGNIZED SPECIAL VECTOR (UPDATE)\r
3242         MOVEI   E,-NUMSAT-1(E)\r
3243         HRLI    E,(E)\r
3244         ADD     E,TD.LNT+1(TVP)\r
3245         SKIPL   E\r
3246         FATAL AGC--BAD TEMPLATE TYPE\r
3247 \r
3248 TD.UPD: MOVEI   C,-1(A)         ; POINTER TO OBJECT IN C\r
3249         XCT     (E)\r
3250         HLRZ    D,B             ; POSSIBLE BASIC LENGTH\r
3251         PUSH    P,[0]\r
3252         PUSH    P,D\r
3253         MOVEI   B,(B)           ; ISOLATE LENGTH\r
3254         PUSH    P,C             ; SAVE POINTER TO OBJECT\r
3255 \r
3256         PUSH    P,[0]           ; HOME FOR VALUES\r
3257         PUSH    P,[0]           ; SLOT FOR TEMP\r
3258         PUSH    P,B             ; SAVE\r
3259         SUB     E,TD.LNT+1(TVP)\r
3260         PUSH    P,E             ; SAVE FOR FINDING OTHER TABLES\r
3261         JUMPE   D,TD.UP2        ; NO REPEATING SEQ\r
3262         ADD     E,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
3263         HLRE    E,(E)           ; E ==> - LNTH OF TEMPLATE\r
3264         ADDI    E,(D)           ; E ==> -LENGTH OF REP SEQ\r
3265         MOVNS   E\r
3266         HRLM    E,-5(P)         ; SAVE IT AND BASIC\r
3267 \r
3268 TD.UP2: SKIPG   D,-1(P)         ; ANY LEFT?\r
3269         JRST    TD.UP1\r
3270 \r
3271         MOVE    E,TD.GET+1(TVP)\r
3272         ADD     E,(P)\r
3273         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
3274         MOVEM   D,-6(P)         ; SAVE ELMENT #\r
3275         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST\r
3276         SOJA    D,TD.UP3\r
3277 \r
3278         MOVEI   0,(B)           ; BASIC LNT TO 0\r
3279         SUBI    0,(D)           ; SEE IF PAST BASIC\r
3280         JUMPGE  0,.-3           ; JUMP IF O.K.\r
3281         MOVSS   B               ; REP LNT TO RH, BASIC TO LH\r
3282         IDIVI   0,(B)           ; A==> -WHICH REPEATER\r
3283         MOVNS   A\r
3284         ADD     A,-5(P)         ; PLUS BASIC\r
3285         ADDI    A,1             ; AND FUDGE\r
3286         MOVEM   A,-6(P)         ; SAVE FOR PUTTER\r
3287         ADDI    E,-1(A)         ; POINT\r
3288         SOJA    D,.+2\r
3289 \r
3290 TD.UP3: ADDI    E,(D)           ; POINT TO SLOT\r
3291         XCT     (E)             ; GET THIS ELEMENT INTO A AND B\r
3292         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT\r
3293         MOVEM   B,-2(P)\r
3294         MOVE    C,B             ; VALUE TO C FOR VALUPD\r
3295         GETYP   B,A\r
3296         MOVEI   A,-3(P)         ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG\r
3297         MOVSI   D,400000        ; RESET FOR MARK\r
3298         PUSHJ   P,VALUPD        ; AND MARK THIS GUY (RET FIXED POINTER IN A)\r
3299         MOVE    C,-4(P)         ; GET POINTER FOR UPDATE OF ELEMENT\r
3300         MOVE    E,TD.PUT+1(TVP)\r
3301         SOS     D,-1(P)         ; RESTORE COUNT\r
3302         ADD     E,(P)\r
3303         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
3304         MOVE    B,-6(P)         ; SAVED OFFSET\r
3305         ADDI    E,(B)-1         ; POINT TO SLOT\r
3306         MOVE    A,-3(P)         ; RESTORE TYPE WORD\r
3307         MOVE    B,-2(P)\r
3308         XCT     (E)             ; SMASH IT BACK\r
3309         FATAL TEMPLATE LOSSAGE\r
3310         MOVE    C,-4(P)\r
3311         JRST    TD.UP2\r
3312 \r
3313 TD.UP1: SUB     P,[7,,7]\r
3314         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT\r
3315         JRST    VECUP4\r
3316 \r
3317 \f; UPDATE ATOM VALUE CELLS\r
3318 \r
3319 ATOMUP: SUBI    A,-1(B)         ; POINT TO VALUE CELL\r
3320         HLRZ    B,(A)\r
3321         HRRZ    0,(A)           ;GOBBLE BINDID\r
3322         JUMPN   0,.+3           ;NOT GLOBAL\r
3323         CAIN    B,TLOCI         ;IS IT A LOCATIVE?\r
3324         MOVEI   B,TVEC          ;MARK AS A VECTOR\r
3325         HRRZ    0,1(A)          ; GET POINTER\r
3326         CAML    0,VECBOT\r
3327         CAMLE   0,VECTOP\r
3328         JRST    .+2             ; OUT OF BOUNDS, DONT UPDATE\r
3329         PUSHJ   P,VALPD1        ;UPDATE IT\r
3330         MOVEI   B,TOBLS         ; TYPE TO OBLIST\r
3331         SKIPGE  2(A)\r
3332         PUSHJ   P,[AOJA A,VALPD1]\r
3333         JRST    VECUP4\r
3334 \r
3335 ; UPDATE PROCESS VECTOR\r
3336 \r
3337 PVPUP:  SUBI    A,-1(B)         ;POINT TO TOP\r
3338         HRRM    LPVP,BINDID(A)  ;CHAIN ALL PROCESSES TOGETHER\r
3339         MOVEI   LPVP,(A)\r
3340         HRRZ    0,TBSTO+1(A)    ;POINT TO CURRENT FRAME\r
3341         HRRM    0,TBSTO(A)      ;SAVE\r
3342         HRRZ    0,TPSTO+1(A)    ;0_SAVED TP POINTER\r
3343         HLRE    B,TPSTO+1(A)\r
3344         SUBI    0,-1(B)         ;0 _ POINTER TO OLD DOPE WORD\r
3345         HRRM    0,TPSTO(A)\r
3346         JRST    VECUP3\r
3347 \r
3348 \r
3349 \f;THIS SUBROUTINE TAKES CARE OF UPDATING ASSOCIATION BLOCKS\r
3350 \r
3351 ASOUP:  SUBI    A,-1(B)         ;POINT TO START OF BLOCK\r
3352         HRRZ    B,ASOLNT-1(A)   ;POINT TO NEXT\r
3353         JUMPE   B,ASOUP1\r
3354         HRRZ    C,ASOLNT+1(B)   ;AND GET ITS RELOC IN C\r
3355         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE\r
3356         ADDM    C,ASOLNT-1(A)   ;C NOW HAS UPDATED PONTER\r
3357 ASOUP1: HLRZ    B,ASOLNT-1(A)   ;GET PREV BLOCK POINTER\r
3358         JUMPE   B,ASOUP2\r
3359         HRRZ    F,ASOLNT+1(B)   ;AND ITS RELOCATION\r
3360         SUBI    F,ASOLNT+1(B)   ; RELATIVIZE\r
3361         MOVSI   F,(F)\r
3362         ADDM    F,ASOLNT-1(A)   ;RELOCATE\r
3363 ASOUP2: HRRZ    B,NODPNT(A)             ;UPDATE NODE CHAIN\r
3364         JUMPE   B,ASOUP4\r
3365         HRRZ    C,ASOLNT+1(B)           ;GET RELOC\r
3366         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE\r
3367         ADDM    C,NODPNT(A)     ;ANID UPDATE\r
3368 ASOUP4: HLRZ    B,NODPNT(A)     ;GET PREV POINTER\r
3369         JUMPE   B,ASOUP5\r
3370         HRRZ    F,ASOLNT+1(B)   ;RELOC\r
3371         SUBI    F,ASOLNT+1(B)\r
3372         MOVSI   F,(F)\r
3373         ADDM    F,NODPNT(A)\r
3374 ASOUP5: HRLI    A,-3            ;SET TO UPDATE OTHER CONTENTS\r
3375 \r
3376 ASOUP3: HLRZ    B,(A)           ;GET TYPE\r
3377         PUSHJ   P,VALPD1        ;UPDATE\r
3378         ADD     A,[1,,2]        ;MOVE POINTER\r
3379         JUMPL   A,ASOUP3\r
3380         JRST    VECUP4          ;AND QUIT\r
3381 \r
3382 \f;VALUPD UPDATES A SINLE VALUE FROM EITHER PAIR SPACE OR VECTOR SPACE\r
3383 ;GETS POINTER TO TYPE CELL IN RH OF A\r
3384 ;TYPE IN RH OF B (LH MUST BE 0)\r
3385 ;VALUE IN C\r
3386 \r
3387 VALPD1: MOVE    C,1(A)          ;GET VALUE TO UPDATE\r
3388 VALUPD: MOVEI   0,(C)\r
3389         CAIGE   0,@PURBOT       ; SKIP IF PURE, I.E. DONT HACK\r
3390         TRNN    C,-1            ;ANY POINTER PART?\r
3391         JRST    CPOPJ           ;NO, LEAVE\r
3392         ANDI    B,TYPMSK\r
3393         LSH     B,1             ;SET TYPE TIMES 2\r
3394         HRRZ    B,@TYPNT        ;GET STORAGE ALLOCATION TYPE\r
3395         ANDI    B,SATMSK\r
3396         CAIG    B,NUMSAT                ; SKIP IF TEMPLATE\r
3397         JRST    @UPDTBS(B)      ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE\r
3398         AOJA    C,TMPLUP\r
3399 \r
3400 ;SAT DISPATCH TABLE\r
3401 \r
3402 DISTBS UPDTBS,CPOPJ,[[SNWORD,NWRDUP],[STPSTK,STCKUP]\r
3403 [SFRAME,FRAMUP],[STBASE,TBUP],[SARGS,ARGUP],[SBYTE,BYTUP],[SATOM,NWRDUP],[SPSTK,STCKUP]\r
3404 [SLOCID,LOCUP],[SPVP,NWRDUP],[S2NWORD,NWRDUP],[SABASE,ABUP],[SCHSTR,BYTUP],[SASOC,ASUP]\r
3405 [SLOCA,ARGUP],[SLOCU,NWRDUP],[SLOCN,ASUP],[SLOCS,BYTUP],[SGATOM,NWRDUP]]\r
3406 \r
3407 \r
3408 \r
3409 \r
3410 ;PAIR POINTER UPDATE\r
3411 2WDUP:  MOVEI   0,(C)\r
3412         CAIGE   0,@PURBOT       ; SKIP AND IGNORE IF PURE\r
3413         TRNN    C,-1            ;POINT TO NIL?\r
3414         POPJ    P,              ;YES -- NO UPDATE NEEDED\r
3415         SKIPGE  B,(C)           ;NO -- IS THIS A BROKEN HEART\r
3416         HRRM    B,1(A)          ;YESS -- STORE NEW VALUE\r
3417         SKIPE   B,PARNEW        ;IF LIST SPACE IS MOVING\r
3418         ADDM    B,1(A)          ;THEN ADD OFFSET TO VALUE\r
3419         POPJ    P,              ;FINISHED\r
3420 \r
3421 ; HERE TO UPDATE ASSOCIATIONS\r
3422 \r
3423 ASUP:   HRLI    C,-ASOLNT       ;MAKE INTO VECTOR POINTER\r
3424         JRST    NWRDUP\r
3425 \f;VECTOR, ATOM, STACK, AND BASE POINTER UPDATE\r
3426 \r
3427 LOCUP:  HRRZ    B,(A)           ;CHECK IF IT IS TIMED\r
3428         JUMPN   B,LOCUP1        ;JUMP IF TIMED, OTHERWISE TREAT LIKE VECTORE\r
3429 \r
3430 NWRDUP: HLRE    B,C             ;EXTEND COUNT IN B\r
3431         SUBI    C,-1(B)         ;SET C TO POINT TO DOPE WORD\r
3432 TMPLUP: HRRZ    B,(C)           ;EXTEND RELOCATION IN B\r
3433         SUBI    B,(C)           ; RELATIVIZE\r
3434         ADDM    B,1(A)          ;AND ADD RELOCATION TO STORED DATUM\r
3435         HRRZ    C,-1(C)         ;GET GROWTH SPECS\r
3436         JUMPE   C,CPOPJ         ;NO GROWTH, LEAVE\r
3437         LDB     C,[111100,,C]   ;GET UPWORD GROWTH\r
3438         TRZN    C,400           ;FLUSH SIGN AN NEGATR DIRECTION\r
3439         MOVNS   C\r
3440         SKIPE   GCDNTG          ; SKIP IF GROWTH WINS\r
3441         JUMPL   C,CPOPJ         ; POS GROWTH, LOSE\r
3442         ASH     C,6+18.         ;TO LH AND TIMES 100(8)\r
3443         ADDM    C,1(A)          ;UPDATE POINTER\r
3444         POPJ    P,\r
3445 \r
3446 \r
3447 LOCUP1:\r
3448 STCKUP: MOVSI   B,PDLBUF        ;GET OFFSET FOR PDLS\r
3449         ADDM    B,1(A)          ;AND ADD TO COUNT\r
3450         JRST    NWRDUP          ;NOW TREAT LIKE VECTOR\r
3451 \r
3452 BYTUP:  MOVEI   C,(A)           ; SET TO GET DOPE WORD\r
3453         PUSH    P,A\r
3454         PUSHJ   P,BYTDOP\r
3455         POP     P,C\r
3456         HRRZ    B,(A)           ;SET B TO RELOCATION FOR THIS VEC\r
3457         SUBI    B,(A)           ; RELATIVIZE\r
3458         ADDM    B,1(C)          ;AND UPDATE VALUE\r
3459         MOVE    A,C             ; FIX UP FOR SCANNER\r
3460         POPJ    P,              ;DONE WITH UPDATE\r
3461 \r
3462 ARGUP:\r
3463 ABUP:   HLRE    B,C             ;GET LENGTH\r
3464         SUB     C,B             ;POINT TO FRAME\r
3465         HLRZ    B,(C)           ;GET TYPE OF NEXT GOODIE\r
3466         ANDI    B,TYPMSK\r
3467         CAIN    B,TINFO         ;IS IT A FRAME\r
3468         ADD     C,1(C)          ;NO, POINT TO FRAME\r
3469         CAIE    B,TINFO ;IF IT IS A FRAME\r
3470         ADDI    C,FRAMLN        ;POINT TO ITS BASE\r
3471 TBUP:   MOVE    C,TPSAV(C)      ;GET A ASTACK POINTER TO FIND DOPE WORD\r
3472         HLRE    B,C             ;UPDATE BASED ON THIS POINTER\r
3473         SUBI    C,(B)\r
3474 ABUP1:  HRRZ    B,1(C)          ;GET RELOCATION\r
3475         SUBI    B,1(C)          ; RELATIVIZE\r
3476         ADDM    B,1(A)          ;AND MUNG POINTER\r
3477         POPJ    P,\r
3478 \r
3479 FRAMUP: HRRZ    B,(A)           ;UPDATE PVP\r
3480         HRRZ    C,(B)           ;IN CELL\r
3481         SUBI    C,(B)           ; RELATIVIZE\r
3482         ADDM    C,(A)\r
3483         HLRZ    C,(B)\r
3484         ANDI    C,377777\r
3485         SUBI    B,-1(C)         ;ADDRESS OF PV\r
3486         HRRZ    C,TPSTO(B)              ;IF TPSTO HAS OLD TP DOPE WORD,\r
3487         JUMPN   C,ABUP2         ;USE IT\r
3488         HRRZ    C,TPSTO+1(B)            ;ELSE, GENERATE IT\r
3489         HLRE    B,TPSTO+1(B)\r
3490         SUBI    C,-1(B)\r
3491 ABUP2:  SOJA    C,ABUP1         ; FUDGE AND GO\r
3492 \r
3493 \f;VECTOR SHRINKING PHASE\r
3494 \r
3495 VECSH:  SUBI    A,1             ;POOINT TO 1ST DOPE WORD\r
3496 VECSH1: CAMGE   A,VECBOT        ;FINISHED\r
3497         POPJ    P,              ;YES, QUIT\r
3498         HRRZ    B,-1(A)         ;GET A SPEC\r
3499         JUMPE   B,NXTSHN        ;IGNORE IF NONE\r
3500         PUSHJ   P,GETGRO        ;GET THE SPECS\r
3501         JUMPGE  C,SHRNBT        ;SHRINKIGN AT BOTTOM\r
3502         MOVEI   E,(A)           ;COPY POINTER\r
3503         ADD     A,C             ;POINT TO NEW DOPE LOCATION WITH E\r
3504         MOVE    F,-1(E)         ;GET OLD DOPE\r
3505         ANDCMI  F,777000        ;KILL THIS SPEC\r
3506         MOVEM   F,-1(A)         ;STORE\r
3507         MOVE    F,(E)           ;OTHER DOPE WORD\r
3508         ADD     F,C             ; UPDATE DESTINATION\r
3509         HRLZI   C,(C)           ;TO LH\r
3510         ADD     F,C             ;CHANGE LENGTH\r
3511         MOVEM   F,(A)           ;AND STORE\r
3512         MOVMS   C               ;PLUSIFY\r
3513         HRRI    C,(E)           ; MAKE NOT MOVE\r
3514         MOVEM   C,(E)           ;AND STORE\r
3515         SETZM   -1(E)\r
3516 SHRNBT: JUMPGE  B,NXTSHN        ;GROWTH, IGNOORE\r
3517         MOVM    E,B             ;GET A POSITIVE COPY\r
3518         HRLZI   B,(B)           ;TO LH\r
3519         ADDM    B,(A)           ;ADD INTO DOPE WORD\r
3520         MOVEI   0,777           ;SET TO CLOBBER GROWTH\r
3521         ANDCAM  0,-1(A)         ;CLOBBER\r
3522         HLRZ    B,(A)           ;GET NEW LENGTH\r
3523         SUBI    A,(B)           ;POINT TO LOW END\r
3524         HRLI    E,(A)           ; MAKE NON MOVER\r
3525         MOVSM   E,(A)           ;STORE\r
3526         SETZM   -1(A)\r
3527 \r
3528 NXTSHN: HLRZ    B,(A)           ;GET LENGTH\r
3529         JUMPE   B,VCMLOS        ;LOOSE\r
3530         SUBI    A,(B)           ;STEP\r
3531         JRST    VECSH1\r
3532 \r
3533 GETGRO: LDB     C,[111100,,B]   ;GET UPWARD GROWTH\r
3534         TRZE    C,400           ;CHECK AND MUNG SIGN\r
3535         MOVNS   C\r
3536         ASH     C,6             ;?IMES 100\r
3537         ANDI    B,777           ;AND GET DOWN GROWTH\r
3538         TRZE    B,400           ;CHECK AND MUNG SIGN\r
3539         MOVNS   B\r
3540         ASH     B,6\r
3541         POPJ    P,\r
3542 \f;VECMOV -- MOVES VECTOR DATA TO WHERE RELOC FIELDS OF\r
3543 ;VECTORS INDICATE.  MOVES DOPEWDS UP FOR VECTORS GROWING AT\r
3544 ;THE END.\r
3545 ;CALLED WITH VECTOP IN A.  CALLS PARMOV TO MOVE PAIRS\r
3546 \r
3547 VECMOV: SUBI    A,1             ;SET A TO ADDR OF TOP DOPE WD\r
3548         MOVSI   D,400000        ;NEGATIVE D MARKS END OF BACK CHAIN\r
3549         MOVEI   TYPNT,0         ;CLEAR ON GOING ADDRESS FOR FORWARD RESUME\r
3550 VECMO1: CAMGE   A,VECBOT        ;GOT TO BOTTOM OF VECTORS\r
3551         JRST    PARMOV          ;YES, MOVE LIST ELEMENTS AND RETURN\r
3552         MOVEI   C,(A)           ;NO, COPY ADDR OF THIS DOPEWD\r
3553         HRRZ    B,(A)           ;GET RELOCATION OF THIS VECTOR\r
3554         SUBI    B,(A)           ; RELATIVIZE\r
3555         JUMPL   B,VECMO5        ;IF MOVING DOWNWARD, MAKE BACK CHAIN\r
3556         JUMPE   B,VECMO4        ;IF NON MOVER, JUST ADJUST DOPW AND MOVE ON\r
3557 \r
3558         ADDI    C,(B)           ;SET ADDR OF LAST DESTINATION WD\r
3559         HRLI    B,A             ;MAKE B INDEX ON A\r
3560         HLL     A,(A)           ;COUNT TO A LEFT HALF\r
3561 \r
3562         POP     A,@B            ;MOVE A WORD\r
3563         TLNE    A,-1            ;REACHED END OF MOVING\r
3564         JRST    .-2             ;NO, REPEAT\r
3565                 ;YES, NOTE A HAS ADDR OF NEXT DOPEWD\r
3566 \f;HERE TO ADJUST LOCATION OF DOPEWDS FOR GROWTH (FORWARDLY)\r
3567 VECMO2: LDB     B,[111000,,-1(C)]               ;GET HIGH GROWTH FIELD\r
3568         JUMPE   B,VECMO3        ;IF NO GROWTH, DONT MOVE\r
3569         SKIPE   GCDNTG          ; SKIP IF GROWTH PERMITTED\r
3570         JRST    VECMO3\r
3571         ASH     B,6             ;EXPRESS GROWTH IN WORDS\r
3572         HRLI    C,2             ;SET COUNT FOR POPPING 2 DOPEWDS\r
3573         HRLI    B,C             ;MAKE B INDEX ON C\r
3574         POP     C,@B            ;MOVE PRIME DOPEWD\r
3575         POP     C,@B            ;MOVE AUX DOPEWD\r
3576 VECMO3: JUMPL   D,VECMO1        ;IF NO BACK CHAIN THEN MOVE ON\r
3577         JRST    VECMO6          ;YES, BACKCHAINING, CONTINUE SAME\r
3578 \r
3579 ;HERE TO SKIP OVER STILL VECTORS (FORWARDLY)\r
3580 VECMO4: HLRZ    B,(A)           ;GET SIZE OF UNMOVER\r
3581         SUBI    A,(B)           ;UPDATE A TO NEXT VECTOR\r
3582         JRST    VECMO2          ;AND GO CLEAN UP GROWTH\r
3583 ;HERE TO ESTABLISH A BACKWARDS CHAIN\r
3584 VECMO5: EXCH    D,(A)           ;CHAIN FORWARD\r
3585         HLRZ    B,D             ;GET SIZE\r
3586         SUBI    A,(B)           ;GO ON TO NEXT VECOTR\r
3587         CAMGE   A,VECBOT        ;HAVE WE GOT TO END OF VECTORS?\r
3588         JRST    VECMO7          ;YES, GO MOVE PAIRS AND UNCHAIN\r
3589         HRRZ    B,(A)           ;GET RELOCATION OF THIS VECTOR\r
3590         SUBI    B,(A)           ; RELATIVIZE\r
3591         JUMPLE  B,VECMO5        ;IF NOT POSITIVE, CONTINUE CHAINING\r
3592         MOVEM   A,TYPNT         ;SAVE ADDR FOR FORWARD RESUME\r
3593 \r
3594 ;HERE TO UNCHAIN A VECTOR, MOVE IT, AND ADJUST DOPEWDS\r
3595 VECMO6: HLRZ    B,D             ;GET SIZE\r
3596         MOVEI   F,1(A)          ;GET A COPY OF BEGINNING OF VECTOR\r
3597         ADDI    A,(B)           ;SET TO POINT TO ADDR OF DOPEWD CURRENTLY IN D\r
3598         EXCH    D,(A)           ;AND UNCHAIN\r
3599         HRRZ    B,(A)           ;GET RELOCATION FOR THIS VECTOR\r
3600         SUBI    B,(A)           ; RELATIVIZE\r
3601         MOVEI   C,(A)           ;COPY A POINTER TO DOPEW\r
3602         SKIPGE  D               ;HAVE WE REACHED THE TOP OF THE CHAIN?\r
3603         MOVE    A,TYPNT         ;YES,   RESTORE FORWARD MOVE RESUME ADDR\r
3604         JUMPE   B,VECMO2        ;IF STILL VECTOR,GO ADJUST DOPEWDS\r
3605         ADDI    C,(B)           ;MAKE C POINT TO NEW DOPEW ADDR\r
3606         ADDI    B,(F)           ;B RH NEW 1ST WORD\r
3607         HRLI    B,(F)           ;B LH OLD 1ST WD ADDR\r
3608         BLT     B,(C)           ;COPY THE DATA\r
3609         JRST    VECMO2          ;AND GO ADJUST DOPEWDS\r
3610 \r
3611 ;HERE TO STOP CHAINING BECAUSE OF BOTTOM OF VECTOR SPACE\r
3612 VECMO7: MOVEM   A,TYPNT\r
3613         PUSH    P,D\r
3614         PUSHJ   P,PARMOV\r
3615         POP     P,D\r
3616         MOVE    A,TYPNT\r
3617         JRST    VECMO6\r
3618 \f;PAIR MOVEMENT PHASE -- USES PARNEW,PARBOT, AND PARTOP TO MOVE PAIRS\r
3619 ;TO NEW HOMES\r
3620 \r
3621 PARMOV: SKIPN   A,PARNEW        ;IS THERE ANY PAIR MOVEMENT?\r
3622         POPJ    P,              ;NO, RETURN\r
3623         JUMPL   A,PARMO2        ;YES -- IF MOVING DOWNWARDS, GO DO A BLT\r
3624         HRLI    A,B             ;MOVING UPWARDS SETAC A TO INDEX OFF AC B\r
3625         MOVE    B,PARTOP        ;GET HIGH PAIR ADDREESS\r
3626         SUB     B,PARBOT        ;AND SUBTRACT BOTTOM TO GET NUMBER OF PAIRS\r
3627         HRLZS   B               ;PUT COUNT IN LEFT HALF\r
3628         HRR     B,PARTOP        ;GET HIGH ADDRESS PLUS ONE IN RH\r
3629         SUBI    B,1             ;AND SUBTRACT ONE TO POINT TO LAST WORD TO BE MOVED\r
3630 \r
3631 PARMO1: TLNN    B,-1            ;HAS COUNT REACHED ZERO?\r
3632         JRST    PARMO3          ;YES -- FINISH UP\r
3633         POP     B,@A            ;NO -- TRANSFER2Y\eU NEXT WORD\r
3634         JRST    PARMO1          ;AND REPEAT\r
3635 \r
3636 PARMO2: MOVE    B,PARBOT        ;GET ADDRESS OF FIRST SOURCE WD\r
3637         HRLS    B               ;IN BOTH HALVES OF AC B\r
3638         ADD     B,A             ;MAKE RH OF B POINT TO FIRST DESTINATION WORD\r
3639         ADD     A,PARTOP        ;MAKE RH OF A POINT TO LAST DESTINATION WORD PLUS ONE\r
3640         BLT     B,-1(A)         ;AND TRANSFER THE BLOCK OF PAIRS\r
3641 \r
3642 PARMO3: MOVE    A,PARNEW        ;GET OFFSET FOR PAIR SPACE\r
3643         ADDM    A,PARBOT        ;AND CORRECT BOTTOM\r
3644         ADDM    A,PARTOP        ;AND CORRECT TOP.\r
3645         SETZM   PARNEW          ;CLEAR SO IF CALLED TWICE, NO LOSSAGE\r
3646         POPJ    P,\r
3647 \f;VECZER -- CLEARS DATA IN AREAS JUST GROWN\r
3648 ;UPDATES SIZE OF VECTORS\r
3649 ;CLEARS RELOCATION AND GROWTH FIELDS IN DOPEWDS\r
3650 ;CALLED WITH NEW VECTOP IN A (VECBOT SHOULD BE NEW TOO)\r
3651 \r
3652 VECZER: SUBI    A,1             ;MAKE A POINT TO HIGH VECTORS\r
3653 VECZE1: CAMGE   A,VECBOT        ;REACHED BOTTOM OF VECTORS?\r
3654         POPJ    P,              ;YES, RETURN\r
3655         HLLZS   F,(A)           ;NO, CLEAR RELOCATION GET SIZE\r
3656         HLRZS   F               ;AND PUT SIZE IN RH OF F\r
3657         HRRZ    B,-1(A)         ;GET GROWTH INTO B\r
3658         JUMPN   B,VECZE3        ;IF THERE IS SOME GROWTH, GO DO IT\r
3659 VECZE2: SUBI    A,(F)           ;GROWTH DONE, MOVE ON TO NEXT VECTOR\r
3660         JRST    VECZE1          ;AND REPEAT\r
3661 \r
3662 VECZE3: HLLZS   -1(A)           ;CLEAR GROWTH IN THE VECTOR\r
3663         LDB     C,[111000,,B]           ;GET HIGH ORDER GROWTH IN C\r
3664         SKIPE   GCDNTG\r
3665         JRST    VECZE5\r
3666         ANDI    B,377           ;AND LIMIT B TO LOW SIDE\r
3667         ASHC    B,6             ;EXPRESS GROWTH IN WORDS\r
3668         JUMPE   C,VECZE4        ;IF NO HIGH GROWTH SKIP TO LOW GROWTH\r
3669         ADDI    F,(C)           ;ADD HIGH GROWTH TO SIZE\r
3670         SUBM    A,C             ;GET ADDR OF 2ND WD TO BE ZEROED\r
3671         SETZM   -1(C)           ;CLEAR 1ST WORD\r
3672         HRLI    C,-1(C)         ;MAKE C A CLEARING BLT POINTER\r
3673         BLT     C,-2(A)         ;AND CLEAR HIGH END DATA\r
3674 \r
3675 VECZE4: JUMPE   B,VECZE5        ;IF NO LOW GROWTH SKIP TO SIZE UPDATE\r
3676         MOVNI   C,(F)           ;GET NEGATIVE SIZE SO FAR\r
3677         ADDI    C,(A)           ;AND MAKE C POINT TO LAST WORD OF STUFF TO BE CLEARED\r
3678         ADDI    F,(B)           ;UPDATE SIZE\r
3679         SUBM    C,B             ;MAKE B POINT TO LAST WD OF NEXT VECT\r
3680         ADDI    B,2             ;AND NOW TO 2ND DATA WD TO BE CLEARED\r
3681         SETZM   -1(B)           ;CLEAR 1ST DATA WD\r
3682         HRLI    B,-1(B)         ;MAKE B A CLEARING BLT POINTER\r
3683         BLT     B,(C)           ;AND CLEAR THE LOW DATA\r
3684 \r
3685 VECZE5: HRLZM   F,(A)           ;STORE THE NEW SIZE IN DOPEWD\r
3686         JRST    VECZE2\r
3687 \r
3688 \f;SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE\r
3689 \r
3690 REHASH: MOVE    TVP,TVPSTO+1(PVP)       ;RESTORE TV POINTER\r
3691         MOVE    D,ASOVEC+1(TVP) ;GET POINTER TO VECTOR\r
3692         MOVEI   E,(D)\r
3693         PUSH    P,E             ;PUSH A POINTER\r
3694         HLRE    A,D             ;GET -LENGTH\r
3695         MOVMS   A               ;AND PLUSIFY\r
3696         PUSH    P,A             ;PUSH IT ALSO\r
3697 \r
3698 REH3:   HRRZ    C,(D)           ;POINT TO FIRST BUCKKET\r
3699         HLRZS   (D)             ;MAKE SURE NEW POINTER IS IN RH\r
3700         JUMPE   C,REH1          ;BUCKET EMPTY, QUIT\r
3701 \r
3702 REH2:   MOVEI   E,(C)           ;MAKE A COPY OF THE POINTER\r
3703         MOVE    A,ITEM(C)       ;START HASHING\r
3704         TLZ     A,TYPMSK#777777 ; KILL MONITORS\r
3705         XOR     A,ITEM+1(C)\r
3706         MOVE    0,INDIC(C)\r
3707         TLZ     0,TYPMSK#777777\r
3708         XOR     A,0\r
3709         XOR     A,INDIC+1(C)\r
3710         TLZ     A,400000        ;MAKE SURE FINAL HASH IS +\r
3711         IDIV    A,(P)           ;DIVIDE BY TOTAL LENGTH\r
3712         ADD     B,-1(P)         ;POINT TO WINNING BUCKET\r
3713 \r
3714         MOVE    C,[002200,,(B)] ;BYTE POINTER TO RH\r
3715         CAILE   B,(D)           ;IF PAST CURRENT POINT\r
3716         MOVE    C,[222200,,(B)] ;USE LH\r
3717         LDB     A,C             ;GET OLD VALUE\r
3718         DPB     E,C             ;STORE NEW VALUE\r
3719         HRRZ    B,ASOLNT-1(E)   ;GET NEXT POINTER\r
3720         HRRZM   A,ASOLNT-1(E)   ;AND CLOBBER IN NEW NEXT\r
3721         SKIPE   A               ;SKKIP IF NOTHING PREVIOUSLY IN BUCKET\r
3722         HRLM    E,ASOLNT-1(A)   ;OTHERWISE CLOBBER\r
3723         SKIPE   C,B             ;SKIP IF END OF CHAIN\r
3724         JRST    REH2\r
3725 REH1:   AOBJN   D,REH3\r
3726 \r
3727         SUB     P,[2,,2]        ;FLUSH THE JUNK\r
3728         POPJ    P,\r
3729 \fVCMLOS:        FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH\r
3730 \r
3731 \r
3732 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC\r
3733 \r
3734 MSGGCT: [ASCIZ /USER CALLED- /]\r
3735         [ASCIZ /FREE STORAGE- /]\r
3736         [ASCIZ /TP-STACK- /]\r
3737         [ASCIZ /TOP-LEVEL LOCALS- /]\r
3738         [ASCIZ /GLOBAL VALUES- /]\r
3739         [ASCIZ /TYPES- /]\r
3740         [ASCIZ /STATIONARY IMPURE STORAGE- /]\r
3741         [ASCIZ /P-STACK /]\r
3742         [ASCIZ /BOTH STACKS BLOWN- /]\r
3743         [ASCIZ /PURE STORAGE- /]\r
3744         [ASCIZ /GC-RCALL- /]\r
3745 \r
3746 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC\r
3747 \r
3748 MSGGFT: 0\r
3749         [ASCIZ /BLOAT /]\r
3750         [ASCIZ /GROW /]\r
3751         [ASCIZ /LIST /]\r
3752         [ASCIZ /VECTOR /]\r
3753         [ASCIZ /SET /]\r
3754         [ASCIZ /SETG /]\r
3755         [ASCIZ /FREEZE /]\r
3756         [ASCIZ /PURE-PAGE LOADER /]\r
3757         [ASCIZ /GC /]\r
3758         [ASCIZ /INTERRUPT-HANDLER /]\r
3759         [ASCIZ /NEWTYPE /]      \r
3760 \r
3761 \r
3762 \r
3763 \f\r
3764 ;LOCAL VARIABLES\r
3765 \r
3766 IMPURE\r
3767 ; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS.\r
3768 ;\r
3769 \r
3770 GCNO:   0                       ; USER-CALLED GC\r
3771 BSTGC:  0                       ; FREE STORAGE\r
3772         0                       ; BLOWN TP\r
3773         0                       ; TOP-LEVEL LVALS\r
3774         0                       ; GVALS\r
3775         0                       ; TYPE\r
3776         0                       ; STORAGE\r
3777         0                       ; P-STACK\r
3778         0                       ; BOTH STATCKS BLOWN\r
3779         0                       ; STORAGE\r
3780 \r
3781 BSTAT:\r
3782 NOWFRE: 0                       ; FREE STORAGE FROM LAST GC\r
3783 CURFRE: 0                       ; STORAGE USED SINCE LAST GC\r
3784 MAXFRE: 0                       ; MAXIMUM FREE STORAGE ALLOCATED\r
3785 USEFRE: 0                       ; TOTAL FREE STORAGE USED\r
3786 NOWTP:  0                       ; TP LENGTH FROM LAST GC\r
3787 CURTP:  0                       ; # WORDS ON TP\r
3788 CTPMX:  0                       ; MAXIMUM SIZE OF TP SO FAR\r
3789 NOWLVL: 0                       ; # OF TOP-LEVEL LVAL-SLOTS\r
3790 CURLVL: 0                       ; # OF TOP-LEVEL LVALS\r
3791 NOWGVL: 0                       ; # OF GVAL SLOTS\r
3792 CURGVL: 0                       ; # OF GVALS\r
3793 NOWTYP: 0                       ; SIZE OF TYPE-VECTOR\r
3794 CURTYP: 0                       ; # OF TYPES\r
3795 NOWSTO: 0                       ; SIZE OF STATIONARY STORAGE\r
3796 CURSTO: 0                       ; STATIONARY STORAGE IN USE\r
3797 CURMAX: 0                       ; MAXIMUM BLOCK OF  CONTIGUOUS STORAGE\r
3798 NOWP:   0                       ; SIZE OF P-STACK\r
3799 CURP:   0                       ; #WORDS ON P\r
3800 CPMX:   0                       ; MAXIMUM P-STACK LENGTH SO FAR\r
3801 GCCAUS: 0                       ; INDICATOR FOR CAUSE OF GC\r
3802 GCCALL: 0                       ; INDICATOR FOR CALLER OF GC\r
3803 \r
3804 \r
3805 ; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW\r
3806 LVLINC: 6                       ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS\r
3807 GVLINC: 4                       ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS\r
3808 TYPIC:  1                       ; TYPE INCREMENT ASSUMED TO BE 32 TYPES\r
3809 STORIC: 2000                    ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE)\r
3810 \r
3811 \r
3812 RCL:    0                       ; POINTER TO LIST OF RECYCLEABLE LIST CELLS\r
3813 GCMONF: 0                       ; NON-ZERO SAY GIN/GOUT\r
3814 GCDANG: 0                       ; NON-ZERO, STORAGE IS LOW\r
3815 GCDNTG: 0                       ; NON-ZERO ABORT GROWTHS\r
3816 GETNUM: 0                       ;NO OF WORDS TO GET\r
3817 PARNUM: 0                       ;NO OF PAIRS MARKED\r
3818 VECNUM: 0                       ;NO OF WORDS IN MARKED VECTORS\r
3819 CORSET: 0                       ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY\r
3820 CORTOP: 0                       ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY\r
3821 \r
3822 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,\r
3823 ;AND WHEN IT WILL GET UNHAPPY\r
3824 \r
3825 SYSMAX: 50.                     ;MAXIMUM SIZE OF MUDDLE\r
3826 FREMIN: 20000                   ;MINIMUM FREE WORDS\r
3827 FREDIF: 10000                   ;DIFFERENCE BETWEEN FREMIN AND MAXIMUM NUMBER OF FREE WORDS\r
3828 ;POINTER TO GROWING PDL\r
3829 \r
3830 TPGROW: 0                       ;POINTS TO A BLOWN TP\r
3831 PPGROW: 0                       ;POINTS TO A BLOWN PP\r
3832 TIMOUT: 0                       ;POINTS TO TIMED OUT PDL\r
3833 PGROW:  0                       ;POINTS TO A BLOWN P\r
3834 \r
3835 ;IN GC FLAG\r
3836 \r
3837 GCFLG:  0\r
3838 GCFLCH: 0               ; TELL INT HANDLER TO ITIC CHARS\r
3839 GCHAIR: 1               ; COUNTS GCS AND TELLS WHEN TO HAIRIFY\r
3840 SHRUNK: 0               ; NON-ZERO=> AVECTOR(S) SHRUNK\r
3841 GREW:   0               ; NON-ZERO=> A VECTOR(S) GREW\r
3842 SPARNW: 0               ; SAVED PARNEW\r
3843 GCDOWN: 0               ; AMOUNT TO TRY AND MOVE DOWN\r
3844 CURPLN: 0               ; LENGTH OF CURRENTLY RUNNING PURE RSUBR\r
3845 \r
3846 ; VARS ASSOCIATED WITH BLOAT LOGIC\r
3847 \r
3848 TPBINC: 0\r
3849 GLBINC: 0\r
3850 TYPINC: 0\r
3851 \r
3852 ; VARS FOR PAGE WINDOW HACKS\r
3853 \r
3854 WNDBOT: 0                       ; BOTTOM OF WINDOW\r
3855 WNDTOP: 0\r
3856 BOTNEW: (FPTR)                  ; POINTER TO FRONTIER\r
3857 GCTIM:  0\r
3858 \r
3859 PURE\r
3860 \r
3861 \r
3862 END\r
3863 \r
3864 \r
3865 \r
3866 \r
3867 \r
3868 \f