sumex/mappur.mcr078

   1 TITLE PURE-PAGE LOADER\r
   2 \r
   3 RELOCATABLE\r
   4 \r
   5 MAPCH==0                        ; channel for MAPing\r
   6 ELN==3                          ; Length of table entry\r
   7 \r
   8 .GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN\r
   9 .GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF\r
  10 \r
  11 .INSRT MUDDLE >\r
  12 \r
  13 SYSQ\r
  14 \r
  15 IFE ITS,[\r
  16 IF1, .INSRT STENEX >\r
  17 ]\r
  18 \r
  19 IFN ITS,[\r
  20 PURDIR==SIXBIT /MUD50/          ; directory containing pure pages\r
  21 OPURDI==SIXBIT /MHILIB/\r
  22 OFIXDI==SIXBIT /MHILIB/\r
  23 FIXDIR==SIXBIT /MUD50/\r
  24 ARC==1                          ; flag saying fixups on archive\r
  25 ]\r
  26 IFN ITS,[\r
  27 PGMSK==1777\r
  28 PGSHFT==10.\r
  29 ]\r
  30 IFE ITS,[\r
  31 PGMSK==777\r
  32 PGSHFT==9.\r
  33 ]\r
  34 \r
  35 ; This routine taskes a slot offset in register A and\r
  36 ; maps in the associated file.  It clobbers all ACs\r
  37 ; It skip returns if it wins.\r
  38 \r
  39 PLOAD:  PUSH    P,A             ; save slot offset\r
  40         ADD     A,PURVEC+1(TVP) ; point into pure vector\r
  41         MOVE    B,(A)           ; get sixbit of name\r
  42 IFN ITS,[\r
  43         MOVE    C,MUDSTR+2      ; get version number\r
  44         PUSHJ   P,CSIXBT        ; vers # to six bit\r
  45         HRRI    C,(SIXBIT /SAV/)\r
  46         MOVSS   C\r
  47         .SUSET  [.RSNAM,,0]     ; GET CURRENT SNAME TO 0\r
  48         .SUSET  [.SSNAM,,[PURDIR]]      ; get sname for it\r
  49         MOVE    A,[SIXBIT /  &DSK/]     ; build open block\r
  50         .OPEN   MAPCH,A         ; try to open file\r
  51         JRST    FIXITU          ; no current version, fix one up\r
  52         PUSH    P,0             ; for compat wit tenex and save old sname\r
  53         DOTCAL  FILLEN,[[1000,,MAPCH],[2000,,A]]\r
  54         JRST    MAPLOS\r
  55         ADDI    A,PGMSK         ; in case not even # of pages\r
  56         ASH     A,-PGSHFT       ; to pages\r
  57         PUSH    P,A             ; save the length\r
  58 ]\r
  59 IFE ITS,[\r
  60         MOVE    E,P             ; save pdl base\r
  61         PUSH    P,[0]           ; slots for building strings\r
  62         PUSH    P,[0]\r
  63         MOVE    A,[440700,,1(E)]\r
  64         MOVE    C,[440600,,B]\r
  65         MOVEI   D,6\r
  66         ILDB    0,C\r
  67         JUMPE   0,.+4           ; violate cardinal ".+ rule"\r
  68         ADDI    0,40            ; to ASCII\r
  69         IDPB    0,A\r
  70         SOJG    D,.-4\r
  71 \r
  72         PUSH    P,[ASCII /  SAV/]\r
  73         MOVE    C,MUDSTR+2      ; get ascii of vers no.\r
  74         IORI    C,1             ; hair to change r.o. to space\r
  75         MOVE    0,C\r
  76         ADDI    C,1\r
  77         ANDCM   C,0             ; C has 1st 1\r
  78         JFFO    C,.+3\r
  79         MOVEI   0,0             ; use zer name\r
  80         JRST    ZER...\r
  81         MOVEI   C,(D)\r
  82         IDIVI   C,7\r
  83         AND     0,MSKS(C)       ; get rid of r.o.s\r
  84 ZER...: PUSH    P,0\r
  85         MOVEI   B,-1(P)         ; point to it\r
  86         HRLI    B,260700\r
  87         HRROI   D,1(E)          ; point to name\r
  88         MOVEI   A,1(P)\r
  89 \r
  90         PUSH    P,[100000,,]\r
  91         PUSH    P,[377777,,377777]\r
  92         PUSH    P,[-1,,[ASCIZ /DSK/]]\r
  93         PUSH    P,[-1,,[ASCIZ /MUDLIB/]]\r
  94         PUSH    P,D\r
  95         PUSH    P,B\r
  96         PUSH    P,[0]\r
  97         PUSH    P,[0]\r
  98         PUSH    P,[0]\r
  99         MOVEI   B,0\r
 100         MOVE    D,4(E)          ; save final version string\r
 101         GTJFN\r
 102         JRST    FIXITU\r
 103 \r
 104         MOVE    B,[440000,,240000]\r
 105         OPENF\r
 106         JRST    FIXITU\r
 107         MOVE    P,E             ; flush crap\r
 108         PUSH    P,A\r
 109         SIZEF                   ; get length\r
 110         JRST    MAPLOS\r
 111         PUSH    P,C             ; save # of pages\r
 112         MOVEI   A,(C)\r
 113 ]\r
 114         PUSHJ   P,ALOPAG        ; get the necessary pages\r
 115         JRST    MAPLS1\r
 116         PUSH    P,B             ; save page number\r
 117 IFN ITS,[\r
 118         MOVN    A,-1(P)         ; get neg count\r
 119         MOVSI   A,(A)           ; build aobjn pointer\r
 120         HRR     A,(P)           ; get page to start\r
 121         MOVE    B,A             ; save for later\r
 122         HLLZ    0,A             ; page pointer for file\r
 123         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0]\r
 124         JRST    MAPLS3          ; total wipe out\r
 125         .CLOSE  MAPCH,          ; no need to have file open anymore\r
 126 ]\r
 127 IFE ITS,[\r
 128         MOVE    D,-1(P)         ; # of pages to D\r
 129         HRLI    B,400000        ; specify this fork\r
 130         HRROI   E,(B)           ; build page aobjn for later\r
 131         TLC     E,-1(D)         ; sexy way of doing lh\r
 132         HRLZ    A,-2(P)         ; JFN to lh of A\r
 133         MOVSI   C,120000        ; bits for read/execute\r
 134 \r
 135         PMAP\r
 136         ADDI    A,1\r
 137         ADDI    B,1\r
 138         SOJG    D,.-3           ; map 'em all\r
 139         MOVE    A,-2(P)\r
 140         CLOSF                   ; try to close file\r
 141         JFCL                    ; ignore failure\r
 142         MOVE    B,E\r
 143 ]\r
 144 \r
 145 ; now try to smash slot in PURVEC\r
 146 \r
 147 PLOAD1: MOVE    A,PURVEC+1(TVP) ; get pointer to it\r
 148         ASH     B,PGSHFT        ; convert to aobjn pointer to words\r
 149         MOVE    C,-3(P)         ; get slot offset\r
 150         ADDI    C,(A)           ; point to slot\r
 151         MOVEM   B,1(C)          ; clobber it in\r
 152         ANDI    B,-1            ; isolate address of page\r
 153         HRRZ    D,PURVEC(TVP)   ; get offset into vector for start of chain\r
 154         TRNE    D,400000        ; skip if not end marker\r
 155         JRST    SCHAIN\r
 156         HRLI    D,A             ; set up indexed pointer\r
 157         ADDI    D,1\r
 158         HRRZ    0,@D            ; get its address\r
 159         JUMPE   0,SCHAIN        ; no chain exists, start one\r
 160         CAILE   0,(B)           ; skip if new one should be first\r
 161         AOJA    D,INLOOP        ; jump into the loop\r
 162 \r
 163         SUBI    D,1             ; undo ADDI\r
 164 FCLOB:  MOVE    E,-3(P)         ; get offset for this guy\r
 165         HRRM    D,2(C)          ; link up\r
 166         HRRM    E,PURVEC(TVP)   ; store him away\r
 167         JRST    PLOADD\r
 168 \r
 169 SCHAIN: MOVEI   D,400000        ; get end of chain indicator\r
 170         JRST    FCLOB           ; and clobber it in\r
 171 \r
 172 INLOOP: MOVE    E,D             ; save in case of later link up\r
 173         HRR     D,@D            ; point to next table entry\r
 174         TRNE    D,400000        ; 400000 is the end of chain bit\r
 175         JRST    SLFOUN          ; found a slot, leave loop\r
 176         ADDI    D,1             ; point to address of progs\r
 177         HRRZ    0,@D            ; get address of block\r
 178         CAILE   0,(B)           ; skip if still haven't fit it in\r
 179         AOJA    D,INLOOP        ; back to loop start and point to chain link\r
 180         SUBI    D,1             ; point back to start of slot\r
 181 \r
 182 SLFOUN: MOVE    0,-3(P)         ; get offset into vector of this guy\r
 183         HRRM    0,@E            ; make previous point to us\r
 184         HRRM    D,2(C)          ; link it in\r
 185 \r
 186 \r
 187 PLOADD: AOS     -4(P)           ; skip return\r
 188 \r
 189 MAPLS3: SUB     P,[1,,1]        ; flush stack crap\r
 190 MAPLS1: SUB     P,[1,,1]\r
 191 MAPLOS:\r
 192 IFN ITS,[\r
 193         MOVE    0,(P)\r
 194         .SUSET  [.SSNAM,,0]     ; restore SNAME\r
 195 ]\r
 196         SUB     P,[2,,2]\r
 197         POPJ    P,\r
 198 \r
 199 ; Here if no current version exists\r
 200 \r
 201 FIXITU: PUSH    TP,$TFIX\r
 202         PUSH    TP,0            ; maybe save sname\r
 203 \r
 204 IFN ITS,[\r
 205         PUSH    P,C             ; save final name\r
 206         MOVE    C,[SIXBIT /FIXUP/]      ; name of fixup file\r
 207 IFN <PURDIR-OFIXDI>,.SUSET [.SSNAM,,[OFIXDI]]\r
 208 IFN ARC,        HRRI    A,(SIXBIT /ARC/)\r
 209         .OPEN   MAPCH,A\r
 210 IFE ARC,        JRST MAPLOS\r
 211 IFN ARC,        PUSHJ P,ARCLOS\r
 212         MOVE    0,[-2,,A]       ; prepare to read version and length\r
 213         PUSH    P,B             ; save program name\r
 214         .IOT    MAPCH,0\r
 215         SKIPGE  0\r
 216         FATAL BAD FIXUP FILE\r
 217         PUSH    P,B             ; save version number of fixup file\r
 218         MOVEI   A,-2(A)         ; length -2 (for vers and length)\r
 219         PUSHJ   P,IBLOCK        ; get a UVECTOR for the fixups\r
 220         PUSH    TP,$TUVEC       ; and save\r
 221         PUSH    TP,B\r
 222         MOVE    A,B\r
 223         MOVSI   0,TUVEC\r
 224         MOVEM   0,ASTO(PVP)     ; prepare for moby iot (interruptable)\r
 225         ENABLE\r
 226         .IOT    MAPCH,A         ; get fixups\r
 227         DISABLE\r
 228         .CLOSE  MAPCH,\r
 229         SETZM   ASTO(PVP)\r
 230         POP     P,A             ; restore version number\r
 231         IDIVI   A,100.          ; get 100s digit in a rest in B\r
 232         ADDI    A,20            ; convert to sixbit\r
 233         IDIVI   B,10.           ; B tens digit C 1s digit\r
 234         ADDI    B,20\r
 235         ADDI    C,20\r
 236         MOVE    0,[220600,,D]\r
 237         MOVSI   D,(SIXBIT /SAV/)\r
 238         CAIE    A,20\r
 239         IDPB    A,0\r
 240         CAIE    B,20\r
 241         IDPB    B,0\r
 242         IDPB    C,0\r
 243         MOVE    B,[SIXBIT /  &DSK/]\r
 244         MOVE    C,(P)           ; program name\r
 245 IFN <OPURDI-OFIXDI>,.SUSET [.SSNAM,,[OPURDI]]\r
 246         .OPEN   MAPCH,B         ; try for this one\r
 247         JRST    MAPLS1\r
 248         DOTCAL  FILLEN,[[1000,,MAPCH],[2000,,A]]\r
 249         JRST    MAPLS1\r
 250         ADDI    A,PGMSK         ; in case not exact pages\r
 251         ASH     A,-PGSHFT       ; to pages\r
 252         PUSH    P,A             ; save\r
 253         PUSHJ   P,ALOPAG        ; find some pages\r
 254         JRST    MAPLS4\r
 255         MOVN    A,(P)           ; build aobjn pointer\r
 256         MOVSI   A,(A)\r
 257         HRRI    A,(B)\r
 258         MOVE    B,A\r
 259         HLLZ    0,B\r
 260         DOTCAL  CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0]\r
 261         JRST    MAPLS4\r
 262         SUB     P,[1,,1]\r
 263         .CLOSE  MAPCH,\r
 264 ]\r
 265 IFE ITS,[\r
 266         PUSH    TP,$TPDL        ; save stack pointer\r
 267         PUSH    TP,E\r
 268         PUSH    P,D             ; save vers string\r
 269         HRROI   A,[ASCIZ /FIXUP/]\r
 270         MOVEM   A,10.(E)        ; into name slot\r
 271         MOVEI   A,5(E)          ; point to arg block\r
 272         SETZB   B,C\r
 273         GTJFN\r
 274         JRST    MAPLS4\r
 275         MOVEI   C,(A)           ; save JFN in case OPNEF loses\r
 276         MOVE    B,[440000,,200000]\r
 277         OPENF\r
 278         JRST    MAPLS4\r
 279         BIN                     ; length of fixups to B\r
 280         PUSH    P,A             ; save JFN\r
 281         MOVEI   A,-2(B)         ; length of uvextor to get\r
 282         PUSHJ   P,IBLOCK\r
 283         PUSH    TP,$TUVEC\r
 284         PUSH    TP,B            ; sav it\r
 285         POP     P,A             ; restore JFN\r
 286         BIN                     ; read in vers #\r
 287         MOVE    D,B             ; save vers #\r
 288         MOVE    B,(TP)\r
 289         HLRE    C,B\r
 290         HRLI    B,444400\r
 291         SIN                     ; read in entire fixups\r
 292         CLOSF                   ; and close file of same\r
 293         JFCL                    ; ignore cailure to close\r
 294         HRROI   C,1(E)          ; point to name\r
 295         MOVEM   C,9.(E)\r
 296         MOVEI   C,3(E)\r
 297         HRLI    C,260700\r
 298         MOVEM   C,10.(E)\r
 299         MOVE    0,[ASCII /     /]\r
 300         MOVEM   0,4(E)          ; all spaces\r
 301         MOVEI   A,(D)\r
 302         IDIVI   A,100.          ; to ascii\r
 303         ADDI    A,60\r
 304         IDIVI   B,10.\r
 305         ADDI    B,60\r
 306         ADDI    C,60\r
 307         MOVE    0,[440700,,4(E)]\r
 308         CAIE    A,60\r
 309         IDPB    A,0\r
 310         CAIE    B,60\r
 311         IDPB    B,0\r
 312         IDPB    C,0\r
 313         SETZB   C,B\r
 314         MOVEI   A,5(E)          ; ready for 'nother GTJFN\r
 315         GTJFN\r
 316         JRST    MAPLS5\r
 317         MOVEI   C,(A)           ; save JFN in case OPENF loses\r
 318         MOVE    B,[440000,,240000]\r
 319         OPENF\r
 320         JRST    MAPLS5\r
 321         SIZEF\r
 322         JRST    MAPLS5\r
 323         PUSH    P,A\r
 324         PUSH    P,C\r
 325         MOVEI   A,(C)\r
 326         PUSHJ   P,ALOPAG        ; get the pages\r
 327         JRST    MAPLS5\r
 328         MOVEI   D,(B)           ; save pointer\r
 329         MOVN    A,(P)           ; build page aobjn pntr\r
 330         HRLI    D,(A)\r
 331         EXCH    D,(P)           ; get length\r
 332         HRLI    B,400000\r
 333 \r
 334         HRLZ    A,-1(P)         ; JFN for PMAP\r
 335         MOVSI   C,120400        ; bits for read/execute/copy-on-write\r
 336 \r
 337         PMAP\r
 338         ADDI    A,1\r
 339         ADDI    B,1\r
 340         SOJG    D,.-3\r
 341 \r
 342         HLRZS   A\r
 343         CLOSF\r
 344         JFCL\r
 345         POP     P,B             ; restore page #\r
 346         SUB     P,[1,,1]\r
 347 ]\r
 348 ; now to do fixups\r
 349 \r
 350         MOVE    A,(TP)          ; pointer to them\r
 351         ASH     B,PGSHFT        ; aobjn to program\r
 352 \r
 353 FIX1:   SKIPL   E,(A)           ; read one hopefully squoze\r
 354         FATAL   ATTEMPT TO TYPE FIX PURE\r
 355         TLZ     E,740000\r
 356         PUSHJ   P,SQUTOA        ; look it up\r
 357         FATAL   BAD FIXUPS\r
 358 \r
 359         AOBJP   A,FIX2\r
 360         HLRZ    D,(A)           ; get old value\r
 361         SUBM    E,D             ; D is diff between old and new\r
 362         HRLM    E,(A)           ; fixup the fixups\r
 363         MOVEI   0,0             ; flag for which half\r
 364 FIX4:   JUMPE   0,FIXRH         ; jump if getting rh\r
 365         MOVEI   0,0             ; next time will get rh\r
 366         AOBJP   A,FIX2          ; done?\r
 367         HLRZ    C,(A)           ; get lh\r
 368         JUMPE   C,FIX3          ; 0 terminates\r
 369 FIX5:   ADDI    C,(B)           ; access the code\r
 370         ADDM    D,-1(C)         ; and fix it up\r
 371         JRST    FIX4\r
 372 \r
 373 FIXRH:  MOVEI   0,1             ; change flag\r
 374         HRRZ    C,(A)           ; get it and\r
 375         JUMPN   C,FIX5\r
 376 \r
 377 FIX3:   AOBJN   A,FIX1          ; do next one\r
 378 \r
 379 FIX2:\r
 380 IFN ITS,[\r
 381 IFN <PURDIR-OPURDI>     .SUSET  [.SSNAM,,[PURDIR]]\r
 382         .OPEN   MAPCH,[SIXBIT /  'DSK_PURE_>/]\r
 383         JRST    MAPLS1\r
 384         MOVE    E,B             ; save pointer\r
 385         ASH     E,-PGSHFT       ; to page AOBJN\r
 386         .IOT    MAPCH,B         ; write out the goodie\r
 387         SETZB   0,A\r
 388         MOVEI   B,MAPCH\r
 389         MOVE    C,(P)\r
 390         MOVE    D,-1(P)\r
 391         .FDELE  0               ; attempt to rename to right thing\r
 392         JRST    MAPLS1\r
 393         .CLOSE  MAPCH,\r
 394         MOVE    B,[SIXBIT /  &DSK/]\r
 395         .OPEN   MAPCH,B\r
 396         FATAL   WHERE DID THE FILE GO?\r
 397         HLLZ    0,E             ; pointer to file pages\r
 398         PUSH    P,E             ; SAVE FOR END\r
 399         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0]\r
 400         FATAL   LOSSAGE LOSSAGE PAGES LOST\r
 401         .CLOSE  MAPCH,\r
 402 \r
 403         SKIPGE  MUDSTR+2        ; skip if not experimental\r
 404         JRST    NOFIXO\r
 405         PUSHJ   P,GENVN         ; get version number as a number\r
 406         MOVE    E,(TP)\r
 407 IFN <PURDIR-FIXDIR>,.SUSET [.SSNAM,,[FIXDIR]]\r
 408 IFE ARC,        .OPEN   MAPCH,[SIXBIT /  'DSK_FIXU_>/]\r
 409 IFN ARC,        .OPEN   MAPCH,[SIXBIT /  'ARC_FIXU_>/]\r
 410 IFE ARC,        FATAL   CANT WRITE FIXUPS\r
 411 IFN ARC,        PUSHJ   P,ARCFAT\r
 412         HLRE    A,E             ; get length\r
 413         MOVNS   A\r
 414         ADDI    A,2             ; account for these 2 words\r
 415         MOVE    0,[-2,,A]       ; write version and length\r
 416         .IOT    MAPCH,0\r
 417         .IOT    MAPCH,E         ; out go the fixups\r
 418         SETZB   0,A\r
 419         MOVEI   B,MAPCH\r
 420         MOVE    C,-1(P)\r
 421         MOVE    D,[SIXBIT /FIXUP/]\r
 422         .FDELE  0\r
 423         FATAL   FIXUP WRITE OUT FAILED\r
 424         .CLOSE  MAPCH,\r
 425 NOFIXO:\r
 426 ]\r
 427 IFE ITS,[\r
 428         MOVE    E,-2(TP)        ; restore P-stack base\r
 429         MOVEI   0,600000        ; fixup args to GTJFN\r
 430         HRLM    0,5(E)\r
 431         MOVE    D,B             ; save page number\r
 432         POP     P,4(E)          ; current version name in\r
 433         MOVEI   A,5(E)          ; pointer ro arg block\r
 434         MOVEI   B,0\r
 435         GTJFN\r
 436         FATAL MAP FIXUP LOSSAGE\r
 437         MOVE    B,[440000,,100000]\r
 438         OPENF\r
 439         FATAL MAP FIXUP LOSSAGE\r
 440         MOVEI   B,(D)           ; ready to write it out\r
 441         HRLI    B,444400\r
 442         HLRE    C,D\r
 443         SOUT                    ; zap it out\r
 444         TLO     A,400000        ; dont recycle the JFN\r
 445         CLOSF\r
 446         JFCL\r
 447         ANDI    A,-1            ; kill sign bit\r
 448         MOVE    B,[440000,,240000]\r
 449         OPENF\r
 450         FATAL MAP FIXUP LOSSAGE\r
 451         MOVE    B,D\r
 452         ASH     B,-PGSHFT       ; aobjn to pages\r
 453         PUSH    P,B\r
 454         HLRE    D,B             ; -count\r
 455         HRLI    B,400000\r
 456         MOVSI   A,(A)\r
 457         MOVSI   C,120000\r
 458 \r
 459         PMAP\r
 460         ADDI    A,1\r
 461         ADDI    B,1\r
 462         AOJL    D,.-3\r
 463 \r
 464         HLRZS   A\r
 465         CLOSF\r
 466         JFCL\r
 467 \r
 468         HRROI   0,[ASCIZ /FIXUP/]       ; now write out new fixup file\r
 469         MOVEM   0,10.(E)\r
 470         MOVEI   A,5(E)\r
 471         MOVEI   B,0\r
 472 \r
 473         SKIPGE  MUDSTR+2\r
 474         JRST    NOFIXO          ; exp vers, dont write out\r
 475 \r
 476         PUSHJ   P,GENVN\r
 477         MOVEI   D,(B)           ; save vers in D\r
 478         GTJFN\r
 479         FATAL MAP FIXUP LOSSAGE\r
 480         MOVE    B,[440000,,100000]\r
 481         OPENF\r
 482         FATAL MAP FIXUP LOSSAGE\r
 483         HLRE    B,(TP)          ; length of fixup vector\r
 484         MOVNS   B\r
 485         ADDI    B,2             ; for length and version words\r
 486         BOUT\r
 487         MOVE    B,D             ; and vers #\r
 488         BOUT\r
 489         MOVSI   B,444400        ; byte pointer to fixups\r
 490         HRR     B,(TP)\r
 491         HLRE    C,(TP)\r
 492         SOUT\r
 493         CLOSF\r
 494         JFCL\r
 495 NOFIXO: MOVE    A,(P)           ; save aobjn to pages\r
 496         MOVE    P,-2(TP)\r
 497         SUB     TP,[2,,2]\r
 498         PUSH    P,A\r
 499 ]\r
 500         HRRZ    A,(P)           ; get page #\r
 501         HLRE    C,(P)           ; and # of same\r
 502         MOVE    B,(P)           ; set B up for return\r
 503         MOVNS   C\r
 504 IFN ITS,[\r
 505         SUB     P,[2,,2]\r
 506         MOVE    0,-2(TP)                ; saved sname\r
 507         MOVEM   0,(P)\r
 508 ]\r
 509         PUSH    P,C\r
 510         PUSH    P,A\r
 511         SUB     TP,[4,,4]\r
 512         JRST    PLOAD1\r
 513 \r
 514 IFN ITS,[\r
 515 MAPLS4: .CLOSE  MAPCH,\r
 516         SUB     P,[1,,1]\r
 517         JRST    MAPLS1\r
 518 ]\r
 519 IFE ITS,[\r
 520 MAPLS4: SKIPA   A,[4,,4]\r
 521 MAPLS5: MOVE    A,[6,,6]\r
 522         MOVE    P,E\r
 523         SUB     TP,A\r
 524         SKIPE   A,C\r
 525         CLOSF\r
 526         JFCL\r
 527         JRST    MAPLOS\r
 528 ]\r
 529 \r
 530 IFN ITS,[\r
 531 IFN ARC,[\r
 532 ARCLOS: PUSHJ   P,CKLOCK\r
 533         JRST    MAPLS1\r
 534 \r
 535 ARCRTR: SOS     (P)\r
 536         SOS     (P)\r
 537         POPJ    P,\r
 538 \r
 539 ARCFAT: PUSHJ   P,CKLOCK\r
 540         FATAL   CANT WRITE FIXUP FILE\r
 541         JRST    ARCRTR\r
 542 \r
 543 CKLOCK: PUSH    P,0\r
 544         .STATUS MAPCH,0\r
 545         LDB     0,[220600,,0]\r
 546         CAIN    0,23            ; file locked?\r
 547         JRST    WAIT            ; wait and retry\r
 548         POP     P,0\r
 549         POPJ    P,\r
 550 \r
 551 WAIT:   MOVEI   0,1\r
 552         .SLEEP  0,\r
 553         POP     P,0\r
 554         AOS     (P)\r
 555         POPJ    P,\r
 556 ]\r
 557 ]\r
 558 \r
 559 ; Here to try to get a free page block for new thing\r
 560 ;       A/      # of pages to get\r
 561 \r
 562 ALOPAG: PUSHJ   P,GETPAG        ; try to get enough pages\r
 563         POPJ    P,\r
 564         AOS     (P)             ; won skip return\r
 565         MOVEI   0,(B)           ; update PURBOT/PURTOP to reflect current state\r
 566         ASH     0,PGSHFT\r
 567         MOVEM   0,PURBOT\r
 568         POPJ    P,\r
 569 \r
 570 GETPAG: MOVE    C,P.TOP         ; top of GC space\r
 571         ASH     C,-PGSHFT       ; to page number\r
 572         MOVE    B,PURBOT        ; current bottom of pure space\r
 573         ASH     B,-PGSHFT       ; also to pages\r
 574         SUBM    B,C             ; pages available ==> C\r
 575         CAIGE   C,(A)           ; skip if have enough already\r
 576         JRST    GETPG1          ; no, try to shuffle around\r
 577         SUBI    B,(A)           ; B/  first new page\r
 578         AOS     (P)\r
 579         POPJ    P,              ; return with new free page in B\r
 580 \r
 581 ; Here if shuffle must occur or gc must be done to make room\r
 582 \r
 583 GETPG1: MOVEI   0,0\r
 584         SKIPE   NOSHUF          ; if can't shuffle, then ask gc\r
 585         JRST    ASKAGC\r
 586         MOVE    0,PURTOP        ; get top of mapped pure area\r
 587         SUB     0,P.TOP         ; total free words to 0\r
 588         ASH     0,-PGSHFT       ; to pages\r
 589         CAIGE   0,(A)           ; skip if winnage possible\r
 590         JRST    ASKAGC          ; please AGC give me some room!!\r
 591         SUBM    A,C             ; C/ amount we must flush to make room\r
 592 \r
 593 ; Here to find pages for flush using LRU algorithm\r
 594 \r
 595 GL1:    MOVE    B,PURVEC+1(TVP) ; get pointer to pure sr vector\r
 596         MOVEI   0,-1            ; get very large age\r
 597 \r
 598 GL2:    SKIPN   1(B)            ; skip if not already flushed\r
 599         JRST    GL3\r
 600         HLRZ    D,2(B)          ; get this ones age\r
 601         CAMLE   D,0             ; skip if this is a candidate\r
 602         JRST    GL3\r
 603         MOVE    E,B             ; point to table entry with E\r
 604         MOVEI   0,(D)           ; and use as current best\r
 605 GL3:    ADD     B,[ELN,,ELN]    ; look at next\r
 606         JUMPL   B,GL2\r
 607 \r
 608         HLRE    B,1(E)          ; get length of flushee\r
 609         ASH     B,-PGSHFT       ; to negative # of pages\r
 610         ADD     C,B             ; update amount needed\r
 611         SETZM   1(E)            ; indicate it will be gone\r
 612         JUMPG   C,GL1           ; jump if more to get\r
 613 \r
 614 ; Now compact pure space\r
 615 \r
 616         PUSH    P,A             ; need all acs\r
 617         SETZB   E,A\r
 618         HRRZ    D,PURVEC(TVP)   ; point to first in core addr order\r
 619         HRRZ    C,PURTOP        ; get destination page\r
 620         ASH     C,-PGSHFT       ; to page number\r
 621 \r
 622 CL1:    ADD     D,PURVEC+1(TVP) ; to real pointer\r
 623         SKIPE   1(D)            ; skip if this one is a flushee\r
 624         JRST    CL2\r
 625 \r
 626         HRRZ    D,2(D)          ; point to next one in chain\r
 627         JUMPN   E,CL3           ; jump if not first one\r
 628         HRRM    D,PURVEC(TVP)   ; and use its next as first\r
 629         JRST    CL4\r
 630 \r
 631 CL3:    HRRM    D,2(E)          ; link up\r
 632         JRST    CL4\r
 633 \r
 634 ; Found a stayer, move it if necessary\r
 635 \r
 636 CL2:    MOVEI   E,(D)           ; another pointer to slot\r
 637         HLRE    B,1(D)          ; - length of block\r
 638         HRRZ    D,1(D)          ; pointer to block\r
 639         SUB     D,B             ; point to top of block\r
 640         ASH     D,-PGSHFT               ; to page number\r
 641         CAIN    D,(C)           ; if not moving, jump\r
 642         JRST    CL6\r
 643 \r
 644         ASH     B,-PGSHFT       ; to pages\r
 645 IFN ITS,[\r
 646 CL5:    SUBI    C,1             ; move to pointer and from pointer\r
 647         SUBI    D,1\r
 648         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D]\r
 649         FATAL   PURE SHUFFLE LOSSAGE\r
 650         AOJL    B,CL5           ; count down\r
 651 ]\r
 652 IFE ITS,[\r
 653         PUSH    P,B             ; save # of pages\r
 654         MOVEI   A,-1(D)         ; copy from pointer\r
 655         HRLI    A,400000        ; get this fork code\r
 656         RMAP                    ; get a JFN (hopefully)\r
 657         EXCH    D,(P)           ; D # of pages (save from)\r
 658         ADDM    D,(P)           ; update from\r
 659         MOVEI   B,-1(C)         ; to pointer in B\r
 660         HRLI    B,400000\r
 661         MOVSI   C,120000        ; read/execute modes\r
 662 \r
 663         PMAP                    ; move a page\r
 664         SUBI    A,1\r
 665         SUBI    B,1\r
 666         AOJL    D,.-3           ; move them all\r
 667 \r
 668         MOVEI   C,1(B)\r
 669         POP     P,D\r
 670         ADDI    D,1\r
 671 ]\r
 672 ; Update the table address for this loser\r
 673 \r
 674         SUBM    C,D             ; compute offset (in pages)\r
 675         ASH     D,PGSHFT        ; to words\r
 676         ADDM    D,1(E)          ; update it\r
 677 CL7:    HRRZ    D,2(E)          ; chain on\r
 678 CL4:    TRNN    D,400000        ; skip if end of chain\r
 679         JRST    CL1\r
 680 \r
 681         ASH     C,PGSHFT        ; to words\r
 682         MOVEM   C,PURBOT        ; reset pur bottom\r
 683         POP     P,A\r
 684         JRST    GETPAG\r
 685 \r
 686 CL6:    HRRZ    C,1(E)          ; get new top of world\r
 687         ASH     C,-PGSHFT       ; to page #\r
 688         JRST    CL7\r
 689 \r
 690 ; SUBR to create an entry in the vector for one of these guys\r
 691 \r
 692 MFUNCTION PCODE,SUBR\r
 693 \r
 694         ENTRY   2\r
 695 \r
 696         GETYP   0,(AB)          ; check 1st arg is string\r
 697         CAIE    0,TCHSTR\r
 698         JRST    WTYP1\r
 699         GETYP   0,2(AB)         ; second must be fix\r
 700         CAIE    0,TFIX\r
 701         JRST    WTYP2\r
 702 \r
 703         MOVE    A,(AB)          ; convert name of program to sixbit\r
 704         MOVE    B,1(AB)\r
 705         PUSHJ   P,STRTO6\r
 706 PCODE4: MOVE    C,(P)           ; get name in sixbit\r
 707 \r
 708 ; Now look for either this one or an empty slot\r
 709 \r
 710         MOVEI   E,0\r
 711         MOVE    B,PURVEC+1(TVP)\r
 712 \r
 713 PCODE2: CAMN    C,(B)           ; skip if this is not it\r
 714         JRST    PCODE1          ; found it, drop out of loop\r
 715         JUMPN   E,.+3           ; dont record another empty if have one\r
 716         SKIPN   (B)             ; skip if slot filled\r
 717         MOVE    E,B             ; remember pointer\r
 718         ADD     B,[ELN,,ELN]\r
 719         JUMPL   B,PCODE2        ; jump if more to look at\r
 720 \r
 721         JUMPE   E,PCODE3        ; if E=0, error no room\r
 722         MOVEM   C,(E)           ; else stash away name and zero rest\r
 723         SETZM   1(E)\r
 724         SETZM   2(E)\r
 725         JRST    .+2\r
 726 \r
 727 PCODE1: MOVE    E,B             ; build <slot #>,,<offset>\r
 728         MOVEI   0,0             ; flag whether new slot\r
 729         SKIPE   1(E)            ; skip if mapped already\r
 730         MOVEI   0,1\r
 731         MOVE    B,3(AB)\r
 732         HLRE    D,E\r
 733         HLRE    E,PURVEC+1(TVP)\r
 734         SUB     D,E\r
 735         HRLI    B,(D)\r
 736         MOVSI   A,TPCODE\r
 737         SKIPN   NOSHUF          ; skip if not shuffling\r
 738         JRST    FINIS\r
 739         JUMPN   0,FINIS         ; jump if winner\r
 740         PUSH    TP,A\r
 741         PUSH    TP,B\r
 742         HLRZ    A,B\r
 743         PUSHJ   P,PLOAD\r
 744         JRST    PCOERR\r
 745         POP     TP,B\r
 746         POP     TP,A\r
 747         JRST    FINIS\r
 748 \r
 749 PCOERR: PUSH    TP,$TATOM\r
 750         PUSH    TP,EQUOTE PURE-LOAD-FAILURE\r
 751         JRST    CALER1\r
 752 \r
 753 \r
 754 PCODE3: HLRE    A,PURVEC+1(TVP) ; get current length\r
 755         MOVNS   A\r
 756         ADDI    A,10*ELN        ; add 10(8) more entry slots\r
 757         PUSHJ   P,IBLOCK\r
 758         EXCH    B,PURVEC+1(TVP) ; store new one and get old\r
 759         HLRE    A,B             ; -old length to A\r
 760         MOVSI   B,(B)           ; start making BLT pointer\r
 761         HRR     B,PURVEC+1(TVP)\r
 762         SUBM    B,A             ; final dest to A\r
 763         BLT     B,-1(A)\r
 764         JRST    PCODE4\r
 765 \r
 766 ; Here if must try to GC for some more core\r
 767 \r
 768 ASKAGC: SKIPE   GCFLG           ; if already in GC, lose\r
 769         POPJ    P,\r
 770         SUBM    A,0             ; amount required to 0\r
 771         ASH     0,PGSHFT        ; TO WORDS\r
 772         MOVEM   0,GCDOWN        ; pass as funny arg to AGC\r
 773         EXCH    A,C             ; save A from gc's destruction\r
 774 IFN ITS,        .IOPUSH MAPCH,          ; gc uses same channel\r
 775         PUSH    P,C\r
 776         MOVE    C,[8,,9.]       ; SET UP INDICATORS FOR GC\r
 777         PUSHJ   P,AGC\r
 778         POP     P,C\r
 779 IFN ITS,        .IOPOP  MAPCH,\r
 780         EXCH    C,A\r
 781         JUMPGE  C,GETPAG\r
 782         PUSH    TP,$TATOM\r
 783         PUSH    TP,EQUOTE NO-MORE-PAGES\r
 784         AOJA    TB,CALER1\r
 785 \r
 786 ; Here to clean up pure space by flushing all shared stuff\r
 787 \r
 788 PURCLN: SKIPE   NOSHUF\r
 789         POPJ    P,\r
 790         MOVEI   B,400000\r
 791         HRRM    B,PURVEC(TVP)   ; flush chain pointer\r
 792         MOVE    B,PURVEC+1(TVP) ; get pointer to table\r
 793         SETZM   1(B)            ; zero pointer entry\r
 794         SETZM   2(B)            ; zero link and age slots\r
 795         ADD     B,[ELN,,ELN]    ; go to next slot\r
 796         JUMPL   B,.-3           ; do til exhausted\r
 797         MOVE    B,PURBOT        ; now return pages\r
 798         SUB     B,PURTOP        ; compute page AOBJN pointer\r
 799         JUMPE   B,CPOPJ         ; no pure pages?\r
 800         MOVSI   B,(B)\r
 801         HRR     B,PURBOT\r
 802         ASH     B,-PGSHFT\r
 803 IFN ITS,[\r
 804         DOTCAL  CORBLK,[[1000,,0],[1000,,-1],B]\r
 805         FATAL   SYSTEM WONT TAKE CORE BACK?\r
 806 ]\r
 807 IFE ITS,[\r
 808         HLRE    D,B             ; - # of pges to flush\r
 809         HRLI    B,400000        ; specify hacking hom fork\r
 810         MOVNI   A,1\r
 811 \r
 812         PMAP\r
 813         ADDI    B,1\r
 814         AOJL    D,.-2\r
 815 ]\r
 816         MOVE    B,PURTOP        ; now fix up pointers\r
 817         MOVEM   B,PURBOT        ;   to indicate no pure\r
 818 CPOPJ:  POPJ    P,\r
 819 \r
 820 ; Here to move the entire pure space.\r
 821 ;       A/      # and direction of pages to move (+ ==> up)\r
 822 \r
 823 MOVPUR: SKIPE   NOSHUF\r
 824         FATAL   CANT MOVE PURE SPACE AROUND\r
 825         IFE ITS [ASH A,1]\r
 826         SKIPN   B,A             ; zero movement, ignore call\r
 827         POPJ    P,\r
 828 \r
 829         ASH     B,PGSHFT        ; convert to words for pointer update\r
 830         MOVE    C,PURVEC+1(TVP) ; loop through updating non-zero entries\r
 831         SKIPE   1(C)\r
 832         ADDM    B,1(C)\r
 833         ADD     C,[ELN,,ELN]\r
 834         JUMPL   C,.-3\r
 835 \r
 836         MOVE    C,PURTOP        ; found pages at top and bottom of pure\r
 837         ASH     C,-PGSHFT\r
 838         MOVE    D,PURBOT\r
 839         ASH     D,-PGSHFT\r
 840         ADDM    B,PURTOP        ; update to new boundaries\r
 841         ADDM    B,PURBOT\r
 842         CAIN    C,(D)           ; differ?\r
 843         POPJ    P,\r
 844         JUMPG   A,PUP           ; if moving up, go do separate CORBLKs\r
 845 \r
 846 IFN ITS,[\r
 847         SUBM    D,C             ; -size of area to C (in pages)\r
 848         MOVEI   E,(D)           ; build pointer to bottom of destination\r
 849         ADD     E,A\r
 850         HRLI    E,(C)\r
 851         HRLI    D,(C)\r
 852         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D]\r
 853         FATAL   CANT MOVE PURE\r
 854         POPJ    P,\r
 855 \r
 856 PUP:    SUBM    C,D             ; pages to move to D\r
 857         ADDI    A,(C)           ; point to new top\r
 858 \r
 859 PUPL:   SUBI    C,1\r
 860         SUBI    A,1\r
 861         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C]\r
 862         FATAL   CANT MOVE PURE\r
 863         SOJG    D,PUPL\r
 864         POPJ    P,\r
 865 ]\r
 866 IFE ITS,[\r
 867         SUBM    D,C             ; pages to move to D\r
 868         MOVSI   E,(C)           ; build aobjn pointer\r
 869         HRRI    E,(D)           ; point to lowest\r
 870         ADD     D,A             ; D==> new lowest page\r
 871 PURCL1: MOVSI   A,400000        ; specify here\r
 872         HRRI    A,(E)           ; get a page\r
 873         RMAP                    ; get a real handle on it\r
 874         MOVE    B,D             ; where to go\r
 875         HRLI    B,400000\r
 876         MOVSI   C,120000\r
 877         PMAP\r
 878         ADDI    D,1\r
 879         AOBJN   E,PURCL1\r
 880         POPJ    P,\r
 881 \r
 882 PUP:    SUB     D,C             ; - count to D\r
 883         MOVSI   E,(D)           ; start building AOBJN\r
 884         HRRI    E,(C)           ; aobjn to top\r
 885         ADD     C,A             ; C==> new top\r
 886         MOVE    D,C\r
 887 \r
 888 PUPL:   MOVSI   A,400000\r
 889         HRRI    A,(E)\r
 890         RMAP                    ; get real handle\r
 891         MOVE    B,D\r
 892         HRLI    B,400000\r
 893         MOVSI   C,120000\r
 894         PMAP\r
 895         SUBI    E,2\r
 896         SUBI    D,1\r
 897         AOBJN   E,PUPL\r
 898 \r
 899         POPJ    P,\r
 900 ]\r
 901 IFN ITS,[\r
 902 CSIXBT: MOVEI   0,5\r
 903         PUSH    P,[440700,,C]\r
 904         PUSH    P,[440600,,D]\r
 905         MOVEI   D,0\r
 906 CSXB2:  ILDB    E,-1(P)\r
 907         CAIN    E,177\r
 908         JRST    CSXB1\r
 909         SUBI    E,40\r
 910         IDPB    E,(P)\r
 911         SOJG    0,CSXB2\r
 912 CSXB1:  SUB     P,[2,,2]\r
 913         MOVE    C,D\r
 914         POPJ    P,\r
 915 ]\r
 916 GENVN:  MOVE    C,[440700,,MUDSTR+2]\r
 917         MOVEI   D,5\r
 918         MOVEI   B,0\r
 919 VNGEN:  ILDB    0,C\r
 920         CAIN    0,177\r
 921         POPJ    P,\r
 922         IMULI   B,10.\r
 923         SUBI    0,60\r
 924         ADD     B,0\r
 925         SOJG    D,VNGEN\r
 926         POPJ    P,\r
 927 \r
 928 IFE ITS,[\r
 929 MSKS:   774000,,0\r
 930         777760,,0\r
 931         777777,,700000\r
 932         777777,,777400\r
 933         777777,,777776\r
 934 ]\r
 935 END\r
 936 \f\r