src/loader.1

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