src/loader.v25

   1         SUBTTL  DICK GRUEN: V25 3 AUG 68\r
   2 \r
   3 \r
   4 L==1                    ;L=1 MEANS THE LISP LOADER\r
   5 IFNDEF L,<L=0>\r
   6 \r
   7 IFNDEF HE,<HE=0>\r
   8 IFE HE-1,<K=1>          ;HE=1 IS HAND EYE 1K LOADER\r
   9 IFE HE-2,<K=0>          ;HE=2 IS HAND-EYE FORTRAN LOADER\r
  10 ;K=1                    ;K=1  MEANS 1KLOADER\r
  11 IFNDEF  K,<K=0>         ;K=0  MEANS F4 LOADER\r
  12 \r
  13 STANSW=1                ;GIVES STANFORD FEATURES\r
  14 IFNDEF STANSW,<STANSW=0>\r
  15 IFN STANSW,<    LDAC=1\r
  16                 EXPAND=1\r
  17                 BLTSYM=1\r
  18                 PP=1\r
  19                 RPGSW=1\r
  20                 FAILSW=1>\r
  21 IFN L,< RPGSW=0\r
  22         BLTSYM=0\r
  23         LDAC=0>\r
  24 \r
  25 UTAHSW=1                ;NUMERIC PPN'S, BUT OTHERWISE = STANSW=1.\r
  26 IFNDEF UTAHSW,<UTAHSW=0>\r
  27 \r
  28 ;FAILSW=1               ;MEANS INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS\r
  29 IFNDEF FAILSW,<FAILSW=0>\r
  30 \r
  31 ;RPGSW=1                ;MEANS RPG FEATURE\r
  32 IFNDEF RPGSW,<RPGSW=0>\r
  33 ;LDAC=1                 ;MEANS LOAD CODE INTO ACS\r
  34 IFNDEF LDAC,<LDAC=0>\r
  35 \r
  36 ;BLTSYM=1               ;MOVE SYMBOL TABLE DOWN TO END OF PROG\r
  37 IFNDEF BLTSYM,<BLTSYM=0>\r
  38 \r
  39 ;EXPAND=1               ;FOR AUTOMATIC CORE EXPANSION\r
  40 IFNDEF EXPAND,< IFN K,<EXPAND=0>\r
  41                 IFE K,<EXPAND=1>>\r
  42 \r
  43 ;PP=1                   ;ALLOW PROJ-PROG #\r
  44 IFNDEF PP,<PP=0>\r
  45 IFN HE,<RPGSW=0\r
  46         PP=0\r
  47         LDAC=0\r
  48         EXPAND=1\r
  49         >\r
  50 \r
  51 ;CHN5=0                 ;IF CHAIN WHICH DOESN'T SAVES JOB41\r
  52 IFNDEF CHN5,<CHN5=1>\r
  53 \r
  54 IFE K,< TITLE   LOADER - LOADS MACROX AND SIXTRAN FOUR>\r
  55 IFN K,< TITLE   1KLOAD - LOADS MACROX>\r
  56 \f;ACCUMULATOR ASSIGNMENTS\r
  57         F=0             ;FLAGS IN LH, SA IN RH\r
  58         N=1             ;PROGRAM NAME POINTER\r
  59         X=2             ;LOADER OFFSET\r
  60         H=3             ;HIGHEST LOC LOADED\r
  61         S=4             ;UNDEFINED POINTER\r
  62         R=5             ;RELOCATION CONSTANT\r
  63         B=6             ;SYMBOL TABLE POINTER\r
  64         D=7\r
  65         T=10\r
  66         V=T+1\r
  67         W=12            ;VALUE\r
  68         C=W+1           ;SYMBOL\r
  69         E=C+1           ;DATA WORD COUNTER\r
  70         Q=15            ;RELOCATION BITS\r
  71         A=Q+1           ;SYMBOL SEARCH POINTER\r
  72         P=17            ;PUSHDOWN POINTER\r
  73 ;FLAGS  F(0 - 17)\r
  74         CSW==1                  ;ON - COLON SEEN\r
  75         ESW==2                  ;ON - EXPLICIT EXTENSION IDENT.\r
  76         SKIPSW==4               ;ON - DO NOT LOAD THIS PROGRAM\r
  77         FSW==10                 ;ON - SCAN FORCED TO COMPLETION\r
  78         FCONSW==20              ;ON - FORCE CONSOLE OUTPUT\r
  79         ASW==100                ;ON - LEFT ARROW ILLEGAL\r
  80         FULLSW==200             ;ON - STORAGE EXCEEDED\r
  81         SLIBSW==400             ;ON - LIB SEARCH IN THIS PROG\r
  82         DSYMSW==1000            ;ON - LOAD WITH SYMBOLS FOR DDT\r
  83         REWSW==2000             ;ON - REWIND AFTER INIT\r
  84         LIBSW==4000             ;ON - LIBRARY SEARCH MODE\r
  85         F4LIB==10000            ;ON - F4 LIBRARY SEARCH LOOKUP\r
  86         ISW==20000              ;ON - DO NOT PERFORM INIT\r
  87         SYMSW==40000            ;ON - LOAD LOCAL SYMBOLS\r
  88         DSW==100000             ;ON - CHAR IN IDENTIFIER\r
  89         NSW==200000             ;ON - SUPPRESS LIBRARY SEARCH\r
  90         SSW==400000             ;ON - SWITCH MODE\r
  91 ;FLAGS  N(0 - 17)\r
  92         ALLFLG==1               ;ON - LIST ALL GLOBALS\r
  93         ISAFLG==2               ;ON - IGNORE STARTING ADDRESSES\r
  94         COMFLG==4               ;ON - SIZE OF COMMON SET\r
  95 IFE K,< F4SW==10                ;F4 IN PROGRESS\r
  96         RCF==20                 ;READ DATA COUNT\r
  97         SYDAT==40               ;SYMBOL IN DATA>\r
  98         SLASH==100              ;SLASH SEEN\r
  99 IFE K,< BLKD1==200              ;ON- FIRST BLOCK DATA SEEN\r
 100         PGM1==400               ;ON FIRST F4 PROG SEEN\r
 101         DZER==1000              ;ON - ZERO SECOND DATA WORD>\r
 102         EXEQSW==2000            ;IMMEDIATE EXECUTION\r
 103         DDSW==4000              ;GO TO DDT\r
 104 IFN RPGSW,<RPGF==10000          ;IN RPG MODE>\r
 105         AUXSWI==20000           ;ON - AUX. DEVICE INITIALIZED\r
 106         AUXSWE==40000           ;ON - AUX. DEVICE ENTERED\r
 107 IFN PP,<PPSW==100000            ;ON - READING PROJ-PROG #\r
 108         PPCSW==200000           ;ON - READING PROJ #>\r
 109 IFN FAILSW,<HSW==400000         ;USED IN BLOCK 11 POLISH FIXUPS>\r
 110 \fLOC    137\r
 111 OCT 25          ;VERSION #\r
 112 RELOC\r
 113         MLON\r
 114         SALL\r
 115 \r
 116 \r
 117 \r
 118 ;MONITOR LOCATIONS IN THE USER AREA\r
 119 \r
 120         JOBPRO==140             ;PROGRAM ORIGIN\r
 121         JOBBLT==134             ;BLT ORIGIN\r
 122         JOBCHN==131             ;RH = PROG BREAK OF FIRST BLOCK DATA\r
 123                                 ;LH = PROG BREAK OF FIRST F4 PROG\r
 124 \r
 125 ;CALLI DEFINITIONS\r
 126 \r
 127 CDDTOUT==3      ;CALLI DDTOUT\r
 128 CEXIT==12       ;CALLI EXIT\r
 129 CDDTGT==5       ;CALLI DDTGT\r
 130 CSETDDT==2      ;CALLI SETDDT\r
 131 \r
 132 ;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS\r
 133 \r
 134 PPDL==60\r
 135 \fIFN RPGSW,<\r
 136 RPGSET: CALLI 0\r
 137         INIT 17,1       ;SET UP DSK\r
 138         SIXBIT /DSK/\r
 139         XWD 0,CTLIN\r
 140         JRST NUTS\r
 141         MOVE [SIXBIT /QQLOAD/]  ;NAME OF COMMAND FILE\r
 142         MOVEM CTLNAM\r
 143         MOVSI (SIXBIT /RPG/)    ;AND EXT\r
 144         MOVEM CTLNAM+1\r
 145         SETZM CTLNAM+3\r
 146         LOOKUP 17,CTLNAM        ;THERE?\r
 147         JRST NUTS       ;NO\r
 148         INIT 16,16      ;GET SET TO DELETE QQLOAD.RPG\r
 149         SIXBIT /DSK/\r
 150         0\r
 151         JRST LD         ;GIVE UP COMPLETELY\r
 152         SETZM CTLNAM+3\r
 153         HLLZS CTLNAM+1  ;CLEAR OUT EXTRA JUNK\r
 154         LOOKUP 16,CTLNAM\r
 155         JRST LD\r
 156         RENAME 16,ZEROS ;DELETE IT\r
 157         JFCL            ;IGNORE IF IT WILL NOT GO\r
 158         RELEASE 16,0    ;GET RID OF THIS DEVICE\r
 159         SETZM NONLOD    ;THIS IS NOT A CONTINUATION\r
 160 RPGS3:  MOVEI CTLBUF\r
 161         MOVEM JOBFF     ;SET UP BUFFER\r
 162         INBUF 17,1\r
 163         MOVEI [ASCIZ /\r
 164 LOADING\r
 165 /]              ;PRINT MESSAGE THAT WE ARE STARTING\r
 166         CALLI CDDTOUT\r
 167         SKIPE NONLOD    ;CONTINUATION?\r
 168         JRST RPGS2      ;YES, SPECIAL SETUP\r
 169         MOVSI R,F.I     ;NOW SO WE CAN SET FLAG\r
 170         BLT R,R\r
 171         TLO N,RPGF\r
 172         JRST CTLSET     ;SET UP TTY\r
 173 RPGS1:  PUSHJ P,[TLNE F,ESW     ;HERE FROM FOO* COMMAND, STORE NAME\r
 174                 JRST LDDT3      ;SAVE EXTENSION\r
 175                 TLZE F,CSW!DSW   ;OR AS NAME\r
 176                 MOVEM W,DTIN\r
 177                 POPJ P,]\r
 178         MOVEM 0,SVRPG#  ;SAVE 0 JUST IN CASE\r
 179         SETZM NONLOD#   ;DETERMINE IF CONTINUATION\r
 180         MOVEI 0,2(B)    ;BY SEEING IF ANY SYMBOLS LOADED\r
 181         CAME 0,JOBREL\r
 182         SETOM NONLOD    ;SET TO -1 AND SKIP CALLI\r
 183         MOVE 0,ILD1\r
 184         MOVEM 0,RPG1\r
 185         INIT 17,1\r
 186 RPG1:   0\r
 187         XWD 0,CTLIN\r
 188         JSP A,ILD5\r
 189         LOOKUP 17,DTIN  ;THE FILE NAME\r
 190         JRST ILD9\r
 191         JRST RPGS3\r
 192 \r
 193 RPGS2:  MOVSI 0,RPGF    ;SET FLAG\r
 194         IORM 0,F.C+N\r
 195         TLO N,RPGF\r
 196         MOVE 0,SVRPG\r
 197         JRST LD2Q       ;BACK TO INPUT SCANNING\r
 198 >\r
 199 \fIFN HE, <\r
 200 .LOAD:  SETZM ERRFLG;           HAND-EYE LOADER INITIALIZATION\r
 201         SETZM RESET\r
 202         MOVSI R,F.I+1;          INITIALIZE ACS\r
 203         AOS R\r
 204         BLT R,R\r
 205         OR F,F.I\r
 206         MOVE B,JOBSYM;          SET UP SYMBOL TABLE POINTER\r
 207         HLRZ H,JOBSA\r
 208         HLR R,JOBSA;            LOAD STARTING AT PROGRAM BREAK\r
 209         MOVS E,R;               CLEAR CORE\r
 210         HRRI E,1(R)\r
 211         SETZM (R)\r
 212         BLT E,(B)\r
 213         PUSHJ P,FIXNAM\r
 214         MOVE S,JOBUSY\r
 215         SKIPN S\r
 216         HRRZ S,B\r
 217         SOS S\r
 218         SOS B\r
 219         MOVEM P,SAVP#;          SAVE SUBR POINTER\r
 220         JRST BEG;               FINISH INIT\r
 221 \r
 222 F.I:    XWD SYMSW,0;            INITIAL F\r
 223         XWD ALLFLG+ISAFLG+COMFLG,0;     INITIAL N\r
 224         XWD V,0;                INITIAL X - LOAD IN PLACE\r
 225         Z\r
 226         Z\r
 227         XWD W,0;                INITIAL R\r
 228         Z\r
 229 .AC:    BLOCK 17\r
 230 LNKSAV: BLOCK 21\r
 231 \r
 232 LD5B1:  HALT\r
 233         >\r
 234 \fIFN HE,<\r
 235 .PRMAP: MOVEM 16,.AC+16;        PRINT STORAGE MAP\r
 236         HRRZI 16,.AC;           SAVE ACS\r
 237         BLT 16,.AC+15\r
 238         MOVE F,F.I+F;           SET UP ACS AS NEEDED\r
 239         MOVE N,F.I+N\r
 240         HLRZ R,JOBSA\r
 241         MOVE S,JOBUSY\r
 242         SOS S\r
 243         MOVE B,JOBSYM\r
 244         SOS B\r
 245         INIT 2,1;               INITIALIZE LPT\r
 246         SIXBIT /LPT/\r
 247         XWD ABUF,0\r
 248         JSP A,ILD5\r
 249         MOVEI E,AUX\r
 250         MOVEM E,JOBFF\r
 251         OUTBUF 2,1\r
 252         TLO N,AUXSWI\r
 253         PUSHJ P,PRMAP;  PRINT MAP\r
 254         RELEASE 2,\r
 255         HRLZI 16,.AC\r
 256         BLT 16,16\r
 257         POPJ P,\r
 258         >\r
 259 \fIFN HE,<\r
 260 ILD:    MOVEI W,BUF1;           INITIALIZE FILE LOADING\r
 261         MOVEM W,JOBFF\r
 262         TLOE F,ISW\r
 263         JRST ILD6\r
 264         INIT 1,14\r
 265         SIXBIT /DSK/\r
 266         Z BUFR\r
 267         JSP A,ILD5;             ERROR RETURN\r
 268 ILD6:   LOOKUP 1,DTIN;          LOOKUP FILE\r
 269         JRST ILD3\r
 270         INBUF 1,2\r
 271         MOVE 15,..NAME\r
 272         MOVEI 12,-2(S)\r
 273         SUBI S,2\r
 274         POP B,2(12)\r
 275         POP B,1(12)\r
 276         MOVE 12,.NAME;          RIGHT HALF VALUE IS LINK\r
 277         HRL 12,R;               LEFT HALF IS RELOCATION\r
 278         MOVEM 12,2(B)\r
 279         MOVEM 15,1(B)\r
 280         HRRZM B,.NAME\r
 281         POPJ P,\r
 282 \r
 283 ILD3:   PUSHJ P,ILDX;           LOOKUP FAILURE\r
 284         JRST ILD9;              NO HOPE\r
 285         JRST ILD6;              TRY AGAIN\r
 286 \r
 287 ILDX:   MOVE W,DTIN2\r
 288         CAMN W,[SIXBIT /  H HE/]\r
 289         POPJ P,;                IF H,HE THERE IS NO HOPE\r
 290         CAMN W,[SIXBIT /  1  3/]\r
 291         JRST [  MOVE W,DTIN;    CHECK IF HELIB[1,3]\r
 292                 CAME W,[SIXBIT /HELIB/]\r
 293                 POPJ P,;                YES - TRY BACKUP FILE\r
 294                 JRST IX]\r
 295 IX:     MOVE W,[SIXBIT /  H HE/]\r
 296         MOVEM W,DTIN2;          NOT H,HE - TRY LIBRARY AREA\r
 297         AOS (P);                TRY AGAIN\r
 298         POPJ P,\r
 299         >\r
 300 \fIFN HE,<\r
 301 FIXNAM: HLRE T,B;               GET END OF PROGRAM NAME LIST\r
 302         MOVMS T\r
 303         ADDI T,(B)\r
 304         SUBI T,3\r
 305         HLRZ D,2(T)\r
 306         JUMPE D,.+3\r
 307         ADD T,D\r
 308         JRST .-3\r
 309         HRRI N,2(T)\r
 310         POPJ P,\r
 311 \r
 312 LD2:    SKIPN RESET\r
 313         JRST LD2Q-2\r
 314         CAMN B,F.C+B\r
 315         CAME S,F.C+S\r
 316         CAIA\r
 317         JRST .+4\r
 318         MOVEI T,[ASCIZ /\r
 319 CANNOT RECOVER/]\r
 320         CALLI T,CDDTOUT\r
 321         CALLI CEXIT\r
 322         MOVE T,.NAME;           REMOVE NAME\r
 323         HRRZ T,2(T)\r
 324         MOVEM T,.NAME\r
 325         MOVEI T,1(S)\r
 326         ADDI S,2\r
 327         PUSH B,1(T)\r
 328         PUSH B,2(T)\r
 329         AOSA ERRFLG#\r
 330         PUSHJ P,LDF\r
 331 LD2Q:   MOVSI T,F.C\r
 332         BLT T,B\r
 333 >\r
 334 \fIFN HE,<\r
 335 GETF:   MOVE P,SAVP;            RESTORE SUBR POINTER\r
 336         SKIPN RESET\r
 337         JRST GETF4\r
 338         SETZM RESET;            RECOVERABLE ERROR\r
 339         PUSHJ P,ILDX;           CHECK FOR ANOTHER COPY\r
 340         JRST GETF4;             NO\r
 341         MOVEI T,[ASCIZ /_\r
 342 /]\r
 343         CALLI T,CDDTOUT\r
 344         JRST LD2Q-1\r
 345 \r
 346 GETF4:  TLNE F,LIBSW\r
 347         JRST GETFY+1;           LIBRARY MODE - CONTINUE\r
 348         PUSHJ P,.GETF;          GET NEXT FILE\r
 349         SETZM 13\r
 350         LSHC 13,6\r
 351         CAIE 13,"/"\r
 352         JRST GETF1\r
 353         ROT 14,6;               FIRST CHAR SLASH - DECODE SWITCH\r
 354         CAIN 14,"D"\r
 355         JRST .DDT\r
 356         CAIN 14,"S"\r
 357         JRST [  TLO F,SYMSW\r
 358                 JRST GETF4+2]\r
 359         CAIN 14,"W"\r
 360         JRST [  TLZ F,SYMSW+DSYMSW\r
 361                 JRST GETF4+2]\r
 362         CAIN 14,'C'\r
 363         JRST GETF4+2;           SAVE /C DECODING FOR LATER\r
 364         JSP A,ERRPT8;           UNKNOWN SWITCH - ERROR\r
 365         SIXBIT /SYNTAX%/\r
 366         JRST LD2\r
 367 \r
 368 .DDT:   MOVSI W,444464; LOAD DDT\r
 369         MOVEM W,DTIN\r
 370         MOVE W,[SIXBIT /  1  3/]\r
 371         MOVEM W,DTIN2\r
 372         JRST LD2Q-1\r
 373         >\r
 374 \fIFN HE,<\r
 375 GETF1:  LSHC 13,-6\r
 376         JUMPE 14,GETF2;         FILE NAME ZERO - FINISHED\r
 377         OR 15,[XWD 600000,0]\r
 378         SKIPN 13,.NAME#\r
 379         JRST GETF3;             NO FILES LOADED\r
 380         CAMN 15,2(13);          SEARCH FOR FILE NAME\r
 381         JRST GETF4+1;           FOUND - DO NOT LOAD\r
 382         HRRZ 13,1(13)\r
 383         JUMPN 13,.-3\r
 384 GETF3:  MOVEM 15,..NAME#\r
 385         MOVEM 14,DTIN;          SET UP ENTER BLOCK\r
 386         MOVEM 16,DTIN2\r
 387         JRST LD2Q-1\r
 388 \r
 389 GETF2:  MOVEI W,3;              END OF FILES - SEARCH LIBRARIES\r
 390         MOVEM W,CNT#\r
 391         SKIPA\r
 392 GETFY:  TLZ F,SYMSW+DSYMSW;     TURN OFF LOCAL SYMBOLS AFTER HELIB\r
 393         JUMPGE S,GETF11\r
 394         TLO F,LIBSW+SKIPSW\r
 395         MOVE W,[SIXBIT /  1  3/]\r
 396         MOVEM W,DTIN2\r
 397         SOSGE W,CNT\r
 398         JRST GETF11\r
 399         MOVE W,.TAB(W)\r
 400         MOVEM W,DTIN\r
 401         JRST LD2Q-1\r
 402 \r
 403 .TAB:   SIXBIT /JOBDAT/\r
 404         SIXBIT /LIB40/\r
 405         SIXBIT /HELIB/\r
 406 \r
 407 GETF11: PUSHJ P,SAS1;           TERMINATE LOADING\r
 408         RELEASE 1,\r
 409         PUSHJ P,BLTSET\r
 410 IFN FAILSW,<\r
 411         MOVE R,[XWD LINKTB,LNKSAV]\r
 412         BLT R,LNKSAV+20>;       SAVE LINK TABLE\r
 413         MOVE R,JOBDDT\r
 414         CALLI R,CSETDDT\r
 415         HLRE 16,S\r
 416         MOVMS 16\r
 417         LSH 16,-1;              RIGHT HALF AC16 IS # UNDEF SYMBS\r
 418         HRL 16,ERRFLG\r
 419         POPJ P,\r
 420 >\r
 421 \fIFE HE,<\r
 422 ;MONITOR LOADER CONTROL\r
 423 \r
 424 BEG:\r
 425 IFE L,<\r
 426 LD:     IFN RPGSW,<SKIPA        ;NORMAL INITIALIZE\r
 427         JRST RPGSET     ;SPECIAL INIT>\r
 428         HLLZS 42        ;GET RID OF ERROR COUNT IF NOT IN RPG MODE\r
 429         CALLI   0               ;INITIALIZE THIS JOB\r
 430 NUTS:   MOVSI     R,F.I         ;SET UP INITIAL ACCUMULATORS\r
 431         BLT     R,R             \r
 432 >\r
 433 IFN L,<\r
 434 LD:     HRRZM 0,LSPXIT#         ;RETURN ADDRESS FOR LISP\r
 435         MOVEI 0,0\r
 436         HRRZM R,RINITL#\r
 437         CALLI 0\r
 438 >\r
 439 CTLSET: INIT    3,1             ;INITIALIZE CONSOLE\r
 440         SIXBIT    /TTY/\r
 441         XWD     BUFO,BUFI\r
 442 CALLEX: CALLI   CEXIT           ;DEVICE ERROR, FATAL TO JOB\r
 443         MOVEI     E,TTY1\r
 444         MOVEM     E,JOBFF\r
 445         INBUF     3,1\r
 446         OUTBUF    3,1           ;INITIALIZE OUTPUT BUFFERS\r
 447         OUTPUT    3,                    ;DO INITIAL REDUNDANT OUTPUT\r
 448 IFE L,< HRRZ    B,JOBREL        ;PICK UP CORE BOUND\r
 449         SKIPE   JOBDDT          ;DOES DDT EXIST?\r
 450         HRRZ    B,JOBSYM        ;USED BOTTOM OF SYMBOL TABLE INSTEAD\r
 451 >\r
 452 IFN L,< MOVE B,JOBSYM>\r
 453         SUB     B,SE3           ;INITIALIZE SYMBOL TABLE POINTER\r
 454         CAILE     H,1(B)                ;TEST CORE ALLOCATION\r
 455         CALLI   CEXIT           ;INSUFFICIENT CORE, FATAL TO JOB\r
 456 IFE L,< MOVS    E,X             ;SET UP BLT POINTER\r
 457         HRRI    E,1(X)>\r
 458 IFN L,< MOVS E,H\r
 459         HRRI E,1(H)>\r
 460         SETZM     -1(E)                 ;ZERO FIRST WORD\r
 461         BLT     E,(B)           ;ZERO CORE UP TO THE SYMBOL AREA\r
 462         HRRZ    S,B             ;INITIALIZE UNDEF. POINTER\r
 463         HRR     N,B             ;INITIALIZE PROGRAM NAME POINTER\r
 464 IFE L,<HRRI     R,JOBPRO        ;INITIALIZE THE LOAD ORIGIN>\r
 465         MOVE    E,COMM          ;SET .COMM. AS THE FIRST PROGRAM\r
 466         MOVEM     E,1(B)                ;STORE IN SYMBOL TABLE\r
 467         HRRZM     R,2(B)                ;STORE COMMON ORIGIN\r
 468         >\r
 469 IFN HE,<BEG:>\r
 470         MOVEI     E,F.C         ;INITIALIZE STATE OF THE LOADER\r
 471         BLT     E,B.C\r
 472         SETZM   MDG             ;MULTIPLY DEFINED GLOBAL COUNT\r
 473 IFE HE,<\r
 474 IFN FAILSW,<    SETZM LINKTB    ;ZERO OUT TE LINK TABLE\r
 475         MOVE W,[XWD LINKTB,LINKTB+1]\r
 476         BLT W,LINKTB+20 ;BEFORE STARTING>\r
 477 IFE L,< MOVSI   W,254200        ;STORE HALT IN JOB41\r
 478         MOVEM   W,JOB41(X)>     ;...\r
 479 IFN L,< MOVE W,JOBREL\r
 480         HRRZM W,OLDJR#>>\r
 481 IFN HE,<IFN FAILSW,<\r
 482         MOVE W,[XWD LNKSAV,LINKTB]\r
 483         BLT W,LINKTB+20\r
 484         >>\r
 485 IFN STANSW,<SETZM CURNAM#>\r
 486 IFN FAILSW,<    MOVEI W,440000  ;SET UP THE SPECIAL BITS OF HEADNUM (ADD+POLISH)\r
 487         MOVEM W,HEADNM#\r
 488         SETZM POLSW#    ;SWITCH SAYS WE ARE DOING POLISH\r
 489         MOVEI W,PDLOV   ;ENABLE FOR PDL OV\r
 490         MOVEM W,JOBAPR\r
 491         MOVEI W,200000\r
 492         CALLI W,16\r
 493 \r
 494 EXTERNAL JOBAPR >\r
 495 IFN LDAC!BLTSYM,<MOVEI W,20     ;SET UP SPACE TO SAVE FOR ACS AND\r
 496         MOVEM W,KORSP#  ;USER DEFINITIONS WITH DDT>\r
 497 \r
 498 IFN HE,<JRST LD2Q>\r
 499 \fIFE HE,<\r
 500 IFN RPGSW,<JRST LD2Q>\r
 501 LD2:    IFN RPGSW,<MOVSI B,RPGF ;HERE ON ERRORS, TURN OFF RPG\r
 502         ANDCAM B,F.C+N  ;IN CORE>\r
 503 ;LOADER SCAN FOR FILE NAMES\r
 504 \r
 505 LD2Q:   MOVSI     B,F.C         ;RESTORE ACCUMULATORS\r
 506         BLT     B,B\r
 507         MOVE    P,PDLPT         ;INITIALIZE PUSHDOWN LIST\r
 508         SETZM     BUFI2         ;CLEAR INPUT BUFFER POINTER\r
 509 IFE PP,<        SETZM     ILD1          ;CLEAR INPUT DEVICE NAME>\r
 510 IFN PP,<        MOVSI T,(SIXBIT /DSK/)  ;ASSUME DSK\r
 511         MOVEM T,ILD1\r
 512         SETZM OLDDEV#   ;TO MAKE IT GO BACK AFTER /D FOR LIBSR>\r
 513         SETZM     DTIN          ;CLEAR INPUT FILE NAME\r
 514 IFN PP,<SETZM   PPN#            ;CLEAR INPUT PROJ-PROG #>\r
 515 \r
 516 LD2B:   RELEAS    1,                    ;RELEASE BINARY INPUT DEVICE\r
 517 IFN RPGSW,<     TLNE N,RPGF     ;NOT IF DOING RPG\r
 518         JRST LD2BA>\r
 519         MOVEI     T,"*"\r
 520         IDPB    T,BUFO1         ;OUTPUT ASTERISK TO START INPUT\r
 521         OUTPUT    3,\r
 522 LD2BA:  TLZ     F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW\r
 523         TLNE    F,LIBSW         ;WAS LIBRARY MODE ON?\r
 524         TLO     F,SKIPSW        ;YES, NORMAL MODE IS SKIPPING\r
 525 \r
 526 LD2D:   IFN PP,<SETZM PPN       ;DO NOT REMEMBER PPNS FOR NOW\r
 527 LD2DB:  SKIPE W,OLDDEV  ;RESET DEVICE IF NEEDED\r
 528         CAMN W,ILD1     ;IS IT SAME?\r
 529         JRST LD2DA      ;YES, FORGET IT\r
 530         TLZ F,ISW+DSW+FSW+REWSW\r
 531         MOVEM W,ILD1>\r
 532 LD2DA:\r
 533 IFN RPGSW,<     SETZM DTIN1     ;CLEAR EXTENSION>\r
 534         MOVEI     W,0           ;INITIALIZE IDENTIFIER SCAN\r
 535         MOVEI     E,6           ;INITIALIZE CHARACTER COUNTER\r
 536         MOVE    V,LSTPT         ;INITIALIZE BYTE POINTER TO W\r
 537         TLZ     F,SSW+DSW+FSW   ;LEAVE SWITCH MODE\r
 538 LD3:    IFN RPGSW,<TLNE N,RPGF  ;CHECK RPG FEATURE\r
 539         JRST RPGRD>\r
 540         SOSG BUFI2      ;DECREMENT CHARACTER COUNT\r
 541         INPUT     3,                    ;FILL TTY BUFFER\r
 542         ILDB    T,BUFI1         ;LOAD T WITH NEXT CHARACTER\r
 543 LD3AA:  MOVE    Q,T\r
 544         IDIVI     Q,11          ;TRANSLATE TO 4 BIT CODE\r
 545         LDB     Q,LD8(A)                ;LOAD CLASSIFICATION CODE\r
 546         CAIGE     Q,4           ;MODIFY CODE IF .GE. 4\r
 547         TLNN    F,SSW           ;MODIFY CODE IF SWITCH MODE OFF\r
 548         ADDI    Q,4             ;MODIFY CLASS. CODE FOR DISPATCH\r
 549         HRRZ    A,LD3A(Q)               ;LOAD RH DISPATCH ENTRY\r
 550         CAIL    Q,10            ;SKIP IF CORRECT DISPATCH ENTRY\r
 551         HLRZ    A,LD3A-10(Q)    ;LOAD LH DISPATCH ENTRY\r
 552         JRST    @A                      ;JUMP TO INDICATED LOCATION\r
 553 \r
 554 ;COMMAND DISPATCH TABLE\r
 555 \r
 556 LD3A:   XWD     LD3,LD7B                ;IGNORED CHAR, BAD CHAR (SWITCH)\r
 557         XWD     LD6A,LD6                ;</> OR <(>, LETTER (SWITCH)\r
 558         XWD     LD5,LD6C                ;<:>, DIGIT (SWITCH ARG.)\r
 559         XWD     LD5A,LD6D               ;<.>, ESCAPE SWITCH MODE <)>\r
 560         XWD     LD5C,LD7                ;<=> OR <L. ARROW>, BAD CHAR.\r
 561         XWD     LD5B,LD4                ;<,>, ALPHABETIC CHAR.\r
 562         XWD     LD5D,LD4                ;<CR.>, NUMERIC CHAR.\r
 563         XWD     LD5E1,LD7               ;<ALT MODE>, BAD CHAR. <)>\r
 564 \r
 565 IFN RPGSW,<RPGRD:       SOSG CTLIN+2    ;CHECK CHARACTER COUNT\r
 566         JRST    [IN 17,0\r
 567                 JRST .+1        ;OK\r
 568                 STATO 17,740000\r
 569                 JRST LD2\r
 570                 JSP A,ERRPT\r
 571                 SIXBIT /ERROR WHILE READING COMMAND FILE%/\r
 572                 JRST LD2]\r
 573         IBP CTLIN+1     ;ADVANCE POINTER\r
 574         MOVE T,@CTLIN+1 ;AND CHECK FOR LINE #\r
 575         TRNE T,1\r
 576         JRST    [MOVNI T,5\r
 577                 ADDM T,CTLIN+2\r
 578                 AOS CTLIN+1\r
 579                 JRST RPGRD      ];GO READ AGAIN\r
 580         LDB T,CTLIN+1   ;GET CHR\r
 581         JRST LD3AA      ;PASS IT ON>\r
 582         >\r
 583 \f;ALPHANUMERIC CHARACTER, NORMAL MODE\r
 584 IFE HE,<\r
 585 LD4:    SOJL    E,LD3           ;JUMP IF NO SPACE FOR CHAR IN W\r
 586         SUBI    T,40            ;CONVERT FROM ASCII TO SIXBIT\r
 587         IDPB    T,V             ;DEPOSIT CHAR OF IDENTIFIER IN W\r
 588         TLO     F,DSW           ;SET IDENTIFIER FLAG\r
 589         JRST    LD3             ;RETURN FOR NEXT CHARACTER\r
 590 \r
 591 ;DEVICE IDENTIFIER DELIMITER <:>\r
 592 \r
 593 LD5:    PUSH    P,W             ;SAVE W\r
 594         TLOE    F,CSW           ;TEST AND SET COLON FLAG\r
 595         PUSHJ     P,LDF         ;FORCE LOADING\r
 596         POP     P,W             ;RESTORE W\r
 597         TLNE    F,ESW           ;TEST SYNTAX\r
 598         JRST    LD7A            ;ERROR, MISSING COMMA ASSUMED\r
 599         JUMPE     W,LD2D                ;JUMP IF NULL DEVICE IDENTIFIER\r
 600         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER\r
 601 IFN PP,<MOVEM W,OLDDEV  ;WE HAVE A NEW ONE SO IGNORE OLD>\r
 602         TLZ     F,ISW+DSW+FSW+REWSW     ;CLEAR OLD DEVICE FLAGS\r
 603 IFN PP,<SETZM   PPN             ;CLEAR OLD PP #>\r
 604         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 605 \r
 606 ;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>\r
 607 \r
 608 LD5A:   TLOE    F,ESW           ;TEST AND SET EXTENSION FLAG\r
 609         JRST    LD7A            ;ERROR, TOO MANY PERIODS\r
 610         TLZE    F,CSW+DSW       ;SKIP IF NULL IDENT AND NO COLON\r
 611         MOVEM     W,DTIN        ;STORE FILE IDENTIFIER\r
 612         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 613 \r
 614 ;INPUT SPECIFICATION DELIMITER <,>\r
 615 \r
 616 LD5B:\r
 617 IFN PP,<TLZE    N,PPCSW                 ;READING PP #?\r
 618         JRST    [\r
 619 IFLE STANSW-UTAHSW,<    HRLM    D,PPN   ;STORE PROJ #\r
 620                 JRST    LD6A1]  ;GET PROG #>\r
 621 IFG STANSW-UTAHSW,<     PUSHJ   P,RJUST         ;RIGHT JUSTIFY W\r
 622                 HRLM    W,PPN   ;STORE PROJ NAME\r
 623                 JRST    LD2DB           ];GET PROG NAME>\r
 624         PUSHJ   P,RBRA          ;CHECK FOR MISSING RBRA>\r
 625         TLZN    F,FSW           ;SKIP IF PREV. FORCED LOADING\r
 626         PUSHJ     P,FSCN2               ;LOAD (FSW NOT SET)\r
 627         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 628 \r
 629 LD5B1:  TLNE    F,ESW           ;TEST EXTENSION FLAG\r
 630         JRST    LDDT3           ;EXPLICIT EXTENSION IDENTIFIER\r
 631         TLZN    F,CSW+DSW               ;SKIP IF IDENT. OR COLON\r
 632         POPJ    P,\r
 633         MOVEM     W,DTIN                ;STORE FILE IDENTIFIER\r
 634         JRST    LDDT2           ;ASSUME <.REL> IN DEFAULT CASE\r
 635         >\r
 636 \f;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>\r
 637 ;OR PROJ-PROG # BRACKETS <[> AND <]>\r
 638 IFE HE,<\r
 639 LD5C:\r
 640 IFN RPGSW,<CAIN T,"@"   ;CHECK  FOR * COMMAND\r
 641         JRST RPGS1>\r
 642 IFN PP,<CAIN    T,"["                   ;PROJ-PROG #?\r
 643         JRST    [TLO    N,PPSW+PPCSW    ;SET FLAGS\r
 644                 MOVEM   W,PPNW#         ;SAVE W\r
 645                 MOVEM   E,PPNE#         ;SAVE E\r
 646                 MOVEM   V,PPNV#         ;SAVE V\r
 647 IFLE STANSW-UTAHSW,<JRST LD6A1-1]       ;READ NUMBERS AS SWITCHES >\r
 648 IFG STANSW-UTAHSW,<     JRST    LD2DB]>\r
 649         CAIN    T,"]"                   ;END OF PP #?\r
 650         JRST    [PUSHJ  P,RBRA          ;PROCESS RIGHT BRACKET\r
 651                 JRST    LD3             ];READ NEXT IDENT>\r
 652         TLOE    F,ASW                   ;TEST AND SET LEFT ARROW FLAG\r
 653         JRST    LD7A                    ;ERROR, MISPLACED LEFT ARROW\r
 654         PUSHJ     P,LD5B1               ;STORE IDENTIFIER\r
 655         TLZN    F,ESW                   ;TEST EXTENSION FLAG\r
 656         MOVSI     W,554160              ;ASSUME <.MAP> IN DEFAULT CASE\r
 657         MOVEM     W,DTOUT1              ;STORE FILE EXTENSION IDENTIFIER\r
 658         MOVE    W,DTIN                  ;LOAD INPUT FILE IDENTIFIER\r
 659         MOVEM     W,DTOUT               ;USE AS OUTPUT FILE IDENTIFIER\r
 660 IFN PP,<MOVE    W,PPN           ;PROJ-PROG #\r
 661         MOVEM   W,DTOUT+3               ;...>\r
 662         MOVE    W,ILD1                  ;LOAD INPUT DEVICE IDENTIFIER\r
 663         MOVEM   W,LD5C1                 ;USE AS OUTPUT DEVICE IDENTIFIER\r
 664 IFN PP,<        SKIPE W,OLDDEV  ;RESTORE OLD\r
 665         MOVEM W,ILD1>\r
 666 ;INITIALIZE AUXILIARY OUTPUT DEVICE\r
 667         TLZE    N,AUXSWI+AUXSWE         ;FLUSH CURRENT DEVICE\r
 668         RELEASE 2,                      ;...\r
 669         CALL    W,[SIXBIT ?DEVCHR?]     ;IS DEVICE A TTY?\r
 670         TLNE    W,10                    ;...\r
 671 JRST    LD2D            ;YES, SKIP INIT\r
 672         INIT    2,1                     ;INIT THE AUXILIARY DEVICE\r
 673 LD5C1:  0               ;AUXILIARY OUTPUT DEVICE NAME\r
 674         XWD     ABUF,0                  ;BUFFER HEADER\r
 675         JSP     A,ILD5                  ;ERROR RETURN\r
 676         TLNE    F,REWSW                 ;REWIND REQUESTED?\r
 677         CALL    2,[SIXBIT /UTPCLR/]             ;DECTAPE REWIND\r
 678         TLZE    F,REWSW                 ;SKIP IF NO REWIND REQUESTED\r
 679         MTAPE   2,1                     ;REWIND THE AUX DEV\r
 680         MOVEI   E,AUX                   ;SET BUFFER ORIGIN\r
 681         MOVEM     E,JOBFF\r
 682         OUTBUF  2,1                     ;INITIALIZE SINGLE BUFFER\r
 683         TLO     N,AUXSWI                        ;SET INITIALIZED FLAG\r
 684         JRST    LD2D                    ;RETURN TO CONTINUE SCAN\r
 685 \r
 686         >\r
 687 \fIFE HE,<\r
 688 ;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)\r
 689 IFN PP,<\r
 690 RBRA:   TLZN    N,PPSW          ;READING PP #?\r
 691         POPJ    P,              ;NOPE, RETURN\r
 692         TLZE    N,PPCSW         ;COMMA SEEN?\r
 693         JRST    LD7A            ;NOPE, INDICATE ERROR\r
 694 IFLE STANSW-UTAHSW,<HRRM        D,PPN           ;STASH PROG NUMBER>\r
 695 IFG STANSW-UTAHSW,<PUSHJ        P,RJUST         ;RIGHT JUSTIFY W\r
 696         HRRM    W,PPN   ;STASH PROG NAME>\r
 697         MOVE    W,PPNW#         ;PICKUP OLD IDENT\r
 698         MOVE    E,PPNE#         ;RESTORE CHAR COUNT\r
 699         MOVE    V,PPNV#         ;RESTORE BYTE PNTR\r
 700         POPJ    P,              ;TRA 1,4\r
 701 \r
 702 ;RIGHT JUSTIFY W\r
 703 \r
 704 RJUST:  JUMPE   W,LD7A          ;NOTHING TO RIGHT JUSTIFY\r
 705         TRNE    W,77            ;IS W RJUSTED YET?\r
 706         POPJ    P,              ;YES, TRA 1,4\r
 707         LSH     W,-6            ;NOPE, TRY AGAIN\r
 708         JRST    .-3             ;...>\r
 709         >\r
 710 \fIFE HE,<\r
 711 ;LINE TERMINATION <CARRIAGE RETURN>\r
 712 \r
 713 LD5D:\r
 714 IFN PP,<PUSHJ   P,RBRA          ;CHECK FOR UNTERMINATED PP #>\r
 715         PUSHJ     P,FSCN                ;FORCE SCAN TO COMPLETION\r
 716         JRST    LD2B            ;RETURN FOR NEXT LINE\r
 717 \r
 718 ;TERMINATE LOADING <ALT MODE>\r
 719 \r
 720 LD5E:   SKIPE     D                     ;ENTER FROM G COMMAND\r
 721         HRR     F,D             ;USE NUMERIC STARTING ADDRESS\r
 722 LD5E1:\r
 723         PUSHJ     P,CRLF                ;START A NEW LINE\r
 724         PUSHJ   P,SASYM         ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY\r
 725 IFN LDAC!BLTSYM,<HRRZ A,R               ;SET UP BLT OF ACS\r
 726         ADDI A,(X)              ;END\r
 727         ADD A,KORSP             ;ADD IN SPACE RESERVED\r
 728         CAIL A,(S)\r
 729 IFN EXPAND,<JRST        [PUSHJ P,XPAND>\r
 730                         PUSHJ   P,[\r
 731 IFE EXPAND,<                    JSP     A,ERRPT\r
 732                                 SIXBIT  /MORE CORE NEEDED#/>\r
 733                                 CALLI   CEXIT]\r
 734 IFN EXPAND,<            JRST .-1]>\r
 735         HRRM R,BOTACS#          ;SAVE FOR LATER\r
 736         HRRZ A,R                ;SET BLT\r
 737         ADD A,X\r
 738         HRL A,X\r
 739         MOVE Q,A\r
 740         BLT A,17(Q)>\r
 741 IFN BLTSYM,<HRRZ A,R    ;PLACE TO BLT TO\r
 742         ADD A,KORSP\r
 743         MOVE W,A        ;SAVE DEST\r
 744         ADDI A,(X)      ;AFTER ADJUSTMENT\r
 745         MOVE Q,S        ;UDEF PNTR\r
 746         ADD Q,B         ;TOTAL UNDEFS AND DEFS IN LEFT\r
 747         HLROS Q         ;NOW NEG IN RIGHT\r
 748         MOVNS Q ;POSITIVE\r
 749         ADDI Q,-1(A)    ;END OF BLT\r
 750         HRLI A,1(S)     ;AND GET PLACE TO BLT FROM\r
 751         SUBI W,1(S)     ;PREST LOC OF SYMBOL TABLE\r
 752         ADDM W,JOBSYM(X)\r
 753         ADDM W,JOBUSY(X)        ;ADJUST POINTERS\r
 754         BLT A,(Q)       ;MOVE IT\r
 755         SKIPN JOBDDT(X) ;IS DDT THERE?\r
 756         JRST NODDT\r
 757         SUBI Q,-1(X)\r
 758         HRRM Q,JOBFF(X) ;RESTET JOBFF IF DDT IS IN\r
 759         HRLM Q,JOBSA(X)\r
 760 NODDT:>\r
 761         MOVE    W,[SIXBIT ?LOADER?]     ;FINAL MESSAGE\r
 762         PUSHJ P,BLTSET          ;SETUP FOR FINAL BLT\r
 763         RELEASE 2,              ;RELEASE AUX. DEV.\r
 764 IFN RPGSW,<RELEASE 17,0 ;RELEASE COMMAND DEVICE>\r
 765 IFE L,<\r
 766 IFN STANSW,<MOVE W,JOBREL       ;IN CASE NO NAME SET\r
 767         MOVE W,-1(W)    ;USE FIRRST LOADED\r
 768         SKIPN CURNAM\r
 769         PUSHJ P,LDNAM\r
 770         MOVE W,CURNAM\r
 771         JRST LD5E4>>\r
 772 IFN L,< JRST @LSPXIT>\r
 773 LD5E5:  MOVE    W,[BLT Q,(A)]   ;BLT OF ALL CODE\r
 774         MOVEM   W,JOBBLT        ;STASH IN JOB DATA AREA\r
 775         MOVEM   W,JOBBLT(X)     ;STASH IN RELOCATED JOBDATA AREA\r
 776 LD5E2:  MOVE    W,CALLEX        ;EXIT AFTER BLT\r
 777         TLZN    N,EXEQSW        ;IMMEDIATE EXECUTION REQUESTED?\r
 778         JRST    LD5E3           ;NOPE, LET USER TYPE START HIMSELF\r
 779         HRRZ    W,JOBSA(X)      ;PICKUP USUAL STARTING ADDRESS\r
 780         TLNE    N,DDSW          ;DDT EXECUTION?\r
 781         HRRZ    W,JOBDDT(X)     ;USE DDT SA INSTEAD\r
 782         JUMPE   W,LD5E2         ;IF SA=0, DON'T EXECUTE\r
 783         HRLI    W,(JRST)        ;INSTRUCTION TO EXECUTE\r
 784 LD5E3:\r
 785 IFE LDAC,<MOVEM W,JOBBLT+1(X)   ;STASH FOR EXECUTION>\r
 786 IFN LDAC,<MOVEM W,JOBBLT+2(X)   ;STASH FOR EXECUTION\r
 787         HRLZ    17,JOBFF(X)     ;BUT FIRST BLT ACS\r
 788         MOVE    W,[BLT 17,17]   ;...\r
 789         MOVEM   W,JOBBLT+1(X)   ;...>\r
 790         JRST    JOBBLT          ;IF IT WERE DONE, 'TWERE BEST DONE QUICKLY\r
 791 \r
 792 IFE L,<\r
 793 IFN STANSW,<LSH W,6     ;LEFT JUSTIFY\r
 794 LD5E4:  TLNN W,770000   ;IS IT LEFT JUSTIFIED?\r
 795         JRST .-2\r
 796         CALL W,[SIXBIT /SETNAM/]\r
 797         JRST LD5E5>>\r
 798 \r
 799         >\r
 800 \fIFE HE, <\r
 801 ;SEARCH LIBRARY, PRINT UNDEFS, SETUP JOBSA,JOBFF,JOBSYM,JOBUSY\r
 802 \r
 803 SASYM:  TLNN    F,NSW           ;SKIP IF NO SEARCH FLAG ON\r
 804         PUSHJ   P,LIBF          ;SEARCH LIBRARY FILE\r
 805         PUSHJ   P,FSCN          ;FORCE SCAN TO COMPLETION\r
 806         PUSHJ   P,PMS           ;PRINT UNDEFINEDS\r
 807 IFE L,< HRRZM   F,JOBSA(X)      ;RH OF JOBSA :=STARTING ADDRESS>\r
 808         >\r
 809 SAS1:   HRRZ    A,H             ;COMPUTE PROG BREAK\r
 810         SUBI    A,(X)           ;...\r
 811         CAIGE   A,(R)           ;BUT NO HIGHER THAN RELOC\r
 812         HRRZ    A,R             ;...\r
 813 IFE L,< HRLM    A,JOBSA(X)      ;LH OR JOBSA IS PROG BREAK\r
 814         HRRZM   A,JOBFF(X)      ;RH OF JOBFF CONTAINS PROG BREAK>\r
 815         MOVE    A,B             ;SET JOBSYM W/ SYMBOL TABLE POINTER\r
 816         AOS     A               ;...\r
 817 IFE L,< MOVEM   A,JOBSYM(X)     ;...>\r
 818 IFN L,< MOVEM   A,JOBSYM>\r
 819         MOVE    A,S             ;SET JOBUSY W/ UNDEFINED SYMBOL POINTER\r
 820         AOS     A               ;...\r
 821 IFE L,< MOVEM   A,JOBUSY(X)     ;...>\r
 822 IFN L,< MOVEM   A,JOBUSY>\r
 823         POPJ    P,              ;RETURN\r
 824 IFE HE,<\r
 825 ;PRINT FINAL MESSAGE, SET UP BLT AC'S, SETDDT, RELEAS\r
 826 \r
 827 BLTSET: PUSHJ   P,FCRLF         ;START FINAL MESSAGE\r
 828         PUSHJ   P,PWORD         ;PRINT W\r
 829         PUSHJ   P,SPACE\r
 830         >\r
 831 IFN HE,<\r
 832 BLTSET:>\r
 833 IFN FAILSW<     MOVSI Q,-20     ;SET TO FIX UP LINKS\r
 834 FXEND:  HLRZ V,LINKTB+1(Q)      ;GET END LINK INFO\r
 835         JUMPE V,NOEND   ;DO NOT LINK THIS ONE\r
 836         HRRZ A,LINKTB+1(Q)      ;GET THE THING TO PUT THERE\r
 837 IFN L,< CAML V,RINITL>\r
 838         HRRM A,@X       ;PUT IT IN\r
 839 NOEND:  AOBJN Q,FXEND   ;FINISH UP>\r
 840 IFN HE,<POPJ P,>\r
 841 IFE HE,<\r
 842         HRRZ    Q,JOBREL        ;PUBLISH HOW MUCH CORE USED\r
 843 IFN L,< SUB     Q,OLDJR         ;OLD JOBREL>\r
 844         LSH     Q,-12           ;...\r
 845         ADDI    Q,1             ;...\r
 846         PUSHJ   P,RCNUM         ;PUBLISH THE NUMBER\r
 847         MOVE    W,[SIXBIT /K CORE/]     ;PUBLISH THE UNITS\r
 848         PUSHJ   P,PWORD         ;...\r
 849         PUSHJ   P,CRLF          ;...\r
 850 IFE L,< MOVSI   Q,20(X)         ;HOW MUCH CODE TO BLT\r
 851         HRRI    Q,20            ;...\r
 852         HRRZ A,42               ;CHECK ON ERRORS\r
 853         JUMPE A,NOEX            ;NONE, GO AHEAD\r
 854         TLZN N,EXEQSW           ;DID HE WANT TO START EXECUTION?\r
 855         JRST NOEX               ;NO\r
 856         JSP A ,ERRPT            ;PRINT AN ERROR MESSAGE\r
 857         SIXBIT /EXECUTION DELETED@/\r
 858 NOEX:   HRRZ    A,JOBREL        ;WHEN TO STOP BLT\r
 859         HRRZM   A,JOBREL(X)     ;SETUP FOR POSSIBLE IMMED. XEQ\r
 860         SUBI    A,(X)           ;...\r
 861 IFE BLTSYM,<CAIL        A,(S)           ;DON'T BLT OVER SYMBOL TABLE\r
 862         MOVEI   A,(S)           ;OR UNDEFINED TABLE>\r
 863 >\r
 864         RELEAS  1,              ;RELEASE DEVICES\r
 865         RELEAS  3,              ;...\r
 866 IFE L,< MOVE    R,JOBDDT(X)     ;SET NEW DDT\r
 867         CALLI   R,CSETDDT       ;...>\r
 868         POPJ    P,              ;RETURN\r
 869         >\r
 870 \r
 871 \fIFE HE,<\r
 872 ;WRITE CHAIN FILES\r
 873 \r
 874 CHNC:   SKIPA   A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST BLOCK DATA\r
 875 CHNR:   HLR     A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST F4 PROG\r
 876         HRRZS   A               ;ONLY RIGHT HALF IS SIGNIFICANT\r
 877         JUMPE   A,LD7C          ;DON'T CHAIN IF ZERO\r
 878         TLNN    N,AUXSWI        ;IS THERE AN AUX DEV?\r
 879         JRST    LD7D            ;NO, DON'T CHAIN\r
 880         PUSH    P,A             ;SAVE WHEREFROM TO CHAIN\r
 881         SKIPE   D               ;STARTING ADDR SPECIFIED?\r
 882         HRR     F,D             ;USE IT\r
 883         PUSHJ   P,SASYM         ;DO LIB SEARCH, SETUP JOBSA, ETC.\r
 884         POP     P,A             ;GET WHEREFROM\r
 885         MOVN    W,JOBREL        ;CALCULATE IOWD FOR DUMP\r
 886         ADDI    W,-1-3-CHN5(A)  ;...\r
 887         HRLI    W,-4-CHN5(A)    ;...\r
 888         MOVSM   W,IOWDPP        ;...\r
 889         ADDI    A,-4-CHN5(X)    ;ADD IN OFFSET\r
 890 IFN CHN5,<PUSH  A,JOBSYM(X)     ;SETUP FOUR WORD TABLE\r
 891         PUSH    A,JOB41(X)      ;...>\r
 892         PUSH    A,JOBDDT(X)     ;JOBDDT IN ALL CASES\r
 893 IFE CHN5,<PUSH  A,JOBSYM(X)     ;JOBDDT, JOBSYM, JOBSA>\r
 894         PUSH    A,JOBSA(X)      ;JOBRYM ALWAYS LAST\r
 895         CLOSE   2,              ;INSURE END OF MAP FILE\r
 896         SETSTS  2,17            ;SET AUX DEV TO DUMP MODE\r
 897         MOVSI   W,435056        ;USE .CHN AS EXTENSION\r
 898         MOVEM   W,DTOUT1        ;...\r
 899         PUSHJ   P,IAD2          ;DO THE ENTER\r
 900         TLZ     N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT\r
 901         MOVE    W,[SIXBIT ?CHAIN?]      ;FINAL MESSAGE\r
 902         PUSHJ   P,BLTSET                ;SETUP BLT PNTR, SETDDT, RELEAS\r
 903 IFE STANSW,<CALLI       CDDTGT          ;START DDT MODE OUTPUT>\r
 904         MOVSI   CHNBLT,CHAIN3   ;BLT CHAIN3 INTO ACS\r
 905         BLT     CHNBLT,CHNBLT   ;...\r
 906         MOVEI   P,CHNERR        ;POINTER TO ERR MESS\r
 907         JRST    0               ;GO DO CHAIN\r
 908 \r
 909         >\r
 910 \fIFE HE, <\r
 911 ;THE AC SECTION OF CHAIN\r
 912 \r
 913 CHAIN3:\r
 914         PHASE   0\r
 915         BLT     Q,(A)           ;USUAL LDRBLT\r
 916         OUTPUT  2,IOWDP         ;WRITE THE CHAIN FILE\r
 917         STATZ   2,IOBAD!IODEND  ;CHECK FOR ERROR OR EOF\r
 918         JRST    LOSEBIG         ;FOUND SAME, GO GRIPE\r
 919         CLOSE   2,              ;FINISH OUTPUT\r
 920         STATZ   2,IOBAD!IODEND  ;CHECK FOR FINAL ERROR\r
 921 LOSEBI: CALLI   CDDTOUT         ;GRIPE ABOUT ERROR\r
 922         CALLI   CEXIT           ;EXIT\r
 923 CHNERR: ASCIZ   ?DEVICE ERROR?  ;ERROR MESSAGE\r
 924 IOWDP:  Z                       ;STORE IOWD FOR DUMP HERE\r
 925 CHNBLT:                         ;LAST WORD OF AC CHAIN (ZERO OF I/O POINTER)\r
 926         DEPHASE\r
 927 IOWDPP=.-1                      ;MEMORY LOC OF AC IOWDP\r
 928         Z                       ;TERMINATOR OF DUMP MODE LIST\r
 929 \r
 930 >\r
 931 \f;EXPAND CORE\r
 932 \r
 933 IFN EXPAND,<\r
 934 XPAND:  PUSH P,H        ;GET SOME REGISTERS TO USE\r
 935         PUSH P,X\r
 936         PUSH P,N\r
 937 IFE HE,<HRRZ X,JOBREL   ;WHAT WE WANT\r
 938         ADDI X,2000\r
 939         CALLI X,11>\r
 940 IFN HE,<JRST XPAND4;            HAND - EYE CORE FIXUP LATER\r
 941         JRST XPAND3\r
 942 XPAND2:         >;              CORE ALLOCATOR CALLS THIS\r
 943         JRST XPAND6\r
 944 IFE K,<         HRRZ H,MLTP     ;GET LOWEST LOCATION\r
 945         TLNN N,F4SW     ;IS FORTRAN LOADING>\r
 946         HRRZ H,S        ;NO, USE S\r
 947 IFE HE,<\r
 948         HRRZ X,JOBREL   ;NOW MOVE\r
 949         SUBI X,2000\r
 950 XPAND2: MOVE N,(X)\r
 951         MOVEM N,2000(X)\r
 952         CAMLE X,H       ;TEST FOR END\r
 953         SOJA X,XPAND2>;         HAND EYE SYSTEM MOVES TABLE\r
 954         HRLI H,-2000\r
 955         SETZM (H)       ;ZERO NEW CORE\r
 956         AOBJN H,.-1\r
 957         MOVEI H,2000\r
 958         ADDM H,S\r
 959         ADDM H,B\r
 960         ADDM H,JOBSYM\r
 961         POP P,N\r
 962         ADDI N,2000\r
 963 IFE K,< TLNN N,F4SW     ;F4?\r
 964         JRST    XPAND3\r
 965         ADDM H,PLTP\r
 966         ADDM H,BITP\r
 967         ADDM H,SDSTP\r
 968         ADDM H,MLTP\r
 969         TLNE N,SYDAT\r
 970         ADDM H,V>\r
 971 IFN HE,<POPJ P,>\r
 972 XPAND3:\r
 973         POP P,X\r
 974         POP P,H\r
 975         AOS (P)\r
 976         POPJ P,\r
 977 XPAND6: JUMPE X,XPAND4\r
 978         JSP A,ERRPT\r
 979 IFE STANSW,<SIXBIT /CORE AVAILABLE, BUT NOT TO YOU#/>\r
 980 IFN STANSW,<SIXBIT /YOU HAVE BEEN FUCKED BY THE SHIT-EATING SYSTEM#/\r
 981         JRST    XPAND5>\r
 982 XPAND4: JSP A,ERRPT\r
 983         SIXBIT /MORE CORE NEEDED#/\r
 984 XPAND5: POP P,N\r
 985         POP P,X\r
 986         POP P,H\r
 987         POPJ P,\r
 988 \r
 989 XPAND7: PUSHJ   P,XPAND\r
 990         JRST    SFULLC\r
 991         JRST    POPJM2\r
 992 \r
 993 POPJM3: SOS     (P)             ;POPJ TO CALL-2\r
 994 POPJM2: SOS     (P)             ;POPJ TO CALL-1\r
 995         SOS     (P)             ;SAME AS POPJ TO\r
 996         POPJ    P,              ;NORMAL POPJ MINUS TWO\r
 997         >\r
 998 \fIFE HE,<\r
 999 \r
1000 ;ENTER SWITCH MODE\r
1001 \r
1002 LD6A:   CAIN    T,57            ;WAS CHAR A SLASH?\r
1003         TLO     N,SLASH         ;REMEBER THAT\r
1004         TLO     F,SSW           ;ENTER SWITCH MODE\r
1005 LD6A1:  MOVEI   D,0             ;ZERO THE NUBER REGISTER\r
1006         JRST    LD3             ;EAT A SWITCH\r
1007 \r
1008 ;ALPHABETIC CHARACTER, SWITCH MODE\r
1009 \r
1010 LD6:    XCT     LD6B-101(T)     ;EXECUTE SWITCH FUNCTION\r
1011         TLZE    N,SLASH ;SWITCH MODE ENTERED W/ SLASH?\r
1012         JRST    LD6D            ;LEAVE SWITCH MODE\r
1013         JRST    LD6A1           ;STAY IN SWITCH MODE\r
1014 \r
1015 ;DISPATCH TABLE FOR SWITCHES\r
1016 \r
1017 ;       THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED\r
1018 \r
1019 LD6B:   TLO     N,ALLFLG        ;A - LIST ALL GLOBALS\r
1020         JRST    LD7B            ;B - ERROR\r
1021         PUSHJ   P,CHNC          ;C - CHAIN, START W/ COMMON\r
1022         PUSHJ     P,LDDT        ;D - DEBUG OPTION, LOAD DDT\r
1023         TLO     N,EXEQSW        ;E - LOAD AND GO\r
1024         PUSHJ     P,LIBF        ;F - LIBRARY SEARCH\r
1025         PUSHJ     P,LD5E        ;G - GO INTO EXECUTION\r
1026         PUSHJ P,LRAIDX          ;H - LOAD AN START RAID\r
1027         TLO     N,ISAFLG        ;I - IGNORE STARTING ADDRESSES\r
1028         TLZ     N,ISAFLG        ;J - USE STARTING ADDRESSES\r
1029 IFE BLTSYM,<JRST        LD7B            ;K - ERROR>\r
1030 IFN BLTSYM,<PUSHJ P,KORADJ      ;K - RESERVE SPACE FOR SYM DEFS>\r
1031         TLO     F,LIBSW+SKIPSW  ;L - ENTER LIBRARY SEARCH\r
1032         PUSHJ     P,PRMAP       ;M - PRINT STORAGE MAP\r
1033         TLZ     F,LIBSW+SKIPSW  ;N - LEAVE LIBRARY SEARCH\r
1034         HRR     R,D             ;O - NEW PROGRAM ORIGIN\r
1035         TLO     F,NSW           ;P - PREVENT AUTO. LIB. SEARCH\r
1036         TLZ     F,NSW           ;Q - ALLOW AUTO. LIB. SEARCH\r
1037         PUSHJ   P,CHNR          ;R - CHAIN, START W/ RESIDENT\r
1038         TLO     F,SYMSW         ;S - LOAD WITH SYMBOLS\r
1039         PUSHJ   P,LDDTX         ;T - LOAD AND GO TO DDT\r
1040         PUSHJ     P,PMS         ;U - PRINT UNDEFINED LIST\r
1041         PUSHJ P,LRAID           ;V - LOAD RAID\r
1042         TLZ     F,SYMSW+DSYMSW  ;W - LOAD WITHOUT SYMBOLS\r
1043         TLZ     N,ALLFLG        ;X - DO NOT LIST ALL GLOBALS\r
1044         TLO     F,REWSW         ;Y - REWIND BEFORE USE\r
1045         JRST    LD              ;Z - RESTART LOADER\r
1046 \r
1047 >\r
1048 \fIFE HE, <\r
1049 ;SWITCH MODE NUMERIC ARGUMENT\r
1050 \r
1051 LD6C:   LSH     D,3             ;BUILD OCTAL NUMERIC ARGUMENT\r
1052         ADDI    D,-60(T)\r
1053         JRST    LD3\r
1054 \r
1055 ;EXIT FROM SWITCH MODE\r
1056 \r
1057 LD6D:   TLZ     F,SSW           ;CLEAR SWITCH MODE FLAG\r
1058         TLNE    F,FSW           ;TEST FORCED SCAN FLAG\r
1059         JRST    LD2D            ;SCAN FORCED, START NEW IDENT.\r
1060         JRST    LD3             ;SCAN NOT FORCED, USE PREV IDENT\r
1061 ;ILLEGAL CHARACTER, NORMAL MODE\r
1062 \r
1063 LD7:    JSP     A,ERRPT8\r
1064         SIXBIT    /CHAR.%/\r
1065         JRST    LD2\r
1066 \r
1067 ;SYNTAX ERROR, NORMAL MODE\r
1068 \r
1069 LD7A:   JSP     A,ERRPT8\r
1070         SIXBIT    /SYNTAX%/\r
1071         JRST    LD2\r
1072 \r
1073 ;ILLEGAL CHARACTER, SWITCH MODE\r
1074 \r
1075 LD7B:   JSP     A,ERRPT8\r
1076         SIXBIT    /SWITCH%/\r
1077         JRST    LD2\r
1078 \r
1079 ;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0\r
1080 \r
1081 LD7C:   JSP     A,ERRPT         ;GRIPE\r
1082         SIXBIT  ?UNCHAINABLE AS LOADED@?\r
1083         JRST    LD2\r
1084 \r
1085 ;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE\r
1086 \r
1087 LD7D:   JSP     A,ERRPT         ;GRIPE\r
1088         SIXBIT  ?NO CHAIN DEVICE@?\r
1089         JRST    LD2\r
1090 \r
1091 >\r
1092 IFN BLTSYM,<KORADJ:     CAMLE D,KORSP   ;IF SMALLER IGNORE\r
1093         MOVEM D,KORSP\r
1094         POPJ P,>\r
1095 \fIFE HE, <\r
1096 ;CHARACTER CLASSIFICATION TABLE DESCRIPTION:\r
1097 \r
1098 ;       EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE\r
1099 ;       PACKED IN THE CHARACTER CLASSIFICATION TABLE.  THE CHARACTER\r
1100 ;       CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE\r
1101 ;       DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.\r
1102 ;       CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND\r
1103 ;       THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS.  FOUR CODES\r
1104 ;       ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS\r
1105 ;       IN EFFECT.\r
1106 \r
1107 \r
1108 ;CLASSIFICATION BYTE CODES:\r
1109 \r
1110 ;       BYTE DISP CLASSIFICATION\r
1111 \r
1112 ;       00 - 00  ILLEGAL CHARACTER, SWITCH MODE\r
1113 ;       01 - 01  ALPHABETIC CHARACTER, SWITCH MODE\r
1114 ;       02 - 02  NUMERIC CHARACTER, SWITCH MODE\r
1115 ;       03 - 03  SWITCH MODE ESCAPE, SWITCH MODE\r
1116 \r
1117 ;       00 - 04  ILLEGAL CHARACTER, NORMAL MODE\r
1118 ;       01 - 05  ALPHABETIC CHARACTER, NORMAL MODE\r
1119 ;       02 - 06  NUMERIC CHARACTER, NORMAL MODE\r
1120 ;       03 - 07  SWITCH MODE ESCAPE, NORMAL MODE\r
1121 \r
1122 ;       04 - 10  IGNORED CHARACTER\r
1123 ;       05 - 11  ENTER SWITCH MODE CHARACTER\r
1124 ;       06 - 12  DEVICE IDENTIFIER DELIMITER\r
1125 ;       07 - 13  FILE EXTENSION DELIMITER\r
1126 ;       10 - 14  OUTPUT SPECIFICATION DELIMITER\r
1127 ;       11 - 15  INPUT SPECIFICATION DELIMITER\r
1128 ;       12 - 16  LINE TERMINATION\r
1129 ;       13 - 17  JOB TERMINATION\r
1130 \r
1131 >\r
1132 \fIFE HE, <\r
1133 ;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE\r
1134 \r
1135 LD8:    POINT     4,LD9(Q),3\r
1136         POINT     4,LD9(Q),7\r
1137         POINT     4,LD9(Q),11\r
1138         POINT     4,LD9(Q),15\r
1139         POINT     4,LD9(Q),19\r
1140         POINT     4,LD9(Q),23\r
1141         POINT     4,LD9(Q),27\r
1142         POINT     4,LD9(Q),31\r
1143         POINT     4,LD9(Q),35\r
1144 \r
1145 ;CHARACTER CLASSIFIACTION TABLE\r
1146 \r
1147 LD9:    BYTE    (4)4,0,0,0,0,0,0,0,0\r
1148         BYTE    (4)4,4,4,4,12,0,0,0,0\r
1149         BYTE    (4)0,0,0,0,0,0,0,0,0\r
1150         BYTE    (4)13,0,0,0,0,4,0,4,0\r
1151         BYTE    (4)0,0,0,0,5,3,0,0,11\r
1152         BYTE    (4)0,7,5,2,2,2,2,2,2\r
1153         BYTE    (4)2,2,2,2,6,0,0,10,0\r
1154 IFE RPGSW,<     BYTE    (4)0,0,1,1,1,1,1,1,1>\r
1155 IFN RPGSW,<     BYTE (4) 0,10,1,1,1,1,1,1,1>\r
1156         BYTE    (4)1,1,1,1,1,1,1,1,1\r
1157         BYTE    (4)1,1,1,1,1,1,1,1,1\r
1158 IFE PP,<BYTE    (4)1,0,0,0,0,10,0,0,0>\r
1159 IFN PP,<BYTE    (4)1,10,0,10,0,10,0,0,0>\r
1160         BYTE    (4)0,0,0,0,0,0,0,0,0\r
1161         BYTE    (4)0,0,0,0,0,0,0,0,0\r
1162         BYTE    (4)0,0,0,0,0,0,0,0,13\r
1163         BYTE    (4)13,4\r
1164 \r
1165 >\r
1166 \fIFE HE, <\r
1167 ;INITIALIZE LOADING OF A FILE\r
1168 \r
1169 ILD:    MOVEI     W,BUF1                ;LOAD BUFFER ORIGIN\r
1170         MOVEM     W,JOBFF\r
1171         TLOE    F,ISW           ;SKIP IF INIT REQUIRED\r
1172         JRST    ILD6            ;DONT DO INIT\r
1173         INIT    1,14\r
1174 ILD1:   0                               ;LOADER INPUT DEVICE\r
1175         XWD     0,BUFR\r
1176         JSP     A,ILD5          ;ERROR RETURN\r
1177 ILD6:   TLZE    F,REWSW         ;SKIP IF NO REWIND\r
1178         MTAPE   1,1             ;REWIND\r
1179 ILD2:   LOOKUP    1,DTIN                ;LOOK UP FILE FROM DIRECTORY\r
1180         JRST    ILD3            ;FILE NOT IN DIRECTORY\r
1181 IFE K,< INBUF     1,2           ;SET UP BUFFERS>\r
1182 IFN K,< INBUF   1,1             ;SET UP BUFFER>\r
1183         TLO     F,ASW           ;SET LEFT ARROW ILLEGAL FLAG\r
1184         TLZ     F,ESW+F4LIB     ;CLEAR EXTENSION FLAG\r
1185         POPJ    P,\r
1186 \r
1187 ;       LOOKUP FAILURE\r
1188 \r
1189 ILD3:   TLOE    F,ESW           ;SKIP IF .REL WAS ASSUMED\r
1190         JRST    ILD4            ;FATAL LOOKUP FAILURE\r
1191         SETZM     DTIN1         ;ZERO FILE EXTENSION\r
1192         JRST    ILD2            ;TRY AGAIN WITH NULL EXTENSION\r
1193 \r
1194 ILD4:   TLZE    F,F4LIB         ;WAS THIS A TRY FOR F40 LIBRARY?\r
1195         JRST    [MOVE   W,[SIXBIT /LIB4/]; YES, TRY LIB4\r
1196                 MOVEM   W,DTIN          ;...\r
1197                 PUSHJ   P,LDDT2         ;USE .REL EXTENSION\r
1198                 TLZ     F,ESW           ;...\r
1199                 JRST    ILD2            ];GO TRY AGAIN\r
1200         >\r
1201 ILD9:   JSP     A,ERRPT\r
1202         SIXBIT    /CANNOT FIND#/\r
1203         JRST    LD2\r
1204 \r
1205 ;       DEVICE SELECTION ERROR\r
1206 \r
1207 ILD5:   MOVE    W,-3(A)         ;LOAD DEVICE NAME FROM INIT\r
1208         TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
1209         PUSHJ   P,PRQ           ;START W/ ?\r
1210         PUSHJ     P,PWORD               ;PRINT DEVICE NAME\r
1211         JSP     A,ERRPT7\r
1212         SIXBIT    /UNAVAILABLE@/\r
1213         JRST    LD2\r
1214 \fIFE HE, <\r
1215 ;LIBRARY SEARCH CONTROL AND LOADER CONTROL\r
1216 \r
1217 ;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>\r
1218 \r
1219 LIBF:   PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION\r
1220         PUSHJ   P,LIBF1                 ;LOAD SYS:JOBDAT.REL\r
1221         TLO     F,F4LIB                 ;INDICATE FORTRAN LIBRARY SEARCH\r
1222         MOVE    W,[SIXBIT /LIB40/]      ;FIRST TRY AT NAME\r
1223         PUSHJ   P,LIBF2                 ;LOAD SYS:LIB40.REL\r
1224 LIBF1:  MOVE    W,[SIXBIT /JOBDAT/]     ;LOAD SYS:JOBDAT.REL\r
1225 LIBF2:  PUSHJ     P,LDDT1\r
1226         JUMPGE    S,EOF2                ;JUMP IF NO UNDEFINED GLOBALS\r
1227         TLO     F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH\r
1228         TLZ     F,SYMSW+DSYMSW  ;DISABLE LOADING WITH SYMBOLS\r
1229         JRST    LDF             ;INITIALIZE LOADING LIB4\r
1230 >;              HAND - EYE DOES OWN LIB SETUP\r
1231 \r
1232 ;       LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE\r
1233 \r
1234 LIB:    JUMPGE    S,EOF1                ;JUMP IF NO UNDEFINED GLOBALS\r
1235         TLO     F,SKIPSW                ;SET SKIPSW TO IGNORE MODE\r
1236         JRST    LOAD            ;CONTINUE LIB. SEARCH\r
1237 \r
1238 LIB1:   CAIE    A,4             ;TEST FOR ENTRY BLOCK\r
1239         JRST    LIB3            ;NOT AN ENTRY BLOCK, IGNORE IT\r
1240 LIB2:   PUSHJ     P,RWORD               ;READ ONE DATA WORD\r
1241         MOVE    C,W\r
1242         TLO     C,040000                ;SET CODE BITS FOR SEARCH\r
1243         PUSHJ     P,SREQ\r
1244         TLZA    F,SKIPSW                ;REQUEST MATCHES ENTRY, LOAD\r
1245         JRST    LIB2            ;NOT FOUND\r
1246 LIB3:   PUSHJ     P,RWORD               ;READ AND IGNORE ONE DATA WORD\r
1247         JRST    LIB3            ;LOOP TO IGNORE INPUT\r
1248 \r
1249 IFE HE,<\r
1250 ;LDDT LOADS <SYS:DDT.REL> AND SETS DSYMSW\r
1251 \r
1252 LRAIDX: TLO N,DDSW!EXEQSW       ;H - LOAD AND START RAID\r
1253 LRAID:  PUSHJ P,FSCN1           ;FORCE END OF SCAN\r
1254         MOVE W,[SIXBIT /RAID/]\r
1255         JRST LDDT0\r
1256 LDDTX:  TLO     N,DDSW+EXEQSW   ;T - LOAD AND GO TO DDT\r
1257 LDDT:   PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION\r
1258         MOVSI     W,444464              ;FILE IDENTIFIER <DDT>\r
1259 LDDT0:  PUSHJ     P,LDDT1\r
1260         PUSHJ     P,LDF         ;LOAD <SYS:DDT.REL>\r
1261         TLO     F,DSYMSW                ;ENABLE LOADING WITH SYMBOLS\r
1262         POPJ    P,\r
1263 \r
1264 LDDT1:  MOVEM     W,DTIN                ;STORE FILE IDENTIFIER\r
1265 IFN PP,<MOVE W,ILD1     ;SAVE OLD DEV\r
1266         MOVEM W,OLDDEV>\r
1267         MOVSI     W,637163              ;DEVICE IDENTIFIER <SYS>\r
1268         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER\r
1269         TLZ     F,ISW+LIBSW+SKIPSW+REWSW        ;CLEAR OLD FLAGS\r
1270 LDDT2:  MOVSI     W,624554              ;EXTENSION IDENTIFIER <.REL>\r
1271 LDDT3:  MOVEM     W,DTIN1               ;STORE EXTENSION IDENTIFIER\r
1272 IFN PP,<MOVE W,PPN      ;GET PROJ-PROG #\r
1273         MOVEM W,DTIN+3>\r
1274         POPJ    P,\r
1275 >;              HAND - EYE DOES OWN DDT LOAD\r
1276 \f;EOF TERMINATES LOADING OF A FILE\r
1277 \r
1278 EOF:    MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER\r
1279 EOF1:   TLZ     F,SLIBSW+SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG\r
1280 EOF2:   POPJ    P,\r
1281 \r
1282 ;       FORCE SCAN TO COMPLETION, LOAD IF NECESSARY\r
1283 \r
1284 FSCN:   PUSHJ     P,FSCN1               ;FORCED LOAD BEFORE TEST\r
1285         TLNN    F,FULLSW                ;TEST FOR OVERLAP\r
1286         POPJ    P,                      ;NO OVERLAP, RETURN\r
1287         MOVE    W,H             ;FETCH CORE SIZE REQUIRED\r
1288         SUBI W,1(S) ; COMPUT DEFICIENCY\r
1289         JUMPL     W,EOF2                ;JUMP IF NO OVERLAP\r
1290         TLO     F,FCONSW                ;INSURE TTY OUTPUT\r
1291         PUSHJ   P,PRQ                   ;START WITH ?\r
1292         PUSHJ     P,PRNUM0              ;INFORM USER\r
1293         JSP     A,ERRPT7\r
1294         SIXBIT    /WORDS OF OVERLAP#/\r
1295         JRST    LD2             ;ERROR RETURN\r
1296 \r
1297 FSCN1:  IFE HE,<TLON    F,FSW           ;SKIP IF NOT FIRST CALL TO FSCN\r
1298         TLNN    F,CSW+DSW+ESW   ;TEST SCAN FOR COMPLETION\r
1299         >;              HAND EYE DOES NOT WANT FORCED SCAN\r
1300         POPJ    P,\r
1301 FSCN2:  PUSHJ     P,LD5B1               ;STORE FILE OR EXTENSION IDENT.\r
1302 \r
1303 ;       LOADER CONTROL, NORMAL MODE\r
1304 \r
1305 LDF:    PUSHJ     P,ILD         ;INITIALIZE LOADING\r
1306 \r
1307 \f;LOAD SUBROUTINE\r
1308 \r
1309 LOAD:   MOVEM     P,PDSAV               ;SAVE PUSHDOWN POINTER\r
1310 IFN FAILSW,<    SETZM LFTHSW    ;RESET LOAD LEFT HALF FIXUP SW>\r
1311 LOAD1:  MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER\r
1312 LOAD1A:   PUSHJ     P,WORD              ;INPUT BLOCK HEADER WORD\r
1313         MOVNI     E,400000(W)   ;WORD COUNT - FROM RH OF HEADER\r
1314         HLRZ    A,W             ;BLOCK TYPE - FROM LH OF HEADER\r
1315 IFN FAILSW,<    SKIPN POLSW     ;ERROR IF STILL DOING POLISH>\r
1316         CAILE     A,DISPL*2+1           ;TEST BLOCK TYPE NUMBER\r
1317         JRST    LOAD4           ;ERROR, ILLEGAL BLOCK TYPE\r
1318         TLNE    F,SKIPSW                ;BLOCK OK - TEST LOAD STATUS\r
1319         JRST    LIB1            ;RETURN TO LIB. SEARCH CONTROL\r
1320         HRRZ    T,LOAD2(A)              ;LOAD RH DISPATCH ENTRY\r
1321         CAILE     A,DISPL               ;SKIP IF CORRECT\r
1322         HLRZ    T,LOAD2-DISPL-1(A)      ;LOAD LH DISPATCH ENTRY\r
1323         TLNE    F,FULLSW                ;TEST CORE OVERLAP INDICATOR\r
1324         SOJG    A,HIGH0         ;IGNORE BLOCK IF NOT TYPE 1\r
1325         JRST    @T                      ;DISPATCH TO BLOCK SUBROUTINE\r
1326 \r
1327 ;DISPATCH TABLE - BLOCK TYPES\r
1328 \r
1329 LOAD2:  XWD NAME,LOAD1A\r
1330         XWD START,PROG\r
1331         XWD LOCD,SYM\r
1332 IFE FAILSW,<    XWD LOAD4A,LOAD4A\r
1333         XWD LOAD4A,LIB3>\r
1334 IFN FAILSW,<    XWD POLFIX,LOAD4A\r
1335         XWD LINK,LIB3>\r
1336 LOAD3:  XWD LOAD4A,HIGH\r
1337 \r
1338         DISPL=LOAD3-LOAD2\r
1339 \r
1340 ;ERROR EXIT FOR BAD HEADER WORDS\r
1341 \r
1342 LOAD4:  IFE K,<\r
1343         CAIN    A,400           ;FORTRAN FOUR BLOCK\r
1344         JRST    F4LD>\r
1345 IFN HE,<CAIE A,400\r
1346         JRST LOAD4A\r
1347         JSP 1,ERRPT\r
1348         SIXBIT /FORTRAN#/\r
1349         SETOM RESET\r
1350         JRST LD2>\r
1351 LOAD4A:   JSP   A,ERRPT         ;INCORRECT HEADER WORD\r
1352         SIXBIT    /ILL. FORMAT#/\r
1353 IFN HE,<SETOM RESET#>\r
1354         JRST    LD2\r
1355 \r
1356 \f;LOAD PROGRAMS AND DATA (BLOCK TYPE 1)\r
1357 \r
1358 PROG:   HRRZ    V,W             ;LOAD BLOCK LENGTH\r
1359         PUSHJ     P,RWORD               ;READ BLOCK ORIGIN\r
1360 IFN HE,<SETZM SFLAG\r
1361         CAIG W,140\r
1362         CAIN W,JOBDDT\r
1363         JRST PROG2\r
1364         SETOM SFLAG\r
1365         JSP A,ERRPT\r
1366         SIXBIT /ADDRESS CONFLICT#/\r
1367 PROG2:\r
1368         >;      HAND-EYE CANNOT HANDLE CODE BELOW 140 \r
1369         ADD     V,W             ;COMPUTE NEW PROG. BREAK\r
1370         CAIG    H,@X            ;COMPARE WITH PREV. PROG. BREAK\r
1371         MOVEI     H,@X          ;UPDATE PROGRAM BREAK\r
1372                 TLNE F,FULLSW\r
1373                 JRST FULLC      ;NO ERROR MESSAGE\r
1374         CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE\r
1375 IFN EXPAND,<    JRST    [PUSHJ P,XPAND>\r
1376                         JRST FULLC\r
1377 IFN EXPAND,<            JRST .-1]>\r
1378         MOVE    V,W\r
1379 PROG1:  PUSHJ     P,RWORD               ;READ DATA WORD\r
1380 IFN HE,<SKIPN SFLAG#>\r
1381 IFN L,< CAML V,RINITL   ;ABSOLUTE >\r
1382         MOVEM     W,@X          ;STORE DATA WORD IN PROG. AT LLC\r
1383         AOJA    V,PROG1         ;ADD ONE TO LOADER LOC. COUNTER\r
1384 \r
1385 ;LOAD SYMBOLS (BLOCK TYPE 2)\r
1386 \r
1387 SYM:    PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1388         PUSHJ   P,SYMPT;                PUT INTO TABLE\r
1389         JRST    SYM\r
1390 \r
1391 ; WFW SYMPT:    JUMPL   C,SYM3;         JUMP IF GLOBAL REQUEST\r
1392 SYMPT:  TLNE C,200000   ;GLOBAL REQUEST? WFW\r
1393         JUMPL C,SYM3    ;CHECK FOR 60 NOT JUST HIGH BIT WFW\r
1394         TLNE    C,100000\r
1395         JRST    SYM1A           ;LOCAL SYMBOL\r
1396         PUSHJ     P,SREQ                ;GLOBAL DEF., SEARCH FOR REQUEST\r
1397         JRST    SYM2            ;REQUEST MATCHES\r
1398         PUSHJ     P,SDEF                ;SEARCH FOR MULTIPLE DEFINITIONS\r
1399         JRST    SYM1            ;MULTIPLY DEFINED GLOBAL\r
1400         JRST    SYM1B\r
1401 \r
1402 ;       PROCESS MULTIPLY DEFINED GLOBAL\r
1403 \r
1404 SYM1:   CAMN    W,2(A)          ;COMPARE NEW AND OLD VALUE\r
1405         POPJ    P,;\r
1406         AOS     MDG             ;COUNT MULTIPLY DEFINED GLOBALS\r
1407         PUSHJ   P,PRQ           ;START W/ ?\r
1408         PUSHJ     P,PRNAM               ;PRINT SYMBOL AND VALUE\r
1409         MOVE    W,2(A)          ;LOAD OLD VALUE\r
1410         PUSHJ     P,PRNUM               ;PRINT OLD VALUE\r
1411         JSP     A,ERRPT7                ;PRINT MESSAGE\r
1412         SIXBIT    /MUL. DEF. GLOBAL#/\r
1413         POPJ    P,;     IGNORE MUL. DEF. GLOBAL SYM\r
1414 \r
1415 \f;      LOCAL SYMBOL\r
1416 \r
1417 SYM1A:  TLNN    F,SYMSW+DSYMSW  ;SKIP IF LOAD LOCALS SWITCH ON\r
1418         POPJ    P,;             IGNORE LOCAL SYMBOLS\r
1419 SYM1B:  CAIL    H,(S)           ;STORE DEFINED SYMBOL\r
1420 IFN EXPAND,<    PUSHJ P,XPAND7>\r
1421 IFE EXPAND,<    JRST SFULLC>\r
1422 SYM1C:  IFE K,<\r
1423         TLNE    N,F4SW;         FORTRAN FOUR REQUIRES A BLT\r
1424         PUSHJ   P,MVDWN;        OF THE TABLES>\r
1425         MOVEI A,-2(S)   ;LOAD A TO SAVE INST. AT SYM2\r
1426 SYM1D:  SUBI    S,2;            UPDATE UNDEFINED POINTER\r
1427         POP     B,2(A)          ;MOVE UNDEFINED VALUE POINTER\r
1428         POP     B,1(A)          ;MOVE UNDEFINED SYMBOL\r
1429         MOVEM     W,2(B)                ;STORE VALUE\r
1430         MOVEM     C,1(B)                ;STORE SYMBOL\r
1431         POPJ    P,;\r
1432 \r
1433 \f;      GLOBAL DEFINITION MATCHES REQUEST\r
1434 \r
1435 SYM2:   PUSH P,SYM2C    ;NEXT MUST BE A SUBROUTINE FOR LATER. SET RETURN\r
1436 SYM2B:  MOVE    V,2(A)          ;LOAD REQUEST POINTER\r
1437         PUSHJ P,REMSYM\r
1438         JUMPL V,SYM2W   ;ADDITIVE REQUEST? WFW\r
1439         PUSHJ     P,SYM4A               ;REPLACE CHAIN WITH DEFINITION\r
1440 ;WFW PATCH TO LOOK FOR MORE THAN ONE REQUEST\r
1441 SYM2W1: PUSHJ P,SREQ    ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL\r
1442         JRST SYM2B      ;FOUND MORE\r
1443         MOVE A,SVA      ;RESTORE A\r
1444 ;END OF PATCH WFW\r
1445 SYM2C:  POPJ P,SYM1D    ;RETURN, SEE SYM2 FOR USE OF ADDRESS\r
1446 SVA:    0       ;A TEMP CELL WFW\r
1447 \r
1448 ;       REQUEST MATCHES GLOBAL DEFINITION\r
1449 \r
1450 SYM2A:  MOVE    V,W             ;LOAD POINTER TO CHAIN\r
1451         MOVE    W,2(A)          ;LOAD VALUE\r
1452         JUMPL V,FIXWP   ;HANDLE ATTITIVE REQUEST WFW\r
1453         JRST    SYM4A;          REPLACE CHAIN WITH DEFINITION\r
1454 \r
1455 ;       PROCESS GLOBAL REQUEST\r
1456 \r
1457 SYM3:   TLNE    C,040000;               COMMON NAME\r
1458         JRST    SYM1B\r
1459         TLC     C,640000;               PERMUTE BITS FROM 60 TO 04\r
1460         PUSHJ     P,SDEF                ;SEARCH FOR GLOBAL DEFINITION\r
1461         JRST    SYM2A           ;MATCHING GLOBAL DEFINITION\r
1462         JUMPL W,SYM3X1  ;ADDITIVE FIXUP WFW\r
1463         PUSHJ     P,SREQ                ;SEARCH FOR EXISTING REQUEST WFW\r
1464         JRST    SYM3A           ;EXISTING REQUEST FOUND WFW\r
1465 SYM3X1: TLNN W,100000   ;CHECK SYMBOL TABLE FIXUP\r
1466         JRST SYM3X2     ;NO\r
1467         MOVE V,1(B)     ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL\r
1468         XOR V,W         ;CHECK FOR IDENTITY\r
1469         TDNE V,[XWD 77777,-1]   ;BUT IGNORE HIGH 3 BITS\r
1470         POPJ P,         ;NOT SAME, ASSUME NOT LOADED LOCAL\r
1471         HRRI W,2(B)     ;GET LOCATION IN RIGHT HALF\r
1472         TLO W,1\r
1473         SUB W,JOBREL    ;AND MAKE RELATIVE\r
1474 IFN FAILSW,<    TLZ W,40000>\r
1475 SYM3X2: CAIL    H,(S)           ;STORE REQUEST IN UNDEF. TABLE WFW\r
1476 IFN EXPAND,<    PUSHJ P,XPAND7>\r
1477 IFE EXPAND,<    JRST SFULLC>\r
1478 SYM3X:  IFE K,<\r
1479         TLNE    N,F4SW;         FORTRAN FOUR\r
1480         PUSHJ   P,MVDWN;                ADJUST TABLES IF F4>\r
1481         SUB     S,SE3           ;ADVANCE UNDEFINED POINTER\r
1482         MOVEM     W,2(S)                ;STORE UNDEFINED VALUE POINTER\r
1483         MOVEM     C,1(S)                ;STORE UNDEFINED SYMBOL\r
1484         POPJ    P,;\r
1485 \r
1486 \f\r
1487 ;       COMBINE TWO REQUEST CHAINS\r
1488 \r
1489 SYM3A:  SKIPL 2(A)      ;IS IT ADDITIVE WFW\r
1490         JRST SYM3A1     ;NO, PROCESS WFW\r
1491         PUSHJ P,SDEF2   ;YES, CONTINUE WFW\r
1492         JRST SYM3A      ;FOUND ANOTHER WFW\r
1493         JRST SYM3X2     ;REALLY NO CHAIN THERE WFW\r
1494 SYM3A1: SUBI A,-2(X)  ;A=A-(-2+X(18-35)); A RELATIVE TO X WFW\r
1495 SYM3B:  HRRZ V,A       ; SAVE CHAIN ADDRESS FOR HRRM W,@X\r
1496 IFN L,< CAMGE V,RINITL\r
1497         HALT    ;LOSE LOSE LOSE>\r
1498         HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN\r
1499         JUMPN A,SYM3B  ; JUMP IF NOT THE LAST ADDR. IN CHAIN\r
1500         HRRM    W,@X            ;COMBINE CHAINS\r
1501         POPJ    P,;\r
1502 ;LHQ PATCH FOR LISP ABSOLUTE FIXUP PREVENTION\r
1503 IFN L,<\r
1504 VTST:   0\r
1505         MOVEM V,VSVV#\r
1506         HRRZS V\r
1507         CAMGE V,RINITL\r
1508         POPJ P,\r
1509         MOVE V,VSVV\r
1510         JRST @VTST>\r
1511 \r
1512 ;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS\r
1513 \r
1514 FIXWP:  TLNN V,100000   ;CHECK FOR SYMBOL TABLE FIXUP\r
1515         JRST FIXW\r
1516         MOVE T,1(B)     ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED\r
1517         XOR T,V         ;CHECK FOR SAME\r
1518         TDNE T,[XWD 77777,-1]   ;EXCEPT FOR HEGH CODE BITS\r
1519         POPJ P,         ;ASSUME NON-LOADED LOCAL\r
1520         HRRI V,2(B)     ;GET LOCATION\r
1521         SUBI V,(X)      ;SO WE CAN USE @X\r
1522 FIXW:   TLNE V,200000   ;IS IT LEFT HALF\r
1523         JRST FIXWL\r
1524 IFN L,< JSR VTST>\r
1525         MOVE T,@X       ;GET WORD\r
1526         ADD T,W         ;VALUE OF GLOBAL\r
1527         HRRM T,@X       ;FIX WITHOUT CARRY\r
1528         MOVSI D,200000  ;SET UP TO REMOVE DEFERED INTERNAL IF THERE\r
1529         JRST SYMFIX\r
1530 FIXWL:  HRLZ    T,W             ;UPDATE VALUE OF LEFT HALF\r
1531 IFN L,< JSR VTST>\r
1532         ADDM    T,@X            ;BY VALUE OF GLOBAL\r
1533         MOVSI D,400000  ;LEFT DEFERED INTERNAL\r
1534 SYMFIX: TLNN V,100000   ;CHECK FOR SYMBOL TABLE FIXUP\r
1535         POPJ P,         ;NO, RETURN\r
1536         ADDI V,(X)      ;GET THE LOCATION\r
1537         MOVE T,-1(V)    ;GET THE SYMBOL NAME\r
1538         TLNN T,40000    ;CHECK TO SEE IF INTERNAL\r
1539         POPJ P,         ;NO, LEAVE\r
1540         ANDCAB D,-1(V)  ;REMOVE PROPER BIT\r
1541         TLNE D,600000   ;IS IT STILL DEFERED?\r
1542         POPJ P,         ;YES, ALL DONE\r
1543         EXCH C,D        ;NO, CHECK FOR A REQUEST FOR IT\r
1544         PUSHJ P,SREQ\r
1545         JRST CHNSYM     ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE\r
1546         MOVE C,D        ;GET C BACK\r
1547         POPJ P,\r
1548 CHNSYM: PUSH P,D        ;HAS THE OLD C IN IT\r
1549         PUSH P,W        ;WE MAY NEED IT LATER\r
1550         MOVE W,(V)      ;GET VALUE\r
1551         PUSHJ P,SYM2B   ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE\r
1552         POP P,W\r
1553         POP P,C         ;RESTORE FOR CALLER\r
1554         POPJ P,         ;AND GO AWAY\r
1555 \r
1556 SYM2W:  IFN FAILSW,<    TLNE V,40000    ;CHECK FOR POLISH\r
1557         JRST POLSAT>\r
1558         TLNN V,100000   ;SYMBOL TABLE?\r
1559         JRST SYM2WA\r
1560         ADD V,JOBREL    ;MAKE ABSOLUTE\r
1561         SUBI V,(X)      ;GET READY TO ADD X\r
1562         SYM2WA: PUSHJ P,FIXW    ;DO FIXUP\r
1563         JRST SYM2W1     ;AND LOOK FOR MORE REQUESTS\r
1564 \r
1565 ;END WFW PATCH\r
1566 \r
1567 \f;PATCH VALUES INTO CHAINED REQUEST\r
1568 SYM4:\r
1569 IFN L,< CAMGE V,RINITL\r
1570         POPJ P,>\r
1571         HRRZ    T,@X            ;LOAD NEXT ADDRESS IN CHAIN\r
1572         HRRM    W,@X            ;INSERT VALUE INTO PROGRAM\r
1573         MOVE    V,T\r
1574 SYM4A:  JUMPN     V,SYM4                ;JUMP IF NOT LAST ADDR. IN CHAIN\r
1575         POPJ    P,\r
1576 \r
1577 IFE     K,<\r
1578 MVDWN:  HRRZ T,MLTP\r
1579 IFN EXPAND,<    SUBI T,2>\r
1580         CAIG    T,@X;           ANY ROOM LEFT?\r
1581 IFN EXPAND,<    JRST    [PUSHJ P,XPAND>\r
1582                         TLOA F,FULLSW\r
1583 IFN EXPAND,<            JRST MVDWN\r
1584                         JRST .+2]>\r
1585         TLNE    F,SKIPSW+FULLSW\r
1586         JRST    MVABRT; ABORT BLT\r
1587         HRREI   T,-2\r
1588         ADDM    T,PLTP;         ADJUST PROGRAMMER LABEL POINTER\r
1589         ADDM    T,BITP;         AND BIT TABLE POINTER\r
1590         ADDM    T,SDSTP;        FIRST DATA STATEMENT\r
1591         ADDM    T,LTC\r
1592         ADDM    T,ITC\r
1593         TLNE    N,SYDAT\r
1594         ADDM    T,V\r
1595         ADDB    T,MLTP;         AND FINALLY TO MADE LABEL TABLE\r
1596         HRLS    T;              SET UP BLT POINTER\r
1597         ADD     T,[XWD 2,0]\r
1598         BLT     T,(S)\r
1599 MVABRT: POPJ    P,;\r
1600 >\r
1601 ;HIGHEST RELOCATABLE POINT (BLOCK TYPE 4)\r
1602 SFULLC: TLOE    F,FULLSW        ;PREVIOUS OVERFLOW?\r
1603         JRST    FULLC           ;YES, DON'T PRINT MESSAGE\r
1604         JSP     A,ERRPT         ;NO, COMPLAIN ABT OVERFLO\r
1605         SIXBIT  ?SYMBOL TABLE OVERLAP#?\r
1606 FULLC:  TLO     F,FULLSW        ;CORE OVERLAP ERROR RETURN\r
1607 IFE K,< TLNE    N,F4SW\r
1608         POPJ    P,>\r
1609         JRST    LIB3            ;LOOK FOR MORE\r
1610 \r
1611 HIGH0:  CAIE A,4  ; TEST FOR END BLOCK (OVERLAP)\r
1612         JRST    LIB3\r
1613 HIGH:   PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1614         HRR     R,C             ;SET NEW PROGRAM BREAK\r
1615         ADDI    C,X;    BE SURE TO RELOCATE\r
1616         CAILE   C,1(S)          ;TEST PROGRAM BREAK\r
1617 IFN EXPAND,<PUSHJ P,[   PUSHJ P,XPAND\r
1618                         TLOA F,FULLSW\r
1619                         JRST POPJM2\r
1620                         POPJ    P,]>\r
1621 IFE EXPAND,<TLO F,FULLSW>\r
1622 HIGH3:  MOVEI   A,F.C           ;SAVE CURRENT STATE OF LOADER\r
1623         BLT     A,B.C\r
1624         TLNE    F,SLIBSW+LIBSW  ;NORMAL MODE EXIT THROUGH LOAD1\r
1625         JRST    LIB             ;LIBRARY SEARCH EXIT\r
1626         JRST LOAD1\r
1627 \r
1628 \f;STARTING ADDRESS (BLOCK TYPE 7)\r
1629 \r
1630 START:  PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1631         TLNN    N,ISAFLG                ;SKIP IF IGNORE SA FLAG ON\r
1632         HRR     F,C             ;SET STARTING ADDRESS\r
1633 IFN STANSW,<MOVE W,1(N) ;SET UP NAME OF THIS PROGRAM\r
1634         PUSHJ P,LDNAM>\r
1635 \r
1636 ;PROGRAM NAME (BLOCK TYPE 6)\r
1637 \r
1638 NAME:   PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1639         TLOE    N,COMFLG                ;SKIP IF COMMON NOT PREV. SET\r
1640         JRST    NAME1           ;SIZE OF COMMON PREV. SET\r
1641         MOVEM     W,COMSAV              ;STORE LENGTH OF COMMON\r
1642         JUMPE     W,NAME2               ;JUMP IF NO COMMON IN THIS JOB\r
1643         HRRI    R,@R            ;FIRST PROGRAM SET LOAD ORIGIN\r
1644 NAME1:  CAILE H,-1(S)           ;TEST FOR AVAIL. SYMBOL SPACE\r
1645 IFN EXPAND,<    PUSHJ P,XPAND7>\r
1646 IFE EXPAND,<    JRST SFULLC>\r
1647         SUBI    S,2             ;UPDATE UNDEF. TABLE POINTER\r
1648         POP     B,2(S)\r
1649         POP     B,1(S)\r
1650         HRRZ    V,N             ;POINTER TO PREVIOUS NAME\r
1651         SUBM    B,V             ;COMPUTE RELATIVE POSITIONS\r
1652         HRLM    V,2(N)          ;STORE FORWARD POINTER\r
1653         HRR     N,B             ;UPDATE NAME POINTER\r
1654 NAME2:  MOVEM     C,1(B)                ;STORE PROGRAM NAME\r
1655         HRRZM   R,2(B)          ;STORE PROGRAM ORIGIN\r
1656         CAMG    W,COMSAV                ;CHECK COMMON SIZE\r
1657         JRST    LIB3            ;COMMON OK\r
1658 ILC:    JSP     A,ERRPT\r
1659         SIXBIT    /ILL. COMMON#/\r
1660 IFN HE,<SETOM RESET>\r
1661         JRST    LD2\r
1662 IFN FAILSW,<\r
1663 LINK:   PUSHJ P,PRWORD  ;GET TWO WORDS\r
1664         JUMPLE C,ENDLNK ;THIS IS AN END OF LINK WORD\r
1665         CAILE C,20      ;IS IT IN RANGE?\r
1666         JRST LOAD4A\r
1667         HRRZ V,W        ;GET THE ADDRESS\r
1668         HRRZ W,LINKTB(C)        ;GET CURRENT LINK\r
1669 IFN L,< CAML V,RINITL   ;LOSE>\r
1670         HRRM W,@X       ;PUT INTO CORE\r
1671         HRRM V,LINKTB(C)        ;SAVE LINK FOR NEXT ONE\r
1672         JRST LINK       ;GO BACK FOR MORE\r
1673 ENDLNK: MOVNS C         ;GET ENTRY NUMBER\r
1674         JUMPE C,LOAD4A  ;0 IS A LOSER\r
1675         CAILE C,20      ;CHECK RANGE\r
1676         JRST LOAD4A\r
1677         HRLM W,LINKTB(C)        ;SAVE END OF LINK INFO\r
1678         JRST LINK       ;MORE>\r
1679 \f\r
1680 ;ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)\r
1681 \r
1682                         ;PMP PATCH FOR LEFT HALF FIXUPS\r
1683 IFN FAILSW,<\r
1684 LOCDLH:\r
1685 IFN L,< CAMGE V,RINITL\r
1686         JRST .+3>\r
1687         HLRZ T,@X       ;LOAD NEXT ADDRESS IN CHAIN\r
1688         HRLM W,@X       ;INSERT VALUE INTO PROGRAM\r
1689         MOVE V,T\r
1690 LOCDLF: JUMPN V,LOCDLH  ;JUMP IF NOT LAST ADDR. IN CHAIN\r
1691         POPJ P,\r
1692 LOCDLI: PUSHJ P,LOCDLF\r
1693         AOSA LFTHSW     ;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP\r
1694 LOCDLG: SETOM LFTHSW    ;TURN ON LEFT HALF FIX SW>\r
1695                         ;END PMP PATCH\r
1696 LOCD:   PUSHJ     P,RWORD               ;READ ONE DATA WORD\r
1697         HLRZ    V,W             ;STORAGE POINTER IN LEFT HALF\r
1698 IFN FAILSW,<    SKIPE LFTHSW#   ;LEFT HALF CHAINED? PMP\r
1699                 JRST LOCDLI     ;YES PMP\r
1700                 CAMN W,[-1]     ;LEFT HALF NEXT? PMP\r
1701                 JRST LOCDLG     ;YES, SET SWITCH PMP>\r
1702         PUSHJ     P,SYM4A               ;LINK BACK REFERENCES\r
1703         JRST    LOCD\r
1704 IFN STANSW,<\r
1705 LDNAM:  MOVE T,[POINT 6,CURNAM] ;POINTER\r
1706         MOVNI D,6       ;SET COUNT\r
1707         TLZ W,740000    ;REMOVE CODE BITS\r
1708 SETNAM: IDIVI W,50      ;CONVERT FROM RAD 50\r
1709         HRLM C,(P)\r
1710         AOSGE D\r
1711         PUSHJ P,SETNAM\r
1712         HLRZ C,(P)\r
1713         JUMPE C,INAM\r
1714         ADDI C,17\r
1715         CAILE C,31\r
1716         ADDI C,7\r
1717         CAILE C,72\r
1718         SUBI C,70\r
1719         CAIN C,3\r
1720         MOVEI C,16\r
1721 INAM:   IDPB C,T\r
1722         POPJ P, >\r
1723 \fIFN FAILSW,<\r
1724 ;POLISH FIXUPS <BLOCK TYPE 11>\r
1725 \r
1726 PDLOV:  SKIPE POLSW     ;PDL OV ARE WE DOING POLISH?\r
1727         JRST COMPOL     ;YES\r
1728         JSP A,ERRPT\r
1729         SIXBIT /PUSHDOWN OVERFLOW#/\r
1730 IFN HE,<SETOM RESET>\r
1731         JRST LD2\r
1732 COMPOL: JSP A,ERRPT\r
1733         SIXBIT /POLISH TOO COMPLEX#/\r
1734 IFN HE,<SETOM RESET>\r
1735         JRST LD2\r
1736 \r
1737 \r
1738 ;READ A HALF WORD AT A TIME\r
1739 \r
1740 RDHLF:  TLON N,HSW      ;WHICH HALF\r
1741         JRST NORD\r
1742         PUSHJ P,RWORD   ;GET A NEW ONE\r
1743         TLZ N,HSW       ;SET TO READ OTEHR HALF\r
1744         MOVEM W,SVHWD#  ;SAVE IT\r
1745         HLRZS W         ;GET LEFT HALF\r
1746         POPJ P,         ;AND RETURN\r
1747 NORD:   HRRZ W,SVHWD    ;GET RIGHT HALF\r
1748         POPJ P,         ;AND RETURN\r
1749 \r
1750 \r
1751 POLFIX: MOVE D,[IOWD PPDL,PPDB] ;SET UP THE POLISH PUSHDOWN LIST\r
1752         MOVEI V,100     ;IN CASE OF ON OPERATORS\r
1753         MOVEM V,SVSAT\r
1754         SETOM POLSW     ;WE ARE DOING POLISH\r
1755         TLO N,HSW       ;FIX TO READ A WORD THE FIRST TIME\r
1756         SETOM GLBCNT#   ;NUMBER OF GLOBALS IN THIS FIXUP\r
1757         SETOM OPNUM#    ;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP\r
1758         PUSH D,[15]     ;FAKE OPERATOR SO STORE WILL NOT HACK\r
1759 \r
1760 RPOL:   PUSHJ P,RDHLF   ;GET A HLAF WORD\r
1761         TRNE W,400000   ;IS IT A STORE OP?\r
1762         JRST STOROP     ;YES, DO IT\r
1763         CAIGE W,3       ;0,1,2 ARE OPERANDS\r
1764         JRST OPND\r
1765         CAILE W,14      ;14 IS HIGHEST OPERATOR\r
1766         JRST LOAD4A     ;ILL FORMAT\r
1767         PUSH D,W        ;SAVE OPERATOR IN STACK\r
1768         MOVE V,DESTB-3(W)       ;GET NUMBER OF OPERANDS NEEDED\r
1769         MOVEM V,SVSAT#  ;ALSO SAVE IT\r
1770         JRST RPOL       ;BACK FOR MORE\r
1771 \r
1772 \f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF\r
1773 ;GLOBAL REQUESTS\r
1774 \r
1775 OPND:   MOVE A,W        ;GET THE OPERAND TYPE HERE\r
1776         PUSHJ P,RDHLF   ;THIS IS AT LEAST PART OF THE OPERAND\r
1777         MOVE C,W        ;GET IT INTO C\r
1778         JUMPE A,HLFOP   ;0 IS HALF-WORD OPERAND\r
1779         PUSHJ P,RDHLF   ;NEED FULL WORD, GET SECOND HALF\r
1780         HRL C,W ;GET HALF IN RIGHT PLACE\r
1781         MOVSS C         ;WELL ALMOST RIGHT\r
1782         SOJE A,HLFOP    ;1 IS FULL WORD, 2 IS GLOBAL REQUEST\r
1783         PUSHJ P,SDEF    ;SEE IF IT IS ALREADY DEFINED\r
1784         JRST    [MOVE C,2(A)    ;YES, WE WIN\r
1785                 JRST HLFOP]\r
1786         AOSN GLBCNT     ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP\r
1787         AOS HEADNM      ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL\r
1788         AOS W,OPNUM     ;GET AN OPERAND NUMBER\r
1789         LSH W,4         ;SPACE FOR TYPE\r
1790         IORI W,2        ;TYPE 2 IS GLOBAL \r
1791         HRL W,HEADNM    ;GET FIXUP NUMBER\r
1792         PUSHJ P,SYM3X2  ;AND PUT INTO UDEFINED AREA ALONG WITH NAME\r
1793         MOVE C,W        ;ALSO PUT THAT PART OF THE FIXUP IN\r
1794         PUSHJ P,SYM3X2\r
1795         SKIPA A,[400000]        ;SET UP GLOBAL FLAG\r
1796 HLFOP:  MOVEI A,0       ;VALUE OPERAND FLAG\r
1797 HLFOP1: SOJL V,CSAT     ;ENOUGH OPERANDS SEEN?\r
1798         PUSH D,C        ;NO, SAVE VALUE(OR GLOBAL NAME)\r
1799         HRLI A,400000   ;PUT IN A VALUE MARKER\r
1800         PUSH D,A        ;TO THE STACK\r
1801         JRST RPOL       ;GET MORE POLISH\r
1802 \r
1803 \f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR\r
1804 \r
1805 CSAT:   HRRZS A         ;KEEP ONLY THE GLOBAL-VALUE HALF\r
1806         SKIPN SVSAT     ;IS IT UNARY\r
1807         JRST UNOP       ;YES, NO NEED TO GET 2ND OPERAND\r
1808         HRL A,(D)       ;GET GLOBAL VALUE MARKER FOR 2ND OP\r
1809         POP D,W\r
1810         POP D,W         ;VALUE OR GLOBAL NAME\r
1811 UNOP:   POP D,V         ;OPERATOR\r
1812         JUMPN A,GLOB    ;IF EITHER IS A GLOBAL HANDLE SPECIALLY\r
1813         XCT OPTAB-3(V)  ;IF BOTH VALUES JUST XCT\r
1814         MOVE C,W        ;GET THE CURRENT VALUE\r
1815 SETSAT: SKIPG V,(D)     ;IS THERE A VALUE IN THE STACK\r
1816         MOVE V,-2(D)    ;YES, THIS MUST BE THE OPERATOR\r
1817         MOVE V,DESTB-3(V)       ;GET NUMBER OF OPERANDS NEEDED\r
1818         MOVEM V,SVSAT   ;SAVE IT HERE\r
1819         SKIPG (D)       ;WAS THERE AN OPERAND\r
1820         SUBI V,1        ;HAVE 1 OPERAND ALREADY\r
1821         JRST HLFOP1     ;GO SEE WHAT WE SHOULD DO NOW\r
1822 \r
1823 ;HANDLE GLOBALS\r
1824 \r
1825 GLOB:   TRNE A,-1       ;IS IT IN RIGHT HALF\r
1826         JRST TLHG       ;NO, NEED TO PUT THIS VALUE INTO THE FIXUP LIST\r
1827         PUSH P,W        ;SAVE FOR A WHILE\r
1828         MOVE W,C        ;THE VALUE\r
1829         AOS C,OPNUM     ;GET AN OPERAND NUMBER\r
1830         LSH C,4         ;AND PUT IN TYPE\r
1831         IORI C,2        ;VALUE TYPE\r
1832         HRL C,HEADNM    ;THE FIXUP NUMBER\r
1833         PUSHJ P,SYM3X2\r
1834         POP P,W         ;RETRIEVE THE OTHER VALUE\r
1835 TLHG:   SKIPE SVSAT     ;WAS THIS A UNARY OPERATOR\r
1836         TLNE A,-1       ;WAS THERE A GLOBAL IN LEFT HALF\r
1837         JRST GLSET\r
1838         PUSH P,C        ;SAVE THE FIRST OPERAND\r
1839         AOS C,OPNUM     ;SEE ABOVE\r
1840         LSH C,4\r
1841         IORI C,2\r
1842         HRL C,HEADNM\r
1843         PUSHJ P,SYM3X2\r
1844         MOVE W,C\r
1845         POP P,C\r
1846 \r
1847 GLSET:  EXCH C,W        ;GET THEM IN THE OTHER ORDER\r
1848         HRL W,C         ;SET UP THE OPERATOR LINK\r
1849         AOS C,OPNUM\r
1850         LSH C,4 ;SPACE FOR THYPE\r
1851         IOR C,V         ;THE OPERATOR\r
1852         HRL C,HEADNM\r
1853         PUSHJ P,SYM3X2  ;INTO THE UNDEF LIST\r
1854         MOVEI A,400000  ;SET UP AS A GLOBAL VALUE\r
1855         JRST SETSAT     ;AND SET UP FOR NEXT OPERATOR\r
1856 \r
1857 \f;FINALLY WE GET TO STORE THIS MESS\r
1858 \r
1859 STOROP: MOVE T,-2(D)    ;THIS SHOULD BE THE FAKE OPERATOR\r
1860         CAIE T,15       ;IS IT\r
1861         JRST LOAD4A     ;NO, ILL FORMAT\r
1862         HRRZ T,(D)      ;GET THE VALUE TYPE\r
1863         JUMPN T,GLSTR   ;AND TREAT GLOBALS SPECIAL\r
1864         MOVE A,W        ;THE TYPE OF STORE OPERATOR\r
1865         PUSHJ P,RDHLF   ;GET THE ADDRESS\r
1866         MOVE V,W        ;SET UP FOR FIXUPS\r
1867         POP D,W         ;GET THE VALUE\r
1868         POP D,W         ;AFTER IGNORING THE FLAG\r
1869         PUSHJ P,@STRTAB+3(A)    ;CALL THE CORRECT FIXUP ROUTINE\r
1870 COMSTR: SETZM POLSW     ;ALL DONE WITH POLISH\r
1871         MOVE T,OPNUM    ;CHECK ON SIZES\r
1872         MOVE V,HEADNM\r
1873         CAIG V,477777\r
1874         CAILE T,37777\r
1875         JRST COMPOL     ;TOO BIG, GIVE ERROR\r
1876         PUSHJ P,RWORD   ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)\r
1877         JRST LOAD4A     ;IF NOT, SOMETHING IS WRONG\r
1878 \r
1879 STRTAB: EXP ALSTR,LOCDLF,SYM4A\r
1880 \r
1881 GLSTR:  MOVEI A,20(W)   ;CONVERT TO OPERATOR 15-17\r
1882         PUSHJ P,RDHLF   ;GET THE STORE LOCATION\r
1883         POP D,V         ;GET VALUE\r
1884         POP D,V\r
1885         HRLM V,W        ;SET UP STORAGE ELEMENT\r
1886         AOS C,OPNUM\r
1887         LSH C,4\r
1888         IOR C,A\r
1889         HRL C,HEADNM\r
1890         PUSHJ P,SYM3X2\r
1891         MOVE W,C        ;NOW SET UP THE HEADER\r
1892         AOS V,GLBCNT    ;WHICH HAS NUMBER OF GLOBALS\r
1893         HRLM V,W\r
1894         HRRZ C,HEADNM\r
1895         PUSHJ P,SYM3X2\r
1896         JRST COMSTR     ;AND FINISH\r
1897 \r
1898 \fALSTR1:\r
1899 IFN L,< CAMGE V,RINITL\r
1900         POPJ P,>\r
1901         HRRZ T,@X\r
1902         MOVEM W,@X      ;FULL WORD FIXUPS\r
1903         MOVE V,T\r
1904 ALSTR:  JUMPN V,ALSTR1\r
1905         POPJ P,\r
1906 DESTB:  EXP 1,1,1,1,1,1,1,1,0,0,100\r
1907 \r
1908 OPTAB:  ADD W,C\r
1909         SUB W,C\r
1910         IMUL W,C\r
1911         IDIV W,C\r
1912         AND W,C\r
1913         IOR W,C\r
1914         LSH W,(C)\r
1915         XOR W,C\r
1916         SETCM W,C\r
1917         MOVN W,C\r
1918         REPEAT 3,<JRST STRSAT>\r
1919 \r
1920 \r
1921 \fPOLSAT:        PUSH P,C        ;SAVE SYMBOL\r
1922         MOVE C,V        ;POINTER\r
1923         PUSHJ P,SREQ    ;GO FIND IT\r
1924         SKIPA\r
1925         JRST LOAD4A     ;SOMETHING IS ROTTEN IN DENMARK\r
1926         MOVEM W,2(A)    ;STORE VALUE\r
1927         HLRZS C         ;NOW FIND HEADER\r
1928         PUSHJ P,SREQ\r
1929         SKIPA\r
1930         JRST LOAD4A\r
1931         HRLZI V,-1      ;AND DECREMENT COUNT\r
1932         ADDB V,2(A)\r
1933         TLNN V,-1       ;IS IT NOW 0\r
1934         JRST PALSAT     ;YES, GO DO POLISH\r
1935         POP P,C         ;RESTORE SYMBOL\r
1936         JRST SYM2W1     ;AND RETURN\r
1937 \r
1938 PALSAT: PUSH P,W        ;SAVE VALUE\r
1939         MOVEM C,HDSAV#  ;SAVE THE HEADER NUMBER\r
1940         MOVE D,[IOWD PPDL,PPDB] ;SET UP A PDL\r
1941         MOVE C,V        ;GET THE POINTER\r
1942         HRL C,HDSAV     ;AND THE FIXUP NUMBER\r
1943         PUSHJ P,REMSYM  ;REMOVE THE HEADER FORM EXISTANCE\r
1944         PUSHJ P,SREQ    ;GO FINE THE NEXT LINK\r
1945         SKIPA\r
1946         JRST LOAD4A     ;LOSE\r
1947         ANDI C,17       ;GET OPERATOR TYPE\r
1948         HRRZ V,2(A)     ;PLACE TO STORE\r
1949         PUSH D,V\r
1950         PUSH D,[XWD 400000,0]\r
1951         PUSH D,C        ;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE\r
1952         HLRZ C,2(A)     ;GET POINTER TO POLISH CHAIN\r
1953 PSAT1:  PUSHJ P,REMSYM  ;REMOVE SYMBOL\r
1954 \r
1955 \fPSAT2: HRL C,HDSAV     ;GET FIXUP NUMBER\r
1956         PUSHJ P,SREQ    ;LOOK FOR IT\r
1957         SKIPA\r
1958         JRST LOAD4A\r
1959         ANDI C,17       ;THE OPERATOR NUMBER\r
1960         CAIN C,2        ;IS IT AN OPERAND?\r
1961         JRST PSOPD      ;YES, GO PROCESS\r
1962         PUSH D,C        ;YES STORE IT\r
1963         SKIPN DESTB-3(C)        ;IS IT UNARY\r
1964         JRST PSUNOP     ;YES\r
1965         HLRZ C,2(A)     ;GET FIRST OPERAND\r
1966         HRLI C,600000   ;AND MARK AS VALUE\r
1967         PUSH D,C\r
1968 PSUNOP: HRRZ C,2(A)     ;OTHER OPERAND\r
1969         JRST PSAT1      ;AND AWAY WE GO\r
1970 \r
1971 PSOPD:  MOVE C,2(A)     ;THIS IS A VALUE\r
1972         PUSHJ P,REMSYM  ;GET RID OF THAT PART OF THE CHAIN\r
1973 PSOPD1: SKIPG V,(D)     ;IS THERE A VALUE IN THE STACK\r
1974         JRST PSOPD2     ;YES, TAKE GOOD CARE OF IT\r
1975 COMOP:  POP D,V         ;NO, GET THAT OPERATOR OUT OF THERE\r
1976         XCT OPTAB-3(V)  ;AND DO IT\r
1977         MOVE C,W        ;GET RESULT IN RIGHT PLACE\r
1978         JRST PSOPD1     ;AND TRY FOR MORE\r
1979 PSOPD2: TLNE V,200000   ;IS IT A POINTER\r
1980         JRST DBLOP      ;YES, NEEDS MORE WORK\r
1981         MOVE W,C        ;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W\r
1982         POP D,C         ;VALUE POINTER\r
1983         POP D,C         ;2ND OPERAND INTO C\r
1984         JRST COMOP      ;GO PROCESS OPERATOR\r
1985 \r
1986 DBLOP:  EXCH C,(D)      ;PUT VALUE IN STACK AND RETRIEV POINTER\r
1987         PUSH D,[XWD 400000,0]   ;MARK AS VALUE\r
1988         JRST PSAT2      ;AND GO LOOK FOR MORE TROUBLE\r
1989 \r
1990 \fSTRSAT:        MOVE W,C        ;GET VALUE TO STORE IN W\r
1991         MOVE C,V        ;GET OPERATOR HERE\r
1992         POP D,V\r
1993         POP D,V         ;GET ADDRESS TO STORE\r
1994         PUSHJ P,@STRTAB-15(C)\r
1995         POP P,W ;RESTORE THINGS\r
1996         POP P,C\r
1997         JRST SYM2W1\r
1998 \r
1999 PPDB:   BLOCK PPDL+1>\r
2000 \r
2001 REMSYM: MOVE T,1(S)\r
2002         MOVEM T,1(A)\r
2003         MOVE T,2(S)\r
2004         MOVEM T,2(A)\r
2005         ADD S,SE3\r
2006         MOVEM A,SVA\r
2007         POPJ P,\r
2008 \r
2009 \f;SYMBOL TABLE SEARCH SUBROUTINES\r
2010 \r
2011 ;       ENTERED WITH SYMBOL IN C\r
2012 ;       RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND\r
2013 ;       OTHERWISE, A SKIP ON RETURN OCCURS\r
2014 \r
2015 SREQ:   JUMPGE    S,CPOPJ1              ;JUMP IF NO UNDEF. SYMBOLS\r
2016         SKIPA     A,S           ;LOAD REQUEST SEARCH POINTER\r
2017 SDEF:   MOVE    A,B             ;LOAD DEF. SYMBOL SEARCH POINTER\r
2018 SDEF1:  CAMN    C,1(A)\r
2019         POPJ    P,                      ;SYMBOLS MATCH, RETURN\r
2020 SDEF2:  ADD     A,SE3\r
2021         JUMPL     A,SDEF1\r
2022 IFE K,< JRST    CPOPJ1          ;SYMBOL NOT FOUND SKIPS ON RETURN>\r
2023 IFN K,<\r
2024 CPOPJ1: AOS     (P)             ;TRA 2,4\r
2025         POPJ    P,              ;...>\r
2026 \r
2027 ;RELOCATION AND BLOCK INPUT\r
2028 \r
2029 PRWORD:   PUSHJ     P,RWORD             ;READ A WORD PAIR\r
2030         MOVE    C,W             ;LOAD C WITH FIRST DATA WORD\r
2031         TRNE    E,377777                ;TEST FOR END OF BLOCK\r
2032         JRST    RWORD1          ;INPUT SECOND WORD OF PAIR\r
2033         MOVEI     W,0           ;NO SECOND WORD, ASSUME ZERO\r
2034         POPJ    P,\r
2035 \r
2036 RWORD:  TRNN    E,377777                ;TEST FOR END OF BLOCK\r
2037         JRST    LOAD1           ;RETURN TO LOAD THE NEXT BLOCK\r
2038 RWORD1:   AOBJN     E,RWORD2            ;JUMP IF DATA WORD NEXT\r
2039         PUSHJ     P,WORD                ;READ CONTROL WORD\r
2040         MOVE    Q,W             ;DON'T COUNT RELOCATION WORDS\r
2041         HRLI    E,-22           ;SET RELOCATION WORD BYTE COUNT\r
2042 RWORD2:   PUSHJ     P,WORD              ;READ INPUT WORD\r
2043         JUMPGE    Q,RWORD3              ;TEST LH RELOCATION BIT\r
2044         HRLZ    T,R\r
2045         ADD     W,T             ;LH RELOCATION\r
2046 RWORD3:   TLNE  Q,200000                ;TEST RH RELOCATION BIT\r
2047         HRRI    W,@R            ;RH RELOCATION\r
2048         LSH     Q,2\r
2049         POPJ    P,\r
2050 \r
2051 \f;PRINT STORAGE MAP SUBROUTINE\r
2052 \r
2053 PRMAP:  PUSHJ   P,FSCN1 ;LOAD OTHER FILES FIRST\r
2054         PUSHJ   P,CRLFLF        ;START NEW PAGE\r
2055         HRRZ    W,R\r
2056         PUSHJ     P,PRNUM0\r
2057         JSP     A,ERRPT7\r
2058         SIXBIT  ?IS THE PROGRAM BREAK@?\r
2059         PUSHJ   P,CRLF          ;START STORAGE MAP\r
2060         JSP     A,ERRPT0        ;PRINT HEADER\r
2061         SIXBIT  ?STORAGE MAP@?\r
2062         HLRE    A,B\r
2063         MOVNS     A\r
2064         ADDI    A,(B)\r
2065 PRMAP1:   SUBI  A,2\r
2066         SKIPL     C,1(A)                ;LOAD SYMBOL, SKIP IF DELETED\r
2067         TLNE    C,300000                ;TEST FOR LOCAL SYMBOL\r
2068         JRST    PRMAP4          ;IGNORE LOCAL SYMBOLS\r
2069         TLNN    C,040000\r
2070         PUSHJ     P,CRLF                ;PROGRAM NAME\r
2071         PUSHJ     P,PRNAM1              ;PRINT SYMBOL AND VALUE\r
2072         TLNE    C,040000\r
2073         JRST    PRMAP3          ;GLOBAL SYMBOL\r
2074         HLRE    C,W             ;POINTER TO NEXT PROG. NAME\r
2075         JUMPGE    C,PRMAP2              ;JUMP IF LAST PROGRAM NAME\r
2076         ADDI    C,2(A)          ;COMPUTE LOC. OF FOLLOWING NAME\r
2077         SKIPA     T,@C          ;LOAD ORIGIN OF FOLLOWING PROG.\r
2078 PRMAP2:   HRRZ  T,R             ;LOAD PROGRAM BREAK\r
2079         SUBM    T,W             ;SUBTRACT ORIGIN TO GET LENGTH\r
2080         PUSHJ     P,PRNUM               ;PRINT PROGRAM LENGTH\r
2081         PUSHJ     P,CRLF\r
2082         TLNN    N,ALLFLG                ;SKIP IF LIST ALL MODE IS ON\r
2083         TRNE    W,777777                ;SKIP IF ZERO LENGTH PROGRAM\r
2084         JRST    PRMAP3\r
2085         JUMPE     C,PRMAP5              ;JUMP IF LAST PROGRAM\r
2086         SKIPA     A,C           ;SKIP GLOBALS, ZERO LENGTH PROG.\r
2087 PRMAP3:   PUSHJ     P,CRLF\r
2088 PRMAP4:   CAILE     A,(B)               ;TEST FOR END OF SYMBOL TABLE\r
2089         JRST    PRMAP1\r
2090 PRMAP5:\r
2091 \r
2092 \f;LIST UNDEFINED GLOBALS\r
2093 \r
2094 PMS:    PUSHJ   P,FSCN1 ;LOAD FILES FIRST\r
2095         JUMPGE  S,PMS3          ;JUMP IF NO UNDEFINED GLOBALS\r
2096         HLLOS 42                ;SET SOME ERROR TO ABORT EXECUTION\r
2097         PUSHJ   P,FCRLF         ;START THE MESSAGE\r
2098         PUSHJ   P,PRQ           ;PRINT ?\r
2099         HLRE    W,S             ;COMPUTE NO. OF UNDEF. GLOBALS\r
2100         MOVMS     W\r
2101         LSH     W,-1            ;<LENGTH OF LIST>/2\r
2102         PUSHJ     P,PRNUM0\r
2103         JSP     A,ERRPT7\r
2104         SIXBIT    /UNDEFINED GLOBALS@/\r
2105         MOVE    A,S             ;LOAD UNDEF. POINTER\r
2106 PMS2:   PUSHJ     P,CRLF\r
2107         PUSHJ   P,PRQ           ;PRINT ?\r
2108         PUSHJ     P,PRNAM0              ;PRINT SYMBOL AND POINTER\r
2109         ADD     A,SE3\r
2110         JUMPL     A,PMS2\r
2111         PUSHJ   P,CRLF          ;SPACE AFTER LISTING\r
2112 \r
2113 ;LIST NUMBER OF MULTIPLY DEFINED GLOBALS\r
2114 \r
2115 PMS3:   SKIPN   W,MDG           ;ANY MULTIPLY DEFINED GLOBALS\r
2116         JRST    PMS4            ;NO, EXCELSIOR\r
2117         HLLOS 42                ;ANOTHER WAY TO LOSE\r
2118         PUSHJ   P,FCRLF         ;ROOM AT THE TOP\r
2119         PUSHJ   P,PRQ           ;PRINT ?\r
2120         PUSHJ   P,PRNUM0        ;NUMBER OF MULTIPLES\r
2121         JSP     A,ERRPT7        ;REST OF MESSAGE\r
2122         SIXBIT  ?MULTIPLY DEFINED GLOBALS@?\r
2123 PMS4:   TLNE    N,AUXSWE        ;AUXILIARY OUTPUT DEVICE?\r
2124         OUTPUT  2,              ;INSURE A COMPLETE BUFFER\r
2125         POPJ    P,              ;RETURN\r
2126 \r
2127 \f;ENTER FILE ON AUXILIARY OUTPUT DEVICE\r
2128 \r
2129 IAD2:   ENTER   2,DTOUT         ;WRITE FILE NAME IN DIRECTORY\r
2130         JRST    IMD3            ;NO MORE DIRECTORY SPACE\r
2131         POPJ    P,\r
2132 \r
2133 IMD3:   JSP     A,ERRPT         ;DIRECTORY FULL ERROR\r
2134         SIXBIT    /DIR. FULL@/\r
2135         JRST    LD2\r
2136 \r
2137 ;PRINT THE 6 DIGIT OCTAL ADDRESS IN W\r
2138 \r
2139 ;       ACCUMULATORS USED: D,T,V\r
2140 \r
2141 PRNAM0:   MOVE  C,1(A)          ;LOAD SYMBOL\r
2142 PRNAM1:   MOVE  W,2(A)          ;LOAD VALUE\r
2143 PRNAM:  PUSHJ     P,PRNAME\r
2144 PRNUM:  PUSHJ     P,SPACES\r
2145 PRNUM0:   MOVE  V,PRNUM2                ;LOAD BYTE POINTER TO RH. OF W\r
2146         MOVNI     D,6           ;LOAD CHAR. COUNT\r
2147 PRNUM1:   ILDB  T,V             ;LOAD DIGIT TO BE OUTPUT\r
2148         ADDI    T,60            ;CONVERT FROM BINARY TO ASCII\r
2149         PUSHJ     P,TYPE2\r
2150         AOJL    D,PRNUM1                ;JUMP IF MORE DIGITS REMAIN\r
2151         POPJ    P,\r
2152 \r
2153 PRNUM2:   XWD   220300,W\r
2154 \r
2155 ;YE OLDE RECURSIVE NUMBER PRINTER\r
2156 ;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T\r
2157 \r
2158 RCNUM:  IDIVI Q,12              ;RADIX DECIMAL\r
2159         ADDI A,"0"\r
2160         HRLM A,(P)\r
2161         SKIPE Q\r
2162         PUSHJ P,RCNUM\r
2163         HLRZ T,(P)\r
2164         JRST TYPE2\r
2165 \r
2166 \f;PRINT FOUR SPACES\r
2167 \r
2168 SPACES:   PUSHJ     P,SP1\r
2169 SP1:    PUSHJ     P,SPACE\r
2170 SPACE:  MOVEI     T,40\r
2171         JRST    TYPE2\r
2172 \r
2173 ;SYMBOL PRINT - RADIX 50\r
2174 \r
2175 ;       ACCUMULATORS USED: D,T\r
2176 \r
2177 PRNAME:   MOVE  T,C             ;LOAD SYMBOL\r
2178         TLZ     T,740000                ;ZERO CODE BITS\r
2179         MOVNI     D,6           ;LOAD CHAR. COUNT\r
2180 SPT:    IDIVI     T,50          ;THE REMAINDER IS THE NEXT CHAR.\r
2181         HRLM    V,(P)           ;STORE IN LH. OF PUSHDOWN LIST\r
2182         AOSGE     D                     ;SKIP IF NO CHARS. REMAIN\r
2183         PUSHJ     P,SPT         ;RECURSIVE CALL FOR NEXT CHAR.\r
2184         HLRZ    T,(P)           ;LOAD FROM LH. OF PUSHDOWN LIST\r
2185         JUMPE     T,TYPE                ;BLANK\r
2186         ADDI    T,60-1\r
2187         CAILE     T,71\r
2188         ADDI    T,101-72\r
2189         CAILE     T,132\r
2190         SUBI    T,134-44\r
2191         CAIN    T,43\r
2192         MOVEI     T,56\r
2193         JRST    TYPE2\r
2194 ;PRINT A WORD OF SIXBIT CHARACTERS IN AC W\r
2195 \r
2196 ;       ACCUMULATORS USED: Q,T,D\r
2197 \r
2198 PWORD:  MOVNI     Q,6           ;SET CHARACTER COUNT TO SIX\r
2199 PWORD1:   MOVE  D,LSTPT         ;ENTER HERE WITH Q PRESET\r
2200 PWORD2:   ILDB  T,D             ;LOAD NEXT CHAR. TO BE OUTPUT\r
2201         PUSHJ     P,TYPE                ;OUTPUT CHARACTER\r
2202         AOJL    Q,PWORD2\r
2203         POPJ    P,\r
2204 \r
2205 \f;ERROR MESSAGE PRINT SUBROUTINE\r
2206 \r
2207 ;       FORM OF CALL:\r
2208 \r
2209 ;       JSP     A,ERRPT\r
2210 ;       SIXBIT    /<MESSAGE>/\r
2211 \r
2212 ;       ACCUMULATORS USED: T,V,C,W\r
2213 \r
2214 ERRPT:  TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
2215         PUSHJ   P,CRLF          ;ROOM AT THE TOP\r
2216         PUSHJ   P,PRQ           ;START OFF WITH ?\r
2217 ERRPT0:   PUSH  P,Q             ;SAVE Q\r
2218         SKIPA     V,ERRPT5\r
2219 ERRPT1:   PUSHJ     P,TYPE\r
2220         ILDB    T,V\r
2221         CAIN    T,40\r
2222         JRST    ERRPT4\r
2223         CAIN    T,5\r
2224         JRST    ERRPT9\r
2225         CAIE    T,3\r
2226         JRST    ERRPT1\r
2227         SKIPN     C,DTIN\r
2228         JRST    ERRPT4\r
2229         MOVNI     Q,14\r
2230         MOVEI     W,77\r
2231 ERRPT2:   TDNE  C,W\r
2232         JRST    ERRPT3\r
2233         LSH     W,6\r
2234         AOJL    Q,ERRPT2\r
2235 ERRPT3:   MOVE  W,ERRPT6\r
2236         PUSHJ     P,PWORD1\r
2237         SKIPN     W,DTIN1\r
2238         JRST    ERRPT4\r
2239         LSH     W,-6\r
2240         TLO     W,160000\r
2241         MOVNI     Q,4\r
2242         PUSHJ     P,PWORD1\r
2243 ERRPT4:   PUSHJ     P,CRLF\r
2244 ERRP41: POP     P,Q\r
2245         TLZ     F,FCONSW        ;ONE ERROR PER CONSOLE\r
2246         AOS     V               ;PROGRAM BUMMERS BEWARE:\r
2247         JRST    @V              ;V HAS AN INDEX OF A\r
2248 \r
2249 ERRPT5:   POINT     6,0(A)\r
2250 ERRPT6:   SIXBIT    / FILE /\r
2251 \r
2252 \fERRPT8:        TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
2253         PUSHJ   P,PRQ           ;START WITH ?\r
2254         CAIGE   T,140           ;IS IT A NON-PRINTING CHAR?\r
2255         CAIL    T,40\r
2256         JRST    ERRP8\r
2257         PUSH    P,T\r
2258         MOVEI     T,136         ;UP ARROW\r
2259         PUSHJ     P,TYPE2\r
2260         POP     P,T\r
2261         ADDI    T,100           ;CONVERT TO PRINTING CHAR.\r
2262 ERRP8:  PUSHJ     P,TYPE2\r
2263 ERRPT7:   PUSHJ     P,SPACE\r
2264         JRST    ERRPT0\r
2265 \r
2266 ERRPT9:   MOVEI     V,@V\r
2267         PUSH    P,V\r
2268         JSP     A,ERRPT7\r
2269         SIXBIT  ?ILLEGAL -LOADER@?\r
2270         POP     P,V\r
2271         JRST    ERRP41\r
2272 \r
2273 ;PRINT QUESTION MARK\r
2274 \r
2275 PRQ:    PUSH    P,T             ;SAVE\r
2276         MOVEI   T,"?"           ;PRINT ?\r
2277         PUSHJ   P,TYPE2         ;...\r
2278         POP     P,T             ;RESTORE\r
2279         POPJ    P,              ;RETURN\r
2280 \r
2281 \f;INPUT - OUTPUT INTERFACE\r
2282 \r
2283 ;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W\r
2284 IFE K,<\r
2285 WORDPR: PUSHJ   P,WORD          ;GET FIRST WORD OF PAIR\r
2286         MOVE    C,W             ;KEEP IT HANDY>\r
2287 WORD:   SOSG    BUFR2           ;SKIP IF BUFFER NOT EMPTY\r
2288         JRST    WORD2\r
2289 WORD1:  ILDB    W,BUFR1         ;PICK UP 36 BIT WORD\r
2290         POPJ    P,\r
2291 \r
2292 WORD2:  INPUT     1,                    ;GET NEXT BUFFER LOAD\r
2293         STATUS    1,W           ;GET DEVICE STATUS FROM MONITOR\r
2294         TRNE    W,IODEND                ;TEST FOR EOF\r
2295         JRST    EOF             ;END OF FILE EXIT\r
2296         TRNN    W,IOBAD         ;TEST FOR DATA ERROR\r
2297         JRST    WORD1           ;DATA OK - CONTINUE LOADING\r
2298         JSP     A,ERRPT         ;DATA ERROR - PRINT MESSAGE\r
2299         SIXBIT    /INPUT ERROR#/\r
2300 IFN HE,<SETOM RESET>\r
2301         JRST    LD2             ;GO TO ERROR RETURN\r
2302 ;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII\r
2303 ;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT\r
2304 ;DEVICE\r
2305 \r
2306 CRLFLF:   PUSHJ     P,CRLF\r
2307 FCRLF:  TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
2308 CRLF:   MOVEI     T,15          ;CARRIAGE RETURN LINE FEED\r
2309         PUSHJ     P,TYPE2\r
2310         MOVEI     T,12-40               ;LINE FEED IN PSEUDO SIXBIT\r
2311 TYPE:   MOVEI     T,40(T)               ;CONVERT SIXBIT TO ASCII\r
2312 TYPE2:  TLNN    N,AUXSWI        ;IS THER AN AUXILIARY DEVICE?\r
2313         JRST    TYPE3           ;NO, DONT OUTPUT TO IT\r
2314         TLON    N,AUXSWE        ;IS AUX. DEV. ENTERED?\r
2315         PUSHJ   P,IAD2          ;NOPE, DO SO!\r
2316         SOSG    ABUF2           ;SPACE LEFT IN BUFFER?\r
2317         OUTPUT  2,              ;CREATE A NEW BUFFER\r
2318         IDPB    T,ABUF1         ;DEPOSIT CHARACTER\r
2319         TLNN    F,FCONSW        ;FORCE OUTPUT TO CONSOLE TOO?\r
2320         POPJ    P,              ;NOPE\r
2321 IFE HE,<\r
2322 TYPE3:  SKIPN   BUFO2           ;END OF BUFFER\r
2323         OUTPUT  3,              ;FORCE OUTPUT NOW\r
2324         IDPB    T,BUFO1         ;DEPOSIT CHARACTER\r
2325         CAIN    T,12            ;END OF LINE\r
2326         OUTPUT  3,              ;FORCE AN OUTPUT\r
2327         >\r
2328 IFN HE, <\r
2329 TYPE3:  ROT T,-7\r
2330         MOVEM T,FOO1#\r
2331         MOVEI T,FOO1\r
2332         CALLI T,CDDTOUT>\r
2333         POPJ    P,\r
2334 \r
2335 \fSE3:   XWD     2,2             ;SYMBOL POINTER INCREMENT\r
2336 LSTPT:  POINT     6,W           ;CHARACTER POINTER TO W\r
2337 PDLPT:  XWD     -41,PDLST-1;    INITIAL PUSHDOWN POINTER\r
2338 COMM:   SQUOZE    0,.COMM.\r
2339 PDSAV:  0                               ;SAVED PUSHDOWN POINTER\r
2340 COMSAV:   0                             ;LENGTH OF COMMON\r
2341 MDG:    0                       ;COUNTER FOR MUL DEF GLOBALS\r
2342 PDLST:  IFE HE,<BLOCK   40>\r
2343 IFN FAILSW,<LINKTB:     BLOCK 21>\r
2344 \r
2345 F.C:    0\r
2346         0       ;STORE N HERE\r
2347         0       ;STORE X HERE\r
2348         0       ;STORE H HERE\r
2349         0       ;STORE S HERE\r
2350         0       ;STORE R HERE\r
2351 B.C:    0\r
2352 IFE HE,<\r
2353 F.I:    0                       ;INITIAL F - FLAGS\r
2354         0                       ;INITIAL N\r
2355         XWD     V,LDEND         ;INITIAL X - LOAD PROGRAM AFTER LOADER\r
2356         EXP     LDEND+JOBPRO    ;INITIAL H - INITIAL PROG BREAK\r
2357         0                       ;INITIAL S\r
2358         XWD     W,JOBPRO        ;INITIAL R - INITIAL RELOC\r
2359         0                       ;INITIAL B\r
2360         >\r
2361 \f;BUFFER HEADERS AND HEADER HEADERS\r
2362 \r
2363 IFE HE,<\r
2364 BUFO:   0                               ;CONSOLE INPUT HEADER HEADER\r
2365 BUFO1:  0\r
2366 BUFO2:  0\r
2367 \r
2368 BUFI:   0                               ;CONSOLE OUTPUT HEADER HEADER\r
2369 BUFI1:  0\r
2370 BUFI2:  0\r
2371         >\r
2372 ABUF:   0                       ;AUXILIARY OUTPUT HEADER HEADER\r
2373 ABUF1:  0\r
2374 ABUF2:  0\r
2375 \r
2376 BUFR:   0                               ;BINARY INPUT HEADER HEADER\r
2377 BUFR1:  0\r
2378 BUFR2:  0\r
2379 \r
2380 DTIN:   0                               ;DECTAPE INPUT BLOCK\r
2381 IFE HE,<DTIN1:  0>\r
2382 IFN HE,<DTIN1:  SIXBIT /REL   />\r
2383         0\r
2384 DTIN2:  0\r
2385 \r
2386 DTOUT:  0                               ;DECTAPE OUTPUT BLOCK\r
2387 DTOUT1:   0\r
2388         0\r
2389         0\r
2390 \r
2391         TTYL=52                 ;TWO TTY BUFFERS\r
2392 IFE K,< BUFL=406                ;TWO DTA BUFFERS FOR LOAD>\r
2393 IFN K,< BUFL=203                ;ONE DTA BUFFER FOR LOAD>\r
2394         ABUFL=203               ;ONE DTA BUFFER FOR AUX DEV\r
2395 IFN HE,<BUFL=406>\r
2396 IFE HE,<\r
2397 TTY1:   BLOCK     TTYL          ;TTY BUFFER AREA\r
2398         >\r
2399 BUF1:   BLOCK   BUFL            ;LOAD BUFFER AREA\r
2400 AUX:    BLOCK   ABUFL           ;AUX BUFFER AREA\r
2401 ZEROS:  REPEAT 4,<0>\r
2402 \r
2403 IFN RPGSW,<CTLIN:       BLOCK 3\r
2404 CTLNAM: BLOCK 3\r
2405 CTLBUF: BLOCK 203+1\r
2406 >\r
2407 \fIOBKTL=40000\r
2408 IOIMPM=400000\r
2409         IODERR=200000\r
2410         IODTER=100000\r
2411         IODEND=20000\r
2412 \r
2413 IOBAD=IODERR+IODTER+IOBKTL+IOIMPM\r
2414 \r
2415 IFE HE,<\r
2416         INTERN    PWORD,DTIN,DTOUT,LDEND\r
2417         INTERN    WORD,LD,BEG,PDLST,LOAD\r
2418         INTERN    CRLF,TYPE,PMS,PRMAP\r
2419         INTERN    F,P,X,H,S,R,B,N,T,V,W,C,E,Q,A,D\r
2420         >\r
2421 IFN HE,<\r
2422 INTERNAL .LOAD, .PRMAP, PMS, .NAME, ERRPT8\r
2423 EXTERNAL .GETF\r
2424         >\r
2425 \r
2426         EXTERN  JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41\r
2427 IFE HE,<\r
2428 IFN STANSW,<PATCH:      BLOCK   20              ;STANFORD HAS SEMI-INFINITE CORE>\r
2429 >\r
2430 \r
2431 ;END HERE IF 1K LOADER REQUESTED.\r
2432 IFN K,  <LITS:  LIT\r
2433         VAR\r
2434 IFE HE, <\r
2435 LDEND:  END     LD>\r
2436 IFN HE, <\r
2437 LDEND:  END >>\r
2438 \r
2439 \f;HERE BEGINS FORTRAN FOUR LOADER\r
2440 \r
2441 F4LD:\r
2442         HRRZ    V,R;            SET PROG BREAK INTO V\r
2443         MOVEM   V,LLC;          SAVE FIRST WORD ADDRESS\r
2444         MOVEI   W,-2(S);        GENERATE TABLES\r
2445         TLO     N,F4SW\r
2446         HRRZM   W,MLTP;         MADE LABELS\r
2447         HRRZM   W,PLTP;         PROGRAMMER LABELS\r
2448         ADD     W,[POINT 1,1];  GENERATE BIT-BYTE POINTER\r
2449         MOVEM   W,BITP\r
2450         MOVEM   W,SDSTP;        FIRST DATA STATEMENT\r
2451         AOS     SDSTP;\r
2452         MOVE    W,[JRST ALLOVE] ;LAST DATA STATEMENT\r
2453         MOVEM   W,(S)\r
2454         HRREI   W,-^D36;        BITS PER WORDUM\r
2455         MOVEM   W,BITC;         BIT COUNT\r
2456         PUSHJ P,BITWX+1         ;MAKE SURE OF ENOUGH SPACE\r
2457 \r
2458 TEXTR:  PUSHJ   P,WORD;         TEXT BY DEFAULT\r
2459         HLRZ    C,W\r
2460         CAIN    C,-1\r
2461         JRST    HEADER;         HEADER\r
2462         MOVEI   C,1;            RELOCATABLE\r
2463         PUSHJ   P,BITW;         SHOVE AND STORE\r
2464         JRST    TEXTR;          LOOP FOR NEXT WORD\r
2465 \r
2466 ABS:    SOSG    BLKSIZ; MORE TO GET\r
2467         JRST    TEXTR;          NOPE\r
2468 ABSI:   PUSHJ   P,WORD;\r
2469         MOVEI   C,0;            NON-RELOCATABLE\r
2470         PUSHJ   P,BITW;         TYPE 0\r
2471         JRST    ABS\r
2472 \r
2473 \f;PROCESS TABLE ENTRIES\r
2474 \r
2475 MDLB:   TLNE    F,FULLSW+SKIPSW;        MADE LABEL PROC\r
2476         JRST    GLOBDF;         NO ROOM AT THE IN\r
2477         HLRZ    C,MLTP;         GET PRESENT SIZE\r
2478         CAMGE   C,BLKSIZ;       IF NEW SIZE BIGGER, STR-R-RETCH\r
2479         PUSHJ   P,SMLT\r
2480         HRRZ    C,MLTP;         GET BASE\r
2481 MLPLC:  ADD     C,BLKSIZ;       MAKE INDEX\r
2482         TLNN    F,FULLSW+SKIPSW;        DONT LOAD\r
2483         HRRZM   V,(C);          PUT AWAY DEFINITION\r
2484 GLOBDF: PUSHJ   P,WORD\r
2485         TLNE    F,FULLSW+SKIPSW ;SKIPPING THIS PROG?\r
2486         JRST    TEXTR           ;YES, DON'T DEFINE\r
2487         MOVEI   C,(V);          AND LOC\r
2488         EXCH    W,C\r
2489         PUSHJ   P,SYMXX;        PUT IN DDT-SYMBOL TABLE\r
2490         PUSHJ   P,BITWX+1\r
2491         JRST    TEXTR\r
2492 \r
2493 PLB:    TLNE    F,FULLSW+SKIPSW\r
2494         JRST    GLOBDF\r
2495         HLRZ    C,PLTP;         PRESENT SIZE\r
2496         CAMGE   C,BLKSIZ\r
2497         PUSHJ   P,SPLT\r
2498         HRRZ    C,PLTP\r
2499         JRST    MLPLC\r
2500 \r
2501 \f;STORE WORD AND SET BIT TABLE\r
2502 \r
2503 BITW:   TLNE    F,FULLSW+SKIPSW;        WE DONT LOAD THIS\r
2504         POPJ    P,;\r
2505         MOVEM   W,@X;           STORE AWAY OFFSET\r
2506         IDPB    C,BITP;         STORE BIT\r
2507         AOSGE   BITC;           STEP BIT COUNT\r
2508         JRST    BITWX;          SOME MORE ROOM LEFT\r
2509         HRREI   C,-^D36;        RESET COUNT\r
2510         MOVEM   C,BITC\r
2511         SOS     PLTP\r
2512         SOS     BITP;           ALL UPDATED\r
2513 IFE EXPAND,<HRL C,MLTP\r
2514         SOS MLTP\r
2515         HRR     C,MLTP>\r
2516 IFN EXPAND,<HRRZ        C,MLTP;         TO ADDRESS\r
2517                 SUBI C,1\r
2518                 CAIG C,@X\r
2519                 PUSHJ P,[PUSHJ P,XPAND\r
2520                         POPJ P,\r
2521                         ADDI C,2000\r
2522                         JRST POPJM2]\r
2523                 SOS MLTP\r
2524                 HRLI C,1(C)>\r
2525         HRRZ    T,SDSTP;        GET DATA POINTER\r
2526         BLT     C,-1(T);        MOVE DOWN LISTS\r
2527 BITWX:  AOS     V;              STEP LOADER LOCATION\r
2528         HRRZ    T,MLTP\r
2529         CAIG    T,@X;           OVERFLOW CHECK\r
2530 IFE EXPAND,<TLO F,FULLSW>\r
2531 IFN EXPAND,<PUSHJ P,    [PUSHJ P,XPAND\r
2532                         TLOA F,FULLSW\r
2533                         JRST POPJM3\r
2534                         POPJ P,]>\r
2535         POPJ    P,;\r
2536 \r
2537 SMLT:   SUB     C,BLKSIZ;       STRETCH\r
2538         MOVS    W,MLTP          ;LEFT HALF HAS OLD BASE\r
2539         ADD     C,MLTP          ;RIGHT HALF HAS NEW BASE\r
2540 IFN EXPAND,<    HRRZS C ;GET RID OF COUNT\r
2541                 CAIG C,@X\r
2542                 PUSHJ P,[PUSHJ P,XPAND\r
2543                         POPJ P,\r
2544                         ADD W,[XWD 2000,0]\r
2545                         ADDI C,2000\r
2546                         JRST POPJM2]>\r
2547         HRRM C,MLTP             ;PUT IN NEW MLTP\r
2548         HLL     C,W             ;FORM BLT POINTER\r
2549         ADDI    W,(C)           ;LAST ENTRY OF MLTP\r
2550         HRL     W,BLKSIZ        ;NEW SIZE OF MLTP\r
2551         HLLM    W,MLTP          ;...\r
2552 SLTC:   BLT     C,0(W);         MOVE DOWN (UP?)\r
2553         POPJ    P,;\r
2554 \r
2555 SPLT:   SUB     C,BLKSIZ\r
2556         MOVS    W,MLTP;\r
2557         ADDM    C,PLTP\r
2558         ADD     C,MLTP\r
2559 IFN EXPAND,<    HRRZS C\r
2560                 CAIG C,@X\r
2561                 PUSHJ P,[PUSHJ P,XPAND\r
2562                         POPJ P,\r
2563                         ADD W,[XWD 2000,0]\r
2564                         ADDI C,2000\r
2565                         JRST POPJM2]>\r
2566         HRRM C,MLTP             ;PUT IN NEW MLTP\r
2567         HLL     C,W\r
2568         HLRZ    W,PLTP          ;OLD SIZE OF PL TABLE\r
2569         ADD     W,PLTP          ;NEW BASE OF PL TABLE\r
2570         HRL     W,BLKSIZ        ;NEW SIZE OF PL TABLE\r
2571         HLLM    W,PLTP          ;INTO POINTER\r
2572         JRST    SLTC\r
2573 \r
2574 PT1:    0\r
2575 \r
2576 \r
2577 \f;PROCESS END CODE WORD\r
2578 \r
2579 ENDS:   PUSHJ   P,WORD;         GET STARTING ADDRESS\r
2580         TLNE F,SKIPSW\r
2581         JRST ENDS1      ;FOOBAZ!!!!!!!!\r
2582         JUMPE   W,ENDS1;        NOT MAIN\r
2583         ADDI    W,(R);          RELOCATION OFFSET\r
2584         TLNN    N,ISAFLG;       IGNORE STARTING ADDRESS\r
2585         HRR     F,W;            SET SA\r
2586 IFN STANSW,<MOVE W,1(N) ;SET UP NAME\r
2587         PUSHJ P,LDNAM>\r
2588 ENDS1:  PUSHJ   P,WORDPR        ;DATA STORE SIZE\r
2589         HRRZM   C,PTEMP         ;NUMBER OF PERMANENT TEMPS\r
2590         MOVEM   V,CCON;         START OF CONSTANTS AREA\r
2591         JUMPE   W,E1;           NULL\r
2592         MOVEM   W,BLKSIZ        ;SAVE COUNT\r
2593         MOVEI   W,0(V)          ;DEFINE CONST.\r
2594         MOVE    C,CNR50         ;...\r
2595         TLNN F,SKIPSW!FULLSW\r
2596         PUSHJ   P,SYMPT         ;...\r
2597         PUSHJ   P,GSWD          ;STORE CONSTANT TABLE\r
2598 E1:     MOVEI   W,0(V);         GET LOADER LOC\r
2599         EXCH    W,PTEMP;        STORE INTO PERM TEMP POINTER\r
2600         ADD     W,PTEMP;        FORM TEMP TEMP ADDRESS\r
2601         MOVEM   W,TTEMP;        POINTER\r
2602         MOVEM   V,GSTAB;        STORE LOADER LOC IN GLOBSUB\r
2603         MOVE    C,TTR50         ;DEFINE %TEMP.\r
2604         TLNE F,SKIPSW!FULLSW\r
2605         JRST E1A\r
2606         PUSHJ   P,SYMPT         ;...\r
2607         MOVE    C,PTR50         ;DEFINE (IF EXTANT) TEMP.\r
2608         MOVEI   W,0(V)          ;...\r
2609         CAME    W,TTEMP         ;ANY PERM TEMPS?\r
2610         PUSHJ   P,SYMPT         ;YES, DEFINE\r
2611 E1A:    PUSHJ   P,WORD;         NUMBER OF GLOBSUBS\r
2612         JUMPE   W,E11\r
2613         MOVEM   W,BLKSIZ        ;SIZE OF GLOBSUB\r
2614         PUSHJ   P,GSWD          ;STORE GLOBSUB TABLE\r
2615 E11:    MOVEM   V,STAB;         SCALARS\r
2616         PUSHJ   P,WORD;         HOW MANY?\r
2617         JUMPE   W,E21;          NONE\r
2618         PUSHJ   P,GSWDPR        ;STORE SCALAR TABLE\r
2619 E21:    MOVEM   V,ATAB;         ARRAY POINTER\r
2620         PUSHJ   P,WORD;         COMMENTS FOR SCALARS APPLY\r
2621         JUMPE   W,E31\r
2622         PUSHJ   P,GSWDPR        ;STORE ARRAY TABLE\r
2623 E31:    MOVEM   V,AOTAB;        ARRAYS OFFSET\r
2624         PUSHJ   P,WORD;         SAME COMMENTS AS ABOVE\r
2625         JUMPE   W,E41\r
2626         PUSHJ   P,GSWDPR        ;STORE ARRAY OFFSET TABLE\r
2627 E41:    PUSHJ   P,WORD;         TEMP, SCALAR, ARRAY SIZE\r
2628         TLNE    F,FULLSW!SKIPSW ;SKIPPING THIS PROG?\r
2629         MOVEI   W,0             ;DON'T ACCEPT GLOB SUBPROG REQUESTS\r
2630         MOVEM   V,CTAB;         SETUP COMMON TABLE POINTER\r
2631         ADD     W,GSTAB;        GLOBAL SUBPROG BASE\r
2632         MOVEM   W,COMBAS;       START OF COMMON\r
2633         PUSHJ   P,WORD;         COMMON BLOCK SIZE\r
2634         HRRZM   W,BLKSIZ\r
2635         JUMPE   W,PASS2;        NO COMMON\r
2636 COMTOP: PUSHJ   P,WORDPR        ;GET A COMMON PAIR\r
2637         PUSHJ   P,SDEF;         SEARCH\r
2638         JRST    COMYES;         ALREADY THERE\r
2639         HRLS    W\r
2640         HRR     W,COMBAS;       PICK UP THIS COMMON LOC\r
2641         TLNN F,SKIPSW!FULLSW\r
2642         PUSHJ   P,SYMXX;        DEFINE IT\r
2643         MOVS    W,W;            SWAP HALFS\r
2644         ADD     W,COMBAS;       UPDATE COMMON LOC\r
2645         HRRM    W,COMBAS;       OLD BASE PLUS NEW SIZE\r
2646         HLRZS   W;              RETURN ADDRESS\r
2647         TLZ     C,400000\r
2648         TLNN F,SKIPSW!FULLSW\r
2649         PUSHJ   P,SYMXX\r
2650 COMCOM: PUSHJ   P,CWSTWX        ;STORE A WORD PAIR\r
2651         SOS     BLKSIZ\r
2652         SOSLE   BLKSIZ\r
2653         JRST    COMTOP\r
2654         JRST    PASS2\r
2655 \r
2656 COMYES: TLNE F,SKIPSW\r
2657         JRST COMCOM     ;NO ERRORS IF SKIPPING\r
2658         HLRZ    C,2(A);         PICK UP DEFINITION\r
2659         CAMLE   W,C;            CHECK SIZE\r
2660         JRST    ILC;            ILLEGAL COMMON\r
2661         MOVE    C,1(A);         NAME\r
2662         HRRZ    W,2(A); BASE\r
2663         JRST    COMCOM\r
2664 \r
2665 \f\r
2666 PRSTWX: PUSHJ   P,WORDPR        ;GET A WORD PAIR\r
2667 CWSTWX: EXCH    C,W             ;SPACE TO STORE FIRST WORD OF PAIR?\r
2668         PUSHJ   P,WSTWX         ;...\r
2669         EXCH    C,W             ;THERE WAS; IT'S STORED\r
2670 WSTWX:  TLNE    F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD?\r
2671         POPJ    P,              ;NOPE, RETURN\r
2672         MOVEM   W,@X            ;YES, STORE IT.\r
2673         JRST    BITWX           ;TELL THE TABLES ABOUT IT; THEN RETURN\r
2674 \r
2675 \r
2676 GSWD:   PUSHJ   P,WORD          ;GET WORD FROM TABLE\r
2677         PUSHJ   P,WSTWX         ;STASH IT\r
2678         SOSE    BLKSIZ          ;FINISHED?\r
2679         JRST    GSWD            ;NOPE, LOOP\r
2680         POPJ    P,              ;TRA 1,4\r
2681 \r
2682 GSWDPR: MOVEM   W,BLKSIZ        ;KEEP COUNT\r
2683 GSWDP1: PUSHJ   P,PRSTWX        ;GET AND STASH A PAIR\r
2684         SOS     BLKSIZ          ;FINISHED?\r
2685         SOSLE   BLKSIZ          ;...\r
2686         JRST    GSWDP1          ;NOPE, LOOP\r
2687         POPJ    P,              ;TRA 1,4\r
2688 \r
2689 \f;BEGIN HERE PASS2 TEXT PROCESSING\r
2690 \r
2691 PASS2:  ADDI V,(X)\r
2692         MOVEM V,TOPTAB  ;SAVE FOR OVERLAP CHECKING\r
2693         TLNE    F,FULLSW+SKIPSW;        ABORT?\r
2694         JRST    ALLOVE;         YES\r
2695         MOVE    V,LLC           ;PICK UP PROGRAM ORIGIN\r
2696         CAML    V,CCON          ;IS THIS A PROGRAM?\r
2697         JRST    FBLKD           ;NO, GO LOOK FOR FIRST BLK DATA\r
2698         TLOE    N,PGM1          ;YES, IS THIS FIRST F4 PROG?\r
2699         JRST    NOPRG           ;NO\r
2700         HRR     W,COMBAS        ;YES, PLACE PROG BREAK IN LH\r
2701 IFE L,< HRLM    W,JOBCHN(X)     ;FOR CHAIN>\r
2702 NOPRG:  HRRZ    W,PLTP;         GET PROG TABLE BASE\r
2703         HLRZ    C,PLTP;         AND SIZE\r
2704         ADD     W,C;            COMPUTE END OF PROG TABLE\r
2705         ADD     W,[POINT 1,1];  AND BEGINNING OF BIT TABLE\r
2706         EXCH    W,BITP;         SWAP POINTERS\r
2707 PASS2B: ILDB    C,BITP;         GET A BIT\r
2708         JUMPE   C,PASS2C;       NO PASS2 PROCESSING\r
2709         PUSHJ   P,PROC;         PROCESS A TAG\r
2710         JRST    PASS2B;         MORE TO COME\r
2711         JRST    ENDTP;\r
2712 \r
2713 PROC:   LDB     C,[POINT 6,@X,23];      TAG\r
2714         SETZM   MODIF;          ZERO TO ADDRESS MODIFIER\r
2715         TRZE    C,40;\r
2716         AOS     MODIF\r
2717         HRLM    C,ENDTAB;       ERROR SETUP\r
2718         MOVEI   W,TABDIS;       HEAD OF TABLE\r
2719         HLRZ    T,(W);          GET ENTRY\r
2720         CAME    T,C;            CHECK\r
2721         AOJA    W,.-2\r
2722         HRRZ    W,(W);          GET DISPATCH\r
2723         LDB     C,[POINT 12,@X,35]\r
2724         JRST    (W);            DISPATCH\r
2725 \r
2726 TABDIS: XWD 11,PCONS;           CONSTANTS\r
2727         XWD 06,PGS;             GLOBAL SUBPROGRAMS\r
2728         XWD 20,PST;             SCALARS\r
2729         XWD 22,PAT;             ARRAYS\r
2730         XWD 01,PATO;            ARRAYS OFFSET\r
2731         XWD 00,PPLT;            PROGRAMMER LABELS\r
2732         XWD 31,PMLT;            MADE LABESL\r
2733         XWD 26,PPT;             PERMANENT TEMPORARYS\r
2734         XWD 27,PTT;             TEMPORARY TEMPORARYS\r
2735 ENDTAB: XWD 00,LOAD4A;          ERRORS\r
2736 \r
2737 PASS2C: PUSHJ   P,PASS2A\r
2738         JRST    PASS2B\r
2739         JRST    ENDTP\r
2740 \r
2741 \f;DISPATCH ON A HEADER\r
2742 \r
2743 HEADER: CAMN    W,[EXP -2];     END OF PASS ONE\r
2744         JRST    ENDS\r
2745         LDB     C,[POINT 12,W,35];      GET SIZE\r
2746         MOVEM   C,BLKSIZ\r
2747         ANDI    W,770000\r
2748         JUMPE   W,PLB;  PROGRAMMER LABEL\r
2749         CAIN    W,500000;       ABSOLUTE BLOCK\r
2750         JRST    ABSI;\r
2751         CAIN    W,310000;       MADE LABEL\r
2752         JRST    MDLB;           MADE LABEL\r
2753         CAIN    W,600000\r
2754         JRST    GLOBDF\r
2755         CAIN    W,700000;       DATA STATEMENT\r
2756         JRST    DATAS\r
2757         JRST    LOAD4A;         DATA STATEMENTS WILL GO HERE\r
2758 \r
2759 TOPTAB: 0       ;TOP OF TABLES\r
2760 CTAB:   0;      COMMON\r
2761 ATAB:   0;      ARRAYS\r
2762 STAB:   0;      SCALARS\r
2763 GSTAB:  0;      GLOBAL SUBPROGS\r
2764 AOTAB:  0;      OFFSET ARRAYS\r
2765 CCON:   0;      CONSTANTS\r
2766 PTEMP:  0;      PERMANENT TEMPS\r
2767 TTEMP:  0;      TEMPORARY TEMPS\r
2768 COMBAS: 0;      BASE OF COMMON\r
2769 LLC:    0;      PROGRAM ORIGIN\r
2770 BITP:   0;      BIT POINTER\r
2771 BITC:   0;      BIT COUNT\r
2772 PLTP:   0;      PROGRAMMER LABEL TABLE\r
2773 MLTP:   0;      MADE LABEL TABLE\r
2774 SDS:    0       ;START OF DATA STATEMENTS\r
2775 SDSTP:  0       ;START OF DATA STATEMENTS POINTER\r
2776 BLKSIZ: 0;      BLOCK SIZE\r
2777 MODIF:  0;      ADDRESS MODIFICATION +1\r
2778 TTR50:  XWD     136253,114765   ;RADIX 50 %TEMP.\r
2779 PTR50:  XWD     100450,614765   ;RADIX 50 TEMP.\r
2780 CNR50:  XWD     112320,235025   ;RADIX 50 CONST.\r
2781 \r
2782 \f;ROUTINES TO PROCESS POINTERS\r
2783 \r
2784 PCONS:  ADD     C,CCON;         GENERATE CONSTANT ADDRESS\r
2785         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
2786 \r
2787 PSTA:   PUSHJ   P,SWAPSY        ;NON-COMMON SCALARS AND ARRAYS\r
2788         ADDI    C,(R);          RELOCATE\r
2789 PCOM1:  PUSHJ   P,SYDEF         ;...\r
2790 PCOMX:  ADD     C,MODIF         ;ADDR RELOC FOR DP\r
2791         HRRM    C,@X;           REPLACE ADDRESS\r
2792 PASS2A: AOS     V;              STEP READOUT POINTER\r
2793         CAML    V,CCON          ;END OF PROCESSABLES?\r
2794 CPOPJ1: AOS     (P);            SKIP\r
2795         POPJ    P,;\r
2796 \r
2797 PAT:    SKIPA   W,ATAB          ;ARRAY TABLE BASE\r
2798 PST:    MOVE    W,STAB          ;SCALAR TABLE  BASE\r
2799         ROT     C,1             ;SCALE BY 2\r
2800         ADD     C,W             ;ADD IN TABLE BASE\r
2801         ADDI    C,-2(X);        TABLE ENTRY\r
2802         HLRZ    W,(C);          CHECK FOR COMMON\r
2803         JUMPE   W,PSTA;         NO COMMON\r
2804         PUSHJ   P,COMDID        ;PROCESS COMMON\r
2805         JRST    PCOM1\r
2806 \r
2807 COMDID: LSH     W,1             ;PROCESS COMMON TABLE ENTRIES\r
2808         ADD     W,CTAB;         COMMON TAG\r
2809         ADDI    W,-2(X);        OFFSET\r
2810         PUSHJ   P,SWAPSY;       GET SYMBOL AND SET TO DEFINED\r
2811         ADD     C,1(W);         BASE OF COMMON\r
2812         POPJ    P,              ;RETURN\r
2813 \r
2814 PATO:   ROT     C,1\r
2815         ADD     C,AOTAB;        ARRAY OFFSET\r
2816         ADDI    C,-2(X);        LOADER OFFSET\r
2817         MOVEM   C,CT1;          SAVE CURRENT POINTER\r
2818         HRRZ    C,1(C);         PICK UP REFERENCE POINTER\r
2819         ANDI    C,7777; MASK TO ADDRESS\r
2820         ROT     C,1;            ALWAYS A ARRAY\r
2821         ADDI    C,-2(X)\r
2822         ADD     C,ATAB\r
2823         HLRZ    W,(C);          COMMON CHECK\r
2824         JUMPE   W,NCO\r
2825         PUSHJ   P,COMDID        ;PROCESS COMMON\r
2826         PUSHJ   P,SYDEF\r
2827         MOVE    C,CT1\r
2828         HRRE    C,(C)\r
2829         ADD     C,1(W)\r
2830         JRST    PCOMX\r
2831 \r
2832 \fNCO:   PUSHJ   P,SWAPSY;\r
2833         ADDI    C,(R)           ;DEFINE SYMBOL IN TRUE LOC\r
2834         PUSHJ   P,SYDEF         ;...\r
2835         MOVE    C,CT1\r
2836         HRRZ    C,(C)           ;OFFSET ADDRESS PICKUP\r
2837         ADDI    C,(R)           ;WHERE IT WILL BE\r
2838         JRST    PCOMX           ;STASH ADDR AWAY\r
2839 \r
2840 PTT:    ADD     C,TTEMP;        TEMPORARY TEMPS\r
2841         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
2842 \r
2843 PPT:    ADD     C,PTEMP;        PERMANENT TEMPS\r
2844         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
2845 \r
2846 PGS:    ADD     C,GSTAB;        GLOBSUBS\r
2847         ADDI    C,-1(X);        OFFSET\r
2848         MOVE    C,(C)\r
2849         TLC     C,640000;       MAKE A REQUEST\r
2850         PUSHJ P,TBLCHK          ;CHECK FOR OVERLAP\r
2851         MOVEI   W,(V);          THIS LOC\r
2852         HLRM    W,@X;           ZERO RIGHT HALF\r
2853         PUSHJ   P,SYMXX\r
2854         JRST    PASS2A\r
2855 \r
2856 SYDEF:  TLNE    N,SYDAT         ;SYMBOL WANTS DEFININITION?\r
2857         POPJ    P,              ;NO, GO AWAY\r
2858         PUSH    P,C             ;SAVE THE WORLD\r
2859         PUSH    P,W\r
2860         PUSHJ P,TBLCHK  ;CHECK FOR OVERLAP\r
2861         MOVE    W,C\r
2862         SKIPE   C,T     ;PICKUP VALUE\r
2863         PUSHJ   P,SYMXX\r
2864         POP     P,W\r
2865         POP     P,C\r
2866         POPJ    P,;\r
2867 \r
2868 PMLT:   ADD     C,MLTP\r
2869         SKIPA\r
2870 PPLT:   ADD     C,PLTP\r
2871         HRRZ    C,(C)\r
2872         JRST    PCOMX\r
2873 \r
2874 SYMXX:  PUSH    P,V\r
2875         PUSHJ   P,SYMPT\r
2876         POP     P,V\r
2877         POPJ    P,;\r
2878 \r
2879 SWAPSY: MOVEI   T,0;            SET TO EXCHANGE DEFS\r
2880         EXCH    T,1(C);         GET NAME\r
2881         HRRZ    C,(C)           ;GET VALUE\r
2882         POPJ    P,\r
2883 TBLCHK: HRRZ W,MLTP     ;GETT TOP OV TABLES\r
2884         SUBI W,2\r
2885         CAMG W,TOPTAB   ;WILL IT OVERLAP\r
2886 IFE EXPAND,<TLO F,FULLSW>\r
2887 IFN EXPAND,<    JRST    [PUSHJ P,XPAND\r
2888                         TLOA F,FULLSW\r
2889                         JRST TBLCHK\r
2890                         JRST .+1]>\r
2891         POPJ P,\r
2892 \r
2893 \f;END OF PASS2\r
2894 \r
2895 ALLOVE: TLZ     N,F4SW          ;END OF F4 PROG\r
2896         TLNE F,FULLSW!SKIPSW\r
2897         JRST HIGH3\r
2898         HRR     R,COMBAS        ;TOP OF THE DATA\r
2899         HRR     V,R             ;IS THIS THE HIGHEST LOC YET?\r
2900         CAIG    H,@X            ;...\r
2901         MOVEI   H,@X            ;YES, TELL THE WORLD\r
2902         CAMG    H,SDS           ;HIGHEST LOC GREATER THAN DATA STATEMENTS?\r
2903         JRST    HIGH3           ;NO, RETURN\r
2904         ADDI    H,1(S)          ;YES, SET UP MEANINGFUL ERROR COMMENT\r
2905         SUB     H,SDS           ;...\r
2906         TLO     F,FULLSW        ;INDICATE OVERFLO\r
2907         JRST    HIGH3           ;RETURN\r
2908 \r
2909 DATAS:  TLNE    F,FULLSW+SKIPSW\r
2910         JRST    DAX\r
2911         MOVEI   C,(S)           ;ADDR OF WORD UNDER SYMBOL TABLE\r
2912         MOVN    W,BLKSIZ        ;HOW FAR DOWN TO BLT\r
2913         ADDM    W,PLTP          ;UPDATE TABLE POINTERS\r
2914         ADDM    W,BITP          ;...\r
2915         ADDM    W,SDSTP         ;...\r
2916         ADD     C,W             ;RH(C):= WHEN TO STOP BLT\r
2917         HRL     C,MLTP          ;SOURCE OF BLTED DATA\r
2918         ADD     W,MLTP          ;UPDATE, GET DESTINATION OF BLT DATA\r
2919 IFN EXPAND,<    HRRZS W ;GET RID OF LEFT HALF\r
2920                 CAIG W,@X\r
2921                 PUSHJ P,[PUSHJ P,XPAND\r
2922                         POPJ P,\r
2923                         ADDI W,2000\r
2924                         ADD C,[XWD 2000,2000]\r
2925                         JRST POPJM2]>\r
2926         HRRM W,MLTP             ;NO SET THIS SO EXTRA CORE NOT ZEROED\r
2927         HLL     W,C             ;FORM BLT POINTER\r
2928         BLT     W,-1(C)         ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)\r
2929         PUSHJ   P,BITWX+1\r
2930 DAX:    PUSHJ   P,WORD;         READ ONE WORD\r
2931         TLNN    F,FULLSW+SKIPSW\r
2932         MOVEM   W,(C)\r
2933         SOSLE   BLKSIZ          ;COUNT OF DATA SEQUENCE SIZE\r
2934         AOJA    C,DAX           ;INCREMENT DATA SEQUENCE DEPOSIT LOC\r
2935         JRST    TEXTR;          DONE\r
2936 \r
2937 \fFBLKD: TLOE    N,BLKD1         ;IS THIS FIRST BLOCK DATA?\r
2938         JRST    ENDTP           ;NO\r
2939         HRR     V,COMBAS        ;PLACE PROG BREAK IN RH FOR\r
2940 IFE L,< HRRM    V,JOBCHN(X)     ;CHAIN>\r
2941 ENDTP:  TLNE    F,FULLSW+SKIPSW\r
2942         JRST    ALLOVE\r
2943         HRR     V,GSTAB\r
2944 ENDTP0: CAML    V,STAB;         ANY MORE GLOBSUBS\r
2945         JRST    ENDTP2;         NO\r
2946         MOVE    C,@X;           GET SUBPROG NAME\r
2947         PUSHJ   P,SREQ;         IS IT ALLREADY REQUESTED\r
2948         AOJA    V,ENDTP0;       YES\r
2949         PUSHJ   P,SDEF;         OR DEFINED\r
2950         AOJA    V,ENDTP0;       YES\r
2951         PUSHJ P,TBLCHK\r
2952         MOVEI W,0               ;PREPARE DUMMY LINK\r
2953         TLNN    F,FULLSW+SKIPSW;        ABORT\r
2954         PUSHJ   P,SYM3X;        PUT IN DUMMY REQUEST\r
2955         PUSHJ   P,BITWX+1;      OVERLAP CHECK\r
2956         AOJA    V,ENDTP0\r
2957 ENDTP2: SETZM   PT1\r
2958         HRR V,SDSTP\r
2959 IFN EXPAND,<    SUBI V,(X)\r
2960                 CAMG V,COMBAS\r
2961                 JRST    [PUSHJ P,XPAND\r
2962                         TLOA F,FULLSW\r
2963                         JRST .-3\r
2964                         JRST .+1]\r
2965                 HRR V,SDSTP>\r
2966         HRRZM   V,SDS           ;DATA STATEMENT LOC\r
2967 ENDTP1: SUBI    V,(X);          COMPENSATE FOR OFFSET\r
2968         MOVE    W,@X;   GET WORD\r
2969         TLNE    W,-1;           NO LEFT HALF IMPLIES COUNT\r
2970         JRST    DODON;          DATA DONE\r
2971         ADD     W,[MOVEI W,3]\r
2972         ADDI    W,@X\r
2973         EXCH    W,@X\r
2974         AOS     V\r
2975         ADD     W,@X;           ITEMS COUNT\r
2976         MOVEM   W,ITC\r
2977         MOVE    W,[MOVEM W,LTC]\r
2978         MOVEM   W,@X;           SETUP FOR DATA EXECUTION\r
2979         AOS     V\r
2980         MOVE    W,[MOVEI W,0]\r
2981         EXCH    W,@X\r
2982         MOVEM   W,ENC;          END COUNT\r
2983         AOS     V\r
2984         MOVEI   W,@X\r
2985         ADDM    W,ITC\r
2986 LOOP:   MOVE    W,@X\r
2987         HLRZ    T,W;            LEFT HALF INST.\r
2988         ANDI    T,777000\r
2989         CAIN    T,254000        ;JRST?\r
2990         JRST    WRAP            ;END OF DATA\r
2991         CAIN    T,260000        ;PUSHJ?\r
2992         JRST    PJTABL(W)       ;DISPATCH VIA TABLE\r
2993         CAIN    T,200000;       MOVE?\r
2994         AOJA    V,INNER\r
2995         CAIN    T,270000;       ADD?\r
2996         JRST    ADDOP\r
2997         CAIN    T,221000;       IMULI?\r
2998         AOJA    V,LOOP\r
2999         CAIE    T,220000;       IMUL?\r
3000         JRST    LOAD4A;         NOTA\r
3001 INNER:  HRRZ    T,@X;           GET ADDRESS\r
3002         TRZE    T,770000;       ZERO TAG?\r
3003         SOJA    T,CONPOL;       NO, CONSTANT POOL\r
3004         SUB     T,PT1;          SUBTRACT INDUCTION NUMBER\r
3005         ASH     T,1\r
3006         SOS     T;              FORM INDUCTION POINTER\r
3007         HRRM    T,@X\r
3008         HLRZ    T,@X\r
3009         ADDI    T,P\r
3010         HRLM    T,@X\r
3011         AOJA    V,LOOP\r
3012 \r
3013 \fCONPOL:        ADD     T,ITC;  CONSTANT BASE\r
3014         HRRM    T,@X\r
3015         AOJA    V,LOOP\r
3016 \r
3017 ADDOP:  HRRZ    T,@X\r
3018         TRZE    T,770000\r
3019         SOJA    T,CONPOL\r
3020 SKIPIN: AOJA    V,LOOP\r
3021 \r
3022 PJTABL: JRST    DWFS            ;PUSHJ 17,0\r
3023         AOSA    PT1             ;INCREMENT DO COUNT\r
3024         SOSA    PT1;            DECREMENT DO COUNT\r
3025         SKIPA   W,[EXP DOINT.]\r
3026         MOVEI   W,DOEND.\r
3027         HRRM    W,@X\r
3028         AOJA    V,SKIPIN        ;SKIP A WORD\r
3029 \r
3030 DWFS:   MOVEI   W,DWFS.\r
3031         HRRM    W,@X\r
3032         AOS     V\r
3033         TLO     N,SYDAT\r
3034         PUSHJ   P,PROC;         PROCESS THE TAG\r
3035         JRST    LOAD4A          ;DATA STATEMENT BELOW CODE TOP\r
3036         JRST    LOOP            ;PROPER RETURN\r
3037 \r
3038 DOINT.: POP     P,V;            GET ADDRESS OF INITIAL VALUE\r
3039         PUSH    P,(V);          STORE INDUCTION VARIABLE\r
3040         AOS     V\r
3041         PUSH    P,V;            INITIAL ADDRESS\r
3042         JRST    (V)\r
3043 \r
3044 DOEND.: HLRZ    T,@(P)\r
3045         ADDM    T,-2(P);        INCREMENT\r
3046         HRRZ    T,@(P);         GET FINAL VALUE\r
3047         CAMGE   T,-2(P);        END CHECK\r
3048         JRST    DODONE;         WRAP IT UP\r
3049         POP     P,(P);          BACK UP POINTER\r
3050         JRST    @(P)\r
3051 \r
3052 \fDODONE:        POP     P,-1(P);        BACK UP ADDRESS\r
3053         POP     P,-1(P)\r
3054         JRST    CPOPJ1          ;RETURN\r
3055 \r
3056 WRAP:   MOVE    W,ENC;          NUMBER OF CONSTANTS\r
3057         ADD     W,ITC;          CONSTANT BASE\r
3058         MOVEI   C,(W);          CHAIN\r
3059         HRRM    C,@X\r
3060         MOVEI   V,(W);          READY TO GO\r
3061         JRST    ENDTP1\r
3062 \r
3063 DODON:  TLZ     N,RCF!SYDAT!DZER        ;DATA STATEMENT FLAGS\r
3064         MOVE    W,PTEMP         ;TOP OF PROG\r
3065         ADDI    W,(X)           ;+OFFSET\r
3066         MOVE    C,COMBAS        ;TOP OF DATA\r
3067         ADDI    C,(X)           ;+OFFSET\r
3068 SECZER: CAML    W,C             ;ANY DATA TO ZERO?\r
3069         JRST    @SDS            ;NO, DO DATA STATEMENTS\r
3070         CAML    W,SDS           ;IS DATA BELOW DATA STATEMENTS?\r
3071         TLO     F,FULLSW        ;NO, INDICATE OVERFLO\r
3072         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?\r
3073         SETZM   (W)             ;YES, DO SO\r
3074         TLON    N,DZER          ;GO BACK FOR MORE?\r
3075         AOJA    W,SECZER        ;YES, PLEASE\r
3076         CAMLE   C,SDS           ;ALL DATA BELOW DATA STATEMENTS?\r
3077         MOVE    C,SDS           ;ALL ZEROED DATA MUST BE\r
3078         HRLI    W,-1(W)         ;SET UP BLT POINTER TO ZERO DATA\r
3079         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?\r
3080         BLT     W,-1(C)         ;YES, DO SO\r
3081         JRST    @SDS            ;GO DO DATA STATEMENTS\r
3082 \r
3083 \fDREAD: TLNE    N,RCF;          NEW REPEAT COUNT NEEDED\r
3084         JRST    FETCH;          NO\r
3085         MOVE    W,LTC\r
3086         MOVEM   W,LTCTEM\r
3087         MOVE    W,@LTC;         GET A WORD\r
3088         HLRZM   W,RCNT;         SET REPEAT COUNT\r
3089         HRRZM   W,WCNT;         SET WORD COUNT\r
3090         POP     W,(W);          SUBTRACT ONE FROM BOTH HALFS\r
3091         HLLM    W,@LTC;         DECREMENT REPEAT COUNT\r
3092         AOS     W,LTC;          STEP READOUT\r
3093         TLO     N,RCF\r
3094 FETCH:  MOVE    W,@LTC\r
3095         AOS     LTC\r
3096         SOSE    WCNT\r
3097         POPJ    P,;\r
3098         SOSN    RCNT\r
3099         JRST    DOFF.\r
3100         MOVE    V,LTCTEM;       RESTORE READOUT\r
3101         MOVEM   V,LTC\r
3102 DOFF.:  TLZ     N,RCF;          RESET DATA REPEAT FLAG\r
3103         POPJ    P,;\r
3104 \r
3105 DWFS.:  MOVE    T,(P)\r
3106         AOS     (P)\r
3107         MOVE    T,(T);          GET ADDRESS\r
3108         HLRZM   T,DWCT;         DATA WORD COUNT\r
3109         HRRES   T\r
3110         ADD     T,W;            OFFSET\r
3111         ADDI    T,(X);          LOADER OFFSET\r
3112 DWFS.1: PUSHJ   P,DREAD         ;GET A DATA WORD\r
3113         CAML    T,SDS           ;BELOW BEGINNING OF DATA STATEMENTS\r
3114         TLO     F,FULLSW        ;YES, INDICATE OVERFLO\r
3115         TLNN    F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?\r
3116         MOVEM   W,(T)           ;YES, STORE IT\r
3117         AOS     T\r
3118         SOSE    W,DWCT;         STEP DOWN AND TEST\r
3119         JRST    DWFS.1          ;ONE MORE TIME, MOZART BABY!\r
3120         POPJ    P,;\r
3121 \r
3122 \r
3123 \f;LITERAL TABLE\r
3124 \r
3125 LITS:   LIT\r
3126         VAR\r
3127 CT1:    0               ;TEMP FOR C\r
3128 LTC:    0\r
3129 ITC:    0\r
3130 ENC:    0\r
3131 WCNT:   0               ;DATA WORD COUNT\r
3132 RCNT:   0               ;DATA REPEAT COUNT\r
3133 \r
3134 LTCTEM: 0               ;TEMP FOR LTC\r
3135 DWCT:   0               ;DATA WORD COUNT\r
3136 IFE L,<\r
3137 IFE HE,<\r
3138 LDEND:  END     LD\r
3139         >>\r
3140 IFN HE,<\r
3141 LDEND:  END>\r
3142 IFN L,<\r
3143 LDEND:\r
3144 LODMAK: MOVEI A,LODMAK\r
3145         MOVEM A,137\r
3146         INIT 17\r
3147         SIXBIT /DSK/\r
3148         0\r
3149         HALT\r
3150         ENTER LMFILE\r
3151         HALT\r
3152         OUTPUT [IOWD 1,LMLST    ;OUTPUT LENGTH OF FILE\r
3153                 0]\r
3154         OUTPUT LMLST\r
3155         STATZ 740000\r
3156         HALT\r
3157         RELEASE\r
3158         CALL [SIXBIT /EXIT/]\r
3159 \r
3160 LMFILE: SIXBIT /LISP/\r
3161         SIXBIT /LOD/\r
3162         0\r
3163         0\r
3164 \r
3165 LMLST:  IOWD LODMAK+1-LD,137\r
3166         0\r
3167 \r
3168         END LODMAK>\r