src/loader.v1

   1         SUBTTL  DICK GRUEN: V25 3 AUG 68\r
   2 \r
   3 \r
   4 L==0                    ;L=1 MEANS THE LISP LOADER\r
   5 IFNDEF L,<L=0>\r
   6 \r
   7 ;K=1                    ;K=1  MEANS 1KLOADER\r
   8 IFNDEF  K,<K=0>         ;K=0  MEANS F4 LOADER\r
   9 \r
  10 IFN L,< BLTSYM=0\r
  11         LDAC=0>\r
  12 \r
  13 ;BLTSYM=1               ;MOVE SYMBOL TABLE DOWN TO END OF PROG\r
  14 IFNDEF BLTSYM,<BLTSYM=0>\r
  15 \r
  16 ;EXPAND=1               ;FOR AUTOMATIC CORE EXPANSION\r
  17 IFNDEF EXPAND,< IFN K,<EXPAND=0>\r
  18                 IFE K,<EXPAND=1>>\r
  19 \r
  20 ;PP=1                   ;ALLOW PROJ-PROG #\r
  21 IFNDEF PP,<PP=0>\r
  22 \r
  23 ;CHN5=0                 ;IF CHAIN WHICH DOESN'T SAVES JOB41\r
  24 IFNDEF CHN5,<CHN5=1>\r
  25 \r
  26 IFE K,< TITLE   LOADER - LOADS MACROX AND SIXTRAN FOUR>\r
  27 IFN K,< TITLE   1KLOAD - LOADS MACROX>\r
  28 \f;ACCUMULATOR ASSIGNMENTS\r
  29         F=0             ;FLAGS IN LH, SA IN RH\r
  30         N=1             ;PROGRAM NAME POINTER\r
  31         X=2             ;LOADER OFFSET\r
  32         H=3             ;HIGHEST LOC LOADED\r
  33         S=4             ;UNDEFINED POINTER\r
  34         R=5             ;RELOCATION CONSTANT\r
  35         B=6             ;SYMBOL TABLE POINTER\r
  36         D=7\r
  37         T=10\r
  38         V=T+1\r
  39         W=12            ;VALUE\r
  40         C=W+1           ;SYMBOL\r
  41         E=C+1           ;DATA WORD COUNTER\r
  42         Q=15            ;RELOCATION BITS\r
  43         A=Q+1           ;SYMBOL SEARCH POINTER\r
  44         P=17            ;PUSHDOWN POINTER\r
  45 ;FLAGS  F(0 - 17)\r
  46         CSW==1                  ;ON - COLON SEEN\r
  47         ESW==2                  ;ON - EXPLICIT EXTENSION IDENT.\r
  48         SKIPSW==4               ;ON - DO NOT LOAD THIS PROGRAM\r
  49         FSW==10                 ;ON - SCAN FORCED TO COMPLETION\r
  50         FCONSW==20              ;ON - FORCE CONSOLE OUTPUT\r
  51         ASW==100                ;ON - LEFT ARROW ILLEGAL\r
  52         FULLSW==200             ;ON - STORAGE EXCEEDED\r
  53         SLIBSW==400             ;ON - LIB SEARCH IN THIS PROG\r
  54         DSYMSW==1000            ;ON - LOAD WITH SYMBOLS FOR DDT\r
  55         REWSW==2000             ;ON - REWIND AFTER INIT\r
  56         LIBSW==4000             ;ON - LIBRARY SEARCH MODE\r
  57         F4LIB==10000            ;ON - F4 LIBRARY SEARCH LOOKUP\r
  58         ISW==20000              ;ON - DO NOT PERFORM INIT\r
  59         SYMSW==40000            ;ON - LOAD LOCAL SYMBOLS\r
  60         DSW==100000             ;ON - CHAR IN IDENTIFIER\r
  61         NSW==200000             ;ON - SUPPRESS LIBRARY SEARCH\r
  62         SSW==400000             ;ON - SWITCH MODE\r
  63 ;FLAGS  N(0 - 17)\r
  64         ALLFLG==1               ;ON - LIST ALL GLOBALS\r
  65         ISAFLG==2               ;ON - IGNORE STARTING ADDRESSES\r
  66         COMFLG==4               ;ON - SIZE OF COMMON SET\r
  67 IFE K,< F4SW==10                ;F4 IN PROGRESS\r
  68         RCF==20                 ;READ DATA COUNT\r
  69         SYDAT==40               ;SYMBOL IN DATA>\r
  70         SLASH==100              ;SLASH SEEN\r
  71 IFE K,< BLKD1==200              ;ON- FIRST BLOCK DATA SEEN\r
  72         PGM1==400               ;ON FIRST F4 PROG SEEN\r
  73         DZER==1000              ;ON - ZERO SECOND DATA WORD>\r
  74         EXEQSW==2000            ;IMMEDIATE EXECUTION\r
  75         DDSW==4000              ;GO TO DDT\r
  76         AUXSWI==20000           ;ON - AUX. DEVICE INITIALIZED\r
  77         AUXSWE==40000           ;ON - AUX. DEVICE ENTERED\r
  78 IFN PP,<PPSW==100000            ;ON - READING PROJ-PROG #\r
  79         PPCSW==200000           ;ON - READING PROJ #>\r
  80 \fLOC    137\r
  81 OCT 25          ;VERSION #\r
  82 RELOC\r
  83         MLON\r
  84         SALL\r
  85 \r
  86 \r
  87 \r
  88 ;MONITOR LOCATIONS IN THE USER AREA\r
  89 \r
  90         JOBPRO==140             ;PROGRAM ORIGIN\r
  91         JOBBLT==134             ;BLT ORIGIN\r
  92         JOBCHN==131             ;RH = PROG BREAK OF FIRST BLOCK DATA\r
  93                                 ;LH = PROG BREAK OF FIRST F4 PROG\r
  94 \r
  95 ;CALLI DEFINITIONS\r
  96 \r
  97 CDDTOUT==3      ;CALLI DDTOUT\r
  98 CEXIT==12       ;CALLI EXIT\r
  99 CDDTGT==5       ;CALLI DDTGT\r
 100 CSETDDT==2      ;CALLI SETDDT\r
 101 \r
 102 ;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS\r
 103 \r
 104 PPDL==60\r
 105 \f\r
 106 ;MONITOR LOADER CONTROL\r
 107 \r
 108 BEG:\r
 109 IFE L,<\r
 110 LD:     HLLZS 42        ;GET RID OF ERROR COUNT IF NOT IN RPG MODE\r
 111         CALLI   0               ;INITIALIZE THIS JOB\r
 112 NUTS:   MOVSI     R,F.I         ;SET UP INITIAL ACCUMULATORS\r
 113         BLT     R,R             \r
 114 >\r
 115 IFN L,<\r
 116 LD:     HRRZM 0,LSPXIT#         ;RETURN ADDRESS FOR LISP\r
 117         MOVEI 0,0\r
 118         HRRZM R,RINITL#\r
 119         CALLI 0\r
 120 >\r
 121 CTLSET: INIT    3,1             ;INITIALIZE CONSOLE\r
 122         SIXBIT    /TTY/\r
 123         XWD     BUFO,BUFI\r
 124 CALLEX: CALLI   CEXIT           ;DEVICE ERROR, FATAL TO JOB\r
 125         MOVEI     E,TTY1\r
 126         MOVEM     E,JOBFF\r
 127         INBUF     3,1\r
 128         OUTBUF    3,1           ;INITIALIZE OUTPUT BUFFERS\r
 129         OUTPUT    3,                    ;DO INITIAL REDUNDANT OUTPUT\r
 130 IFE L,< HRRZ    B,JOBREL        ;PICK UP CORE BOUND\r
 131         SKIPE   JOBDDT          ;DOES DDT EXIST?\r
 132         HRRZ    B,JOBSYM        ;USED BOTTOM OF SYMBOL TABLE INSTEAD\r
 133 >\r
 134 IFN L,< MOVE B,JOBSYM>\r
 135         SUB     B,SE3           ;INITIALIZE SYMBOL TABLE POINTER\r
 136         CAILE     H,1(B)                ;TEST CORE ALLOCATION\r
 137         CALLI   CEXIT           ;INSUFFICIENT CORE, FATAL TO JOB\r
 138 IFE L,< MOVS    E,X             ;SET UP BLT POINTER\r
 139         HRRI    E,1(X)>\r
 140 IFN L,< MOVS E,H\r
 141         HRRI E,1(H)>\r
 142         SETZM     -1(E)                 ;ZERO FIRST WORD\r
 143         BLT     E,(B)           ;ZERO CORE UP TO THE SYMBOL AREA\r
 144         HRRZ    S,B             ;INITIALIZE UNDEF. POINTER\r
 145         HRR     N,B             ;INITIALIZE PROGRAM NAME POINTER\r
 146 IFE L,<HRRI     R,JOBPRO        ;INITIALIZE THE LOAD ORIGIN>\r
 147         MOVE    E,COMM          ;SET .COMM. AS THE FIRST PROGRAM\r
 148         MOVEM     E,1(B)                ;STORE IN SYMBOL TABLE\r
 149         HRRZM     R,2(B)                ;STORE COMMON ORIGIN\r
 150         >\r
 151         MOVEI     E,F.C         ;INITIALIZE STATE OF THE LOADER\r
 152         BLT     E,B.C\r
 153         SETZM   MDG             ;MULTIPLY DEFINED GLOBAL COUNT\r
 154 IFE L,< MOVSI   W,254200        ;STORE HALT IN JOB41\r
 155         MOVEM   W,JOB41(X)>     ;...\r
 156 IFN L,< MOVE W,JOBREL\r
 157         HRRZM W,OLDJR#>\r
 158 IFN LDAC!BLTSYM,<MOVEI W,20     ;SET UP SPACE TO SAVE FOR ACS AND\r
 159         MOVEM W,KORSP#  ;USER DEFINITIONS WITH DDT>\r
 160 \r
 161 \f\r
 162 LD2:    \r
 163 ;LOADER SCAN FOR FILE NAMES\r
 164 \r
 165 LD2Q:   MOVSI     B,F.C         ;RESTORE ACCUMULATORS\r
 166         BLT     B,B\r
 167         MOVE    P,PDLPT         ;INITIALIZE PUSHDOWN LIST\r
 168         SETZM     BUFI2         ;CLEAR INPUT BUFFER POINTER\r
 169 IFE PP,<        SETZM     ILD1          ;CLEAR INPUT DEVICE NAME>\r
 170 IFN PP,<        MOVSI T,(SIXBIT /DSK/)  ;ASSUME DSK\r
 171         MOVEM T,ILD1\r
 172         SETZM OLDDEV#   ;TO MAKE IT GO BACK AFTER /D FOR LIBSR>\r
 173         SETZM     DTIN          ;CLEAR INPUT FILE NAME\r
 174 IFN PP,<SETZM   PPN#            ;CLEAR INPUT PROJ-PROG #>\r
 175 \r
 176 LD2B:   RELEAS    1,                    ;RELEASE BINARY INPUT DEVICE\r
 177         MOVEI     T,"*"\r
 178         IDPB    T,BUFO1         ;OUTPUT ASTERISK TO START INPUT\r
 179         OUTPUT    3,\r
 180 LD2BA:  TLZ     F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW\r
 181         TLNE    F,LIBSW         ;WAS LIBRARY MODE ON?\r
 182         TLO     F,SKIPSW        ;YES, NORMAL MODE IS SKIPPING\r
 183 \r
 184 LD2D:   IFN PP,<SETZM PPN       ;DO NOT REMEMBER PPNS FOR NOW\r
 185 LD2DB:  SKIPE W,OLDDEV  ;RESET DEVICE IF NEEDED\r
 186         CAMN W,ILD1     ;IS IT SAME?\r
 187         JRST LD2DA      ;YES, FORGET IT\r
 188         TLZ F,ISW+DSW+FSW+REWSW\r
 189         MOVEM W,ILD1>\r
 190 LD2DA:\r
 191         MOVEI     W,0           ;INITIALIZE IDENTIFIER SCAN\r
 192         MOVEI     E,6           ;INITIALIZE CHARACTER COUNTER\r
 193         MOVE    V,LSTPT         ;INITIALIZE BYTE POINTER TO W\r
 194         TLZ     F,SSW+DSW+FSW   ;LEAVE SWITCH MODE\r
 195 LD3:    SOSG BUFI2      ;DECREMENT CHARACTER COUNT\r
 196         INPUT     3,                    ;FILL TTY BUFFER\r
 197         ILDB    T,BUFI1         ;LOAD T WITH NEXT CHARACTER\r
 198 LD3AA:  MOVE    Q,T\r
 199         IDIVI     Q,11          ;TRANSLATE TO 4 BIT CODE\r
 200         LDB     Q,LD8(A)                ;LOAD CLASSIFICATION CODE\r
 201         CAIGE     Q,4           ;MODIFY CODE IF .GE. 4\r
 202         TLNN    F,SSW           ;MODIFY CODE IF SWITCH MODE OFF\r
 203         ADDI    Q,4             ;MODIFY CLASS. CODE FOR DISPATCH\r
 204         HRRZ    A,LD3A(Q)               ;LOAD RH DISPATCH ENTRY\r
 205         CAIL    Q,10            ;SKIP IF CORRECT DISPATCH ENTRY\r
 206         HLRZ    A,LD3A-10(Q)    ;LOAD LH DISPATCH ENTRY\r
 207         JRST    @A                      ;JUMP TO INDICATED LOCATION\r
 208 \r
 209 ;COMMAND DISPATCH TABLE\r
 210 \r
 211 LD3A:   XWD     LD3,LD7B                ;IGNORED CHAR, BAD CHAR (SWITCH)\r
 212         XWD     LD6A,LD6                ;</> OR <(>, LETTER (SWITCH)\r
 213         XWD     LD5,LD6C                ;<:>, DIGIT (SWITCH ARG.)\r
 214         XWD     LD5A,LD6D               ;<.>, ESCAPE SWITCH MODE <)>\r
 215         XWD     LD5C,LD7                ;<=> OR <L. ARROW>, BAD CHAR.\r
 216         XWD     LD5B,LD4                ;<,>, ALPHABETIC CHAR.\r
 217         XWD     LD5D,LD4                ;<CR.>, NUMERIC CHAR.\r
 218         XWD     LD5E1,LD7               ;<ALT MODE>, BAD CHAR. <)>\r
 219 \r
 220 \f;ALPHANUMERIC CHARACTER, NORMAL MODE\r
 221 LD4:    SOJL    E,LD3           ;JUMP IF NO SPACE FOR CHAR IN W\r
 222         SUBI    T,40            ;CONVERT FROM ASCII TO SIXBIT\r
 223         IDPB    T,V             ;DEPOSIT CHAR OF IDENTIFIER IN W\r
 224         TLO     F,DSW           ;SET IDENTIFIER FLAG\r
 225         JRST    LD3             ;RETURN FOR NEXT CHARACTER\r
 226 \r
 227 ;DEVICE IDENTIFIER DELIMITER <:>\r
 228 \r
 229 LD5:    PUSH    P,W             ;SAVE W\r
 230         TLOE    F,CSW           ;TEST AND SET COLON FLAG\r
 231         PUSHJ     P,LDF         ;FORCE LOADING\r
 232         POP     P,W             ;RESTORE W\r
 233         TLNE    F,ESW           ;TEST SYNTAX\r
 234         JRST    LD7A            ;ERROR, MISSING COMMA ASSUMED\r
 235         JUMPE     W,LD2D                ;JUMP IF NULL DEVICE IDENTIFIER\r
 236         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER\r
 237 IFN PP,<MOVEM W,OLDDEV  ;WE HAVE A NEW ONE SO IGNORE OLD>\r
 238         TLZ     F,ISW+DSW+FSW+REWSW     ;CLEAR OLD DEVICE FLAGS\r
 239 IFN PP,<SETZM   PPN             ;CLEAR OLD PP #>\r
 240         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 241 \r
 242 ;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>\r
 243 \r
 244 LD5A:   TLOE    F,ESW           ;TEST AND SET EXTENSION FLAG\r
 245         JRST    LD7A            ;ERROR, TOO MANY PERIODS\r
 246         TLZE    F,CSW+DSW       ;SKIP IF NULL IDENT AND NO COLON\r
 247         MOVEM     W,DTIN        ;STORE FILE IDENTIFIER\r
 248         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 249 \r
 250 ;INPUT SPECIFICATION DELIMITER <,>\r
 251 \r
 252 LD5B:\r
 253 IFN PP,<TLZE    N,PPCSW                 ;READING PP #?\r
 254         JRST    [\r
 255         HRLM    D,PPN   ;STORE PROJ #\r
 256         JRST    LD6A1]  ;GET PROG #\r
 257         PUSHJ   P,RBRA          ;CHECK FOR MISSING RBRA>\r
 258         TLZN    F,FSW           ;SKIP IF PREV. FORCED LOADING\r
 259         PUSHJ     P,FSCN2               ;LOAD (FSW NOT SET)\r
 260         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER\r
 261 \r
 262 LD5B1:  TLNE    F,ESW           ;TEST EXTENSION FLAG\r
 263         JRST    LDDT3           ;EXPLICIT EXTENSION IDENTIFIER\r
 264         TLZN    F,CSW+DSW               ;SKIP IF IDENT. OR COLON\r
 265         POPJ    P,\r
 266         MOVEM     W,DTIN                ;STORE FILE IDENTIFIER\r
 267         JRST    LDDT2           ;ASSUME <.REL> IN DEFAULT CASE\r
 268 \f;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>\r
 269 ;OR PROJ-PROG # BRACKETS <[> AND <]>\r
 270 LD5C:\r
 271 IFN PP,<CAIN    T,"["                   ;PROJ-PROG #?\r
 272         JRST    [TLO    N,PPSW+PPCSW    ;SET FLAGS\r
 273                 MOVEM   W,PPNW#         ;SAVE W\r
 274                 MOVEM   E,PPNE#         ;SAVE E\r
 275                 MOVEM   V,PPNV#         ;SAVE V\r
 276                 JRST LD6A1-1]   ;READ NUMBERS AS SWITCHES \r
 277         CAIN    T,"]"                   ;END OF PP #?\r
 278         JRST    [PUSHJ  P,RBRA          ;PROCESS RIGHT BRACKET\r
 279                 JRST    LD3             ];READ NEXT IDENT>\r
 280         TLOE    F,ASW                   ;TEST AND SET LEFT ARROW FLAG\r
 281         JRST    LD7A                    ;ERROR, MISPLACED LEFT ARROW\r
 282         PUSHJ     P,LD5B1               ;STORE IDENTIFIER\r
 283         TLZN    F,ESW                   ;TEST EXTENSION FLAG\r
 284         MOVSI     W,554160              ;ASSUME <.MAP> IN DEFAULT CASE\r
 285         MOVEM     W,DTOUT1              ;STORE FILE EXTENSION IDENTIFIER\r
 286         MOVE    W,DTIN                  ;LOAD INPUT FILE IDENTIFIER\r
 287         MOVEM     W,DTOUT               ;USE AS OUTPUT FILE IDENTIFIER\r
 288 IFN PP,<MOVE    W,PPN           ;PROJ-PROG #\r
 289         MOVEM   W,DTOUT+3               ;...>\r
 290         MOVE    W,ILD1                  ;LOAD INPUT DEVICE IDENTIFIER\r
 291         MOVEM   W,LD5C1                 ;USE AS OUTPUT DEVICE IDENTIFIER\r
 292 IFN PP,<        SKIPE W,OLDDEV  ;RESTORE OLD\r
 293         MOVEM W,ILD1>\r
 294 ;INITIALIZE AUXILIARY OUTPUT DEVICE\r
 295         TLZE    N,AUXSWI+AUXSWE         ;FLUSH CURRENT DEVICE\r
 296         RELEASE 2,                      ;...\r
 297         CALL    W,[SIXBIT ?DEVCHR?]     ;IS DEVICE A TTY?\r
 298         TLNE    W,10                    ;...\r
 299 JRST    LD2D            ;YES, SKIP INIT\r
 300         INIT    2,1                     ;INIT THE AUXILIARY DEVICE\r
 301 LD5C1:  0               ;AUXILIARY OUTPUT DEVICE NAME\r
 302         XWD     ABUF,0                  ;BUFFER HEADER\r
 303         JSP     A,ILD5                  ;ERROR RETURN\r
 304         TLNE    F,REWSW                 ;REWIND REQUESTED?\r
 305         CALL    2,[SIXBIT /UTPCLR/]             ;DECTAPE REWIND\r
 306         TLZE    F,REWSW                 ;SKIP IF NO REWIND REQUESTED\r
 307         MTAPE   2,1                     ;REWIND THE AUX DEV\r
 308         MOVEI   E,AUX                   ;SET BUFFER ORIGIN\r
 309         MOVEM     E,JOBFF\r
 310         OUTBUF  2,1                     ;INITIALIZE SINGLE BUFFER\r
 311         TLO     N,AUXSWI                        ;SET INITIALIZED FLAG\r
 312         JRST    LD2D                    ;RETURN TO CONTINUE SCAN\r
 313 \r
 314 \f\r
 315 ;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)\r
 316 IFN PP,<\r
 317 RBRA:   TLZN    N,PPSW          ;READING PP #?\r
 318         POPJ    P,              ;NOPE, RETURN\r
 319         TLZE    N,PPCSW         ;COMMA SEEN?\r
 320         JRST    LD7A            ;NOPE, INDICATE ERROR\r
 321         HRRM    D,PPN           ;STASH PROG NUMBER\r
 322         MOVE    W,PPNW#         ;PICKUP OLD IDENT\r
 323         MOVE    E,PPNE#         ;RESTORE CHAR COUNT\r
 324         MOVE    V,PPNV#         ;RESTORE BYTE PNTR\r
 325         POPJ    P,              ;TRA 1,4\r
 326 \r
 327 ;RIGHT JUSTIFY W\r
 328 \r
 329 RJUST:  JUMPE   W,LD7A          ;NOTHING TO RIGHT JUSTIFY\r
 330         TRNE    W,77            ;IS W RJUSTED YET?\r
 331         POPJ    P,              ;YES, TRA 1,4\r
 332         LSH     W,-6            ;NOPE, TRY AGAIN\r
 333         JRST    .-3             ;...>\r
 334 \f\r
 335 ;LINE TERMINATION <CARRIAGE RETURN>\r
 336 \r
 337 LD5D:\r
 338 IFN PP,<PUSHJ   P,RBRA          ;CHECK FOR UNTERMINATED PP #>\r
 339         PUSHJ     P,FSCN                ;FORCE SCAN TO COMPLETION\r
 340         JRST    LD2B            ;RETURN FOR NEXT LINE\r
 341 \r
 342 ;TERMINATE LOADING <ALT MODE>\r
 343 \r
 344 LD5E:   SKIPE     D                     ;ENTER FROM G COMMAND\r
 345         HRR     F,D             ;USE NUMERIC STARTING ADDRESS\r
 346 LD5E1:\r
 347         PUSHJ     P,CRLF                ;START A NEW LINE\r
 348         PUSHJ   P,SASYM         ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY\r
 349 IFN LDAC!BLTSYM,<HRRZ A,R               ;SET UP BLT OF ACS\r
 350         ADDI A,(X)              ;END\r
 351         ADD A,KORSP             ;ADD IN SPACE RESERVED\r
 352         CAIL A,(S)\r
 353 IFN EXPAND,<JRST        [PUSHJ P,XPAND>\r
 354                         PUSHJ   P,[\r
 355 IFE EXPAND,<                    JSP     A,ERRPT\r
 356                                 SIXBIT  /MORE CORE NEEDED#/>\r
 357                                 CALLI   CEXIT]\r
 358 IFN EXPAND,<            JRST .-1]>\r
 359         HRRM R,BOTACS#          ;SAVE FOR LATER\r
 360         HRRZ A,R                ;SET BLT\r
 361         ADD A,X\r
 362         HRL A,X\r
 363         MOVE Q,A\r
 364         BLT A,17(Q)>\r
 365 IFN BLTSYM,<HRRZ A,R    ;PLACE TO BLT TO\r
 366         ADD A,KORSP\r
 367         MOVE W,A        ;SAVE DEST\r
 368         ADDI A,(X)      ;AFTER ADJUSTMENT\r
 369         MOVE Q,S        ;UDEF PNTR\r
 370         ADD Q,B         ;TOTAL UNDEFS AND DEFS IN LEFT\r
 371         HLROS Q         ;NOW NEG IN RIGHT\r
 372         MOVNS Q ;POSITIVE\r
 373         ADDI Q,-1(A)    ;END OF BLT\r
 374         HRLI A,1(S)     ;AND GET PLACE TO BLT FROM\r
 375         SUBI W,1(S)     ;PREST LOC OF SYMBOL TABLE\r
 376         ADDM W,JOBSYM(X)\r
 377         ADDM W,JOBUSY(X)        ;ADJUST POINTERS\r
 378         BLT A,(Q)       ;MOVE IT\r
 379         SKIPN JOBDDT(X) ;IS DDT THERE?\r
 380         JRST NODDT\r
 381         SUBI Q,-1(X)\r
 382         HRRM Q,JOBFF(X) ;RESTET JOBFF IF DDT IS IN\r
 383         HRLM Q,JOBSA(X)\r
 384 NODDT:>\r
 385         MOVE    W,[SIXBIT ?LOADER?]     ;FINAL MESSAGE\r
 386         PUSHJ P,BLTSET          ;SETUP FOR FINAL BLT\r
 387         RELEASE 2,              ;RELEASE AUX. DEV.\r
 388 IFN L,< JRST @LSPXIT>\r
 389 LD5E5:  MOVE    W,[BLT Q,(A)]   ;BLT OF ALL CODE\r
 390         MOVEM   W,JOBBLT        ;STASH IN JOB DATA AREA\r
 391         MOVEM   W,JOBBLT(X)     ;STASH IN RELOCATED JOBDATA AREA\r
 392 LD5E2:  MOVE    W,CALLEX        ;EXIT AFTER BLT\r
 393         TLZN    N,EXEQSW        ;IMMEDIATE EXECUTION REQUESTED?\r
 394         JRST    LD5E3           ;NOPE, LET USER TYPE START HIMSELF\r
 395         HRRZ    W,JOBSA(X)      ;PICKUP USUAL STARTING ADDRESS\r
 396         TLNE    N,DDSW          ;DDT EXECUTION?\r
 397         HRRZ    W,JOBDDT(X)     ;USE DDT SA INSTEAD\r
 398         JUMPE   W,LD5E2         ;IF SA=0, DON'T EXECUTE\r
 399         HRLI    W,(JRST)        ;INSTRUCTION TO EXECUTE\r
 400 LD5E3:\r
 401 IFE LDAC,<MOVEM W,JOBBLT+1(X)   ;STASH FOR EXECUTION>\r
 402 IFN LDAC,<MOVEM W,JOBBLT+2(X)   ;STASH FOR EXECUTION\r
 403         HRLZ    17,JOBFF(X)     ;BUT FIRST BLT ACS\r
 404         MOVE    W,[BLT 17,17]   ;...\r
 405         MOVEM   W,JOBBLT+1(X)   ;...>\r
 406         JRST    JOBBLT          ;IF IT WERE DONE, 'TWERE BEST DONE QUICKLY\r
 407 \r
 408 \f\r
 409 ;SEARCH LIBRARY, PRINT UNDEFS, SETUP JOBSA,JOBFF,JOBSYM,JOBUSY\r
 410 \r
 411 SASYM:  TLNN    F,NSW           ;SKIP IF NO SEARCH FLAG ON\r
 412         PUSHJ   P,LIBF          ;SEARCH LIBRARY FILE\r
 413         PUSHJ   P,FSCN          ;FORCE SCAN TO COMPLETION\r
 414         PUSHJ   P,PMS           ;PRINT UNDEFINEDS\r
 415 IFE L,< HRRZM   F,JOBSA(X)      ;RH OF JOBSA :=STARTING ADDRESS>\r
 416 SAS1:   HRRZ    A,H             ;COMPUTE PROG BREAK\r
 417         SUBI    A,(X)           ;...\r
 418         CAIGE   A,(R)           ;BUT NO HIGHER THAN RELOC\r
 419         HRRZ    A,R             ;...\r
 420 IFE L,< HRLM    A,JOBSA(X)      ;LH OR JOBSA IS PROG BREAK\r
 421         HRRZM   A,JOBFF(X)      ;RH OF JOBFF CONTAINS PROG BREAK>\r
 422         MOVE    A,B             ;SET JOBSYM W/ SYMBOL TABLE POINTER\r
 423         AOS     A               ;...\r
 424 IFE L,< MOVEM   A,JOBSYM(X)     ;...>\r
 425 IFN L,< MOVEM   A,JOBSYM>\r
 426         MOVE    A,S             ;SET JOBUSY W/ UNDEFINED SYMBOL POINTER\r
 427         AOS     A               ;...\r
 428 IFE L,< MOVEM   A,JOBUSY(X)     ;...>\r
 429 IFN L,< MOVEM   A,JOBUSY>\r
 430         POPJ    P,              ;RETURN\r
 431 ;PRINT FINAL MESSAGE, SET UP BLT AC'S, SETDDT, RELEAS\r
 432 \r
 433 BLTSET: PUSHJ   P,FCRLF         ;START FINAL MESSAGE\r
 434         PUSHJ   P,PWORD         ;PRINT W\r
 435         PUSHJ   P,SPACE\r
 436         HRRZ    Q,JOBREL        ;PUBLISH HOW MUCH CORE USED\r
 437 IFN L,< SUB     Q,OLDJR         ;OLD JOBREL>\r
 438         LSH     Q,-12           ;...\r
 439         ADDI    Q,1             ;...\r
 440         PUSHJ   P,RCNUM         ;PUBLISH THE NUMBER\r
 441         MOVE    W,[SIXBIT /K CORE/]     ;PUBLISH THE UNITS\r
 442         PUSHJ   P,PWORD         ;...\r
 443         PUSHJ   P,CRLF          ;...\r
 444 IFE L,< MOVSI   Q,20(X)         ;HOW MUCH CODE TO BLT\r
 445         HRRI    Q,20            ;...\r
 446         HRRZ A,42               ;CHECK ON ERRORS\r
 447         JUMPE A,NOEX            ;NONE, GO AHEAD\r
 448         TLZN N,EXEQSW           ;DID HE WANT TO START EXECUTION?\r
 449         JRST NOEX               ;NO\r
 450         JSP A ,ERRPT            ;PRINT AN ERROR MESSAGE\r
 451         SIXBIT /EXECUTION DELETED@/\r
 452 NOEX:   HRRZ    A,JOBREL        ;WHEN TO STOP BLT\r
 453         HRRZM   A,JOBREL(X)     ;SETUP FOR POSSIBLE IMMED. XEQ\r
 454         SUBI    A,(X)           ;...\r
 455 IFE BLTSYM,<CAIL        A,(S)           ;DON'T BLT OVER SYMBOL TABLE\r
 456         MOVEI   A,(S)           ;OR UNDEFINED TABLE>\r
 457         RELEAS  1,              ;RELEASE DEVICES\r
 458         RELEAS  3,              ;...\r
 459 IFE L,< MOVE    R,JOBDDT(X)     ;SET NEW DDT\r
 460         CALLI   R,CSETDDT       ;...>\r
 461         POPJ    P,              ;RETURN\r
 462         >\r
 463 \r
 464 \f\r
 465 ;WRITE CHAIN FILES\r
 466 \r
 467 CHNC:   SKIPA   A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST BLOCK DATA\r
 468 CHNR:   HLR     A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST F4 PROG\r
 469         HRRZS   A               ;ONLY RIGHT HALF IS SIGNIFICANT\r
 470         JUMPE   A,LD7C          ;DON'T CHAIN IF ZERO\r
 471         TLNN    N,AUXSWI        ;IS THERE AN AUX DEV?\r
 472         JRST    LD7D            ;NO, DON'T CHAIN\r
 473         PUSH    P,A             ;SAVE WHEREFROM TO CHAIN\r
 474         SKIPE   D               ;STARTING ADDR SPECIFIED?\r
 475         HRR     F,D             ;USE IT\r
 476         PUSHJ   P,SASYM         ;DO LIB SEARCH, SETUP JOBSA, ETC.\r
 477         POP     P,A             ;GET WHEREFROM\r
 478         MOVN    W,JOBREL        ;CALCULATE IOWD FOR DUMP\r
 479         ADDI    W,-1-3-CHN5(A)  ;...\r
 480         HRLI    W,-4-CHN5(A)    ;...\r
 481         MOVSM   W,IOWDPP        ;...\r
 482         ADDI    A,-4-CHN5(X)    ;ADD IN OFFSET\r
 483 IFN CHN5,<PUSH  A,JOBSYM(X)     ;SETUP FOUR WORD TABLE\r
 484         PUSH    A,JOB41(X)      ;...>\r
 485         PUSH    A,JOBDDT(X)     ;JOBDDT IN ALL CASES\r
 486 IFE CHN5,<PUSH  A,JOBSYM(X)     ;JOBDDT, JOBSYM, JOBSA>\r
 487         PUSH    A,JOBSA(X)      ;JOBRYM ALWAYS LAST\r
 488         CLOSE   2,              ;INSURE END OF MAP FILE\r
 489         SETSTS  2,17            ;SET AUX DEV TO DUMP MODE\r
 490         MOVSI   W,435056        ;USE .CHN AS EXTENSION\r
 491         MOVEM   W,DTOUT1        ;...\r
 492         PUSHJ   P,IAD2          ;DO THE ENTER\r
 493         TLZ     N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT\r
 494         MOVE    W,[SIXBIT ?CHAIN?]      ;FINAL MESSAGE\r
 495         PUSHJ   P,BLTSET                ;SETUP BLT PNTR, SETDDT, RELEAS\r
 496         CALLI   CDDTGT          ;START DDT MODE OUTPUT\r
 497         MOVSI   CHNBLT,CHAIN3   ;BLT CHAIN3 INTO ACS\r
 498         BLT     CHNBLT,CHNBLT   ;...\r
 499         MOVEI   P,CHNERR        ;POINTER TO ERR MESS\r
 500         JRST    0               ;GO DO CHAIN\r
 501 \r
 502 \f\r
 503 ;THE AC SECTION OF CHAIN\r
 504 \r
 505 CHAIN3:\r
 506         PHASE   0\r
 507         BLT     Q,(A)           ;USUAL LDRBLT\r
 508         OUTPUT  2,IOWDP         ;WRITE THE CHAIN FILE\r
 509         STATZ   2,IOBAD!IODEND  ;CHECK FOR ERROR OR EOF\r
 510         JRST    LOSEBIG         ;FOUND SAME, GO GRIPE\r
 511         CLOSE   2,              ;FINISH OUTPUT\r
 512         STATZ   2,IOBAD!IODEND  ;CHECK FOR FINAL ERROR\r
 513 LOSEBI: CALLI   CDDTOUT         ;GRIPE ABOUT ERROR\r
 514         CALLI   CEXIT           ;EXIT\r
 515 CHNERR: ASCIZ   ?DEVICE ERROR?  ;ERROR MESSAGE\r
 516 IOWDP:  Z                       ;STORE IOWD FOR DUMP HERE\r
 517 CHNBLT:                         ;LAST WORD OF AC CHAIN (ZERO OF I/O POINTER)\r
 518         DEPHASE\r
 519 IOWDPP=.-1                      ;MEMORY LOC OF AC IOWDP\r
 520         Z                       ;TERMINATOR OF DUMP MODE LIST\r
 521 \r
 522 \f;EXPAND CORE\r
 523 \r
 524 IFN EXPAND,<\r
 525 XPAND:  PUSH P,H        ;GET SOME REGISTERS TO USE\r
 526         PUSH P,X\r
 527         PUSH P,N\r
 528         HRRZ X,JOBREL   ;WHAT WE WANT\r
 529         ADDI X,2000\r
 530         CALLI X,11\r
 531         JRST XPAND6\r
 532 IFE K,<         HRRZ H,MLTP     ;GET LOWEST LOCATION\r
 533         TLNN N,F4SW     ;IS FORTRAN LOADING>\r
 534         HRRZ H,S        ;NO, USE S\r
 535         HRRZ X,JOBREL   ;NOW MOVE\r
 536         SUBI X,2000\r
 537 XPAND2: MOVE N,(X)\r
 538         MOVEM N,2000(X)\r
 539         CAMLE X,H       ;TEST FOR END\r
 540         SOJA X,XPAND2;          HAND EYE SYSTEM MOVES TABLE\r
 541         HRLI H,-2000\r
 542         SETZM (H)       ;ZERO NEW CORE\r
 543         AOBJN H,.-1\r
 544         MOVEI H,2000\r
 545         ADDM H,S\r
 546         ADDM H,B\r
 547         ADDM H,JOBSYM\r
 548         POP P,N\r
 549         ADDI N,2000\r
 550 IFE K,< TLNN N,F4SW     ;F4?\r
 551         JRST    XPAND3\r
 552         ADDM H,PLTP\r
 553         ADDM H,BITP\r
 554         ADDM H,SDSTP\r
 555         ADDM H,MLTP\r
 556         TLNE N,SYDAT\r
 557         ADDM H,V>\r
 558 XPAND3:\r
 559         POP P,X\r
 560         POP P,H\r
 561         AOS (P)\r
 562         POPJ P,\r
 563 XPAND6: JUMPE X,XPAND4\r
 564         JSP A,ERRPT\r
 565         SIXBIT /CORE AVAILABLE, BUT NOT TO YOU#/\r
 566 XPAND4: JSP A,ERRPT\r
 567         SIXBIT /MORE CORE NEEDED#/\r
 568 XPAND5: POP P,N\r
 569         POP P,X\r
 570         POP P,H\r
 571         POPJ P,\r
 572 \r
 573 XPAND7: PUSHJ   P,XPAND\r
 574         JRST    SFULLC\r
 575         JRST    POPJM2\r
 576 \r
 577 POPJM3: SOS     (P)             ;POPJ TO CALL-2\r
 578 POPJM2: SOS     (P)             ;POPJ TO CALL-1\r
 579         SOS     (P)             ;SAME AS POPJ TO\r
 580         POPJ    P,              ;NORMAL POPJ MINUS TWO\r
 581 \f\r
 582 \r
 583 ;ENTER SWITCH MODE\r
 584 \r
 585 LD6A:   CAIN    T,57            ;WAS CHAR A SLASH?\r
 586         TLO     N,SLASH         ;REMEBER THAT\r
 587         TLO     F,SSW           ;ENTER SWITCH MODE\r
 588 LD6A1:  MOVEI   D,0             ;ZERO THE NUBER REGISTER\r
 589         JRST    LD3             ;EAT A SWITCH\r
 590 \r
 591 ;ALPHABETIC CHARACTER, SWITCH MODE\r
 592 \r
 593 LD6:    XCT     LD6B-101(T)     ;EXECUTE SWITCH FUNCTION\r
 594         TLZE    N,SLASH ;SWITCH MODE ENTERED W/ SLASH?\r
 595         JRST    LD6D            ;LEAVE SWITCH MODE\r
 596         JRST    LD6A1           ;STAY IN SWITCH MODE\r
 597 \r
 598 ;DISPATCH TABLE FOR SWITCHES\r
 599 \r
 600 ;       THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED\r
 601 \r
 602 LD6B:   TLO     N,ALLFLG        ;A - LIST ALL GLOBALS\r
 603         JRST    LD7B            ;B - ERROR\r
 604         PUSHJ   P,CHNC          ;C - CHAIN, START W/ COMMON\r
 605         PUSHJ     P,LDDT        ;D - DEBUG OPTION, LOAD DDT\r
 606         TLO     N,EXEQSW        ;E - LOAD AND GO\r
 607         PUSHJ     P,LIBF        ;F - LIBRARY SEARCH\r
 608         PUSHJ     P,LD5E        ;G - GO INTO EXECUTION\r
 609         PUSHJ P,LRAIDX          ;H - LOAD AN START RAID\r
 610         TLO     N,ISAFLG        ;I - IGNORE STARTING ADDRESSES\r
 611         TLZ     N,ISAFLG        ;J - USE STARTING ADDRESSES\r
 612 IFE BLTSYM,<JRST        LD7B            ;K - ERROR>\r
 613 IFN BLTSYM,<PUSHJ P,KORADJ      ;K - RESERVE SPACE FOR SYM DEFS>\r
 614         TLO     F,LIBSW+SKIPSW  ;L - ENTER LIBRARY SEARCH\r
 615         PUSHJ     P,PRMAP       ;M - PRINT STORAGE MAP\r
 616         TLZ     F,LIBSW+SKIPSW  ;N - LEAVE LIBRARY SEARCH\r
 617         HRR     R,D             ;O - NEW PROGRAM ORIGIN\r
 618         TLO     F,NSW           ;P - PREVENT AUTO. LIB. SEARCH\r
 619         TLZ     F,NSW           ;Q - ALLOW AUTO. LIB. SEARCH\r
 620         PUSHJ   P,CHNR          ;R - CHAIN, START W/ RESIDENT\r
 621         TLO     F,SYMSW         ;S - LOAD WITH SYMBOLS\r
 622         PUSHJ   P,LDDTX         ;T - LOAD AND GO TO DDT\r
 623         PUSHJ     P,PMS         ;U - PRINT UNDEFINED LIST\r
 624         PUSHJ P,LRAID           ;V - LOAD RAID\r
 625         TLZ     F,SYMSW+DSYMSW  ;W - LOAD WITHOUT SYMBOLS\r
 626         TLZ     N,ALLFLG        ;X - DO NOT LIST ALL GLOBALS\r
 627         TLO     F,REWSW         ;Y - REWIND BEFORE USE\r
 628         JRST    LD              ;Z - RESTART LOADER\r
 629 \r
 630 \f\r
 631 ;SWITCH MODE NUMERIC ARGUMENT\r
 632 \r
 633 LD6C:   LSH     D,3             ;BUILD OCTAL NUMERIC ARGUMENT\r
 634         ADDI    D,-60(T)\r
 635         JRST    LD3\r
 636 \r
 637 ;EXIT FROM SWITCH MODE\r
 638 \r
 639 LD6D:   TLZ     F,SSW           ;CLEAR SWITCH MODE FLAG\r
 640         TLNE    F,FSW           ;TEST FORCED SCAN FLAG\r
 641         JRST    LD2D            ;SCAN FORCED, START NEW IDENT.\r
 642         JRST    LD3             ;SCAN NOT FORCED, USE PREV IDENT\r
 643 ;ILLEGAL CHARACTER, NORMAL MODE\r
 644 \r
 645 LD7:    JSP     A,ERRPT8\r
 646         SIXBIT    /CHAR.%/\r
 647         JRST    LD2\r
 648 \r
 649 ;SYNTAX ERROR, NORMAL MODE\r
 650 \r
 651 LD7A:   JSP     A,ERRPT8\r
 652         SIXBIT    /SYNTAX%/\r
 653         JRST    LD2\r
 654 \r
 655 ;ILLEGAL CHARACTER, SWITCH MODE\r
 656 \r
 657 LD7B:   JSP     A,ERRPT8\r
 658         SIXBIT    /SWITCH%/\r
 659         JRST    LD2\r
 660 \r
 661 ;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0\r
 662 \r
 663 LD7C:   JSP     A,ERRPT         ;GRIPE\r
 664         SIXBIT  ?UNCHAINABLE AS LOADED@?\r
 665         JRST    LD2\r
 666 \r
 667 ;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE\r
 668 \r
 669 LD7D:   JSP     A,ERRPT         ;GRIPE\r
 670         SIXBIT  ?NO CHAIN DEVICE@?\r
 671         JRST    LD2\r
 672 \r
 673 IFN BLTSYM,<KORADJ:     CAMLE D,KORSP   ;IF SMALLER IGNORE\r
 674         MOVEM D,KORSP\r
 675         POPJ P,>\r
 676 \f\r
 677 ;CHARACTER CLASSIFICATION TABLE DESCRIPTION:\r
 678 \r
 679 ;       EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE\r
 680 ;       PACKED IN THE CHARACTER CLASSIFICATION TABLE.  THE CHARACTER\r
 681 ;       CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE\r
 682 ;       DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.\r
 683 ;       CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND\r
 684 ;       THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS.  FOUR CODES\r
 685 ;       ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS\r
 686 ;       IN EFFECT.\r
 687 \r
 688 \r
 689 ;CLASSIFICATION BYTE CODES:\r
 690 \r
 691 ;       BYTE DISP CLASSIFICATION\r
 692 \r
 693 ;       00 - 00  ILLEGAL CHARACTER, SWITCH MODE\r
 694 ;       01 - 01  ALPHABETIC CHARACTER, SWITCH MODE\r
 695 ;       02 - 02  NUMERIC CHARACTER, SWITCH MODE\r
 696 ;       03 - 03  SWITCH MODE ESCAPE, SWITCH MODE\r
 697 \r
 698 ;       00 - 04  ILLEGAL CHARACTER, NORMAL MODE\r
 699 ;       01 - 05  ALPHABETIC CHARACTER, NORMAL MODE\r
 700 ;       02 - 06  NUMERIC CHARACTER, NORMAL MODE\r
 701 ;       03 - 07  SWITCH MODE ESCAPE, NORMAL MODE\r
 702 \r
 703 ;       04 - 10  IGNORED CHARACTER\r
 704 ;       05 - 11  ENTER SWITCH MODE CHARACTER\r
 705 ;       06 - 12  DEVICE IDENTIFIER DELIMITER\r
 706 ;       07 - 13  FILE EXTENSION DELIMITER\r
 707 ;       10 - 14  OUTPUT SPECIFICATION DELIMITER\r
 708 ;       11 - 15  INPUT SPECIFICATION DELIMITER\r
 709 ;       12 - 16  LINE TERMINATION\r
 710 ;       13 - 17  JOB TERMINATION\r
 711 \r
 712 \f\r
 713 ;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE\r
 714 \r
 715 LD8:    POINT     4,LD9(Q),3\r
 716         POINT     4,LD9(Q),7\r
 717         POINT     4,LD9(Q),11\r
 718         POINT     4,LD9(Q),15\r
 719         POINT     4,LD9(Q),19\r
 720         POINT     4,LD9(Q),23\r
 721         POINT     4,LD9(Q),27\r
 722         POINT     4,LD9(Q),31\r
 723         POINT     4,LD9(Q),35\r
 724 \r
 725 ;CHARACTER CLASSIFIACTION TABLE\r
 726 \r
 727 LD9:    BYTE    (4)4,0,0,0,0,0,0,0,0\r
 728         BYTE    (4)4,4,4,4,12,0,0,0,0\r
 729         BYTE    (4)0,0,0,0,0,0,0,0,0\r
 730         BYTE    (4)13,0,0,0,0,4,0,4,0\r
 731         BYTE    (4)0,0,0,0,5,3,0,0,11\r
 732         BYTE    (4)0,7,5,2,2,2,2,2,2\r
 733         BYTE    (4)2,2,2,2,6,0,0,10,0\r
 734         BYTE    (4)0,0,1,1,1,1,1,1,1\r
 735         BYTE    (4)1,1,1,1,1,1,1,1,1\r
 736         BYTE    (4)1,1,1,1,1,1,1,1,1\r
 737 IFE PP,<BYTE    (4)1,0,0,0,0,10,0,0,0>\r
 738 IFN PP,<BYTE    (4)1,10,0,10,0,10,0,0,0>\r
 739         BYTE    (4)0,0,0,0,0,0,0,0,0\r
 740         BYTE    (4)0,0,0,0,0,0,0,0,0\r
 741         BYTE    (4)0,0,0,0,0,0,0,0,13\r
 742         BYTE    (4)13,4\r
 743 \r
 744 \f\r
 745 ;INITIALIZE LOADING OF A FILE\r
 746 \r
 747 ILD:    MOVEI     W,BUF1                ;LOAD BUFFER ORIGIN\r
 748         MOVEM     W,JOBFF\r
 749         TLOE    F,ISW           ;SKIP IF INIT REQUIRED\r
 750         JRST    ILD6            ;DONT DO INIT\r
 751         INIT    1,14\r
 752 ILD1:   0                               ;LOADER INPUT DEVICE\r
 753         XWD     0,BUFR\r
 754         JSP     A,ILD5          ;ERROR RETURN\r
 755 ILD6:   TLZE    F,REWSW         ;SKIP IF NO REWIND\r
 756         MTAPE   1,1             ;REWIND\r
 757 ILD2:   LOOKUP    1,DTIN                ;LOOK UP FILE FROM DIRECTORY\r
 758         JRST    ILD3            ;FILE NOT IN DIRECTORY\r
 759 IFE K,< INBUF     1,2           ;SET UP BUFFERS>\r
 760 IFN K,< INBUF   1,1             ;SET UP BUFFER>\r
 761         TLO     F,ASW           ;SET LEFT ARROW ILLEGAL FLAG\r
 762         TLZ     F,ESW+F4LIB     ;CLEAR EXTENSION FLAG\r
 763         POPJ    P,\r
 764 \r
 765 ;       LOOKUP FAILURE\r
 766 \r
 767 ILD3:   TLOE    F,ESW           ;SKIP IF .REL WAS ASSUMED\r
 768         JRST    ILD4            ;FATAL LOOKUP FAILURE\r
 769         SETZM     DTIN1         ;ZERO FILE EXTENSION\r
 770         JRST    ILD2            ;TRY AGAIN WITH NULL EXTENSION\r
 771 \r
 772 ILD4:   TLZE    F,F4LIB         ;WAS THIS A TRY FOR F40 LIBRARY?\r
 773         JRST    [MOVE   W,[SIXBIT /LIB4/]; YES, TRY LIB4\r
 774                 MOVEM   W,DTIN          ;...\r
 775                 PUSHJ   P,LDDT2         ;USE .REL EXTENSION\r
 776                 TLZ     F,ESW           ;...\r
 777                 JRST    ILD2            ];GO TRY AGAIN\r
 778 ILD9:   JSP     A,ERRPT\r
 779         SIXBIT    /CANNOT FIND#/\r
 780         JRST    LD2\r
 781 \r
 782 ;       DEVICE SELECTION ERROR\r
 783 \r
 784 ILD5:   MOVE    W,-3(A)         ;LOAD DEVICE NAME FROM INIT\r
 785         TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
 786         PUSHJ   P,PRQ           ;START W/ ?\r
 787         PUSHJ     P,PWORD               ;PRINT DEVICE NAME\r
 788         JSP     A,ERRPT7\r
 789         SIXBIT    /UNAVAILABLE@/\r
 790         JRST    LD2\r
 791 \f\r
 792 ;LIBRARY SEARCH CONTROL AND LOADER CONTROL\r
 793 \r
 794 ;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>\r
 795 \r
 796 LIBF:   PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION\r
 797         PUSHJ   P,LIBF1                 ;LOAD SYS:JOBDAT.REL\r
 798         TLO     F,F4LIB                 ;INDICATE FORTRAN LIBRARY SEARCH\r
 799         MOVE    W,[SIXBIT /LIB40/]      ;FIRST TRY AT NAME\r
 800         PUSHJ   P,LIBF2                 ;LOAD SYS:LIB40.REL\r
 801 LIBF1:  MOVE    W,[SIXBIT /JOBDAT/]     ;LOAD SYS:JOBDAT.REL\r
 802 LIBF2:  PUSHJ     P,LDDT1\r
 803         JUMPGE    S,EOF2                ;JUMP IF NO UNDEFINED GLOBALS\r
 804         TLO     F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH\r
 805         TLZ     F,SYMSW+DSYMSW  ;DISABLE LOADING WITH SYMBOLS\r
 806         JRST    LDF             ;INITIALIZE LOADING LIB4\r
 807 \r
 808 ;       LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE\r
 809 \r
 810 LIB:    JUMPGE    S,EOF1                ;JUMP IF NO UNDEFINED GLOBALS\r
 811         TLO     F,SKIPSW                ;SET SKIPSW TO IGNORE MODE\r
 812         JRST    LOAD            ;CONTINUE LIB. SEARCH\r
 813 \r
 814 LIB1:   CAIE    A,4             ;TEST FOR ENTRY BLOCK\r
 815         JRST    LIB3            ;NOT AN ENTRY BLOCK, IGNORE IT\r
 816 LIB2:   PUSHJ     P,RWORD               ;READ ONE DATA WORD\r
 817         MOVE    C,W\r
 818         TLO     C,040000                ;SET CODE BITS FOR SEARCH\r
 819         PUSHJ     P,SREQ\r
 820         TLZA    F,SKIPSW                ;REQUEST MATCHES ENTRY, LOAD\r
 821         JRST    LIB2            ;NOT FOUND\r
 822 LIB3:   PUSHJ     P,RWORD               ;READ AND IGNORE ONE DATA WORD\r
 823         JRST    LIB3            ;LOOP TO IGNORE INPUT\r
 824 \r
 825 ;LDDT LOADS <SYS:DDT.REL> AND SETS DSYMSW\r
 826 \r
 827 LRAIDX: TLO N,DDSW!EXEQSW       ;H - LOAD AND START RAID\r
 828 LRAID:  PUSHJ P,FSCN1           ;FORCE END OF SCAN\r
 829         MOVE W,[SIXBIT /RAID/]\r
 830         JRST LDDT0\r
 831 LDDTX:  TLO     N,DDSW+EXEQSW   ;T - LOAD AND GO TO DDT\r
 832 LDDT:   PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION\r
 833         MOVSI     W,444464              ;FILE IDENTIFIER <DDT>\r
 834 LDDT0:  PUSHJ     P,LDDT1\r
 835         PUSHJ     P,LDF         ;LOAD <SYS:DDT.REL>\r
 836         TLO     F,DSYMSW                ;ENABLE LOADING WITH SYMBOLS\r
 837         POPJ    P,\r
 838 \r
 839 LDDT1:  MOVEM     W,DTIN                ;STORE FILE IDENTIFIER\r
 840 IFN PP,<MOVE W,ILD1     ;SAVE OLD DEV\r
 841         MOVEM W,OLDDEV>\r
 842         MOVSI     W,637163              ;DEVICE IDENTIFIER <SYS>\r
 843         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER\r
 844         TLZ     F,ISW+LIBSW+SKIPSW+REWSW        ;CLEAR OLD FLAGS\r
 845 LDDT2:  MOVSI     W,624554              ;EXTENSION IDENTIFIER <.REL>\r
 846 LDDT3:  MOVEM     W,DTIN1               ;STORE EXTENSION IDENTIFIER\r
 847 IFN PP,<MOVE W,PPN      ;GET PROJ-PROG #\r
 848         MOVEM W,DTIN+3>\r
 849         POPJ    P,\r
 850 \f;EOF TERMINATES LOADING OF A FILE\r
 851 \r
 852 EOF:    MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER\r
 853 EOF1:   TLZ     F,SLIBSW+SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG\r
 854 EOF2:   POPJ    P,\r
 855 \r
 856 ;       FORCE SCAN TO COMPLETION, LOAD IF NECESSARY\r
 857 \r
 858 FSCN:   PUSHJ     P,FSCN1               ;FORCED LOAD BEFORE TEST\r
 859         TLNN    F,FULLSW                ;TEST FOR OVERLAP\r
 860         POPJ    P,                      ;NO OVERLAP, RETURN\r
 861         MOVE    W,H             ;FETCH CORE SIZE REQUIRED\r
 862         SUBI W,1(S) ; COMPUT DEFICIENCY\r
 863         JUMPL     W,EOF2                ;JUMP IF NO OVERLAP\r
 864         TLO     F,FCONSW                ;INSURE TTY OUTPUT\r
 865         PUSHJ   P,PRQ                   ;START WITH ?\r
 866         PUSHJ     P,PRNUM0              ;INFORM USER\r
 867         JSP     A,ERRPT7\r
 868         SIXBIT    /WORDS OF OVERLAP#/\r
 869         JRST    LD2             ;ERROR RETURN\r
 870 \r
 871 FSCN1:  TLON    F,FSW           ;SKIP IF NOT FIRST CALL TO FSCN\r
 872         TLNN    F,CSW+DSW+ESW   ;TEST SCAN FOR COMPLETION\r
 873         ;               HAND EYE DOES NOT WANT FORCED SCAN\r
 874         POPJ    P,\r
 875 FSCN2:  PUSHJ     P,LD5B1               ;STORE FILE OR EXTENSION IDENT.\r
 876 \r
 877 ;       LOADER CONTROL, NORMAL MODE\r
 878 \r
 879 LDF:    PUSHJ     P,ILD         ;INITIALIZE LOADING\r
 880 \r
 881 \f;LOAD SUBROUTINE\r
 882 \r
 883 LOAD:   MOVEM     P,PDSAV               ;SAVE PUSHDOWN POINTER\r
 884 LOAD1:  MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER\r
 885 LOAD1A:   PUSHJ     P,WORD              ;INPUT BLOCK HEADER WORD\r
 886         MOVNI     E,400000(W)   ;WORD COUNT - FROM RH OF HEADER\r
 887         HLRZ    A,W             ;BLOCK TYPE - FROM LH OF HEADER\r
 888         CAILE     A,DISPL*2+1           ;TEST BLOCK TYPE NUMBER\r
 889         JRST    LOAD4           ;ERROR, ILLEGAL BLOCK TYPE\r
 890         TLNE    F,SKIPSW                ;BLOCK OK - TEST LOAD STATUS\r
 891         JRST    LIB1            ;RETURN TO LIB. SEARCH CONTROL\r
 892         HRRZ    T,LOAD2(A)              ;LOAD RH DISPATCH ENTRY\r
 893         CAILE     A,DISPL               ;SKIP IF CORRECT\r
 894         HLRZ    T,LOAD2-DISPL-1(A)      ;LOAD LH DISPATCH ENTRY\r
 895         TLNE    F,FULLSW                ;TEST CORE OVERLAP INDICATOR\r
 896         SOJG    A,HIGH0         ;IGNORE BLOCK IF NOT TYPE 1\r
 897         JRST    @T                      ;DISPATCH TO BLOCK SUBROUTINE\r
 898 \r
 899 ;DISPATCH TABLE - BLOCK TYPES\r
 900 \r
 901 LOAD2:  XWD NAME,LOAD1A\r
 902         XWD START,PROG\r
 903         XWD LOCD,SYM\r
 904         XWD LOAD4A,LOAD4A\r
 905         XWD LOAD4A,LIB3\r
 906 LOAD3:  XWD LOAD4A,HIGH\r
 907 \r
 908         DISPL=LOAD3-LOAD2\r
 909 \r
 910 ;ERROR EXIT FOR BAD HEADER WORDS\r
 911 \r
 912 LOAD4:  IFE K,<\r
 913         CAIN    A,400           ;FORTRAN FOUR BLOCK\r
 914         JRST    F4LD>\r
 915 LOAD4A:   JSP   A,ERRPT         ;INCORRECT HEADER WORD\r
 916         SIXBIT    /ILL. FORMAT#/\r
 917         JRST    LD2\r
 918 \r
 919 \f;LOAD PROGRAMS AND DATA (BLOCK TYPE 1)\r
 920 \r
 921 PROG:   HRRZ    V,W             ;LOAD BLOCK LENGTH\r
 922         PUSHJ     P,RWORD               ;READ BLOCK ORIGIN\r
 923         ADD     V,W             ;COMPUTE NEW PROG. BREAK\r
 924         CAIG    H,@X            ;COMPARE WITH PREV. PROG. BREAK\r
 925         MOVEI     H,@X          ;UPDATE PROGRAM BREAK\r
 926                 TLNE F,FULLSW\r
 927                 JRST FULLC      ;NO ERROR MESSAGE\r
 928         CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE\r
 929 IFN EXPAND,<    JRST    [PUSHJ P,XPAND>\r
 930                         JRST FULLC\r
 931 IFN EXPAND,<            JRST .-1]>\r
 932         MOVE    V,W\r
 933 PROG1:  PUSHJ     P,RWORD               ;READ DATA WORD\r
 934 IFN L,< CAML V,RINITL   ;ABSOLUTE >\r
 935         MOVEM     W,@X          ;STORE DATA WORD IN PROG. AT LLC\r
 936         AOJA    V,PROG1         ;ADD ONE TO LOADER LOC. COUNTER\r
 937 \r
 938 ;LOAD SYMBOLS (BLOCK TYPE 2)\r
 939 \r
 940 SYM:    PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
 941         PUSHJ   P,SYMPT;                PUT INTO TABLE\r
 942         JRST    SYM\r
 943 \r
 944 ; WFW SYMPT:    JUMPL   C,SYM3;         JUMP IF GLOBAL REQUEST\r
 945 SYMPT:  TLNE C,200000   ;GLOBAL REQUEST? WFW\r
 946         JUMPL C,SYM3    ;CHECK FOR 60 NOT JUST HIGH BIT WFW\r
 947         TLNE    C,100000\r
 948         JRST    SYM1A           ;LOCAL SYMBOL\r
 949         PUSHJ     P,SREQ                ;GLOBAL DEF., SEARCH FOR REQUEST\r
 950         JRST    SYM2            ;REQUEST MATCHES\r
 951         PUSHJ     P,SDEF                ;SEARCH FOR MULTIPLE DEFINITIONS\r
 952         JRST    SYM1            ;MULTIPLY DEFINED GLOBAL\r
 953         JRST    SYM1B\r
 954 \r
 955 ;       PROCESS MULTIPLY DEFINED GLOBAL\r
 956 \r
 957 SYM1:   CAMN    W,2(A)          ;COMPARE NEW AND OLD VALUE\r
 958         POPJ    P,;\r
 959         AOS     MDG             ;COUNT MULTIPLY DEFINED GLOBALS\r
 960         PUSHJ   P,PRQ           ;START W/ ?\r
 961         PUSHJ     P,PRNAM               ;PRINT SYMBOL AND VALUE\r
 962         MOVE    W,2(A)          ;LOAD OLD VALUE\r
 963         PUSHJ     P,PRNUM               ;PRINT OLD VALUE\r
 964         JSP     A,ERRPT7                ;PRINT MESSAGE\r
 965         SIXBIT    /MUL. DEF. GLOBAL#/\r
 966         POPJ    P,;     IGNORE MUL. DEF. GLOBAL SYM\r
 967 \r
 968 \f;      LOCAL SYMBOL\r
 969 \r
 970 SYM1A:  TLNN    F,SYMSW+DSYMSW  ;SKIP IF LOAD LOCALS SWITCH ON\r
 971         POPJ    P,;             IGNORE LOCAL SYMBOLS\r
 972 SYM1B:  CAIL    H,(S)           ;STORE DEFINED SYMBOL\r
 973 IFN EXPAND,<    PUSHJ P,XPAND7>\r
 974 IFE EXPAND,<    JRST SFULLC>\r
 975 SYM1C:  IFE K,<\r
 976         TLNE    N,F4SW;         FORTRAN FOUR REQUIRES A BLT\r
 977         PUSHJ   P,MVDWN;        OF THE TABLES>\r
 978         MOVEI A,-2(S)   ;LOAD A TO SAVE INST. AT SYM2\r
 979 SYM1D:  SUBI    S,2;            UPDATE UNDEFINED POINTER\r
 980         POP     B,2(A)          ;MOVE UNDEFINED VALUE POINTER\r
 981         POP     B,1(A)          ;MOVE UNDEFINED SYMBOL\r
 982         MOVEM     W,2(B)                ;STORE VALUE\r
 983         MOVEM     C,1(B)                ;STORE SYMBOL\r
 984         POPJ    P,;\r
 985 \r
 986 \f;      GLOBAL DEFINITION MATCHES REQUEST\r
 987 \r
 988 SYM2:   PUSH P,SYM2C    ;NEXT MUST BE A SUBROUTINE FOR LATER. SET RETURN\r
 989 SYM2B:  MOVE    V,2(A)          ;LOAD REQUEST POINTER\r
 990         PUSHJ P,REMSYM\r
 991         JUMPL V,SYM2W   ;ADDITIVE REQUEST? WFW\r
 992         PUSHJ     P,SYM4A               ;REPLACE CHAIN WITH DEFINITION\r
 993 ;WFW PATCH TO LOOK FOR MORE THAN ONE REQUEST\r
 994 SYM2W1: PUSHJ P,SREQ    ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL\r
 995         JRST SYM2B      ;FOUND MORE\r
 996         MOVE A,SVA      ;RESTORE A\r
 997 ;END OF PATCH WFW\r
 998 SYM2C:  POPJ P,SYM1D    ;RETURN, SEE SYM2 FOR USE OF ADDRESS\r
 999 SVA:    0       ;A TEMP CELL WFW\r
1000 \r
1001 ;       REQUEST MATCHES GLOBAL DEFINITION\r
1002 \r
1003 SYM2A:  MOVE    V,W             ;LOAD POINTER TO CHAIN\r
1004         MOVE    W,2(A)          ;LOAD VALUE\r
1005         JUMPL V,FIXWP   ;HANDLE ATTITIVE REQUEST WFW\r
1006         JRST    SYM4A;          REPLACE CHAIN WITH DEFINITION\r
1007 \r
1008 ;       PROCESS GLOBAL REQUEST\r
1009 \r
1010 SYM3:   TLNE    C,040000;               COMMON NAME\r
1011         JRST    SYM1B\r
1012         TLC     C,640000;               PERMUTE BITS FROM 60 TO 04\r
1013         PUSHJ     P,SDEF                ;SEARCH FOR GLOBAL DEFINITION\r
1014         JRST    SYM2A           ;MATCHING GLOBAL DEFINITION\r
1015         JUMPL W,SYM3X1  ;ADDITIVE FIXUP WFW\r
1016         PUSHJ     P,SREQ                ;SEARCH FOR EXISTING REQUEST WFW\r
1017         JRST    SYM3A           ;EXISTING REQUEST FOUND WFW\r
1018 SYM3X1: TLNN W,100000   ;CHECK SYMBOL TABLE FIXUP\r
1019         JRST SYM3X2     ;NO\r
1020         MOVE V,1(B)     ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL\r
1021         XOR V,W         ;CHECK FOR IDENTITY\r
1022         TDNE V,[XWD 77777,-1]   ;BUT IGNORE HIGH 3 BITS\r
1023         POPJ P,         ;NOT SAME, ASSUME NOT LOADED LOCAL\r
1024         HRRI W,2(B)     ;GET LOCATION IN RIGHT HALF\r
1025         TLO W,1\r
1026         SUB W,JOBREL    ;AND MAKE RELATIVE\r
1027 SYM3X2: CAIL    H,(S)           ;STORE REQUEST IN UNDEF. TABLE WFW\r
1028 IFN EXPAND,<    PUSHJ P,XPAND7>\r
1029 IFE EXPAND,<    JRST SFULLC>\r
1030 SYM3X:  IFE K,<\r
1031         TLNE    N,F4SW;         FORTRAN FOUR\r
1032         PUSHJ   P,MVDWN;                ADJUST TABLES IF F4>\r
1033         SUB     S,SE3           ;ADVANCE UNDEFINED POINTER\r
1034         MOVEM     W,2(S)                ;STORE UNDEFINED VALUE POINTER\r
1035         MOVEM     C,1(S)                ;STORE UNDEFINED SYMBOL\r
1036         POPJ    P,;\r
1037 \r
1038 \f\r
1039 ;       COMBINE TWO REQUEST CHAINS\r
1040 \r
1041 SYM3A:  SKIPL 2(A)      ;IS IT ADDITIVE WFW\r
1042         JRST SYM3A1     ;NO, PROCESS WFW\r
1043         PUSHJ P,SDEF2   ;YES, CONTINUE WFW\r
1044         JRST SYM3A      ;FOUND ANOTHER WFW\r
1045         JRST SYM3X2     ;REALLY NO CHAIN THERE WFW\r
1046 SYM3A1: SUBI A,-2(X)  ;A=A-(-2+X(18-35)); A RELATIVE TO X WFW\r
1047 SYM3B:  HRRZ V,A       ; SAVE CHAIN ADDRESS FOR HRRM W,@X\r
1048 IFN L,< CAMGE V,RINITL\r
1049         HALT    ;LOSE LOSE LOSE>\r
1050         HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN\r
1051         JUMPN A,SYM3B  ; JUMP IF NOT THE LAST ADDR. IN CHAIN\r
1052         HRRM    W,@X            ;COMBINE CHAINS\r
1053         POPJ    P,;\r
1054 ;LHQ PATCH FOR LISP ABSOLUTE FIXUP PREVENTION\r
1055 IFN L,<\r
1056 VTST:   0\r
1057         MOVEM V,VSVV#\r
1058         HRRZS V\r
1059         CAMGE V,RINITL\r
1060         POPJ P,\r
1061         MOVE V,VSVV\r
1062         JRST @VTST>\r
1063 \r
1064 ;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS\r
1065 \r
1066 FIXWP:  TLNN V,100000   ;CHECK FOR SYMBOL TABLE FIXUP\r
1067         JRST FIXW\r
1068         MOVE T,1(B)     ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED\r
1069         XOR T,V         ;CHECK FOR SAME\r
1070         TDNE T,[XWD 77777,-1]   ;EXCEPT FOR HEGH CODE BITS\r
1071         POPJ P,         ;ASSUME NON-LOADED LOCAL\r
1072         HRRI V,2(B)     ;GET LOCATION\r
1073         SUBI V,(X)      ;SO WE CAN USE @X\r
1074 FIXW:   TLNE V,200000   ;IS IT LEFT HALF\r
1075         JRST FIXWL\r
1076 IFN L,< JSR VTST>\r
1077         MOVE T,@X       ;GET WORD\r
1078         ADD T,W         ;VALUE OF GLOBAL\r
1079         HRRM T,@X       ;FIX WITHOUT CARRY\r
1080         MOVSI D,200000  ;SET UP TO REMOVE DEFERED INTERNAL IF THERE\r
1081         JRST SYMFIX\r
1082 FIXWL:  HRLZ    T,W             ;UPDATE VALUE OF LEFT HALF\r
1083 IFN L,< JSR VTST>\r
1084         ADDM    T,@X            ;BY VALUE OF GLOBAL\r
1085         MOVSI D,400000  ;LEFT DEFERED INTERNAL\r
1086 SYMFIX: TLNN V,100000   ;CHECK FOR SYMBOL TABLE FIXUP\r
1087         POPJ P,         ;NO, RETURN\r
1088         ADDI V,(X)      ;GET THE LOCATION\r
1089         MOVE T,-1(V)    ;GET THE SYMBOL NAME\r
1090         TLNN T,40000    ;CHECK TO SEE IF INTERNAL\r
1091         POPJ P,         ;NO, LEAVE\r
1092         ANDCAB D,-1(V)  ;REMOVE PROPER BIT\r
1093         TLNE D,600000   ;IS IT STILL DEFERED?\r
1094         POPJ P,         ;YES, ALL DONE\r
1095         EXCH C,D        ;NO, CHECK FOR A REQUEST FOR IT\r
1096         PUSHJ P,SREQ\r
1097         JRST CHNSYM     ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE\r
1098         MOVE C,D        ;GET C BACK\r
1099         POPJ P,\r
1100 CHNSYM: PUSH P,D        ;HAS THE OLD C IN IT\r
1101         PUSH P,W        ;WE MAY NEED IT LATER\r
1102         MOVE W,(V)      ;GET VALUE\r
1103         PUSHJ P,SYM2B   ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE\r
1104         POP P,W\r
1105         POP P,C         ;RESTORE FOR CALLER\r
1106         POPJ P,         ;AND GO AWAY\r
1107 \r
1108 SYM2W:  TLNN V,100000   ;SYMBOL TABLE?\r
1109         JRST SYM2WA\r
1110         ADD V,JOBREL    ;MAKE ABSOLUTE\r
1111         SUBI V,(X)      ;GET READY TO ADD X\r
1112         SYM2WA: PUSHJ P,FIXW    ;DO FIXUP\r
1113         JRST SYM2W1     ;AND LOOK FOR MORE REQUESTS\r
1114 \r
1115 ;END WFW PATCH\r
1116 \r
1117 \f;PATCH VALUES INTO CHAINED REQUEST\r
1118 SYM4:\r
1119 IFN L,< CAMGE V,RINITL\r
1120         POPJ P,>\r
1121         HRRZ    T,@X            ;LOAD NEXT ADDRESS IN CHAIN\r
1122         HRRM    W,@X            ;INSERT VALUE INTO PROGRAM\r
1123         MOVE    V,T\r
1124 SYM4A:  JUMPN     V,SYM4                ;JUMP IF NOT LAST ADDR. IN CHAIN\r
1125         POPJ    P,\r
1126 \r
1127 IFE     K,<\r
1128 MVDWN:  HRRZ T,MLTP\r
1129 IFN EXPAND,<    SUBI T,2>\r
1130         CAIG    T,@X;           ANY ROOM LEFT?\r
1131 IFN EXPAND,<    JRST    [PUSHJ P,XPAND>\r
1132                         TLOA F,FULLSW\r
1133 IFN EXPAND,<            JRST MVDWN\r
1134                         JRST .+2]>\r
1135         TLNE    F,SKIPSW+FULLSW\r
1136         JRST    MVABRT; ABORT BLT\r
1137         HRREI   T,-2\r
1138         ADDM    T,PLTP;         ADJUST PROGRAMMER LABEL POINTER\r
1139         ADDM    T,BITP;         AND BIT TABLE POINTER\r
1140         ADDM    T,SDSTP;        FIRST DATA STATEMENT\r
1141         ADDM    T,LTC\r
1142         ADDM    T,ITC\r
1143         TLNE    N,SYDAT\r
1144         ADDM    T,V\r
1145         ADDB    T,MLTP;         AND FINALLY TO MADE LABEL TABLE\r
1146         HRLS    T;              SET UP BLT POINTER\r
1147         ADD     T,[XWD 2,0]\r
1148         BLT     T,(S)\r
1149 MVABRT: POPJ    P,;\r
1150 >\r
1151 ;HIGHEST RELOCATABLE POINT (BLOCK TYPE 4)\r
1152 SFULLC: TLOE    F,FULLSW        ;PREVIOUS OVERFLOW?\r
1153         JRST    FULLC           ;YES, DON'T PRINT MESSAGE\r
1154         JSP     A,ERRPT         ;NO, COMPLAIN ABT OVERFLO\r
1155         SIXBIT  ?SYMBOL TABLE OVERLAP#?\r
1156 FULLC:  TLO     F,FULLSW        ;CORE OVERLAP ERROR RETURN\r
1157 IFE K,< TLNE    N,F4SW\r
1158         POPJ    P,>\r
1159         JRST    LIB3            ;LOOK FOR MORE\r
1160 \r
1161 HIGH0:  CAIE A,4  ; TEST FOR END BLOCK (OVERLAP)\r
1162         JRST    LIB3\r
1163 HIGH:   PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1164         HRR     R,C             ;SET NEW PROGRAM BREAK\r
1165         ADDI    C,X;    BE SURE TO RELOCATE\r
1166         CAILE   C,1(S)          ;TEST PROGRAM BREAK\r
1167 IFN EXPAND,<PUSHJ P,[   PUSHJ P,XPAND\r
1168                         TLOA F,FULLSW\r
1169                         JRST POPJM2\r
1170                         POPJ    P,]>\r
1171 IFE EXPAND,<TLO F,FULLSW>\r
1172 HIGH3:  MOVEI   A,F.C           ;SAVE CURRENT STATE OF LOADER\r
1173         BLT     A,B.C\r
1174         TLNE    F,SLIBSW+LIBSW  ;NORMAL MODE EXIT THROUGH LOAD1\r
1175         JRST    LIB             ;LIBRARY SEARCH EXIT\r
1176         JRST LOAD1\r
1177 \r
1178 \f;STARTING ADDRESS (BLOCK TYPE 7)\r
1179 \r
1180 START:  PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1181         TLNN    N,ISAFLG                ;SKIP IF IGNORE SA FLAG ON\r
1182         HRR     F,C             ;SET STARTING ADDRESS\r
1183 \r
1184 ;PROGRAM NAME (BLOCK TYPE 6)\r
1185 \r
1186 NAME:   PUSHJ     P,PRWORD              ;READ TWO DATA WORDS\r
1187         TLOE    N,COMFLG                ;SKIP IF COMMON NOT PREV. SET\r
1188         JRST    NAME1           ;SIZE OF COMMON PREV. SET\r
1189         MOVEM     W,COMSAV              ;STORE LENGTH OF COMMON\r
1190         JUMPE     W,NAME2               ;JUMP IF NO COMMON IN THIS JOB\r
1191         HRRI    R,@R            ;FIRST PROGRAM SET LOAD ORIGIN\r
1192 NAME1:  CAILE H,-1(S)           ;TEST FOR AVAIL. SYMBOL SPACE\r
1193 IFN EXPAND,<    PUSHJ P,XPAND7>\r
1194 IFE EXPAND,<    JRST SFULLC>\r
1195         SUBI    S,2             ;UPDATE UNDEF. TABLE POINTER\r
1196         POP     B,2(S)\r
1197         POP     B,1(S)\r
1198         HRRZ    V,N             ;POINTER TO PREVIOUS NAME\r
1199         SUBM    B,V             ;COMPUTE RELATIVE POSITIONS\r
1200         HRLM    V,2(N)          ;STORE FORWARD POINTER\r
1201         HRR     N,B             ;UPDATE NAME POINTER\r
1202 NAME2:  MOVEM     C,1(B)                ;STORE PROGRAM NAME\r
1203         HRRZM   R,2(B)          ;STORE PROGRAM ORIGIN\r
1204         CAMG    W,COMSAV                ;CHECK COMMON SIZE\r
1205         JRST    LIB3            ;COMMON OK\r
1206 ILC:    JSP     A,ERRPT\r
1207         SIXBIT    /ILL. COMMON#/\r
1208         JRST    LD2\r
1209 \f\r
1210 ;ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)\r
1211 \r
1212                         ;PMP PATCH FOR LEFT HALF FIXUPS\r
1213                         ;END PMP PATCH\r
1214 LOCD:   PUSHJ     P,RWORD               ;READ ONE DATA WORD\r
1215         HLRZ    V,W             ;STORAGE POINTER IN LEFT HALF\r
1216         PUSHJ     P,SYM4A               ;LINK BACK REFERENCES\r
1217         JRST    LOCD\r
1218 \r
1219 REMSYM: MOVE T,1(S)\r
1220         MOVEM T,1(A)\r
1221         MOVE T,2(S)\r
1222         MOVEM T,2(A)\r
1223         ADD S,SE3\r
1224         MOVEM A,SVA\r
1225         POPJ P,\r
1226 \r
1227 \f;SYMBOL TABLE SEARCH SUBROUTINES\r
1228 \r
1229 ;       ENTERED WITH SYMBOL IN C\r
1230 ;       RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND\r
1231 ;       OTHERWISE, A SKIP ON RETURN OCCURS\r
1232 \r
1233 SREQ:   JUMPGE    S,CPOPJ1              ;JUMP IF NO UNDEF. SYMBOLS\r
1234         SKIPA     A,S           ;LOAD REQUEST SEARCH POINTER\r
1235 SDEF:   MOVE    A,B             ;LOAD DEF. SYMBOL SEARCH POINTER\r
1236 SDEF1:  CAMN    C,1(A)\r
1237         POPJ    P,                      ;SYMBOLS MATCH, RETURN\r
1238 SDEF2:  ADD     A,SE3\r
1239         JUMPL     A,SDEF1\r
1240 IFE K,< JRST    CPOPJ1          ;SYMBOL NOT FOUND SKIPS ON RETURN>\r
1241 IFN K,<\r
1242 CPOPJ1: AOS     (P)             ;TRA 2,4\r
1243         POPJ    P,              ;...>\r
1244 \r
1245 ;RELOCATION AND BLOCK INPUT\r
1246 \r
1247 PRWORD:   PUSHJ     P,RWORD             ;READ A WORD PAIR\r
1248         MOVE    C,W             ;LOAD C WITH FIRST DATA WORD\r
1249         TRNE    E,377777                ;TEST FOR END OF BLOCK\r
1250         JRST    RWORD1          ;INPUT SECOND WORD OF PAIR\r
1251         MOVEI     W,0           ;NO SECOND WORD, ASSUME ZERO\r
1252         POPJ    P,\r
1253 \r
1254 RWORD:  TRNN    E,377777                ;TEST FOR END OF BLOCK\r
1255         JRST    LOAD1           ;RETURN TO LOAD THE NEXT BLOCK\r
1256 RWORD1:   AOBJN     E,RWORD2            ;JUMP IF DATA WORD NEXT\r
1257         PUSHJ     P,WORD                ;READ CONTROL WORD\r
1258         MOVE    Q,W             ;DON'T COUNT RELOCATION WORDS\r
1259         HRLI    E,-22           ;SET RELOCATION WORD BYTE COUNT\r
1260 RWORD2:   PUSHJ     P,WORD              ;READ INPUT WORD\r
1261         JUMPGE    Q,RWORD3              ;TEST LH RELOCATION BIT\r
1262         HRLZ    T,R\r
1263         ADD     W,T             ;LH RELOCATION\r
1264 RWORD3:   TLNE  Q,200000                ;TEST RH RELOCATION BIT\r
1265         HRRI    W,@R            ;RH RELOCATION\r
1266         LSH     Q,2\r
1267         POPJ    P,\r
1268 \r
1269 \f;PRINT STORAGE MAP SUBROUTINE\r
1270 \r
1271 PRMAP:  PUSHJ   P,FSCN1 ;LOAD OTHER FILES FIRST\r
1272         PUSHJ   P,CRLFLF        ;START NEW PAGE\r
1273         HRRZ    W,R\r
1274         PUSHJ     P,PRNUM0\r
1275         JSP     A,ERRPT7\r
1276         SIXBIT  ?IS THE PROGRAM BREAK@?\r
1277         PUSHJ   P,CRLF          ;START STORAGE MAP\r
1278         JSP     A,ERRPT0        ;PRINT HEADER\r
1279         SIXBIT  ?STORAGE MAP@?\r
1280         HLRE    A,B\r
1281         MOVNS     A\r
1282         ADDI    A,(B)\r
1283 PRMAP1:   SUBI  A,2\r
1284         SKIPL     C,1(A)                ;LOAD SYMBOL, SKIP IF DELETED\r
1285         TLNE    C,300000                ;TEST FOR LOCAL SYMBOL\r
1286         JRST    PRMAP4          ;IGNORE LOCAL SYMBOLS\r
1287         TLNN    C,040000\r
1288         PUSHJ     P,CRLF                ;PROGRAM NAME\r
1289         PUSHJ     P,PRNAM1              ;PRINT SYMBOL AND VALUE\r
1290         TLNE    C,040000\r
1291         JRST    PRMAP3          ;GLOBAL SYMBOL\r
1292         HLRE    C,W             ;POINTER TO NEXT PROG. NAME\r
1293         JUMPGE    C,PRMAP2              ;JUMP IF LAST PROGRAM NAME\r
1294         ADDI    C,2(A)          ;COMPUTE LOC. OF FOLLOWING NAME\r
1295         SKIPA     T,@C          ;LOAD ORIGIN OF FOLLOWING PROG.\r
1296 PRMAP2:   HRRZ  T,R             ;LOAD PROGRAM BREAK\r
1297         SUBM    T,W             ;SUBTRACT ORIGIN TO GET LENGTH\r
1298         PUSHJ     P,PRNUM               ;PRINT PROGRAM LENGTH\r
1299         PUSHJ     P,CRLF\r
1300         TLNN    N,ALLFLG                ;SKIP IF LIST ALL MODE IS ON\r
1301         TRNE    W,777777                ;SKIP IF ZERO LENGTH PROGRAM\r
1302         JRST    PRMAP3\r
1303         JUMPE     C,PRMAP5              ;JUMP IF LAST PROGRAM\r
1304         SKIPA     A,C           ;SKIP GLOBALS, ZERO LENGTH PROG.\r
1305 PRMAP3:   PUSHJ     P,CRLF\r
1306 PRMAP4:   CAILE     A,(B)               ;TEST FOR END OF SYMBOL TABLE\r
1307         JRST    PRMAP1\r
1308 PRMAP5:\r
1309 \r
1310 \f;LIST UNDEFINED GLOBALS\r
1311 \r
1312 PMS:    PUSHJ   P,FSCN1 ;LOAD FILES FIRST\r
1313         JUMPGE  S,PMS3          ;JUMP IF NO UNDEFINED GLOBALS\r
1314         HLLOS 42                ;SET SOME ERROR TO ABORT EXECUTION\r
1315         PUSHJ   P,FCRLF         ;START THE MESSAGE\r
1316         PUSHJ   P,PRQ           ;PRINT ?\r
1317         HLRE    W,S             ;COMPUTE NO. OF UNDEF. GLOBALS\r
1318         MOVMS     W\r
1319         LSH     W,-1            ;<LENGTH OF LIST>/2\r
1320         PUSHJ     P,PRNUM0\r
1321         JSP     A,ERRPT7\r
1322         SIXBIT    /UNDEFINED GLOBALS@/\r
1323         MOVE    A,S             ;LOAD UNDEF. POINTER\r
1324 PMS2:   PUSHJ     P,CRLF\r
1325         PUSHJ   P,PRQ           ;PRINT ?\r
1326         PUSHJ     P,PRNAM0              ;PRINT SYMBOL AND POINTER\r
1327         ADD     A,SE3\r
1328         JUMPL     A,PMS2\r
1329         PUSHJ   P,CRLF          ;SPACE AFTER LISTING\r
1330 \r
1331 ;LIST NUMBER OF MULTIPLY DEFINED GLOBALS\r
1332 \r
1333 PMS3:   SKIPN   W,MDG           ;ANY MULTIPLY DEFINED GLOBALS\r
1334         JRST    PMS4            ;NO, EXCELSIOR\r
1335         HLLOS 42                ;ANOTHER WAY TO LOSE\r
1336         PUSHJ   P,FCRLF         ;ROOM AT THE TOP\r
1337         PUSHJ   P,PRQ           ;PRINT ?\r
1338         PUSHJ   P,PRNUM0        ;NUMBER OF MULTIPLES\r
1339         JSP     A,ERRPT7        ;REST OF MESSAGE\r
1340         SIXBIT  ?MULTIPLY DEFINED GLOBALS@?\r
1341 PMS4:   TLNE    N,AUXSWE        ;AUXILIARY OUTPUT DEVICE?\r
1342         OUTPUT  2,              ;INSURE A COMPLETE BUFFER\r
1343         POPJ    P,              ;RETURN\r
1344 \r
1345 \f;ENTER FILE ON AUXILIARY OUTPUT DEVICE\r
1346 \r
1347 IAD2:   ENTER   2,DTOUT         ;WRITE FILE NAME IN DIRECTORY\r
1348         JRST    IMD3            ;NO MORE DIRECTORY SPACE\r
1349         POPJ    P,\r
1350 \r
1351 IMD3:   JSP     A,ERRPT         ;DIRECTORY FULL ERROR\r
1352         SIXBIT    /DIR. FULL@/\r
1353         JRST    LD2\r
1354 \r
1355 ;PRINT THE 6 DIGIT OCTAL ADDRESS IN W\r
1356 \r
1357 ;       ACCUMULATORS USED: D,T,V\r
1358 \r
1359 PRNAM0:   MOVE  C,1(A)          ;LOAD SYMBOL\r
1360 PRNAM1:   MOVE  W,2(A)          ;LOAD VALUE\r
1361 PRNAM:  PUSHJ     P,PRNAME\r
1362 PRNUM:  PUSHJ     P,SPACES\r
1363 PRNUM0:   MOVE  V,PRNUM2                ;LOAD BYTE POINTER TO RH. OF W\r
1364         MOVNI     D,6           ;LOAD CHAR. COUNT\r
1365 PRNUM1:   ILDB  T,V             ;LOAD DIGIT TO BE OUTPUT\r
1366         ADDI    T,60            ;CONVERT FROM BINARY TO ASCII\r
1367         PUSHJ     P,TYPE2\r
1368         AOJL    D,PRNUM1                ;JUMP IF MORE DIGITS REMAIN\r
1369         POPJ    P,\r
1370 \r
1371 PRNUM2:   XWD   220300,W\r
1372 \r
1373 ;YE OLDE RECURSIVE NUMBER PRINTER\r
1374 ;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T\r
1375 \r
1376 RCNUM:  IDIVI Q,12              ;RADIX DECIMAL\r
1377         ADDI A,"0"\r
1378         HRLM A,(P)\r
1379         SKIPE Q\r
1380         PUSHJ P,RCNUM\r
1381         HLRZ T,(P)\r
1382         JRST TYPE2\r
1383 \r
1384 \f;PRINT FOUR SPACES\r
1385 \r
1386 SPACES:   PUSHJ     P,SP1\r
1387 SP1:    PUSHJ     P,SPACE\r
1388 SPACE:  MOVEI     T,40\r
1389         JRST    TYPE2\r
1390 \r
1391 ;SYMBOL PRINT - RADIX 50\r
1392 \r
1393 ;       ACCUMULATORS USED: D,T\r
1394 \r
1395 PRNAME:   MOVE  T,C             ;LOAD SYMBOL\r
1396         TLZ     T,740000                ;ZERO CODE BITS\r
1397         MOVNI     D,6           ;LOAD CHAR. COUNT\r
1398 SPT:    IDIVI     T,50          ;THE REMAINDER IS THE NEXT CHAR.\r
1399         HRLM    V,(P)           ;STORE IN LH. OF PUSHDOWN LIST\r
1400         AOSGE     D                     ;SKIP IF NO CHARS. REMAIN\r
1401         PUSHJ     P,SPT         ;RECURSIVE CALL FOR NEXT CHAR.\r
1402         HLRZ    T,(P)           ;LOAD FROM LH. OF PUSHDOWN LIST\r
1403         JUMPE     T,TYPE                ;BLANK\r
1404         ADDI    T,60-1\r
1405         CAILE     T,71\r
1406         ADDI    T,101-72\r
1407         CAILE     T,132\r
1408         SUBI    T,134-44\r
1409         CAIN    T,43\r
1410         MOVEI     T,56\r
1411         JRST    TYPE2\r
1412 ;PRINT A WORD OF SIXBIT CHARACTERS IN AC W\r
1413 \r
1414 ;       ACCUMULATORS USED: Q,T,D\r
1415 \r
1416 PWORD:  MOVNI     Q,6           ;SET CHARACTER COUNT TO SIX\r
1417 PWORD1:   MOVE  D,LSTPT         ;ENTER HERE WITH Q PRESET\r
1418 PWORD2:   ILDB  T,D             ;LOAD NEXT CHAR. TO BE OUTPUT\r
1419         PUSHJ     P,TYPE                ;OUTPUT CHARACTER\r
1420         AOJL    Q,PWORD2\r
1421         POPJ    P,\r
1422 \r
1423 \f;ERROR MESSAGE PRINT SUBROUTINE\r
1424 \r
1425 ;       FORM OF CALL:\r
1426 \r
1427 ;       JSP     A,ERRPT\r
1428 ;       SIXBIT    /<MESSAGE>/\r
1429 \r
1430 ;       ACCUMULATORS USED: T,V,C,W\r
1431 \r
1432 ERRPT:  TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
1433         PUSHJ   P,CRLF          ;ROOM AT THE TOP\r
1434         PUSHJ   P,PRQ           ;START OFF WITH ?\r
1435 ERRPT0:   PUSH  P,Q             ;SAVE Q\r
1436         SKIPA     V,ERRPT5\r
1437 ERRPT1:   PUSHJ     P,TYPE\r
1438         ILDB    T,V\r
1439         CAIN    T,40\r
1440         JRST    ERRPT4\r
1441         CAIN    T,5\r
1442         JRST    ERRPT9\r
1443         CAIE    T,3\r
1444         JRST    ERRPT1\r
1445         SKIPN     C,DTIN\r
1446         JRST    ERRPT4\r
1447         MOVNI     Q,14\r
1448         MOVEI     W,77\r
1449 ERRPT2:   TDNE  C,W\r
1450         JRST    ERRPT3\r
1451         LSH     W,6\r
1452         AOJL    Q,ERRPT2\r
1453 ERRPT3:   MOVE  W,ERRPT6\r
1454         PUSHJ     P,PWORD1\r
1455         SKIPN     W,DTIN1\r
1456         JRST    ERRPT4\r
1457         LSH     W,-6\r
1458         TLO     W,160000\r
1459         MOVNI     Q,4\r
1460         PUSHJ     P,PWORD1\r
1461 ERRPT4:   PUSHJ     P,CRLF\r
1462 ERRP41: POP     P,Q\r
1463         TLZ     F,FCONSW        ;ONE ERROR PER CONSOLE\r
1464         AOS     V               ;PROGRAM BUMMERS BEWARE:\r
1465         JRST    @V              ;V HAS AN INDEX OF A\r
1466 \r
1467 ERRPT5:   POINT     6,0(A)\r
1468 ERRPT6:   SIXBIT    / FILE /\r
1469 \r
1470 \fERRPT8:        TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
1471         PUSHJ   P,PRQ           ;START WITH ?\r
1472         CAIGE   T,140           ;IS IT A NON-PRINTING CHAR?\r
1473         CAIL    T,40\r
1474         JRST    ERRP8\r
1475         PUSH    P,T\r
1476         MOVEI     T,136         ;UP ARROW\r
1477         PUSHJ     P,TYPE2\r
1478         POP     P,T\r
1479         ADDI    T,100           ;CONVERT TO PRINTING CHAR.\r
1480 ERRP8:  PUSHJ     P,TYPE2\r
1481 ERRPT7:   PUSHJ     P,SPACE\r
1482         JRST    ERRPT0\r
1483 \r
1484 ERRPT9:   MOVEI     V,@V\r
1485         PUSH    P,V\r
1486         JSP     A,ERRPT7\r
1487         SIXBIT  ?ILLEGAL -LOADER@?\r
1488         POP     P,V\r
1489         JRST    ERRP41\r
1490 \r
1491 ;PRINT QUESTION MARK\r
1492 \r
1493 PRQ:    PUSH    P,T             ;SAVE\r
1494         MOVEI   T,"?"           ;PRINT ?\r
1495         PUSHJ   P,TYPE2         ;...\r
1496         POP     P,T             ;RESTORE\r
1497         POPJ    P,              ;RETURN\r
1498 \r
1499 \f;INPUT - OUTPUT INTERFACE\r
1500 \r
1501 ;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W\r
1502 IFE K,<\r
1503 WORDPR: PUSHJ   P,WORD          ;GET FIRST WORD OF PAIR\r
1504         MOVE    C,W             ;KEEP IT HANDY>\r
1505 WORD:   SOSG    BUFR2           ;SKIP IF BUFFER NOT EMPTY\r
1506         JRST    WORD2\r
1507 WORD1:  ILDB    W,BUFR1         ;PICK UP 36 BIT WORD\r
1508         POPJ    P,\r
1509 \r
1510 WORD2:  INPUT     1,                    ;GET NEXT BUFFER LOAD\r
1511         STATUS    1,W           ;GET DEVICE STATUS FROM MONITOR\r
1512         TRNE    W,IODEND                ;TEST FOR EOF\r
1513         JRST    EOF             ;END OF FILE EXIT\r
1514         TRNN    W,IOBAD         ;TEST FOR DATA ERROR\r
1515         JRST    WORD1           ;DATA OK - CONTINUE LOADING\r
1516         JSP     A,ERRPT         ;DATA ERROR - PRINT MESSAGE\r
1517         SIXBIT    /INPUT ERROR#/\r
1518         JRST    LD2             ;GO TO ERROR RETURN\r
1519 ;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII\r
1520 ;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT\r
1521 ;DEVICE\r
1522 \r
1523 CRLFLF:   PUSHJ     P,CRLF\r
1524 FCRLF:  TLO     F,FCONSW        ;INSURE TTY OUTPUT\r
1525 CRLF:   MOVEI     T,15          ;CARRIAGE RETURN LINE FEED\r
1526         PUSHJ     P,TYPE2\r
1527         MOVEI     T,12-40               ;LINE FEED IN PSEUDO SIXBIT\r
1528 TYPE:   MOVEI     T,40(T)               ;CONVERT SIXBIT TO ASCII\r
1529 TYPE2:  TLNN    N,AUXSWI        ;IS THER AN AUXILIARY DEVICE?\r
1530         JRST    TYPE3           ;NO, DONT OUTPUT TO IT\r
1531         TLON    N,AUXSWE        ;IS AUX. DEV. ENTERED?\r
1532         PUSHJ   P,IAD2          ;NOPE, DO SO!\r
1533         SOSG    ABUF2           ;SPACE LEFT IN BUFFER?\r
1534         OUTPUT  2,              ;CREATE A NEW BUFFER\r
1535         IDPB    T,ABUF1         ;DEPOSIT CHARACTER\r
1536         TLNN    F,FCONSW        ;FORCE OUTPUT TO CONSOLE TOO?\r
1537         POPJ    P,              ;NOPE\r
1538 TYPE3:  SKIPN   BUFO2           ;END OF BUFFER\r
1539         OUTPUT  3,              ;FORCE OUTPUT NOW\r
1540         IDPB    T,BUFO1         ;DEPOSIT CHARACTER\r
1541         CAIN    T,12            ;END OF LINE\r
1542         OUTPUT  3,              ;FORCE AN OUTPUT\r
1543         POPJ    P,\r
1544 \r
1545 \fSE3:   XWD     2,2             ;SYMBOL POINTER INCREMENT\r
1546 LSTPT:  POINT     6,W           ;CHARACTER POINTER TO W\r
1547 PDLPT:  XWD     -41,PDLST-1;    INITIAL PUSHDOWN POINTER\r
1548 COMM:   SQUOZE    0,.COMM.\r
1549 PDSAV:  0                               ;SAVED PUSHDOWN POINTER\r
1550 COMSAV:   0                             ;LENGTH OF COMMON\r
1551 MDG:    0                       ;COUNTER FOR MUL DEF GLOBALS\r
1552 PDLST:  BLOCK   40\r
1553 \r
1554 F.C:    0\r
1555         0       ;STORE N HERE\r
1556         0       ;STORE X HERE\r
1557         0       ;STORE H HERE\r
1558         0       ;STORE S HERE\r
1559         0       ;STORE R HERE\r
1560 B.C:    0\r
1561 F.I:    0                       ;INITIAL F - FLAGS\r
1562         0                       ;INITIAL N\r
1563         XWD     V,LDEND         ;INITIAL X - LOAD PROGRAM AFTER LOADER\r
1564         EXP     LDEND+JOBPRO    ;INITIAL H - INITIAL PROG BREAK\r
1565         0                       ;INITIAL S\r
1566         XWD     W,JOBPRO        ;INITIAL R - INITIAL RELOC\r
1567         0                       ;INITIAL B\r
1568 \f;BUFFER HEADERS AND HEADER HEADERS\r
1569 \r
1570 BUFO:   0                               ;CONSOLE INPUT HEADER HEADER\r
1571 BUFO1:  0\r
1572 BUFO2:  0\r
1573 \r
1574 BUFI:   0                               ;CONSOLE OUTPUT HEADER HEADER\r
1575 BUFI1:  0\r
1576 BUFI2:  0\r
1577 ABUF:   0                       ;AUXILIARY OUTPUT HEADER HEADER\r
1578 ABUF1:  0\r
1579 ABUF2:  0\r
1580 \r
1581 BUFR:   0                               ;BINARY INPUT HEADER HEADER\r
1582 BUFR1:  0\r
1583 BUFR2:  0\r
1584 \r
1585 DTIN:   0                               ;DECTAPE INPUT BLOCK\r
1586 DTIN1:  0\r
1587         0\r
1588 DTIN2:  0\r
1589 \r
1590 DTOUT:  0                               ;DECTAPE OUTPUT BLOCK\r
1591 DTOUT1:   0\r
1592         0\r
1593         0\r
1594 \r
1595         TTYL=52                 ;TWO TTY BUFFERS\r
1596 IFE K,< BUFL=406                ;TWO DTA BUFFERS FOR LOAD>\r
1597 IFN K,< BUFL=203                ;ONE DTA BUFFER FOR LOAD>\r
1598         ABUFL=203               ;ONE DTA BUFFER FOR AUX DEV\r
1599 TTY1:   BLOCK     TTYL          ;TTY BUFFER AREA\r
1600 BUF1:   BLOCK   BUFL            ;LOAD BUFFER AREA\r
1601 AUX:    BLOCK   ABUFL           ;AUX BUFFER AREA\r
1602 ZEROS:  REPEAT 4,<0>\r
1603 \r
1604 \fIOBKTL=40000\r
1605 IOIMPM=400000\r
1606         IODERR=200000\r
1607         IODTER=100000\r
1608         IODEND=20000\r
1609 \r
1610 IOBAD=IODERR+IODTER+IOBKTL+IOIMPM\r
1611 \r
1612         INTERN    PWORD,DTIN,DTOUT,LDEND\r
1613         INTERN    WORD,LD,BEG,PDLST,LOAD\r
1614         INTERN    CRLF,TYPE,PMS,PRMAP\r
1615         INTERN    F,P,X,H,S,R,B,N,T,V,W,C,E,Q,A,D\r
1616 \r
1617         EXTERN  JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41\r
1618 \r
1619 ;END HERE IF 1K LOADER REQUESTED.\r
1620 IFN K,  <LITS:  LIT\r
1621         VAR\r
1622 >\r
1623 \r
1624 \f;HERE BEGINS FORTRAN FOUR LOADER\r
1625 \r
1626 F4LD:\r
1627         HRRZ    V,R;            SET PROG BREAK INTO V\r
1628         MOVEM   V,LLC;          SAVE FIRST WORD ADDRESS\r
1629         MOVEI   W,-2(S);        GENERATE TABLES\r
1630         TLO     N,F4SW\r
1631         HRRZM   W,MLTP;         MADE LABELS\r
1632         HRRZM   W,PLTP;         PROGRAMMER LABELS\r
1633         ADD     W,[POINT 1,1];  GENERATE BIT-BYTE POINTER\r
1634         MOVEM   W,BITP\r
1635         MOVEM   W,SDSTP;        FIRST DATA STATEMENT\r
1636         AOS     SDSTP;\r
1637         MOVE    W,[JRST ALLOVE] ;LAST DATA STATEMENT\r
1638         MOVEM   W,(S)\r
1639         HRREI   W,-^D36;        BITS PER WORDUM\r
1640         MOVEM   W,BITC;         BIT COUNT\r
1641         PUSHJ P,BITWX+1         ;MAKE SURE OF ENOUGH SPACE\r
1642 \r
1643 TEXTR:  PUSHJ   P,WORD;         TEXT BY DEFAULT\r
1644         HLRZ    C,W\r
1645         CAIN    C,-1\r
1646         JRST    HEADER;         HEADER\r
1647         MOVEI   C,1;            RELOCATABLE\r
1648         PUSHJ   P,BITW;         SHOVE AND STORE\r
1649         JRST    TEXTR;          LOOP FOR NEXT WORD\r
1650 \r
1651 ABS:    SOSG    BLKSIZ; MORE TO GET\r
1652         JRST    TEXTR;          NOPE\r
1653 ABSI:   PUSHJ   P,WORD;\r
1654         MOVEI   C,0;            NON-RELOCATABLE\r
1655         PUSHJ   P,BITW;         TYPE 0\r
1656         JRST    ABS\r
1657 \r
1658 \f;PROCESS TABLE ENTRIES\r
1659 \r
1660 MDLB:   TLNE    F,FULLSW+SKIPSW;        MADE LABEL PROC\r
1661         JRST    GLOBDF;         NO ROOM AT THE IN\r
1662         HLRZ    C,MLTP;         GET PRESENT SIZE\r
1663         CAMGE   C,BLKSIZ;       IF NEW SIZE BIGGER, STR-R-RETCH\r
1664         PUSHJ   P,SMLT\r
1665         HRRZ    C,MLTP;         GET BASE\r
1666 MLPLC:  ADD     C,BLKSIZ;       MAKE INDEX\r
1667         TLNN    F,FULLSW+SKIPSW;        DONT LOAD\r
1668         HRRZM   V,(C);          PUT AWAY DEFINITION\r
1669 GLOBDF: PUSHJ   P,WORD\r
1670         TLNE    F,FULLSW+SKIPSW ;SKIPPING THIS PROG?\r
1671         JRST    TEXTR           ;YES, DON'T DEFINE\r
1672         MOVEI   C,(V);          AND LOC\r
1673         EXCH    W,C\r
1674         PUSHJ   P,SYMXX;        PUT IN DDT-SYMBOL TABLE\r
1675         PUSHJ   P,BITWX+1\r
1676         JRST    TEXTR\r
1677 \r
1678 PLB:    TLNE    F,FULLSW+SKIPSW\r
1679         JRST    GLOBDF\r
1680         HLRZ    C,PLTP;         PRESENT SIZE\r
1681         CAMGE   C,BLKSIZ\r
1682         PUSHJ   P,SPLT\r
1683         HRRZ    C,PLTP\r
1684         JRST    MLPLC\r
1685 \r
1686 \f;STORE WORD AND SET BIT TABLE\r
1687 \r
1688 BITW:   TLNE    F,FULLSW+SKIPSW;        WE DONT LOAD THIS\r
1689         POPJ    P,;\r
1690         MOVEM   W,@X;           STORE AWAY OFFSET\r
1691         IDPB    C,BITP;         STORE BIT\r
1692         AOSGE   BITC;           STEP BIT COUNT\r
1693         JRST    BITWX;          SOME MORE ROOM LEFT\r
1694         HRREI   C,-^D36;        RESET COUNT\r
1695         MOVEM   C,BITC\r
1696         SOS     PLTP\r
1697         SOS     BITP;           ALL UPDATED\r
1698 IFE EXPAND,<HRL C,MLTP\r
1699         SOS MLTP\r
1700         HRR     C,MLTP>\r
1701 IFN EXPAND,<HRRZ        C,MLTP;         TO ADDRESS\r
1702                 SUBI C,1\r
1703                 CAIG C,@X\r
1704                 PUSHJ P,[PUSHJ P,XPAND\r
1705                         POPJ P,\r
1706                         ADDI C,2000\r
1707                         JRST POPJM2]\r
1708                 SOS MLTP\r
1709                 HRLI C,1(C)>\r
1710         HRRZ    T,SDSTP;        GET DATA POINTER\r
1711         BLT     C,-1(T);        MOVE DOWN LISTS\r
1712 BITWX:  AOS     V;              STEP LOADER LOCATION\r
1713         HRRZ    T,MLTP\r
1714         CAIG    T,@X;           OVERFLOW CHECK\r
1715 IFE EXPAND,<TLO F,FULLSW>\r
1716 IFN EXPAND,<PUSHJ P,    [PUSHJ P,XPAND\r
1717                         TLOA F,FULLSW\r
1718                         JRST POPJM3\r
1719                         POPJ P,]>\r
1720         POPJ    P,;\r
1721 \r
1722 SMLT:   SUB     C,BLKSIZ;       STRETCH\r
1723         MOVS    W,MLTP          ;LEFT HALF HAS OLD BASE\r
1724         ADD     C,MLTP          ;RIGHT HALF HAS NEW BASE\r
1725 IFN EXPAND,<    HRRZS C ;GET RID OF COUNT\r
1726                 CAIG C,@X\r
1727                 PUSHJ P,[PUSHJ P,XPAND\r
1728                         POPJ P,\r
1729                         ADD W,[XWD 2000,0]\r
1730                         ADDI C,2000\r
1731                         JRST POPJM2]>\r
1732         HRRM C,MLTP             ;PUT IN NEW MLTP\r
1733         HLL     C,W             ;FORM BLT POINTER\r
1734         ADDI    W,(C)           ;LAST ENTRY OF MLTP\r
1735         HRL     W,BLKSIZ        ;NEW SIZE OF MLTP\r
1736         HLLM    W,MLTP          ;...\r
1737 SLTC:   BLT     C,0(W);         MOVE DOWN (UP?)\r
1738         POPJ    P,;\r
1739 \r
1740 SPLT:   SUB     C,BLKSIZ\r
1741         MOVS    W,MLTP;\r
1742         ADDM    C,PLTP\r
1743         ADD     C,MLTP\r
1744 IFN EXPAND,<    HRRZS C\r
1745                 CAIG C,@X\r
1746                 PUSHJ P,[PUSHJ P,XPAND\r
1747                         POPJ P,\r
1748                         ADD W,[XWD 2000,0]\r
1749                         ADDI C,2000\r
1750                         JRST POPJM2]>\r
1751         HRRM C,MLTP             ;PUT IN NEW MLTP\r
1752         HLL     C,W\r
1753         HLRZ    W,PLTP          ;OLD SIZE OF PL TABLE\r
1754         ADD     W,PLTP          ;NEW BASE OF PL TABLE\r
1755         HRL     W,BLKSIZ        ;NEW SIZE OF PL TABLE\r
1756         HLLM    W,PLTP          ;INTO POINTER\r
1757         JRST    SLTC\r
1758 \r
1759 PT1:    0\r
1760 \r
1761 \r
1762 \f;PROCESS END CODE WORD\r
1763 \r
1764 ENDS:   PUSHJ   P,WORD;         GET STARTING ADDRESS\r
1765         TLNE F,SKIPSW\r
1766         JRST ENDS1      ;FOOBAZ!!!!!!!!\r
1767         JUMPE   W,ENDS1;        NOT MAIN\r
1768         ADDI    W,(R);          RELOCATION OFFSET\r
1769         TLNN    N,ISAFLG;       IGNORE STARTING ADDRESS\r
1770         HRR     F,W;            SET SA\r
1771 ENDS1:  PUSHJ   P,WORDPR        ;DATA STORE SIZE\r
1772         HRRZM   C,PTEMP         ;NUMBER OF PERMANENT TEMPS\r
1773         MOVEM   V,CCON;         START OF CONSTANTS AREA\r
1774         JUMPE   W,E1;           NULL\r
1775         MOVEM   W,BLKSIZ        ;SAVE COUNT\r
1776         MOVEI   W,0(V)          ;DEFINE CONST.\r
1777         MOVE    C,CNR50         ;...\r
1778         TLNN F,SKIPSW!FULLSW\r
1779         PUSHJ   P,SYMPT         ;...\r
1780         PUSHJ   P,GSWD          ;STORE CONSTANT TABLE\r
1781 E1:     MOVEI   W,0(V);         GET LOADER LOC\r
1782         EXCH    W,PTEMP;        STORE INTO PERM TEMP POINTER\r
1783         ADD     W,PTEMP;        FORM TEMP TEMP ADDRESS\r
1784         MOVEM   W,TTEMP;        POINTER\r
1785         MOVEM   V,GSTAB;        STORE LOADER LOC IN GLOBSUB\r
1786         MOVE    C,TTR50         ;DEFINE %TEMP.\r
1787         TLNE F,SKIPSW!FULLSW\r
1788         JRST E1A\r
1789         PUSHJ   P,SYMPT         ;...\r
1790         MOVE    C,PTR50         ;DEFINE (IF EXTANT) TEMP.\r
1791         MOVEI   W,0(V)          ;...\r
1792         CAME    W,TTEMP         ;ANY PERM TEMPS?\r
1793         PUSHJ   P,SYMPT         ;YES, DEFINE\r
1794 E1A:    PUSHJ   P,WORD;         NUMBER OF GLOBSUBS\r
1795         JUMPE   W,E11\r
1796         MOVEM   W,BLKSIZ        ;SIZE OF GLOBSUB\r
1797         PUSHJ   P,GSWD          ;STORE GLOBSUB TABLE\r
1798 E11:    MOVEM   V,STAB;         SCALARS\r
1799         PUSHJ   P,WORD;         HOW MANY?\r
1800         JUMPE   W,E21;          NONE\r
1801         PUSHJ   P,GSWDPR        ;STORE SCALAR TABLE\r
1802 E21:    MOVEM   V,ATAB;         ARRAY POINTER\r
1803         PUSHJ   P,WORD;         COMMENTS FOR SCALARS APPLY\r
1804         JUMPE   W,E31\r
1805         PUSHJ   P,GSWDPR        ;STORE ARRAY TABLE\r
1806 E31:    MOVEM   V,AOTAB;        ARRAYS OFFSET\r
1807         PUSHJ   P,WORD;         SAME COMMENTS AS ABOVE\r
1808         JUMPE   W,E41\r
1809         PUSHJ   P,GSWDPR        ;STORE ARRAY OFFSET TABLE\r
1810 E41:    PUSHJ   P,WORD;         TEMP, SCALAR, ARRAY SIZE\r
1811         TLNE    F,FULLSW!SKIPSW ;SKIPPING THIS PROG?\r
1812         MOVEI   W,0             ;DON'T ACCEPT GLOB SUBPROG REQUESTS\r
1813         MOVEM   V,CTAB;         SETUP COMMON TABLE POINTER\r
1814         ADD     W,GSTAB;        GLOBAL SUBPROG BASE\r
1815         MOVEM   W,COMBAS;       START OF COMMON\r
1816         PUSHJ   P,WORD;         COMMON BLOCK SIZE\r
1817         HRRZM   W,BLKSIZ\r
1818         JUMPE   W,PASS2;        NO COMMON\r
1819 COMTOP: PUSHJ   P,WORDPR        ;GET A COMMON PAIR\r
1820         PUSHJ   P,SDEF;         SEARCH\r
1821         JRST    COMYES;         ALREADY THERE\r
1822         HRLS    W\r
1823         HRR     W,COMBAS;       PICK UP THIS COMMON LOC\r
1824         TLNN F,SKIPSW!FULLSW\r
1825         PUSHJ   P,SYMXX;        DEFINE IT\r
1826         MOVS    W,W;            SWAP HALFS\r
1827         ADD     W,COMBAS;       UPDATE COMMON LOC\r
1828         HRRM    W,COMBAS;       OLD BASE PLUS NEW SIZE\r
1829         HLRZS   W;              RETURN ADDRESS\r
1830         TLZ     C,400000\r
1831         TLNN F,SKIPSW!FULLSW\r
1832         PUSHJ   P,SYMXX\r
1833 COMCOM: PUSHJ   P,CWSTWX        ;STORE A WORD PAIR\r
1834         SOS     BLKSIZ\r
1835         SOSLE   BLKSIZ\r
1836         JRST    COMTOP\r
1837         JRST    PASS2\r
1838 \r
1839 COMYES: TLNE F,SKIPSW\r
1840         JRST COMCOM     ;NO ERRORS IF SKIPPING\r
1841         HLRZ    C,2(A);         PICK UP DEFINITION\r
1842         CAMLE   W,C;            CHECK SIZE\r
1843         JRST    ILC;            ILLEGAL COMMON\r
1844         MOVE    C,1(A);         NAME\r
1845         HRRZ    W,2(A); BASE\r
1846         JRST    COMCOM\r
1847 \r
1848 \f\r
1849 PRSTWX: PUSHJ   P,WORDPR        ;GET A WORD PAIR\r
1850 CWSTWX: EXCH    C,W             ;SPACE TO STORE FIRST WORD OF PAIR?\r
1851         PUSHJ   P,WSTWX         ;...\r
1852         EXCH    C,W             ;THERE WAS; IT'S STORED\r
1853 WSTWX:  TLNE    F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD?\r
1854         POPJ    P,              ;NOPE, RETURN\r
1855         MOVEM   W,@X            ;YES, STORE IT.\r
1856         JRST    BITWX           ;TELL THE TABLES ABOUT IT; THEN RETURN\r
1857 \r
1858 \r
1859 GSWD:   PUSHJ   P,WORD          ;GET WORD FROM TABLE\r
1860         PUSHJ   P,WSTWX         ;STASH IT\r
1861         SOSE    BLKSIZ          ;FINISHED?\r
1862         JRST    GSWD            ;NOPE, LOOP\r
1863         POPJ    P,              ;TRA 1,4\r
1864 \r
1865 GSWDPR: MOVEM   W,BLKSIZ        ;KEEP COUNT\r
1866 GSWDP1: PUSHJ   P,PRSTWX        ;GET AND STASH A PAIR\r
1867         SOS     BLKSIZ          ;FINISHED?\r
1868         SOSLE   BLKSIZ          ;...\r
1869         JRST    GSWDP1          ;NOPE, LOOP\r
1870         POPJ    P,              ;TRA 1,4\r
1871 \r
1872 \f;BEGIN HERE PASS2 TEXT PROCESSING\r
1873 \r
1874 PASS2:  ADDI V,(X)\r
1875         MOVEM V,TOPTAB  ;SAVE FOR OVERLAP CHECKING\r
1876         TLNE    F,FULLSW+SKIPSW;        ABORT?\r
1877         JRST    ALLOVE;         YES\r
1878         MOVE    V,LLC           ;PICK UP PROGRAM ORIGIN\r
1879         CAML    V,CCON          ;IS THIS A PROGRAM?\r
1880         JRST    FBLKD           ;NO, GO LOOK FOR FIRST BLK DATA\r
1881         TLOE    N,PGM1          ;YES, IS THIS FIRST F4 PROG?\r
1882         JRST    NOPRG           ;NO\r
1883         HRR     W,COMBAS        ;YES, PLACE PROG BREAK IN LH\r
1884 IFE L,< HRLM    W,JOBCHN(X)     ;FOR CHAIN>\r
1885 NOPRG:  HRRZ    W,PLTP;         GET PROG TABLE BASE\r
1886         HLRZ    C,PLTP;         AND SIZE\r
1887         ADD     W,C;            COMPUTE END OF PROG TABLE\r
1888         ADD     W,[POINT 1,1];  AND BEGINNING OF BIT TABLE\r
1889         EXCH    W,BITP;         SWAP POINTERS\r
1890 PASS2B: ILDB    C,BITP;         GET A BIT\r
1891         JUMPE   C,PASS2C;       NO PASS2 PROCESSING\r
1892         PUSHJ   P,PROC;         PROCESS A TAG\r
1893         JRST    PASS2B;         MORE TO COME\r
1894         JRST    ENDTP;\r
1895 \r
1896 PROC:   LDB     C,[POINT 6,@X,23];      TAG\r
1897         SETZM   MODIF;          ZERO TO ADDRESS MODIFIER\r
1898         TRZE    C,40;\r
1899         AOS     MODIF\r
1900         HRLM    C,ENDTAB;       ERROR SETUP\r
1901         MOVEI   W,TABDIS;       HEAD OF TABLE\r
1902         HLRZ    T,(W);          GET ENTRY\r
1903         CAME    T,C;            CHECK\r
1904         AOJA    W,.-2\r
1905         HRRZ    W,(W);          GET DISPATCH\r
1906         LDB     C,[POINT 12,@X,35]\r
1907         JRST    (W);            DISPATCH\r
1908 \r
1909 TABDIS: XWD 11,PCONS;           CONSTANTS\r
1910         XWD 06,PGS;             GLOBAL SUBPROGRAMS\r
1911         XWD 20,PST;             SCALARS\r
1912         XWD 22,PAT;             ARRAYS\r
1913         XWD 01,PATO;            ARRAYS OFFSET\r
1914         XWD 00,PPLT;            PROGRAMMER LABELS\r
1915         XWD 31,PMLT;            MADE LABESL\r
1916         XWD 26,PPT;             PERMANENT TEMPORARYS\r
1917         XWD 27,PTT;             TEMPORARY TEMPORARYS\r
1918 ENDTAB: XWD 00,LOAD4A;          ERRORS\r
1919 \r
1920 PASS2C: PUSHJ   P,PASS2A\r
1921         JRST    PASS2B\r
1922         JRST    ENDTP\r
1923 \r
1924 \f;DISPATCH ON A HEADER\r
1925 \r
1926 HEADER: CAMN    W,[EXP -2];     END OF PASS ONE\r
1927         JRST    ENDS\r
1928         LDB     C,[POINT 12,W,35];      GET SIZE\r
1929         MOVEM   C,BLKSIZ\r
1930         ANDI    W,770000\r
1931         JUMPE   W,PLB;  PROGRAMMER LABEL\r
1932         CAIN    W,500000;       ABSOLUTE BLOCK\r
1933         JRST    ABSI;\r
1934         CAIN    W,310000;       MADE LABEL\r
1935         JRST    MDLB;           MADE LABEL\r
1936         CAIN    W,600000\r
1937         JRST    GLOBDF\r
1938         CAIN    W,700000;       DATA STATEMENT\r
1939         JRST    DATAS\r
1940         JRST    LOAD4A;         DATA STATEMENTS WILL GO HERE\r
1941 \r
1942 TOPTAB: 0       ;TOP OF TABLES\r
1943 CTAB:   0;      COMMON\r
1944 ATAB:   0;      ARRAYS\r
1945 STAB:   0;      SCALARS\r
1946 GSTAB:  0;      GLOBAL SUBPROGS\r
1947 AOTAB:  0;      OFFSET ARRAYS\r
1948 CCON:   0;      CONSTANTS\r
1949 PTEMP:  0;      PERMANENT TEMPS\r
1950 TTEMP:  0;      TEMPORARY TEMPS\r
1951 COMBAS: 0;      BASE OF COMMON\r
1952 LLC:    0;      PROGRAM ORIGIN\r
1953 BITP:   0;      BIT POINTER\r
1954 BITC:   0;      BIT COUNT\r
1955 PLTP:   0;      PROGRAMMER LABEL TABLE\r
1956 MLTP:   0;      MADE LABEL TABLE\r
1957 SDS:    0       ;START OF DATA STATEMENTS\r
1958 SDSTP:  0       ;START OF DATA STATEMENTS POINTER\r
1959 BLKSIZ: 0;      BLOCK SIZE\r
1960 MODIF:  0;      ADDRESS MODIFICATION +1\r
1961 TTR50:  XWD     136253,114765   ;RADIX 50 %TEMP.\r
1962 PTR50:  XWD     100450,614765   ;RADIX 50 TEMP.\r
1963 CNR50:  XWD     112320,235025   ;RADIX 50 CONST.\r
1964 \r
1965 \f;ROUTINES TO PROCESS POINTERS\r
1966 \r
1967 PCONS:  ADD     C,CCON;         GENERATE CONSTANT ADDRESS\r
1968         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
1969 \r
1970 PSTA:   PUSHJ   P,SWAPSY        ;NON-COMMON SCALARS AND ARRAYS\r
1971         ADDI    C,(R);          RELOCATE\r
1972 PCOM1:  PUSHJ   P,SYDEF         ;...\r
1973 PCOMX:  ADD     C,MODIF         ;ADDR RELOC FOR DP\r
1974         HRRM    C,@X;           REPLACE ADDRESS\r
1975 PASS2A: AOS     V;              STEP READOUT POINTER\r
1976         CAML    V,CCON          ;END OF PROCESSABLES?\r
1977 CPOPJ1: AOS     (P);            SKIP\r
1978         POPJ    P,;\r
1979 \r
1980 PAT:    SKIPA   W,ATAB          ;ARRAY TABLE BASE\r
1981 PST:    MOVE    W,STAB          ;SCALAR TABLE  BASE\r
1982         ROT     C,1             ;SCALE BY 2\r
1983         ADD     C,W             ;ADD IN TABLE BASE\r
1984         ADDI    C,-2(X);        TABLE ENTRY\r
1985         HLRZ    W,(C);          CHECK FOR COMMON\r
1986         JUMPE   W,PSTA;         NO COMMON\r
1987         PUSHJ   P,COMDID        ;PROCESS COMMON\r
1988         JRST    PCOM1\r
1989 \r
1990 COMDID: LSH     W,1             ;PROCESS COMMON TABLE ENTRIES\r
1991         ADD     W,CTAB;         COMMON TAG\r
1992         ADDI    W,-2(X);        OFFSET\r
1993         PUSHJ   P,SWAPSY;       GET SYMBOL AND SET TO DEFINED\r
1994         ADD     C,1(W);         BASE OF COMMON\r
1995         POPJ    P,              ;RETURN\r
1996 \r
1997 PATO:   ROT     C,1\r
1998         ADD     C,AOTAB;        ARRAY OFFSET\r
1999         ADDI    C,-2(X);        LOADER OFFSET\r
2000         MOVEM   C,CT1;          SAVE CURRENT POINTER\r
2001         HRRZ    C,1(C);         PICK UP REFERENCE POINTER\r
2002         ANDI    C,7777; MASK TO ADDRESS\r
2003         ROT     C,1;            ALWAYS A ARRAY\r
2004         ADDI    C,-2(X)\r
2005         ADD     C,ATAB\r
2006         HLRZ    W,(C);          COMMON CHECK\r
2007         JUMPE   W,NCO\r
2008         PUSHJ   P,COMDID        ;PROCESS COMMON\r
2009         PUSHJ   P,SYDEF\r
2010         MOVE    C,CT1\r
2011         HRRE    C,(C)\r
2012         ADD     C,1(W)\r
2013         JRST    PCOMX\r
2014 \r
2015 \fNCO:   PUSHJ   P,SWAPSY;\r
2016         ADDI    C,(R)           ;DEFINE SYMBOL IN TRUE LOC\r
2017         PUSHJ   P,SYDEF         ;...\r
2018         MOVE    C,CT1\r
2019         HRRZ    C,(C)           ;OFFSET ADDRESS PICKUP\r
2020         ADDI    C,(R)           ;WHERE IT WILL BE\r
2021         JRST    PCOMX           ;STASH ADDR AWAY\r
2022 \r
2023 PTT:    ADD     C,TTEMP;        TEMPORARY TEMPS\r
2024         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
2025 \r
2026 PPT:    ADD     C,PTEMP;        PERMANENT TEMPS\r
2027         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY\r
2028 \r
2029 PGS:    ADD     C,GSTAB;        GLOBSUBS\r
2030         ADDI    C,-1(X);        OFFSET\r
2031         MOVE    C,(C)\r
2032         TLC     C,640000;       MAKE A REQUEST\r
2033         PUSHJ P,TBLCHK          ;CHECK FOR OVERLAP\r
2034         MOVEI   W,(V);          THIS LOC\r
2035         HLRM    W,@X;           ZERO RIGHT HALF\r
2036         PUSHJ   P,SYMXX\r
2037         JRST    PASS2A\r
2038 \r
2039 SYDEF:  TLNE    N,SYDAT         ;SYMBOL WANTS DEFININITION?\r
2040         POPJ    P,              ;NO, GO AWAY\r
2041         PUSH    P,C             ;SAVE THE WORLD\r
2042         PUSH    P,W\r
2043         PUSHJ P,TBLCHK  ;CHECK FOR OVERLAP\r
2044         MOVE    W,C\r
2045         SKIPE   C,T     ;PICKUP VALUE\r
2046         PUSHJ   P,SYMXX\r
2047         POP     P,W\r
2048         POP     P,C\r
2049         POPJ    P,;\r
2050 \r
2051 PMLT:   ADD     C,MLTP\r
2052         SKIPA\r
2053 PPLT:   ADD     C,PLTP\r
2054         HRRZ    C,(C)\r
2055         JRST    PCOMX\r
2056 \r
2057 SYMXX:  PUSH    P,V\r
2058         PUSHJ   P,SYMPT\r
2059         POP     P,V\r
2060         POPJ    P,;\r
2061 \r
2062 SWAPSY: MOVEI   T,0;            SET TO EXCHANGE DEFS\r
2063         EXCH    T,1(C);         GET NAME\r
2064         HRRZ    C,(C)           ;GET VALUE\r
2065         POPJ    P,\r
2066 TBLCHK: HRRZ W,MLTP     ;GETT TOP OV TABLES\r
2067         SUBI W,2\r
2068         CAMG W,TOPTAB   ;WILL IT OVERLAP\r
2069 IFE EXPAND,<TLO F,FULLSW>\r
2070 IFN EXPAND,<    JRST    [PUSHJ P,XPAND\r
2071                         TLOA F,FULLSW\r
2072                         JRST TBLCHK\r
2073                         JRST .+1]>\r
2074         POPJ P,\r
2075 \r
2076 \f;END OF PASS2\r
2077 \r
2078 ALLOVE: TLZ     N,F4SW          ;END OF F4 PROG\r
2079         TLNE F,FULLSW!SKIPSW\r
2080         JRST HIGH3\r
2081         HRR     R,COMBAS        ;TOP OF THE DATA\r
2082         HRR     V,R             ;IS THIS THE HIGHEST LOC YET?\r
2083         CAIG    H,@X            ;...\r
2084         MOVEI   H,@X            ;YES, TELL THE WORLD\r
2085         CAMG    H,SDS           ;HIGHEST LOC GREATER THAN DATA STATEMENTS?\r
2086         JRST    HIGH3           ;NO, RETURN\r
2087         ADDI    H,1(S)          ;YES, SET UP MEANINGFUL ERROR COMMENT\r
2088         SUB     H,SDS           ;...\r
2089         TLO     F,FULLSW        ;INDICATE OVERFLO\r
2090         JRST    HIGH3           ;RETURN\r
2091 \r
2092 DATAS:  TLNE    F,FULLSW+SKIPSW\r
2093         JRST    DAX\r
2094         MOVEI   C,(S)           ;ADDR OF WORD UNDER SYMBOL TABLE\r
2095         MOVN    W,BLKSIZ        ;HOW FAR DOWN TO BLT\r
2096         ADDM    W,PLTP          ;UPDATE TABLE POINTERS\r
2097         ADDM    W,BITP          ;...\r
2098         ADDM    W,SDSTP         ;...\r
2099         ADD     C,W             ;RH(C):= WHEN TO STOP BLT\r
2100         HRL     C,MLTP          ;SOURCE OF BLTED DATA\r
2101         ADD     W,MLTP          ;UPDATE, GET DESTINATION OF BLT DATA\r
2102 IFN EXPAND,<    HRRZS W ;GET RID OF LEFT HALF\r
2103                 CAIG W,@X\r
2104                 PUSHJ P,[PUSHJ P,XPAND\r
2105                         POPJ P,\r
2106                         ADDI W,2000\r
2107                         ADD C,[XWD 2000,2000]\r
2108                         JRST POPJM2]>\r
2109         HRRM W,MLTP             ;NO SET THIS SO EXTRA CORE NOT ZEROED\r
2110         HLL     W,C             ;FORM BLT POINTER\r
2111         BLT     W,-1(C)         ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)\r
2112         PUSHJ   P,BITWX+1\r
2113 DAX:    PUSHJ   P,WORD;         READ ONE WORD\r
2114         TLNN    F,FULLSW+SKIPSW\r
2115         MOVEM   W,(C)\r
2116         SOSLE   BLKSIZ          ;COUNT OF DATA SEQUENCE SIZE\r
2117         AOJA    C,DAX           ;INCREMENT DATA SEQUENCE DEPOSIT LOC\r
2118         JRST    TEXTR;          DONE\r
2119 \r
2120 \fFBLKD: TLOE    N,BLKD1         ;IS THIS FIRST BLOCK DATA?\r
2121         JRST    ENDTP           ;NO\r
2122         HRR     V,COMBAS        ;PLACE PROG BREAK IN RH FOR\r
2123 IFE L,< HRRM    V,JOBCHN(X)     ;CHAIN>\r
2124 ENDTP:  TLNE    F,FULLSW+SKIPSW\r
2125         JRST    ALLOVE\r
2126         HRR     V,GSTAB\r
2127 ENDTP0: CAML    V,STAB;         ANY MORE GLOBSUBS\r
2128         JRST    ENDTP2;         NO\r
2129         MOVE    C,@X;           GET SUBPROG NAME\r
2130         PUSHJ   P,SREQ;         IS IT ALLREADY REQUESTED\r
2131         AOJA    V,ENDTP0;       YES\r
2132         PUSHJ   P,SDEF;         OR DEFINED\r
2133         AOJA    V,ENDTP0;       YES\r
2134         PUSHJ P,TBLCHK\r
2135         MOVEI W,0               ;PREPARE DUMMY LINK\r
2136         TLNN    F,FULLSW+SKIPSW;        ABORT\r
2137         PUSHJ   P,SYM3X;        PUT IN DUMMY REQUEST\r
2138         PUSHJ   P,BITWX+1;      OVERLAP CHECK\r
2139         AOJA    V,ENDTP0\r
2140 ENDTP2: SETZM   PT1\r
2141         HRR V,SDSTP\r
2142 IFN EXPAND,<    SUBI V,(X)\r
2143                 CAMG V,COMBAS\r
2144                 JRST    [PUSHJ P,XPAND\r
2145                         TLOA F,FULLSW\r
2146                         JRST .-3\r
2147                         JRST .+1]\r
2148                 HRR V,SDSTP>\r
2149         HRRZM   V,SDS           ;DATA STATEMENT LOC\r
2150 ENDTP1: SUBI    V,(X);          COMPENSATE FOR OFFSET\r
2151         MOVE    W,@X;   GET WORD\r
2152         TLNE    W,-1;           NO LEFT HALF IMPLIES COUNT\r
2153         JRST    DODON;          DATA DONE\r
2154         ADD     W,[MOVEI W,3]\r
2155         ADDI    W,@X\r
2156         EXCH    W,@X\r
2157         AOS     V\r
2158         ADD     W,@X;           ITEMS COUNT\r
2159         MOVEM   W,ITC\r
2160         MOVE    W,[MOVEM W,LTC]\r
2161         MOVEM   W,@X;           SETUP FOR DATA EXECUTION\r
2162         AOS     V\r
2163         MOVE    W,[MOVEI W,0]\r
2164         EXCH    W,@X\r
2165         MOVEM   W,ENC;          END COUNT\r
2166         AOS     V\r
2167         MOVEI   W,@X\r
2168         ADDM    W,ITC\r
2169 LOOP:   MOVE    W,@X\r
2170         HLRZ    T,W;            LEFT HALF INST.\r
2171         ANDI    T,777000\r
2172         CAIN    T,254000        ;JRST?\r
2173         JRST    WRAP            ;END OF DATA\r
2174         CAIN    T,260000        ;PUSHJ?\r
2175         JRST    PJTABL(W)       ;DISPATCH VIA TABLE\r
2176         CAIN    T,200000;       MOVE?\r
2177         AOJA    V,INNER\r
2178         CAIN    T,270000;       ADD?\r
2179         JRST    ADDOP\r
2180         CAIN    T,221000;       IMULI?\r
2181         AOJA    V,LOOP\r
2182         CAIE    T,220000;       IMUL?\r
2183         JRST    LOAD4A;         NOTA\r
2184 INNER:  HRRZ    T,@X;           GET ADDRESS\r
2185         TRZE    T,770000;       ZERO TAG?\r
2186         SOJA    T,CONPOL;       NO, CONSTANT POOL\r
2187         SUB     T,PT1;          SUBTRACT INDUCTION NUMBER\r
2188         ASH     T,1\r
2189         SOS     T;              FORM INDUCTION POINTER\r
2190         HRRM    T,@X\r
2191         HLRZ    T,@X\r
2192         ADDI    T,P\r
2193         HRLM    T,@X\r
2194         AOJA    V,LOOP\r
2195 \r
2196 \fCONPOL:        ADD     T,ITC;  CONSTANT BASE\r
2197         HRRM    T,@X\r
2198         AOJA    V,LOOP\r
2199 \r
2200 ADDOP:  HRRZ    T,@X\r
2201         TRZE    T,770000\r
2202         SOJA    T,CONPOL\r
2203 SKIPIN: AOJA    V,LOOP\r
2204 \r
2205 PJTABL: JRST    DWFS            ;PUSHJ 17,0\r
2206         AOSA    PT1             ;INCREMENT DO COUNT\r
2207         SOSA    PT1;            DECREMENT DO COUNT\r
2208         SKIPA   W,[EXP DOINT.]\r
2209         MOVEI   W,DOEND.\r
2210         HRRM    W,@X\r
2211         AOJA    V,SKIPIN        ;SKIP A WORD\r
2212 \r
2213 DWFS:   MOVEI   W,DWFS.\r
2214         HRRM    W,@X\r
2215         AOS     V\r
2216         TLO     N,SYDAT\r
2217         PUSHJ   P,PROC;         PROCESS THE TAG\r
2218         JRST    LOAD4A          ;DATA STATEMENT BELOW CODE TOP\r
2219         JRST    LOOP            ;PROPER RETURN\r
2220 \r
2221 DOINT.: POP     P,V;            GET ADDRESS OF INITIAL VALUE\r
2222         PUSH    P,(V);          STORE INDUCTION VARIABLE\r
2223         AOS     V\r
2224         PUSH    P,V;            INITIAL ADDRESS\r
2225         JRST    (V)\r
2226 \r
2227 DOEND.: HLRZ    T,@(P)\r
2228         ADDM    T,-2(P);        INCREMENT\r
2229         HRRZ    T,@(P);         GET FINAL VALUE\r
2230         CAMGE   T,-2(P);        END CHECK\r
2231         JRST    DODONE;         WRAP IT UP\r
2232         POP     P,(P);          BACK UP POINTER\r
2233         JRST    @(P)\r
2234 \r
2235 \fDODONE:        POP     P,-1(P);        BACK UP ADDRESS\r
2236         POP     P,-1(P)\r
2237         JRST    CPOPJ1          ;RETURN\r
2238 \r
2239 WRAP:   MOVE    W,ENC;          NUMBER OF CONSTANTS\r
2240         ADD     W,ITC;          CONSTANT BASE\r
2241         MOVEI   C,(W);          CHAIN\r
2242         HRRM    C,@X\r
2243         MOVEI   V,(W);          READY TO GO\r
2244         JRST    ENDTP1\r
2245 \r
2246 DODON:  TLZ     N,RCF!SYDAT!DZER        ;DATA STATEMENT FLAGS\r
2247         MOVE    W,PTEMP         ;TOP OF PROG\r
2248         ADDI    W,(X)           ;+OFFSET\r
2249         MOVE    C,COMBAS        ;TOP OF DATA\r
2250         ADDI    C,(X)           ;+OFFSET\r
2251 SECZER: CAML    W,C             ;ANY DATA TO ZERO?\r
2252         JRST    @SDS            ;NO, DO DATA STATEMENTS\r
2253         CAML    W,SDS           ;IS DATA BELOW DATA STATEMENTS?\r
2254         TLO     F,FULLSW        ;NO, INDICATE OVERFLO\r
2255         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?\r
2256         SETZM   (W)             ;YES, DO SO\r
2257         TLON    N,DZER          ;GO BACK FOR MORE?\r
2258         AOJA    W,SECZER        ;YES, PLEASE\r
2259         CAMLE   C,SDS           ;ALL DATA BELOW DATA STATEMENTS?\r
2260         MOVE    C,SDS           ;ALL ZEROED DATA MUST BE\r
2261         HRLI    W,-1(W)         ;SET UP BLT POINTER TO ZERO DATA\r
2262         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?\r
2263         BLT     W,-1(C)         ;YES, DO SO\r
2264         JRST    @SDS            ;GO DO DATA STATEMENTS\r
2265 \r
2266 \fDREAD: TLNE    N,RCF;          NEW REPEAT COUNT NEEDED\r
2267         JRST    FETCH;          NO\r
2268         MOVE    W,LTC\r
2269         MOVEM   W,LTCTEM\r
2270         MOVE    W,@LTC;         GET A WORD\r
2271         HLRZM   W,RCNT;         SET REPEAT COUNT\r
2272         HRRZM   W,WCNT;         SET WORD COUNT\r
2273         POP     W,(W);          SUBTRACT ONE FROM BOTH HALFS\r
2274         HLLM    W,@LTC;         DECREMENT REPEAT COUNT\r
2275         AOS     W,LTC;          STEP READOUT\r
2276         TLO     N,RCF\r
2277 FETCH:  MOVE    W,@LTC\r
2278         AOS     LTC\r
2279         SOSE    WCNT\r
2280         POPJ    P,;\r
2281         SOSN    RCNT\r
2282         JRST    DOFF.\r
2283         MOVE    V,LTCTEM;       RESTORE READOUT\r
2284         MOVEM   V,LTC\r
2285 DOFF.:  TLZ     N,RCF;          RESET DATA REPEAT FLAG\r
2286         POPJ    P,;\r
2287 \r
2288 DWFS.:  MOVE    T,(P)\r
2289         AOS     (P)\r
2290         MOVE    T,(T);          GET ADDRESS\r
2291         HLRZM   T,DWCT;         DATA WORD COUNT\r
2292         HRRES   T\r
2293         ADD     T,W;            OFFSET\r
2294         ADDI    T,(X);          LOADER OFFSET\r
2295 DWFS.1: PUSHJ   P,DREAD         ;GET A DATA WORD\r
2296         CAML    T,SDS           ;BELOW BEGINNING OF DATA STATEMENTS\r
2297         TLO     F,FULLSW        ;YES, INDICATE OVERFLO\r
2298         TLNN    F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?\r
2299         MOVEM   W,(T)           ;YES, STORE IT\r
2300         AOS     T\r
2301         SOSE    W,DWCT;         STEP DOWN AND TEST\r
2302         JRST    DWFS.1          ;ONE MORE TIME, MOZART BABY!\r
2303         POPJ    P,;\r
2304 \r
2305 \r
2306 \f;LITERAL TABLE\r
2307 \r
2308 LITS:   LIT\r
2309         VAR\r
2310 CT1:    0               ;TEMP FOR C\r
2311 LTC:    0\r
2312 ITC:    0\r
2313 ENC:    0\r
2314 WCNT:   0               ;DATA WORD COUNT\r
2315 RCNT:   0               ;DATA REPEAT COUNT\r
2316 \r
2317 LTCTEM: 0               ;TEMP FOR LTC\r
2318 DWCT:   0               ;DATA WORD COUNT\r
2319 IFE L,<\r
2320 LDEND:  END     LD\r
2321         >\r
2322 IFN L,<\r
2323 LDEND:\r
2324 LODMAK: MOVEI A,LODMAK\r
2325         MOVEM A,137\r
2326         INIT 17\r
2327         SIXBIT /DSK/\r
2328         0\r
2329         HALT\r
2330         ENTER LMFILE\r
2331         HALT\r
2332         OUTPUT [IOWD 1,LMLST    ;OUTPUT LENGTH OF FILE\r
2333                 0]\r
2334         OUTPUT LMLST\r
2335         STATZ 740000\r
2336         HALT\r
2337         RELEASE\r
2338         CALL [SIXBIT /EXIT/]\r
2339 \r
2340 LMFILE: SIXBIT /LISP/\r
2341         SIXBIT /LOD/\r
2342         0\r
2343         0\r
2344 \r
2345 LMLST:  IOWD LODMAK+1-LD,137\r
2346         0\r
2347 \r
2348         END LODMAK>\r