src/loader.52

   1         SUBTTL  RP GRUEN/NGP/WFW/DMN  V.052     7-SEP-70
   2 ; RFS 11-30-70
   3 ;       TURNED ON FAILSW,SAILSW FOR NIH USAGE.
   4 ; DCS 1-24-71
   5 ;       ADDITIONS FOR SAIL (SHARED EXECS, UPDATED STANSW)
   6
   7 ; REG 7-17-71
   8 ;       TURN ON REENT FEATURES
   9
  10         VLOADER==52
  11         VPATCH==0               ;DEC PATCH LEVEL
  12         VCUSTOM==<SIXBIT /   SG1/>              ;NON-DEC PATCH LEVEL
  13                                 ;SAISEG VERSION 1
  14
  15         LOC <JOBVER==137>
  16         XWD VCUSTOM,VLOADER+1000*VPATCH
  17         RELOC
  18
  19 COMMENT *       ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)
  20
  21         SWITCHES ON (NON-ZERO) IN DEC VERSION
  22 SEG2SW          GIVES TWO SEGMENT CODE (IF MACRO ALLOWS IT)
  23 PURESW          GIVES PURE CODE (VARIABLES IN LOW SEG)
  24 REENT           GIVES REENTRANT CAPABILITY PDP-10
  25         (REENT=0 FOR PDP-10/30 OR PDP-6 OR EARLY PDP-10)
  26 RPGSW           INCLUDE CCL FEATURE
  27 TEMP            INCLUDE TMPCOR FEATURE
  28 DMNSW            SYMBOL TABLE WILL BE MOVED DOWN FROM TOP OF CORE
  29 KUTSW            GIVES CORE CUTBACK ON /K
  30 EXPAND           FOR AUTOMATIC CORE EXPANSION
  31 PP              ALLOW PROJ-PROG #
  32 DIDAL           GIVES DIRECT ACCESS LIBRARY SEARCH MODE
  33 ALGSW           WILL LOAD ALGOL OWN BLOCK (TYPE 15)
  34
  35         SWITCHES OFF (ZERO) IN DEC VERSION
  36 K               GIVES 1KLOADER - NO F4
  37 L                FOR LISP LOADER
  38 SPMON           GIVES SPMON LOADER (MONITOR LOADER)
  39 TEN30           FOR 10/30 LOADER
  40 STANSW           GIVES STANFORD FEATURES
  41 LNSSW           GIVES LNS VERSION
  42 FAILSW          INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS.
  43 LDAC             MEANS LOAD CODE INTO ACS
  44         (LDAC DOES NOT WORK WITH KUTSW=1.CORE UUO CLEARS JOBBLT)
  45 WFWSW           GIVES BLOCK TYPE 13 (VARIABLS INTO LOW SEG)
  46 SYMARG          ACCEPT SYMBOLIC (GLOBAL) ARGUMENTS FOR SWITCHES
  47 SPCHN           WILL DO SPECIAL OVERLAYING
  48 SAILSW          GIVES BLOCK TYPE 15 (FORCE LOAD OF REL FILES)
  49                 AND 16 (FORCE SEARCH OF LIBRARIES) FOR SAIL
  50 *
  51
  52 COMMENT/
  53 AT STANFORD WE USE
  54         STANSW, SAILSW, FAILSW, AND REENT ALL ON
  55         ALGSW, PURESW AND SEG2SW ALL OFF
  56 /
  57         STANSW==0
  58         SAILSW==0
  59         FAILSW==0
  60         REENT==1
  61         ALGSW==0
  62         PURESW==0
  63         SEG2SW==0
  64
  65
  66 \fSUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
  67
  68 IFNDEF SPMON,<SPMON=0>
  69 IFN SPMON,<     TEN30==1
  70                 K==1>
  71
  72 IFNDEF L,<L=0>
  73
  74 IFNDEF TEN30,<TEN30=0>
  75
  76 IFN TEN30!L,<   RPGSW=0
  77                 PP=0
  78 IFNDEF DMNSW,<  DMNSW=0>
  79 DIDAL==1
  80 IFNDEF DIDAL,<  DIDAL=0>
  81                 ALGSW=0
  82                 PURESW=0
  83                 REENT=0
  84                 LDAC=0
  85                 KUTSW=0
  86                 SEG2SW=0
  87                 NAMESW=0>
  88 IFN TEN30,<     EXPAND=0>
  89
  90 IFNDEF  K,<K=0>
  91
  92 STANSW==0
  93 IFNDEF STANSW,<STANSW=0>
  94 IFN STANSW,<
  95                 FAILSW=1
  96                 TEMP==0
  97                 REENT==1>
  98
  99 IFNDEF LNSSW,<LNSSW=0>
 100 IFN LNSSW,<LDAC=1
 101         PP=0>
 102
 103 FAILSW==1
 104 IFNDEF FAILSW,<FAILSW=0>
 105
 106 IFNDEF RPGSW,<RPGSW==1>
 107 IFN RPGSW,<PP==1>       ;REQUIRE DISK FOR CCL
 108 IFE RPGSW,<TEMP=0>
 109
 110 IFNDEF PP,<PP==1>
 111 IFN L,<PP==1>
 112
 113 IFNDEF TEMP,<TEMP==1>
 114
 115 IFNDEF NAMESW,<NAMESW==1>
 116
 117 IFNDEF LDAC,<LDAC=0>
 118 IFN LDAC,<KUTSW=0>
 119
 120 IFNDEF KUTSW,<KUTSW==1>
 121
 122 IFNDEF EXPAND,< IFN K,<EXPAND==0>
 123                 IFE K,<EXPAND==1>>
 124
 125 IFNDEF DMNSW,<DMNSW==1>
 126 IFN DMNSW!LDAC,<IFNDEF SYMPAT,<SYMPAT==20>
 127         IFN LDAC,<IFG 20-SYMPAT,<SYMPAT==20>>>
 128
 129 IFNDEF REENT,<REENT==1>
 130 IFE REENT,<PURESW=0
 131         SEG2SW=0>
 132 IFG STANSW,<SEG2SW==0
 133         PURESW==0>
 134
 135 IFDEF TWOSEG,<IFNDEF SEG2SW,<SEG2SW==1>>
 136 IFNDEF SEG2SW,<SEG2SW==0>
 137 IFN SEG2SW,<PURESW==1>
 138
 139 IFNDEF PURESW,<PURESW==1>
 140
 141 IFNDEF WFWSW,<WFWSW==0>
 142
 143 IFN K,<SYMARG=0
 144         SPCHN=0>
 145
 146 IFNDEF SYMARG,<SYMARG==0>
 147
 148 IFNDEF SPCHN,<SPCHN==0>
 149
 150 IFNDEF DIDAL,<DIDAL==1>
 151
 152 IFNDEF ALGSW,<ALGSW==0>
 153
 154 SAILSW==1
 155 IFNDEF SAILSW,<SAILSW==0>
 156
 157
 158 \fSUBTTL ACCUMULATOR ASSIGNMENTS
 159         F=0             ;FLAGS IN BOTH HALVES OF F
 160         N=1             ;FLAGS IN LH, PROGRAM NAME POINTER IN RH
 161         X=2             ;LOADER OFFSET
 162         H=3             ;HIGHEST LOC LOADED
 163         S=4             ;UNDEFINED POINTER
 164         R=5             ;RELOCATION CONSTANT
 165         B=6             ;SYMBOL TABLE POINTER
 166         D=7
 167         T=10
 168         V=T+1
 169         W=12            ;VALUE
 170         C=W+1           ;SYMBOL
 171         E=C+1           ;DATA WORD COUNTER
 172         Q=15            ;RELOCATION BITS
 173         A=Q+1           ;SYMBOL SEARCH POINTER
 174         P=17            ;PUSHDOWN POINTER
 175
 176
 177 ;MONITOR LOCATIONS IN THE USER AREA
 178
 179 JOBDA==140
 180 JOBHDA==10
 181
 182 EXTERN  JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41
 183 IFN REENT,<     EXTERN  JOBHRL,JOBCOR>
 184 IFE K,<EXTERN   JOBCHN          ;RH = PROG BREAK OF FIRST BLOCK DATA
 185                                 ;LH = PROG BREAK OF FIRST F4 PROG>
 186 IFN RPGSW,<     EXTERN  JOBERR>
 187 IFN LDAC,<      EXTERN  JOBBLT>
 188 IFN FAILSW,<    EXTERN  JOBAPR>
 189
 190 NEGOFF==400             ;NEGATIVE OFFSET OF HIGH SEGMENT
 191
 192
 193 IFN FAILSW,<;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
 194 PPDL==60>
 195
 196
 197 \f;FLAGS F(0 - 17)
 198         CSW==1                  ;ON - COLON SEEN
 199         ESW==2                  ;ON - EXPLICIT EXTENSION IDENT.
 200         SKIPSW==4               ;ON - DO NOT LOAD THIS PROGRAM
 201         FSW==10                 ;ON - SCAN FORCED TO COMPLETION
 202         FCONSW==20              ;ON - FORCE CONSOLE OUTPUT
 203 IFN REENT,<HIPROG==40   ;LOADING HI PROGRAM, SET BY HISEG. CLEARED BY EOF>
 204         ASW==100                ;ON - LEFT ARROW ILLEGAL
 205         FULLSW==200             ;ON - STORAGE EXCEEDED
 206         SLIBSW==400             ;ON - LIB SEARCH IN THIS PROG
 207         RMSMSW==1000            ;REMEMBER IF LOADING WITH SYMBOLS DURING LIB SEARCH
 208         REWSW==2000             ;ON - REWIND AFTER INIT
 209         LIBSW==4000             ;ON - LIBRARY SEARCH MODE
 210         NAMSSW==10000           ;NAME BLOCK HAS BEEN SEEN FOR THIS PROG
 211         ISW==20000              ;ON - DO NOT PERFORM INIT
 212         SYMSW==40000            ;ON - LOAD LOCAL SYMBOLS
 213         DSW==100000             ;ON - CHAR IN IDENTIFIER
 214         NSW==200000             ;ON - SUPPRESS LIBRARY SEARCH
 215         SSW==400000             ;ON - SWITCH MODE
 216
 217
 218 ;FLAGS  N(0 - 17)
 219         ALLFLG==1               ;ON - LIST ALL GLOBALS
 220         ISAFLG==2               ;ON - IGNORE STARTING ADDRESSES
 221         COMFLG==4               ;ON - SIZE OF COMMON SET
 222 IFE K,< F4SW==10                ;F4 IN PROGRESS
 223         RCF==20                 ;READ DATA COUNT
 224         SYDAT==40;              SYMBOL IN DATA>
 225         SLASH==100              ;SLASH SEEN
 226 IFE K,< BLKD1==200              ;ON- FIRST BLOCK DATA SEEN
 227         PGM1==400               ;ON FIRST F4 PROG SEEN
 228         DZER==1000              ;ON - ZERO SECOND DATA WORD>
 229         EXEQSW==2000            ;IMMEDIATE EXECUTION
 230         DDSW==4000              ;GO TO DDT
 231 IFN RPGSW,<RPGF==10000          ;IN RPG MODE>
 232         AUXSWI==20000           ;ON - AUX. DEVICE INITIALIZED
 233         AUXSWE==40000           ;ON - AUX. DEVICE ENTERED
 234 IFN PP,<PPSW==100000            ;ON - READING PROJ-PROG #>
 235 IFN PP!SPCHN,<PPCSW==200000     ;ON - READING PROJ #>
 236 IFN FAILSW,<HSW==400000         ;USED IN BLOCK 11 POLISH FIXUPS>
 237
 238
 239 \f
 240 ;MORE FLAGS IN F (18-35)
 241 IFN REENT,<
 242 SEENHI==1               ;HAVE SEEN HI STUFF
 243 NOHI==2                 ;LOAD AS NON-REENTRANT>
 244 IFN RPGSW,<NOTTTY==4    ;DEV "TTY" IS NOT A TTY>
 245 NOHI6==10               ;PDP-6 TYPE SYSTEM
 246 IFN DMNSW,<HISYM==20    ;BLT SYMBOLS INTO HIGH SEGMENT>
 247 SEGFL==40               ;LOAD INTO HI-SEG>
 248 IFN DIDAL,<XFLG==100            ;INDEX IN CORE (BLOCK TYPE 14)
 249 LSTLOD==200             ;LAST PROG WAS LOADED
 250 DTAFLG==400             ;LIBRARY DEVICE IS A DTA (NEEDED FOR INDEXING)>
 251 IFN DMNSW,<DMNFLG==1000>        ;SYMBOL TABLE TO BE MOVED DOWN
 252 IFN REENT,<VFLG==2000   ;DO LIB SEARCH OF IMP40.REL BEFORE LIB40>
 253 IFN SYMARG,<ARGFL==4000 ;TREAT $%. AS RADIX-50 CHAR.>
 254 TWOFL==10000            ;TWO SEGMENTS IN THIS BINARY FILE
 255 LOCAFL==20000           ;PRINT LOCAL SYMBOLS IN MAP
 256 TTYFL==40000                    ;AUX. DEV. IS TTY
 257
 258
 259 IFE K,<F4FL==400000             ;FORTRAN SEEN>
 260 COBFL==200000                   ;COBOL SEEN
 261 IFN ALGSW,<ALGFL==100000        ;ALGOL SEEN>
 262
 263 DEFINE ERROR (X,Y)<
 264 JSP A,ERRPT'X
 265 SIXBIT Y>
 266
 267
 268
 269 \fIFE K,<        TITLE   LOADER - LOADS MACRO AND FORTRAN FOUR>
 270 IFN K,< TITLE   1KLOAD - LOADS MACRO>
 271
 272 IFN PURESW,<
 273 IFE SEG2SW,<HISEG>
 274 IFN SEG2SW,<TWOSEGMENTS
 275         RELOC   400000>>
 276
 277
 278
 279 IFN SPCHN,<
 280 DSKBLK==200     ;LENGTH OF DISK BLOCKS
 281 VECLEN==↑D25  ;LENGTH OF VECTOR TABLE FOR OVERLAYS>
 282
 283 IFN SAILSW,<
 284 RELLEN==↑D20  ;#NUMBER OF REL FILES OR LIBRARIES (MUST BE SAME)>
 285
 286 ;CALLI DEFINITIONS
 287
 288 OPDEF   RESET   [CALLI   0]
 289 OPDEF   SETDDT  [CALLI   2]
 290 OPDEF   DDTOUT  [CALLI   3]
 291 OPDEF   DEVCHR  [CALLI   4]
 292 OPDEF   CORE    [CALLI  11]
 293 OPDEF   EXIT    [CALLI  12]
 294 OPDEF   UTPCLR  [CALLI  13]
 295 OPDEF   DATE    [CALLI  14]
 296 OPDEF   MSTIME  [CALLI  23]
 297 OPDEF   PJOB    [CALLI  30]
 298 OPDEF   SETUWP  [CALLI  36]
 299 OPDEF   REMAP   [CALLI  37]
 300 OPDEF   GETSEG  [CALLI  40]
 301 IFE STANSW,<
 302 OPDEF   SETNAM  [CALLI  43]
 303 >
 304 IFN STANSW,<
 305 OPDEF   SETNAM  [CALLI  400002]
 306 >
 307 OPDEF   TMPCOR  [CALLI  44]
 308
 309
 310         MLON
 311 IFDEF SALL,<    SALL>
 312
 313
 314 \fSUBTTL CCL INITIALIZATION
 315 IFN RPGSW,<
 316 BEG:    JRST    LD      ;NORMAL INITIALIZATION
 317 RPGSET: RESET           ;RESET UUO.
 318 IFN TEMP,<MOVEI F,CTLBUF-1      ;USE CCL BUFFER FOR COMMANDS
 319         HRRM F,CTLIN+1          ;DUMMY UP BYTE POINTER
 320         HRLI F,-200     ;MAKE IT AN IOWD
 321         MOVEM F,TMPFIL+1
 322         MOVSI F,(SIXBIT /LOA/)
 323         MOVEM F,TMPFIL
 324         MOVE N,[XWD 2,TMPFIL]   ;POINTER FOR TMPCOR READ
 325         TMPCOR  N,              ;READ AND DELETE LOA FILE
 326         JRST RPGTMP             ;NO SUCH FILE IN CORE, TRY DISK
 327         IMULI N,5               ;GET CHAR COUNT
 328         ADDI N,1
 329         MOVEM N,CTLIN+2         ;STORE IN BUFFER HEADER
 330         MOVEI N,700             ;BYTE POINTER FOR LOA FILE
 331         HRLM N,CTLIN+1          ;BYTE POINTER NOW COMPLETE
 332         SETOM TMPFLG            ;MARK THAT A TMPCOR READ WAS DONE
 333         SETZM NONLOD            ;NOT YET STARTED SCAN
 334         JRST RPGS3C             ;GET BACK IN MAIN STREAM
 335 RPGTMP: SETZM TMPFLG    ;MARK AS NOT TMP>
 336         INIT    17,1    ;SET UP DSK FOR COMMAND FILE INPUT.
 337         SIXBIT /DSK/
 338         XWD 0,CTLIN
 339         JRST    NUTS    ;CAN'T INIT, GET INPUT FROM TTY.
 340         MOVEI   F,3
 341 IFE STANSW,<
 342         PJOB    N,      ;GET JOB NUMBER
 343 LUP:    IDIVI   N,12    ;STRIP OFF LAST DIGIT
 344         ADDI    N+1,"0"-40      ;CONVERT TO SIXBIT
 345         LSHC    N+1,-6  ;SAVE
 346         SOJG    F,LUP   ;3 DIGITS YET?
 347         HLLZ    N+2     ;YES.
 348         HRRI    (SIXBIT /LOA/)  ;LOADER NAME PART OF FILE NAME.
 349         MOVEM   CTLNAM
 350         MOVSI   (SIXBIT /TMP/)  ;AND EXTENSION.
 351         MOVEM   CTLNAM+1
 352 >
 353 IFN STANSW,<
 354         MOVE    N,[SIXBIT /QQLOAD/]
 355         MOVEM   N,CTLNAM
 356         MOVSI   N,(SIXBIT /RPG/)
 357         MOVEM   N,CTLNAM+1
 358 >
 359         SETZM   CTLNAM+3
 360         LOOKUP  17,CTLNAM       ;FILE THERE?
 361         JRST    NUTS            ;NO.
 362         INIT 16,1       ;GET SET TO DELETE FILE
 363         SIXBIT /DSK/
 364         0
 365         JRST RPGS3A     ;GIVE UP
 366         SETZM CTLNAM+3  ;PUT STUFF BACK AS IT WAS
 367         LOOKUP 16,CTLNAM
 368         JRST RPGS3B
 369         SETZM CTLNAM    ;SET FOR RENAME
 370 IFN STANSW,<
 371         SETZM   CTLNAM+3        ;RENAME SHOULD REQUIRE THIS ANYWAY?
 372 >
 373         RENAME 16,CTLNAM
 374         JFCL            ;IGNORE FAILURE
 375 RPGS3B: RELEASE 16,     ;GET RID OF DEVICE
 376 RPGS3A: SETZM   NONLOD          ;TO INDICATE WE HAVE NOT YET STARTED TO SCAN
 377                                 ;COMMAND IN FILE.
 378
 379
 380 \fRPGS3: MOVEI   CTLBUF
 381         MOVEM   JOBFF
 382         INBUF   17,1            ;SET UP BUFFER.
 383 RPGS3C: TTCALL  3,[ASCIZ /LOADING/]     ;PRINT MESSAGE THAT WE ARE STARTING.
 384         SKIPE   NONLOD          ;CONTIUATION OF COMMAND?
 385         JRST    RPGS2           ;YES, SPECIAL SETUP.
 386 CCLCHN: MOVSI   N,RPGF          ;@ CHAIN FILES CYCLE FROM HERE
 387         JRST    CTLSET          ;SET UP TTY
 388
 389 RPGS1:  PUSHJ   P,[TLNE F,ESW   ;HERE FROM FOO@ COMMAND, STORE NAME.
 390                    JRST LDDT3   ;SAVE EXTENSION.
 391                    TLZE F,CSW!DSW  ;AS NAME
 392                    MOVEM W,DTIN ;STORE AS NAME
 393                    SETZM W,DTIN1        ;TRY BLANK EXTENSION FIRST.
 394                    JRST LDDT4]
 395         MOVEM   0,SVRPG         ;SAVE 0 JUST IN CASE
 396         SETZM   NONLOD          ;DETERMINE IF CONTINUATION.
 397         MOVEI   0,2(B)          ;BY SEEING IF ANY SYMBOLS LOADED.
 398         CAME    0,JOBREL
 399         SETOM   NONLOD          ;SET TO -1 AND SKIP CALLI
 400 IFN TEMP,<SETZM TMPFLG>
 401         MOVE    0,ILD1
 402         MOVEM   0,RPG1
 403         OPEN    17,OPEN1                ;KEEP IT PURE
 404         JRST    [MOVE   W,RPG1
 405                 JRST    ILD5]
 406         LOOKUP  17,DTIN         ;THE FILE NAME.
 407         JRST    [MOVE   0,SVRPG ;RESTORE AC0=F
 408                 TLOE    F,ESW   ;WAS EXT EXPLICIT?
 409                 JRST    ILD9    ;YES, DON'T TRY AGAIN.
 410                 MOVEM   0,SVRPG ;SAVE AC0 AGAIN
 411                 MOVSI   0,(SIXBIT /TMP/)        ;TRY TMP INSTEAD
 412                 MOVEM   0,DTIN1
 413                 PUSHJ P,LDDT4   ;SET UP PPN
 414                 JRST    .-1]    ;TRY AGAIN
 415         JRST    RPGS3
 416
 417 RPGS2:  MOVSI   0,RPGF  ;SET FLAG
 418         IORM    0,F.C+N
 419         TLO     N,RPGF
 420         MOVE    0,SVRPG
 421         JRST    LD2Q            ;BACK TO INPUT SCANNING.
 422
 423 >
 424
 425
 426
 427 \fSUBTTL NORMAL INITIALIZATION
 428
 429 LD:     IFE RPGSW,<BEG:>
 430 IFN L,< HRRZM 0,LSPXIT
 431         MOVEI 0,0
 432         HRRZM R,RINITL
 433         RESET>
 434 IFE L,<IFN RPGSW,<
 435         HLLZS   JOBERR          ;MAKE SURE ITS CLEAR.>
 436         RESET                   ;INITIALIZE THIS JOB
 437 NUTS:   SETZ    N,              ;CLEAR N
 438 CTLSET: SETZB   F,S             ;CLEAR THESE AS WELL
 439         HLRZ    X,JOBSA         ;TOP OF LOADER
 440         HRLI    X,V             ;PUT IN INDEX
 441         HRRZI   H,JOBDA(X)      ;PROGRAM BREAK
 442         MOVE    R,[XWD W,JOBDA] ;INITIAL RELOCATION>
 443         MOVSI   E,(SIXBIT /TTY/)
 444         DEVCHR  E,
 445         TLNN    E,10            ;IS IT A REAL TTY?
 446 IFN RPGSW,<JRST [TLNN   F,RPGF  ;IN CCL MODE?>
 447                 EXIT            ;NO, EXIT IF NOT TTY
 448 IFN RPGSW,<     TRO F,NOTTTY    ;SET FLAG
 449                 JRST    LD1]    ;SKIP INIT>
 450         INIT    3,1             ;INITIALIZE CONSOLE
 451         SIXBIT    /TTY/
 452         XWD     BUFO,BUFI
 453 CALLEX: EXIT                    ;DEVICE ERROR, FATAL TO JOB
 454         MOVEI     E,TTY1
 455         MOVEM     E,JOBFF
 456         INBUF     3,1
 457         OUTBUF    3,1           ;INITIALIZE OUTPUT BUFFERS
 458         OUTPUT    3,                    ;DO INITIAL REDUNDANT OUTPUT
 459 LD1:
 460 IFE L,< HRRZ    B,JOBREL        ;MUST BE JOBREL FOR LOADING REENTRANT>
 461 IFN L,< MOVE    B,JOBSYM        ;USED INSTEAD OF JOBREL FOR SYMBOL TABLE FIXUPS>
 462         HRRZM   B,HISTRT
 463         SUB     B,SE3           ;INITIALIZE SYMBOL TABLE POINTER
 464         CAILE     H,1(B)        ;TEST CORE ALLOCATION>
 465         JRST    [HRRZ   B,JOBREL;TOP OF CORE
 466                 ADDI    B,2000  ;1K MORE
 467                 CORE    B,      ;TRY TO GET IT
 468                 EXIT            ;INSUFFICIENT CORE, FATAL TO JOB
 469                 JRST    LD1]    ;TRY AGAIN
 470 IFN EXPAND,< IFE STANSW ,<SETZ S,
 471         CORE    S,              ;GET PERMITTED CORE
 472         JFCL
 473         LSH     S,12
 474         SUBI    S,1             ;CONVERT TO NUMBER OF WORDS
 475         MOVEM   S,ALWCOR        ;SAVE IT FOR XPAND TEST>>
 476 IFN STANSW,<
 477         MOVEI   S,-1            ;THERE IS ALWAYS CORE AT STANFORD!!
 478         MOVEM   S,ALWCOR         >
 479
 480 IFN PURESW,<MOVE S,[XWD HICODE,LOWCOD]
 481         BLT S,LOWCOD+CODLN-1>
 482 IFE L,< MOVS    E,X             ;SET UP BLT POINTER
 483         HRRI    E,1(X)>
 484 IFN L,<MOVS E,H
 485         HRRI E,1(H)>
 486         SETZM     -1(E)                 ;ZERO FIRST WORD
 487         BLT     E,(B)           ;ZERO CORE UP TO THE SYMBOL AREA
 488         HRRZ    S,B             ;INITIALIZE UNDEF. POINTER
 489         HRR     N,B             ;INITIALIZE PROGRAM NAME POINTER
 490 IFE L,< HRRI    R,JOBDA         ;INITIALIZE THE LOAD ORIGIN
 491         MOVE    E,COMM          ;SET .COMM. AS THE FIRST PROGRAM
 492         MOVEM     E,1(B)                ;STORE IN SYMBOL TABLE
 493         HRRZM     R,2(B)                ;STORE COMMON ORIGIN>
 494         MOVEI     E,F.C         ;INITIALIZE STATE OF THE LOADER
 495         BLT     E,B.C
 496         SETZM   MDG             ;MULTIPLY DEFINED GLOBAL COUNT
 497         SETZM   STADDR          ;CLEAR STARTING ADDRESS
 498 IFN REENT,<MOVSI W,1
 499         MOVEM W,HVAL1
 500         MOVEM W,HVAL
 501         MOVEM X,LOWX
 502         SETZM HILOW
 503         MOVEM R,LOWR
 504         HRRZI   W,1
 505 IFE STANSW,<    SETUWP  W,              ;SETUWP UUO.
 506         TRO     F,NOHI6         ;PDP-6 COMES HERE.>
 507         MOVEM   F,F.C           ;PDP-10 COMES HERE.>
 508 IFE L,< IFN STANSW,< TRO F,DMNFLG       ;ASSUME /B IS SAID...
 509         MOVEM   F,F.C           ;AND SAVE>>
 510 IFN SAILSW,<MOVE W,[XWD -RELLEN-1,LIBFLS-1]     ;SET UP POINTERS
 511         MOVEM W,LIBPNT# ;IN THE FORM OF AOBJN WORDS
 512         MOVE W,[XWD -RELLEN-1,PRGFLS-1]
 513         MOVEM W,PRGPNT#>
 514 IFE L,< MOVSI   W,254200        ;STORE HALT IN JOB41
 515         MOVEM   W,JOB41(X)      ;...>
 516 IFN L,< MOVE W,JOBREL
 517         HRRZM W,OLDJR>
 518 IFN SPCHN,<SETZM CHNACB ;USED AS DEV INITED FLAG TOO>
 519 IFN NAMESW,<SETZM       CURNAM>
 520 IFN FAILSW,<MOVEI W,440000      ;SET UP THE SPECIAL BITS OF HEADNUM(ADD+POLISH)
 521         MOVEM   W,HEADNM
 522         SETZM   POLSW   ;SWITCH SAYS WE ARE DOING POLISH
 523         MOVEI   W,PDLOV ;ENABLE FOR PDL OV
 524         MOVEM   W,JOBAPR
 525         MOVEI   W,200000
 526         CALLI   W,16
 527         SETZM LINKTB    ;ZERO OUT TABLE OF LINKS
 528
 529
 530 \f       MOVE W,[XWD LINKTB,LINKTB+1]
 531         BLT W,LINKTB+20>
 532 IFN DMNSW,<MOVEI W,SYMPAT
 533         MOVEM W,KORSP>
 534 IFN KUTSW,< IFE STANSW,<SETOM CORSZ>>
 535 IFN KUTSW,< IFN STANSW,<SETZM CORSZ>> ;ASSUME  /K FOR KIDS...
 536
 537
 538 \fIFN RPGSW,<JRST LD2Q>
 539 LD2:    IFN RPGSW,<MOVSI B,RPGF ;HERE ON ERRORS, TURN OFF RPG
 540         ANDCAM B,F.C+N  ;IN CORE>
 541 ;LOADER SCAN FOR FILE NAMES
 542
 543 LD2Q:   MOVSI     B,F.C         ;RESTORE ACCUMULATORS
 544         BLT     B,B
 545         MOVE    P,PDLPT         ;INITIALIZE PUSHDOWN LIST
 546         SETZM     BUFI2         ;CLEAR INPUT BUFFER POINTER
 547 IFE PP,<        SETZM     ILD1          ;CLEAR INPUT DEVICE NAME>
 548 IFN PP,<        MOVSI   T,(SIXBIT /DSK/)        ;ASSUME DSK.
 549         MOVEM   T,ILD1
 550         SETZM   OLDDEV  ;TO MAKE IT GO BACK AFTER /D FOR LIBSR>
 551         SETZM     DTIN          ;CLEAR INPUT FILE NAME
 552
 553 LD2B:   RELEAS    1,                    ;RELEASE BINARY INPUT DEVICE
 554 IFN RPGSW,<     TLNE    N,RPGF          ;NOT IF DOING CCL STUFF
 555         JRST    LD2BA>
 556         MOVEI     T,"*"
 557         IDPB    T,BUFO1         ;OUTPUT ASTERISK TO START INPUT
 558         OUTPUT    3,
 559 LD2BA:  TLZ     F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW
 560 LD2BP:  TLNE    F,LIBSW         ;WAS LIBRARY MODE ON?
 561         TLO     F,SKIPSW        ;YES, NORMAL MODE IS SKIPPING
 562
 563 LD2D:   IFN PP,<SETZM   PPN             ;DON'T REMEMBER PPN FROM ONE FILE TO NEXT.
 564 LD2DB:  SKIPE   W,OLDDEV                ;RESET DEVICE IF NEEDED.
 565         CAMN    W,ILD1          ;IS IT SAME?
 566         JRST    LD2DA           ;YES, FORGET IT.
 567         TLZ     F,ISW+DSW+FSW+REWSW
 568         MOVEM   W,ILD1>
 569 LD2DA:  MOVEI     W,0           ;INITIALIZE IDENTIFIER SCAN
 570         MOVEI     E,6           ;INITIALIZE CHARACTER COUNTER
 571         MOVE    V,LSTPT         ;INITIALIZE BYTE POINTER TO W
 572         TLZ     F,SSW+DSW+FSW   ;LEAVE SWITCH MODE
 573 LD3:    IFN RPGSW,<TLNE N,RPGF  ;CHECK RPG FEATURE
 574         JRST    RPGRD>
 575         SOSG    BUFI2           ;DECREMENT CHARACTER COUNTER
 576         INPUT     3,                    ;FILL TTY BUFFER
 577         ILDB    T,BUFI1         ;LOAD T WITH NEXT CHARACTER
 578 LD3AA:  CAIN    T,175   ;OLD ALTMOD
 579         MOVEI   T,33    ;NEW ONE
 580         CAIL    T,140   ;LOWER CASE?
 581         TRZ     T,40    ;CONVERT TO UPPER CASE
 582         MOVE    Q,T
 583         HRLM    Q,LIMBO         ;SAVE THIS CHAR.
 584         MOVSS   LIMBO           ;AND LAST ONE
 585         IDIVI     Q,11          ;TRANSLATE TO 4 BIT CODE
 586         LDB     Q,LD8(A)                ;LOAD CLASSIFICATION CODE
 587         CAIGE     Q,4           ;MODIFY CODE IF .GE. 4
 588         TLNN    F,SSW           ;MODIFY CODE IF SWITCH MODE OFF
 589         ADDI    Q,4             ;MODIFY CLASS. CODE FOR DISPATCH
 590 IFN SYMARG,<CAIL Q,20                   ;SKIP UNLESS SECOND FORM OF DISPATCH
 591         JRST    LD3AB                   ;DIFFERENT DISPATCH>
 592         HRRZ    A,LD3A(Q)               ;LOAD RH DISPATCH ENTRY
 593         CAIL    Q,10            ;SKIP IF CORRECT DISPATCH ENTRY
 594         HLRZ    A,LD3A-10(Q)    ;LOAD LH DISPATCH ENTRY
 595         JRST    @A                      ;JUMP TO INDICATED LOCATION
 596
 597 ;COMMAND DISPATCH TABLE
 598
 599 LD3A:   XWD     LD3,LD7B                ;IGNORED CHAR, BAD CHAR (SWITCH)
 600         XWD     LD6A,LD6                ;</> OR <(>, LETTER (SWITCH)
 601         XWD     LD5,LD6C                ;<:>, DIGIT (SWITCH ARG.)
 602         XWD     LD5A,LD6D               ;<.>, ESCAPE SWITCH MODE <)>
 603         XWD     LD5C,LD7                ;<=> OR <L. ARROW>, BAD CHAR.
 604         XWD     LD5B,LD4                ;<,>, ALPHABETIC CHAR.
 605         XWD     LD5D,LD4                ;<CR.>, NUMERIC CHAR.
 606         XWD     LD5E1,LD7               ;<ALT MODE>, BAD CHAR. <)>
 607 IFN SYMARG,<XWD LD7,LD10                ;BAD CHAR,&>
 608
 609 IFN RPGSW,<
 610 RPGRD1: MOVNI T,5
 611         ADDM T,CTLIN+2
 612         AOS     CTLIN+1
 613 RPGRD:  SOSG    CTLIN+2 ;CHECK CHARACTER COUNT.
 614         JRST    [IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO READ DONE?
 615                 JRST LD2        ;YES, JUST LEAVE>
 616                 IN 17,0
 617                 JRST .+1
 618                 STATO 17,740000
 619                 JRST LD2
 620                 JSP A,ERRPT
 621                 SIXBIT /ERROR WHILE READING COMMAND FILE%/
 622                 JRST LD2]
 623         IBP     CTLIN+1 ;ADVANCE POINTER
 624
 625
 626 \f       MOVE    T,@CTLIN+1      ;AND CHECK FOR LINE #
 627
 628
 629 \f       TRNE    T,1
 630         JRST    RPGRD1
 631         LDB     T,CTLIN+1       ;GET CHR
 632         JRST    LD3AA           ;PASS IT ON>
 633 IFN SYMARG,<
 634 LD3AB:  ROT     Q,-1                    ;CUT Q IN HALF
 635         HRRZ    A,LD3A(Q)               ;PULL OFF RIGHT HALF OF TABLE ENTRY
 636         JUMPGE  Q,@A                    ;WHICH IS CORRECT FOR EVEN ENTRIES
 637         HLRZ    A,LD3A(Q)               ;BUT USE LEFT HALF FOR ODD ENTRIES
 638         JRST    @A>
 639
 640
 641 \fSUBTTL CHARACTER HANDLING
 642
 643 ;ALPHANUMERIC CHARACTER, NORMAL MODE
 644 LD4:    SOJL    E,LD3           ;JUMP IF NO SPACE FOR CHAR IN W
 645         CAIGE   T,141           ;WORRY ABOUT LOWER CASE LETTERS
 646         SUBI    T,40            ;CONVERT FROM ASCII TO SIXBIT
 647         IDPB    T,V             ;DEPOSIT CHAR OF IDENTIFIER IN W
 648         TLO     F,DSW           ;SET IDENTIFIER FLAG
 649         JRST    LD3             ;RETURN FOR NEXT CHARACTER
 650
 651 ;DEVICE IDENTIFIER DELIMITER <:>
 652
 653 LD5:    PUSH    P,W             ;SAVE W
 654         TLOE    F,CSW           ;TEST AND SET COLON FLAG
 655         PUSHJ     P,LDF         ;FORCE LOADING
 656         POP     P,W             ;RESTORE W
 657         TLNE    F,ESW           ;TEST SYNTAX
 658         JRST    LD7A            ;ERROR, MISSING COMMA ASSUMED
 659         JUMPE     W,LD2D                ;JUMP IF NULL DEVICE IDENTIFIER
 660         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER
 661 IFN PP,<MOVEM   W,OLDDEV        ;WE HAVE A NEW ONE, DO IGNORE OLD.>
 662         TLZ     F,ISW+DSW+FSW+REWSW     ;CLEAR OLD DEVICE FLAGS
 663         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER
 664
 665 ;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>
 666 LD5A:   IFN SYMARG,<
 667         TRNE    F,ARGFL         ;IS "." SPECIAL
 668         JRST    LD4             ;YES,RADIX-50>
 669         TLOE    F,ESW           ;TEST AND SET EXTENSION FLAG
 670         JRST    LD7A            ;ERROR, TOO MANY PERIODS
 671         TLZE    F,CSW+DSW       ;SKIP IF NULL IDENT AND NO COLON
 672         MOVEM     W,DTIN        ;STORE FILE IDENTIFIER
 673         JRST    LD2D            ;RETURN FOR NEXT IDENTIFIER
 674
 675 ;INPUT SPECIFICATION DELIMITER <,>
 676 LD5B:
 677 IFN PP,<TLZE    N,PPCSW                 ;READING PP #?
 678         JRST    [
 679 IFE STANSW,<    HRLM    D,PPN           ;STORE PROJ #
 680                 JRST    LD6A1           ];GET PROG #>
 681 IFN STANSW,<    PUSHJ   P,RJUST         ;RIGHT JUSTIFY W
 682                 HRLM    W,PPN           ;STORE PROJ NAME
 683                 JRST    LD2DB           ];GET PROG NAME>
 684         PUSHJ   P,RBRA          ;CHECK FOR MISSING RBRA>
 685         SETOM   LIMBO           ;USED TO INDICATE COMMA SEEN
 686         TLZN    F,FSW           ;SKIP IF PREV. FORCED LOADING
 687         PUSHJ     P,FSCN2               ;LOAD (FSW NOT SET)
 688         JRST    LD2BP           ;RETURN FOR NEXT IDENTIFIER
 689
 690 LD5B1:  TLNE    F,ESW           ;TEST EXTENSION FLAG
 691         JRST    LDDT3           ;EXPLICIT EXTENSION IDENTIFIER
 692         TLZN    F,CSW+DSW               ;SKIP IF IDENT. OR COLON
 693         POPJ    P,
 694         MOVEM     W,DTIN                ;STORE FILE IDENTIFIER
 695         JRST    LDDT2           ;ASSUME <.REL> IN DEFAULT CASE
 696
 697
 698 \f;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>
 699 ;OR PROJ-PROG # BRACKETS <[> AND <]>
 700
 701 LD5C:
 702 IFN SPCHN,<CAIN T,"="   ;DO A /= AS SWITCH
 703         TLNN F,SSW
 704         SKIPA
 705         JRST LD6>
 706 IFN RPGSW,<CAIN T,"@"   ;CHECK FOR * COMMAND.
 707         JRST    RPGS1>
 708 IFN PP,<CAIN    T,"["                   ;PROJ-PROG #?
 709         JRST    [TLO    N,PPSW+PPCSW    ;SET FLAGS
 710                 MOVEM   W,PPNW          ;SAVE W
 711                 MOVEM   E,PPNE          ;SAVE E
 712                 MOVEM   V,PPNV          ;SAVE V
 713 IFE STANSW,<    JRST    LD6A2]>         ;READ NUMBERS AS SWITCHES
 714 IFN STANSW,<    JRST    LD2DB]>
 715         CAIN    T,"]"                   ;END OF PP #?
 716         JRST    [PUSHJ  P,RBRA          ;PROCESS RIGHT BRACKET
 717                 JRST    LD3]            ;READ NEXT IDENT>
 718         TLOE    F,ASW                   ;TEST AND SET LEFT ARROW FLAG
 719         JRST    LD7A                    ;ERROR, MISPLACED LEFT ARROW
 720         PUSHJ     P,LD5B1               ;STORE IDENTIFIER
 721         TLZN    F,ESW                   ;TEST EXTENSION FLAG
 722         MOVSI     W,554160              ;ASSUME <.MAP> IN DEFAULT CASE
 723         MOVEM     W,DTOUT1              ;STORE FILE EXTENSION IDENTIFIER
 724         MOVE    W,DTIN                  ;LOAD INPUT FILE IDENTIFIER
 725         MOVEM     W,DTOUT               ;USE AS OUTPUT FILE IDENTIFIER
 726 IFN SPCHN,<MOVEM W,CHNENT       ;AND FOR SPECAIL CHAINING>
 727 IFN PP,<MOVE    W,PPN                   ;PROJ-PROG #
 728         MOVEM   W,DTOUT+3               ;...>
 729         MOVE    W,ILD1                  ;LOAD INPUT DEVICE IDENTIFIER
 730         MOVEM   W,LD5C1                 ;USE AS OUTPUT DEVICE IDENTIFIER
 731 IFN PP,<SKIPE   W,OLDDEV                ;RESTORE OLD
 732         MOVEM   W,ILD1>
 733 ;INITIALIZE AUXILIARY OUTPUT DEVICE
 734         TRZ     F,TTYFL
 735         TLZE    N,AUXSWI+AUXSWE         ;FLUSH CURRENT DEVICE
 736         RELEASE 2,                      ;...
 737         DEVCHR  W,                      ;IS DEVICE A TTY?
 738         TLNE    W,10                    ;...
 739         JRST    [TRO    F,TTYFL         ;TTY IS AUX. DEV.
 740                 JRST    LD2D]           ;YES, SKIP INIT
 741         OPEN    2,OPEN2                 ;KEEP IT PURE
 742         JRST    ILD5A
 743         TLNE    F,REWSW                 ;REWIND REQUESTED?
 744         UTPCLR  2,                      ;DECTAPE REWIND
 745         TLZE    F,REWSW                 ;SKIP IF NO REWIND REQUESTED
 746         MTAPE   2,1                     ;REWIND THE AUX DEV
 747         MOVEI   E,AUX                   ;SET BUFFER ORIGIN
 748         MOVEM     E,JOBFF
 749         OUTBUF  2,1                     ;INITIALIZE SINGLE BUFFER
 750         TLO     N,AUXSWI                        ;SET INITIALIZED FLAG
 751 IFN LNSSW,<EXCH E,JOBFF
 752         SUBI    E,AUX
 753         IDIV    C,E
 754         OUTBUF  2,(C)>
 755         JRST    LD2D                    ;RETURN TO CONTINUE SCAN
 756
 757
 758
 759 \f;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
 760 IFN PP,<
 761 RBRA:   TLZN    N,PPSW          ;READING PP #?
 762         POPJ    P,              ;NOPE, RETURN
 763         TLZE    N,PPCSW         ;COMMA SEEN?
 764         JRST    LD7A            ;NOPE, INDICATE ERROR
 765 IFE STANSW,<HRRM        D,PPN           ;STASH PROG NUMBER
 766                 TLZ     F,SSW   ;AND TURN OFF SWITCH MODE>
 767 IFN STANSW,<PUSHJ       P,RJUST         ;RIGHT JUSTIFY W
 768         HRRM    W,PPN           ;STASH PROG NAME>
 769         MOVE    W,PPNW          ;PICKUP OLD IDENT
 770         MOVE    E,PPNE          ;RESTORE CHAR COUNT
 771         MOVE    V,PPNV          ;RESTORE BYTE PNTR
 772         POPJ    P,              ;TRA 1,4
 773
 774 ;RIGHT JUSTIFY W
 775
 776 IFN STANSW,<
 777 RJUST:  JUMPE   W,LD7A          ;NOTHING TO RIGHT JUSTIFY
 778         TRNE    W,77            ;IS W RJUSTED YET?
 779         POPJ    P,              ;YES, TRA 1,4
 780         LSH     W,-6            ;NOPE, TRY AGAIN
 781         JRST    .-3             ;...>>
 782
 783 IFN SYMARG,<
 784 ;& SELECTS A SYMBOL RATHER THAN ANUMBER FOR A SWITCH ARGUMENT
 785 ;& MUST ALSO FOLLOW THW SYMBOL; THE FORM IS /&SYMBOL&SWITHCH
 786 LD10:   TRC     F,ARGFL         ;SET OR CLEAR SPECIAL CHARS.
 787         TLCE    F,SSW           ;IF IN SWITCH MODE, EXIT TO GET IDENTIFIER
 788         JRST    LD10B
 789         PUSHJ   P,ASCR50        ;IF NOT, REENTER IT, CONVERT IDENTIFIER TO R50
 790         PUSHJ   P,SDEF          ;AND SEE IF IT EXISTS
 791         JRST    LD10A           ;YES IT DOES
 792         PUSHJ   P,PRQ           ;NO, COMPLAIN. OUTPUT ?
 793         PUSHJ   P,SPACE         ;FOLLOWED BY A SPACE
 794         PUSHJ   P,PRNAME        ;FOLLOWED BY THIS SYMBOL
 795         ERROR   0,</ DOESN'T EXIST@/>
 796         JRST    LD2
 797 LD10A:  MOVE    D,2(A)          ;SET D=VALUE OF SYMBOL AS NUMERIC ARG
 798         TLZ     F,DSW!FSW
 799         MOVEI   E,6             ;INITIALIZE NEW IDENTIFIER SCAN
 800         MOVE    V,LSTPT         ;(W IS ALREADY 0)
 801         JRST    LD3             ;NOW EAT SWITCH AND CONTINUE PROCESSING COMMAND
 802 LD10B:  PUSHJ   P,FSCN1         ;FORCE SCAN TO COMPLETION TO MAKE SURE FILE IS LOADED
 803         JRST    LD2DA>
 804
 805
 806 \f
 807         IFN SYMARG,<
 808 ;CONVERT SYMBOL IN W TO RADIX-50 IN C
 809 ;ALSO USES A
 810 ASCR50: MOVEI   A,0
 811 R50A:   MOVEI   C,0
 812         ROTC    W,6             ;C IS NEXT SIXBIT CHAR
 813         CAIGE   C,20
 814         JRST    R50B            ;UNDER 20, MAY BE ., $, OR %
 815         CAILE   C,31
 816         JRST    R50C            ;OVER 31
 817         SUBI    C,20-1          ;IS NUMBER
 818 R50D:   IMULI   A,50
 819         ADD     A,C
 820         JUMPN   W,R50A          ;LOOP FOR ALL CHARS
 821         MOVE    C,A             ;WIND UP WITH CHAR IN C
 822         TLO     C,040000        ;MAKE IT GLOBAL DEFINITION
 823         POPJ    P,
 824 R50B:   JUMPE   C,R50D          ;OK IF SPACE
 825         CAIE    C,16            ;TEST IF .
 826         JRST    .+3             ;NO
 827         MOVEI   C,45            ;YES
 828         JRST    R50D
 829         CAIE    C,4             ;SKIP IF $
 830 R50E:   MOVEI   C,5             ;ASSUME % IF NOTHING ELSE
 831         ADDI    C,42
 832         JRST    R50D
 833 R50C:   CAIGE   C,41
 834         JRST    R50E            ;BETWEEN 31 AND 41
 835         CAILE   C,72
 836         JRST    R50E            ;OVER 72
 837         SUBI    C,41-13         ;IS LETTER
 838         JRST    R50D>
 839
 840 ;DEFINE PUTS A SYMBOL IN THE UNDEFINED SYMBOL TABLE
 841 ;SO LOADER CAN SCAN LIBRARY AND LOAD PROGRAMS BEFORE THEY ARE REQUESTED
 842 ;THE FORM IS /&SYMBOL# WHERE SYMBOL IS CONVERTED TO RADIX-50
 843 IFN SYMARG,<
 844 DEFINE: PUSHJ   P,ASCR50        ;CONVRT TO R-50
 845         MOVEI   W,-2(S)         ;WHERE SYMBOL WILL GO
 846         CAIG    W,(H)           ;ENOUGH ROOM
 847 IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
 848                 TLOA    F,FULLSW
 849                 JRST    POPJM3
 850                 POPJ    P,]>
 851 IFE EXPAND,<TLO F,FULLSW>
 852         SUB     S,SE3           ;ADJUST POINTER
 853         MOVEM   C,1(S)          ;R-50 SYMBOL
 854         SETZM   2(S)            ;VALUE
 855         TLZ     F,DSW!SSW       ;TURN OFF SWITCHES
 856         JRST    LD2D            ;CONTINUE TO SCAN
 857 >
 858
 859
 860 \fSUBTTL TERMINATION
 861 ;LINE TERMINATION <CARRIAGE RETURN>
 862
 863 LD5D:
 864 IFN PP,<PUSHJ   P,RBRA          ;CHECK FOR UNTERMINATED PP #>
 865         SKIPGE  LIMBO           ;WAS LAST CHAR. BEFORE CR A COMMA?
 866         TLO     F,DSW           ;YES ,SO LOAD ONE MORE FILE
 867         PUSHJ   P,FSCN          ;FORCE SCAN TO COMPLETION
 868         JRST    LD2B            ;RETURN FOR NEXT LINE
 869
 870 ;TERMINATE LOADING <ALT MODE>
 871
 872 LD5E:   JUMPE   D,LD5E1         ;ENTER FROM G COMMAND
 873         TLO     N,ISAFLG        ;AND IGNORE ANY STARTING ADDRESS TO COME
 874         HRRZM   D,STADDR        ;USE NUMERIC STARTING ADDRESS
 875 LD5E1:  PUSHJ   P,CRLF          ;START A NEW LINE
 876 IFN RPGSW,<RELEASE 17,0         ;RELEASE COMMAND DEVICE>
 877         PUSHJ   P,SASYM         ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
 878         MOVE    W,[SIXBIT ?LOADER?]     ;FINAL MESSAGE
 879         PUSHJ P,BLTSET          ;SETUP FOR FINAL BLT
 880         RELEASE 2,              ;RELEASE AUX. DEV.
 881         RELEASE 1,0     ;INPUT DEVICE
 882         RELEASE 3,0     ;TTY
 883 IFN SPCHN,<RELEASE 4,0  ;SPECIAL CHAINING CHANEL>
 884 IFN NAMESW,<HRRZ        W,HISTRT        ;IN CASE NO NAME SET, USE FIRST LOADED
 885         MOVE    W,-1(W)
 886         SKIPN   CURNAM
 887         PUSHJ   P,LDNAM
 888         SKIPE   W,CURNAM
 889         CAMN    W,[SIXBIT /MAIN/]       ;FORTRAN MAIN PROG, OR MACRO NO TITLE
 890         SKIPE   W,PRGNAM        ;USE BINARY FILE NAME IN EITHER CASE
 891         SETNAM  W,                      ;SETNAME>
 892 IFN L,<JRST @LSPXIT>
 893
 894
 895 \fIFE L,<                ;NONE OF THIS NEEDED FOR LISP
 896 IFN PURESW,<
 897         MOVE    V,[XWD HHIGO,HIGO]
 898         BLT     V,HIGONE        ;MOVE DOWN CODE TO EXIT>
 899         TLNN N,EXEQSW   ;DO WE WANT TO START
 900         JRST LD5E3
 901 IFN RPGSW,<TLNN N,RPGF  ;IF IN RPG MODE
 902         JRST LD5E2
 903         HRRZ C,JOBERR   ;CHECK FOR ERRORS
 904         JUMPE C,LD5E2   ;NONE
 905 EXDLTD: TTCALL 3,[ASCIZ /?EXECUTION DELETED
 906 /]
 907         JRST LD5E3>
 908 LD5E2:  HRRZ W,JOBSA(X)
 909         TLNE N,DDSW     ;SHOULD WE START DDT??
 910         HRRZ W,JOBDDT(X)
 911 IFN RPGSW,<     TLNE    N,RPGF  ;IF IN RPG MODE
 912         JUMPE   W,[TTCALL 3,[ASCIZ /?NO STARTING ADDRESS
 913 /]
 914                 JRST    EXDLTD]>
 915         JUMPE   W,LD5E3 ;ANYTHING THERE?
 916         TLOA W,(JRST)   ;SET UP A JRST
 917 LD5E3:  SKIPA W,CALLEX  ;NO OR NO EXECUTE, SET CALLI 12
 918         TTCALL 3,[ASCIZ /EXECUTION
 919 /]
 920 IFN LDAC,<      HRLZ P,BOTACS   ;SET UP FOR ACBLT
 921         MOVEM W,JOBBLT+1(X)     ;SET JOBBLT
 922         MOVE W,[BLT P,P]
 923         MOVEM W,JOBBLT(X)>
 924         MOVSI LSTAC,LODACS      ;SET UP TO BLT BLT CODE INTO ACS
 925         BLT LSTAC,LSTAC
 926 IFN KUTSW,<SKIPGE E,CORSZ       ;DO WE WANT CORE ADJUST
 927         MOVE CORAC,JFCLAC       ;NO, CLEAR COREUUO>
 928 IFE LDAC,<MOVE LSTAC,W          ;SET END CONDITION>
 929 IFN REENT,<
 930         MOVSI   V,LD            ;DOES IT HAVE HISEG
 931         JUMPG   V,HINOGO        ;NO,DON'T DO CORE UUO
 932         MOVSI   V,1             ;SET HISEG CORE NONE ZERO
 933         JRST    HIGO            ;AND GO>
 934 IFE REENT,<JRST 0>
 935
 936 LODACS: PHASE 0
 937         BLT Q,(A)       ;BLT CODE DOWN
 938 IFN KUTSW,<CORAC:       CORE E, ;CUT BACK CORE
 939 JFCLAC: JFCL    ;SHOULD NEVER HAVE AN ERROR SINCE REDUCING CORE>
 940 LSTAC: IFN LDAC,<JRST JOBBLT>
 941 IFE LDAC,<EXIT>
 942 DEPHASE
 943 > ;;;;END OF IFE L AT BEGINNING OF THIS PAGE
 944
 945
 946 \fSUBTTL PRINT FINAL MESSAGE
 947 ; SET UP BLT AC'S, SETDDT, RELEAS
 948
 949 BLTSET: IFN RPGSW,<IFE K,<
 950         JUMPE   W,.+4   ;NO MESSAGE FROM CHAIN IN CCL@>>
 951         PUSHJ P,FCRLF   ;A RETURN
 952         PUSHJ P,PWORD   ;AND CHAIN OR LOADER
 953         PUSHJ P,SPACE
 954 IFN FAILSW,<MOVSI Q,-20 ;FINISH UP LINK STUFF
 955 FREND:  HLRZ V,LINKTB+1(Q)
 956         JUMPE V,NOEND
 957         HRRZ A,LINKTB+1(Q)
 958 IFN REENT,<CAMGE V,HVAL1
 959         SKIPA X,LOWX
 960         MOVE X,HIGHX>
 961 IFN L,<CAML V,RINITL>
 962         HRRM A,@X       ;PUT END OF LINK CHAIN IN PROPER PLACE
 963 NOEND:  AOBJN Q,FREND
 964 IFN REENT,<MOVE X,LOWX  ;RESET THINGS>>
 965 IFN KUTSW,<SKIPGE C,CORSZ       ;NEG MEANS DO NOT KUT BACK CORE
 966         JRST NOCUT
 967         JUMPE C,MINCUT  ;0 IS KUT TO MIN. POSSIBLE
 968         LSH C,12        ;GET AS A NUMBER OF WORDS
 969         SUBI C,1
 970         CAMG C,JOBREL   ;DO WE NEED MORE THAN WE HAVE??
 971         JRST TRYSML     ;NO, SEE IF NUMBER REQUESTED IS TOO SMALL
 972         MOVEI Q,0
 973         CORE Q,
 974         JFCL            ;WE JUST WANT TO KNOW HOW MUCH
 975         HRRZS Q
 976         CAMGE Q,CORSZ
 977         JRST CORERR
 978         JRST NOCUT1     ;SET FOR DO NOT CHANGE SIZE
 979 TRYSML: CAIG C,(R)      ;IS DESIRED AMOUNT BIGGER THAN NEEDED
 980 MINCUT: HRRZ C,R        ;GET MIN AMOUNT
 981         IORI C,1777     ;CONVERT TO A 1K MULTIPLE
 982 IFN DMNSW,<     TRNN F,DMNFLG   ;DID WE MOVE SYMBOLS??
 983         SKIPN JOBDDT(X) ;IF NOT IS DDT THERE??
 984         JRST    .+2>
 985 IFE DMNSW,<SKIPE JOBDDT(X)      ;IF NO SYMBOL MOVING JUST CHECK DDT>
 986         JRST NOCUT      ;DO NOT CUT IF SYMBOLS AT TOP AND DDT
 987 NOCUT1: MOVEM C,JOBREL(X)       ;SAVE FOR CORE UUO
 988         MOVEM C,CORSZ   ;SAVE AWAY FOR LATER
 989         JRST    .+2
 990 NOCUT:  SETOM CORSZ     ;SET FOR NO CUT  BACK>
 991 IFN RPGSW,<IFE K,<
 992         JUMPE   W,NOMAX ;NO MESSAGE IF CHAIN IN CCL@>>
 993 IFN L,<HRRZ Q,JOBREL
 994         SUB Q,OLDJR     ;PROPER SIZE>
 995 IFE L,<HRRZ Q,JOBREL(X)>
 996         LSH Q,-12       ;GET CORE SIZE TO PRINT
 997         ADDI Q,1
 998         PUSHJ P,RCNUM
 999 IFN REENT,<MOVE Q,HVAL
1000         SUB Q,HVAL1
1001         HRRZS Q
1002         JUMPE   Q,NOHY          ;NO HIGH SEGMENT
1003         MOVEI   T,"+"-40        ;THERE IS A HISEG
1004         PUSHJ   P,TYPE
1005         LSH     Q,-12
1006         ADDI    Q,1
1007         PUSHJ   P,RCNUM
1008 NOHY:>
1009         MOVE W,[SIXBIT /K CORE/]
1010         PUSHJ P,PWORD
1011         PUSHJ P,CRLF
1012 IFE L,<
1013 IFN RPGSW,<TLNE N,RPGF
1014         JRST NOMAX      ;DO NOT PRINT EXTRA JUNK IN RPG MODE>
1015         MOVE Q,JOBREL
1016         LSH Q,-12
1017         ADDI Q,1
1018         PUSHJ P,RCNUM   ;PRINT MAX LOW CORE SIZE
1019 IFN REENT,<     SKIPE Q,JOBHRL  ;GET SIZE OF HIGH SEGMENT
1020         PUSHJ P,[MOVEI Q,400001(Q) ;CLEAR HIGH ORDER BIT
1021                 MOVEI T,"+"-40  ;PRINT A HIGH CORE PART
1022                 PUSHJ P,TYPE
1023                 LSH Q,-12
1024                 JRST RCNUM]>
1025         MOVE W,[SIXBIT /K MAX/]
1026         PUSHJ P,PWORD
1027 IFN DMNSW,<TRNN F,DMNFLG>
1028         SKIPN JOBDDT(X)
1029         SKIPA Q,JOBREL(X)
1030         MOVEI Q,1(S)    ;FIND THE AMOUNT OF SPACE LEFT OVER
1031         SUB Q,JOBFF(X)
1032         PUSHJ P,RCNUM
1033         MOVE W,[SIXBIT / WORDS/]
1034         PUSHJ P,PWORD
1035         MOVE W,[SIXBIT / FREE/]
1036         PUSHJ P,PWORD
1037         PUSHJ P,CRLF    >
1038 NOMAX:  MOVE W,JOBDDT(X)
1039         SETDDT W,
1040 IFE TEN30,<HRLI Q,20(X) ;SET UP BLT FOR CODE
1041         HRRI Q,20>
1042 IFN TEN30,<HRLI Q,JOBDDT(X)
1043         HRRI Q,JOBDDT>
1044         HRRZ A,R
1045         POPJ P,         ;WE HAVE SET R UP BY CLEVER CODE IN SASYM
1046 IFN KUTSW,<CORERR:      TTCALL 3,[ASCIZ /?NOT ENOUGH CORE
1047 /]
1048         EXIT>
1049
1050
1051 \fSUBTTL SET UP JOBDAT
1052 SASYM:  TLNN F,NSW
1053         PUSHJ P,LIBF    ;SEARCH LIBRARY IF REQUIRED
1054         PUSHJ P,FSCN    ;FORCE END OF SCAN
1055 IFN ALGSW,<MOVE C,[RADIX50 44,%OWN]
1056         MOVE    W,%OWN          ;GET VALUE
1057         TRNE    F,ALGFL         ;IF ALGOL PROG LOADED
1058         PUSHJ   P,SYMPT         ;DEFINE %OWN>
1059 IFN RPGSW,<HLRE A,S
1060         MOVNS A
1061         LSH A,-1
1062         ADD A,JOBERR
1063         HRRM A,JOBERR>
1064         PUSHJ P,PMS1    ;PRINT UNDEFS
1065         HRRZ A,H        ;DO NOT CLOBBER H IF STILL INSERTING SYMBOLS
1066         SUBI A,(X)      ;HIGHEST LOC LOADED INCLUDES LOC STMTS
1067         CAILE A,(R)     ;CHECK AGAINST R
1068         HRR R,A         ;AND USE LARGER
1069 IFE L,< HRRZ    A,STADDR        ;GET STARTING ADDRESS
1070         HRRM    A,JOBSA(X)      ;STORE STARTING ADDRESS
1071         HRRZM R,JOBFF(X)        ;AND CURRENT END OF PROG
1072         HRLM R,JOBSA(X)>
1073 IFN DMNSW,<MOVE C,[RADIX50 44,PAT..]    ;MARK PATCH SPACE FOR RPG
1074         MOVEI W,(R)
1075         SKIPE   JOBDDT(X)               ;BUT ONLY IF DDT LOADED
1076         PUSHJ P,SYMPT
1077 IFN REENT,<TRNE F,HISYM         ;SHOULD SYMBOLS GO IN HISEG?
1078         JRST    BLTSYM          ;YES>>
1079 IFN DMNSW!LDAC,<                ;ONLY ASSEMBLE IF EITHER SET
1080 IFE LDAC,<      TRNN F,DMNFLG   ;GET EXTRA  SPACE IF SYMBOLS
1081         JRST    NODDT   ;MOVED OR IF LOADING ACS>
1082 IFE DMNSW,<     MOVEI A,20      ;FOR LOADING ACS>
1083 IFN DMNSW,<     MOVE A,KORSP
1084 IFN LDAC,<      TRNN F,DMNFLG   ;ONLY 20 IF SYMBOLS NOT MOVED
1085         MOVEI A,20>>
1086         ADDI A,(R)      ;GET ACTUAL PLACE TO PUT END OF SPACE
1087         ADDI A,(X)
1088         CAIL A,(S)      ;DO NOT OVERWRITE SYMBOLS
1089 IFN EXPAND,<JRST [PUSHJ P,XPAND>
1090                 PUSHJ P,MORCOR
1091 IFN EXPAND,<    JRST .-1]>
1092 IFN LDAC,<HRRM R,BOTACS ;SAVE BOTTOM OF WHERE WE PUT ACS
1093         HRRZ A,R
1094         ADDI A,(X)
1095         HRL A,X ;SET UP BLT FROM (X) TO R(X)
1096         MOVEI Q,17(A)
1097         BLT A,(Q)>>
1098 IFN DMNSW,<TRNN F,DMNFLG        ;NOW THE CODE TO MOVE SYMBOLS
1099         JRST NODDT
1100         HRRZ A,R
1101         ADD A,KORSP
1102         MOVE W,A        ;SAVE POINTER TO FINAL LOC OF UNDEFS
1103         ADDI A,(X)
1104         HLLZ Q,S        ;COMPUTE LENGTH OF SYMBOL TABLE
1105         ADD Q,B
1106         HLROS Q
1107         MOVNS Q
1108         ADDI Q,-1(A)    ;GET PLACE TO STOP BLT
1109         HRLI A,1(S)     ;WHERE TO BLT FROM
1110         SUBI W,1(S)     ;GET AMOUNT TO CHANGE S AND B BY
1111         BLT A,(Q)       ;MOVE SYMBOL TABLE
1112         ADD S,W
1113         ADD B,W ;CORRECT S AND B FOR MOVE
1114         HRRI R,1(Q)     ;SET R TO POINT TO END OF SYMBOLS
1115         SUBI R,(X)
1116         SKIPN JOBDDT(X) ;IS DDT LOADED
1117         JRST NODDT      ;ON THE CONTRARY, DO LEAVE SYMBOLS!!!!!
1118         HRRM R,JOBFF(X)
1119         HRLM R,JOBSA(X) ;AND SAVE AWAY NEW JOBFF
1120 IFN LDAC,<SKIPA>        ;SKIP THE ADD TO R
1121 NODDT:>
1122 IFN LDAC,<ADDI R,20>    ;MAKE SURE R IS CORRECT FOR BLT
1123         MOVE A,B
1124         ADDI A,1        ;SET UP JOBSYM, JOBUSY
1125 IFE L,<MOVEM A,JOBSYM(X)>
1126 IFN L,<MOVEM A,JOBSYM>
1127         MOVE A,S
1128         ADDI A,1
1129 IFE L,<MOVEM A,JOBUSY(X)
1130         MOVE A,HISTRT   ;TAKE POSSIBLE REMAP INTO ACCOUNT
1131         MOVEM A,JOBREL(X)       ;SET UP FOR IMEDIATE EXECUTION>
1132 IFN L,<MOVEM A,JOBUSY>
1133 IFN REENT,<
1134         SKIPE A,HILOW   ;SET UP TOP LOC OF LOW CORE EXCLUDING BLOCKS
1135         SUBI A,1(X)     ;IF NON-ZERO THEN IT NEEDS RELOCATION
1136         HRLM A,JOBCOR(X)
1137         TRNN F,SEENHI
1138         POPJ P,
1139         HRRZ A,HVAL
1140         HRRM A,JOBHRL(X)
1141         SUB A,HVAL1
1142         HRLM A,JOBHRL(X)>
1143         POPJ P,
1144
1145
1146
1147 \fSUBTTL BLT SYMBOL TABLE INTO HIGH SEGMENT
1148 IFN DMNSW&REENT,<
1149 BLTSYM: MOVE    Q,HVAL  ;GET ORIGIN OF HISEG
1150         CAMN    Q,HVAL1 ;HAS IT CHANGED?
1151         JRST    NOBLT   ;NO
1152         HLLZ    Q,S     ;COMPUTE LENGTH OF SYMBOL TABLE
1153         HLRS    S       ;PUT NEG COUNT IN BOTH HALVES
1154         JUMPE   S,.+2   ;SKIP IF S IS ZERO
1155         HRLI    S,-1(S) ;SUB 1 FROM LEFT TO FIX CARRY PROBLEM
1156         ADD     Q,B
1157         HLROS   Q
1158         MOVNS   Q
1159         ADD     Q,HVAL  ;ADD LENGTH OF HISEG
1160         SUB     Q,HVAL1 ;BUT REMOVE ORIGIN
1161         ADD     Q,HISTRT        ;START OF HISEG IN CORE
1162         HRRZS   Q       ;CLEAR INDEX FROM Q
1163         ADD     Q,KORSP ;SAVE SPACE FOR SYMBOL PATCHES
1164         CORE    Q,      ;EXPAND IF NEEDED
1165         PUSHJ   P,MORCOR
1166         PUSH    P,B     ;SAVE B
1167         SOJ     B,      ;REMOVE CARRY FROM ADD TO FOLLOW
1168         MOVSS   B       ;SWAP SYMBOL POINTER
1169         ADD     B,JOBREL
1170         HRRM    B,(P)   ;SAVE NEW B
1171         MOVE    Q,JOBREL
1172         ADD     B,S     ;INCASE ANY UNDEFS.
1173         BLT     B,(Q)   ;MOVE SYMBOLS
1174         POP     P,B     ;GET NEW B
1175         SUB     B,HISTRT
1176         ADD     B,HVAL1
1177         SOJ     B,      ;REMOVE CARRY
1178         ADDI    S,(B)   ;SET UP JOBUSY
1179 BLTSY1: MOVE    Q,JOBREL
1180         SUB     Q,HISTRT
1181         ADD     Q,HVAL1
1182         SUBI    Q,1     ;ONE TOO HIGH
1183         MOVEM   Q,HVAL
1184         JRST    NODDT
1185
1186
1187
1188 \fNOBLT: HRRZ    Q,HILOW ;GET HIGHEST LOC LOADED
1189         HRRZ    A,S     ;GET BOTTOM OF UNDF SYMBOLS
1190         SUB     A,KORSP ;DON'T FORGET PATCH SPACE
1191         IORI    A,1777  ;MAKE INTO A K BOUND
1192         IORI    Q,1777
1193         CAIN    A,(Q)   ;ARE THEY IN SAME K
1194 IFN EXPAND,<JRST        [PUSHJ  P,XPAND>
1195                 PUSHJ   P,MORCOR
1196 IFN EXPAND,<    JRST    NOBLT]>
1197         MOVEM   Q,HISTRT        ;SAVE AS START OF HIGH
1198         MOVEI   A,400000        ;HISEG ORIGIN
1199         MOVEM   A,HVAL1         ;SAVE AS ORIGIN
1200         SUB     S,HISTRT        ;GET POSITION OF UNDF POINTER
1201         ADDI    S,377777        ;RELATIVE TO ORG
1202         SUB     B,HISTRT        ;SAME FOR SYM POINTER
1203         ADDI    B,377777
1204         TRO     F,SEENHI        ;SO JOBHRL WILL BE SET UP
1205         JRST    BLTSY1          ;AND USE COMMON CODE
1206 >
1207
1208 IFN DMNSW!LDAC,<
1209 MORCOR: ERROR ,</MORE CORE NEEDED#/>
1210         EXIT>
1211
1212
1213 \fSUBTTL WRITE CHAIN FILES
1214
1215 IFE K,<                 ;DONT INCLUDE IN 1KLOAD
1216 CHNC:   SKIPA   A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST BLOCK DATA
1217 CHNR:   HLR     A,JOBCHN(X)     ;CHAIN FROM BREAK OF FIRST F4 PROG
1218 IFN ALGSW,<TRNE F,ALGFL         ;IF ALGOL LOADING
1219         POPJ    P,              ;JUST RETURN>
1220         HRRZS   A               ;ONLY RIGHT HALF IS SIGNIFICANT
1221         JUMPE   A,LD7C          ;DON'T CHAIN IF ZERO
1222         TLNN    N,AUXSWI        ;IS THERE AN AUX DEV?
1223         JRST    LD7D            ;NO, DON'T CHAIN
1224         PUSH    P,A             ;SAVE WHEREFROM TO CHAIN
1225         JUMPE   D,.+2           ;STARTING ADDR SPECIFIED?
1226         HRRZM   D,STADDR        ;USE IT
1227         CLOSE   2,              ;INSURE END OF MAP FILE
1228         TLZ     N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT
1229         PUSHJ   P,SASYM         ;DO LIB SEARCH, SETUP JOBSA, ETC.
1230 IFN RPGSW,<TLNE N,RPGF          ;IF IN CCL MODE
1231         TDZA    W,W             ;NO MESSAGES>
1232         MOVE    W,[SIXBIT ?CHAIN?]      ;FINAL MESSAGE
1233         PUSHJ   P,BLTSET        ;SETUP BLT PNTR, SETDDT, RELEAS
1234         POP     P,A             ;GET WHEREFROM
1235         HRRZ    W,R             ;CALCULATE MIN IOWD NECESSARY
1236         SKIPE   JOBDDT(X)       ;IF JOBDDT KEEP SYMBOLS
1237         CAILE   W,1(S)
1238         JRST    CHNLW1
1239         HRRZ    W,JOBREL        ;NEED SYMBOLS AND THEY HAVE NOT MOVED DOWN
1240         SUBI    W,(X)           ;BECAUSE WE WILL NOT HAVE BLITTED
1241         SUBI    B,-1(X)         ;SYMBOL TABLE WILL COME OUT IN A
1242         MOVEM   B,JOBSYM(X)     ;DIFFERENT PLACE
1243 CHNLW1: MOVNS   W
1244         ADDI    W,-7(A)
1245         ADDI    A,-7(X)
1246         PUSH    A,W     ;SAVE LENGTH
1247         HRLI    W,-1(A)
1248         MOVSM   W,IOWDPP        ;...
1249         SETZM   IOWDPP+1        ;JUST IN CASE
1250         PUSH    A,JOBCHN(X)
1251         PUSH    A,JOBSA(X)      ;SETUP SIX WORD TABLE
1252         PUSH    A,JOBSYM(X)     ;...
1253         PUSH    A,JOB41(X)
1254         PUSH    A,JOBDDT(X)
1255         SETSTS  2,17            ;SET AUX DEV TO DUMP MODE
1256         MOVSI   W,435056        ;USE .CHN AS EXTENSION
1257         MOVEM   W,DTOUT1        ;...
1258         PUSHJ   P,IAD2          ;DO THE ENTER
1259         OUTPUT  2,IOWDPP        ;WRITE THE CHAIN FILE
1260         STATZ   2,IOBAD!IODEND
1261         JRST    LOSEBIG
1262         CLOSE   2,
1263         STATZ   2,IOBAD!IODEND
1264 IFN RPGSW,<JRST LOSEBIG
1265         TLNE    N,RPGF          ;IF IN CCL MODE
1266         JRST    CCLCHN          ;LOAD NEXT LINK
1267         EXIT>
1268 LOSEBI: TTCALL  3,[ASCIZ /?DEVICE ERROR/]
1269         EXIT>
1270
1271
1272 \fSUBTTL SPECIAL CHAINB
1273 IFE SPCHN,<     XLIST   >
1274 IFN SPCHN,<
1275 CHNBG:
1276         PUSHJ   P,FSCN1A                ;FORCE SCAN TO COMPLETION FOR CURRENT FILE
1277         TLNN N,AUXSWI   ;IS THERE AN AUX DEV??
1278         JRST LD7D
1279         HRLZI   W,-1(R)         ;CHNTAB-L = ADDRESS OF VECTOR TABLE
1280         HRRI    W,1             ;CHNTAB-R = NEXT DISK BLOCK TO RITE INTO
1281         MOVEM   W,CHNTAB
1282         MOVE    C,[RADIX50 4,OVTAB]     ;DEFINE GLOBAL SYMBOL OVTAB
1283         MOVEI   W,(R)           ;TO HAVE VALUE THE BEGINNING OF THE VECTOR TABLE
1284         PUSHJ   P,SYMPT
1285         ADDI    R,VECLEN        ;RESERVE SPACE FOR VECTOR TABLE
1286         MOVE    C,[RADIX50 4,OVBEG]     ;OVBEG IS BEGINNING OF OVERLAY AREA
1287         MOVEI   W,(R)
1288         PUSHJ   P,SYMPT
1289         HRRZM   R,BEGOV         ;AND SAVE IN OVBEG
1290         OPEN    4,CHNOUT        ;OPEN FILE FOR CHAIN
1291         JRST    ILD5            ;CANT OPEN CHAIN FILE
1292         ENTER   4,CHNENT        ;ENTER CHAIN FILE
1293         JRST    IMD3            ;NO CAN DO
1294         HRRZ    W,N
1295         SUB     W,HISTRT        ;KEEP N RIGHT HALF AS RELATIVE TO HISTRT
1296         HRRZM W,CHNACN  ;SAVE FOR RESTORING
1297         MOVEM B,CHNACB  ;ALSO B R IS SAVED IN BEGOV
1298         POPJ    P,
1299
1300 CHNENS: TLOA N,PPCSW    ;THIS FLAG UNUSED AT THIS POINT
1301 CHNEN:  TLZ N,PPCSW     ;ON TO NOT DELETE NEW SYMBOLS
1302         SKIPN CHNACB    ;WILL BE NON-ZERO IF WE SAW A /<  (> TO KEEP  MACRO HAPPY)
1303         JRST LD7D       ;ERROR MESSAGE
1304         PUSHJ P,FSCN1A          ;LOAD LIB (IF DESIRED) AND FORCE SCAN
1305         SKIPL Q,S       ;CHECK SYMBOL TABLE FOR MISSED UNDEFS
1306         JRST NOER       ;NONE THERE
1307         MOVEI E,0       ;COUNT OF ERRORS
1308 ONCK:
1309         IFN FAILSW,<SKIPL V,1(Q)        ;IF HIGH ORDER BIT IS ON
1310         TLNN V,740000   ;OR IF ALL CODE BITS 0
1311         JRST NXTCK      ;THEN NOT TO BE CHECKED>
1312         MOVE V,2(Q)     ;GET FIXUP WORD
1313         TLNE V,100000   ;BIT INDICATES SYMBOL TABLE FIXUP
1314         JRST SMTBFX
1315 IFN FAILSW,<TLNE V,40000        ;BIT INDICATES POLISH FIXUP
1316         JRST POLCK>
1317         TLZE V,740000   ;THESE BITS WOULD MEAN ADDITIVE
1318         JRST    [JSP A,CORCKL
1319                 JRST NXTCK]     ;ONLY TRY FIRST LOCATION
1320 CORCK:  JSP A,CORCKL
1321         HRRZ V,@X       ;THE WAY TO LINK
1322 CORCKL: IFN REENT,<CAMGE V,HVAL1>
1323         CAMGE V,BEGOV
1324         SKIPA   ;NOT IN BAD RANGE
1325         JRST ERCK       ;BAD, GIVE ERROR
1326         JUMPE V,NXTCK   ;CHAIN HAS RUN OUT
1327 IFN REENT,<CAMGE V,HVAL1        ;GET CORRECT LINK
1328         SKIPA X,LOWX
1329         MOVE X,HIGHX>
1330         XCT (A)         ;TELLS US WHAT TO DO
1331         JRST CORCKL     ;GO ON WITH NEXT LINK
1332
1333
1334 \fSMTBFX:        TLNE N,PPCSW    ;IF NOT CUTTING BACK SYMBOL TABLE
1335         JRST NXTCK      ;THE ALL OK
1336         ADD V,HISTRT    ;GET PLACE TO POINT TO
1337         HRRZS V
1338         HLRE D,CHNACB   ;OLD LENGTH OF TABLE (NEGATIVE)
1339         HLRE T,B        ;NEW LENGTH
1340         SUB D,T         ;-OLD LEN+NEW LEN
1341         ADDI D,(B)      ;OLD BOTTOM=NEW BOTTOM+NEW LEN-OLD LEN
1342         CAIG V,(D)      ;IS IT IN THE PART WE ARE KEEPING
1343         JRST ERCK
1344         JRST NXTCK      ;YES
1345 IFN FAILSW,<POLCK:      HLRZ C,V        ;FIND HEADER
1346         PUSHJ P,SREQ
1347         SKIPA
1348         JRST LOAD4A     ;SHOULD BE THERE
1349         HRL C,2(A)      ;NOW FIRST OPERATOR (STORE)
1350         MOVSS C
1351         PUSHJ P,SREQ
1352         SKIPA
1353         JRST LOAD4A
1354         ANDI C,37       ;GET OPERATION
1355         HRRZ V,2(A)     ;DESTINATION
1356         JRST @CKSMTB-15(C)      ;DISPATCH
1357 CKSMTB: EXP SMTBFX,SMTBFX,SMTBFX,CORCK,LCORCK,CORCK,NXTCK
1358 LCORCK: JSP A,CORCKL
1359         HLRZ V,@X>
1360 ERCK:   MOVE C,1(Q)     ;GET SYMBOL NAME
1361         PUSHJ P,FCRLF   ;FORCE CRLF AND OUTPUT ON TTY
1362         PUSHJ P,PRNAME  ;PRINT IT
1363         ADDI E,1        ;MARK ERROR
1364 NXTCK:  ADD Q,SE3       ;TRY ANOTHER
1365         JUMPL Q,ONCK
1366 IFN REENT,<PUSHJ P,RESTRX       ;GET PROPER X BACK>
1367         JUMPE E,NOER    ;DID ANYTHING GO WRONG??
1368         ERROR   ,</UNDEFINED GLOBAL(S) IN LINK@/>
1369         JRST LD2        ;GIVE UP
1370 NOER:   MOVE A,BEGOV    ;GET START OF OVERLAY
1371         ADDI A,(X)      ;GET ACTUAL CURRENT LOCATION
1372 IFN REENT,<HRRZ W,HILOW ;AND END OF OVERLAY+1
1373         HRRZM A,HILOW   ;RESET>
1374 IFE REENT,<HRRZ W,R
1375         ADDI R,(X)      ;A GOOD GUESS>
1376         SUBM A,W        ;W=-LENGTH
1377         SUBI A,1        ;SET TO BASE-1 (FOR IOWD)
1378         HRL A,W         ;GET COUNT
1379         MOVEM A,IOWDPP
1380         HRR A,CHNTAB    ;BLOCK WE ARE WRITING ON
1381         HLRZ V,CHNTAB   ;POINTER TO SEGMENT TABLE
1382         ADDI V,1        ;NEXT LOCATION
1383         HRLM V,CHNTAB   ;REMEMBER IT
1384         CAML V,BEGOV    ;CHECK FOR OVERRUN
1385         JRST    [ERROR </?TOO MANY LINKS@/>
1386                 JRST LD2];GIVE UP
1387         MOVEM A,@X      ;PUT INTO TABLE
1388         MOVN W,W        ;GET POSITIVE LENGTH
1389         ADDI W,DSKBLK-1
1390         IDIVI W,DSKBLK  ;GET NUMBER OF BLOCKS
1391         ADDM W,CHNTAB   ;AND UPDATE
1392         TLZE N,PPCSW
1393         JRST NOMVB      ;DO NOT ADJUST SYMBOLS
1394         HLRE W,CHNACB   ;GET OLD LENGTH OF DEF SYMBOLS
1395         HLRE C,B        ;AND NEW LENGTH
1396         SUB W,C         ;-OLD LEN+NEW LEN
1397         HRRZ C,B        ;SAVE POINTER TO CURRENT S
1398         ADD S,W
1399         HRL W,W
1400         ADD B,W         ;UPDATE B (COUNT AND LOC)
1401         JUMPGE S,UNLNKD ;JUST IN CASE NOTHING TO MOVE
1402         HRRZ A,B        ;PLACE TO PUT UNDEFS
1403 UNLNK:  MOVE W,(C)
1404         MOVEM W,(A)     ;TRANSFER
1405         SUBI A,1
1406         CAIE A,(S)      ;HAVE WE MOVED LAST WORD??
1407         SOJA C,UNLNK    ;NO, CONTINUE
1408 UNLNKD: HRRZ W,CHNACN   ;GET SAVED N
1409         ADD W,HISTRT
1410         HRR N,W ;AND RESET IT
1411 NOMVB:  HRR R,BEGOV     ;PICK UP BASE OF AREA
1412         OUTPUT 4,IOWDPP ;DUMP IT
1413         STATZ 4,IOBAD!IODEND    ;AND ERROR CHECK
1414         JRST LOSEBI
1415         HRRZ V,R        ;GET AREA TO ZERO
1416         MOVEI W,@X
1417         CAIL W,1(S)     ;MUST MAKE SURE SOME THERE
1418         POPJ P, ;DONE
1419         SETZM (W)
1420         CAIL W,(S)
1421         POPJ P,
1422         HRLS W
1423         ADDI W,1
1424         BLT W,(S)       ;ZERO WORLD
1425         POPJ P,
1426 >
1427         LIST
1428
1429
1430 \fSUBTTL EXPAND CORE
1431
1432 IFN EXPAND,<
1433 XPAND:  TLNE    F,FULLSW        ;IF CORE  EXCEEDED
1434         POPJ    P,              ;DON'T WASTE TIME  ON  CORE UUO
1435         PUSH    P,Q
1436         HRRZ    Q,JOBREL
1437         ADDI    Q,2000
1438 XPAND1: PUSH P,H        ;GET SOME REGISTERS TO USE
1439         PUSH P,X
1440         PUSH P,N
1441         PUSH    P,JOBREL        ;SAVE PREVIOUS SIZE
1442         CAMG    Q,ALWCOR        ;CHECK TO SEE IF RUNNING OVER
1443         CORE Q,
1444         JRST XPAND6
1445 IFE K,< HRRZ H,MLTP     ;GET LOWEST LOCATION
1446         TLNN N,F4SW     ;IS FORTRAN LOADING>
1447         MOVEI H,1(S)    ;NO, USE S
1448         POP     P,X     ;LAST JOBREL
1449         HRRZ    Q,JOBREL;NEW JOBREL
1450         SUBI    Q,(X)   ;GET DIFFERENCE
1451         HRLI    Q,X     ;PUT X IN INDEX FIELD
1452 XPAND2: MOVE N,(X)
1453         MOVEM N,@Q
1454         CAMLE X,H       ;TEST FOR END
1455         SOJA X,XPAND2
1456         HRLI    H,-1(Q)
1457         TLC     H,-1    ;MAKE IT NEGATIVE
1458         SETZM (H)       ;ZERO NEW CORE
1459         AOBJN H,.-1
1460         MOVEI H,(Q)
1461 XPAND8: ADD     S,H
1462         ADD     B,H
1463         ADDM H,HISTRT   ;UPDATE START OF HISEG
1464 IFN REENT,<ADDM H,HIGHX ;AND STORE LOCATION
1465         TLNE F,HIPROG
1466         ADDM H,-1(P)    ;X IS CURRENTLY IN THE STACK>
1467         POP P,N
1468         ADD N,H
1469 IFE K,< TLNN N,F4SW     ;F4?
1470         JRST    XPAND3
1471         ADDM H,PLTP
1472         ADDM H,BITP
1473         ADDM H,SDSTP
1474         ADDM H,MLTP
1475         TLNE N,SYDAT
1476         ADDM H,V>
1477 XPAND3: AOSA -3(P)
1478 XPAND5: POP P,N
1479         POP P,X
1480         POP P,H
1481         POP     P,Q
1482         POPJ P,
1483
1484
1485 \f
1486 XPAND6: POP     P,A     ;CLEAR JOBREL OUT OF STACK
1487         ERROR   ,</MORE CORE NEEDED#/>
1488         JRST XPAND5
1489
1490 XPAND7: PUSHJ   P,XPAND
1491         JRST    SFULLC
1492         JRST    POPJM2
1493
1494 XPAND9: PUSH    P,Q             ;SAVE Q
1495         HRRZ    Q,JOBREL        ;GET CORE SIZE
1496         ADDI    Q,(V)           ;ADD XTRA NEEDED
1497         JRST    XPAND1          ;AND JOIN COMMON CODE
1498
1499 POPJM3: SOS     (P)             ;POPJ TO CALL-2
1500 POPJM2: SOS     (P)             ;POPJ TO CALL-1
1501         SOS     (P)             ;SAME AS POPJ TO
1502         POPJ    P,              ;NORMAL POPJ MINUS TWO
1503 >
1504
1505
1506
1507 \fSUBTTL SWITCH HANDLING
1508
1509 ;ENTER SWITCH MODE
1510
1511 LD6A:   CAIN    T,57            ;WAS CHAR A SLASH?
1512         TLO     N,SLASH         ;REMEBER THAT
1513 LD6A2:  TLO     F,SSW           ;ENTER SWITCH MODE
1514 LD6A1:  SETZB   D,C     ;ZERO TWO REGS FOR DECIMAL AND OCTAL
1515         JRST    LD3             ;EAT A SWITCH
1516
1517 ;ALPHABETIC CHARACTER, SWITCH MODE
1518
1519 LD6:
1520         CAIL    T,141           ;ACCEPT LOWER CASE SWITCHES
1521         SUBI    T,40
1522 IFN SPCHN,<XCT  LD6B-74(T)      ;EXECUTE SWITCH FUNCTION>
1523 IFE SPCHN,<XCT  LD6B-101(T)     ;EXECUTE SWITCH FUNCTION>
1524         TLZE    N,SLASH ;SWITCH MODE ENTERED W/ SLASH?
1525         JRST    LD6D            ;LEAVE SWITCH MODE
1526         JRST    LD6A1           ;STAY IN SWITCH MODE
1527
1528
1529
1530 \f;DISPATCH TABLE FOR SWITCHES
1531
1532 ;       THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED
1533
1534 LD6B:
1535 IFN SPCHN,<PUSHJ P,CHNBG        ;LESS THAN - BEGINNING OF OVERLAY
1536         PUSHJ   P,CHNENS        ;= - PUT OUT CHAIN RETAINING SYMBOLS
1537         PUSHJ   P,CHNEN         ;GREATER THAN - END OF OVERLAY
1538 IFE STANSW,<JRST        LD7B            ;? - ERROR
1539         JRST    LD7B            ;@ - ERROR>
1540 IFG STANSW,<PUSHJ       P,VSWTCH        ;? HERE = VSWITCH
1541         PUSHJ   P,HSET                  ;@ HERE = H SWITCH>>
1542 COMMENT/
1543 AT STANFORD MAP SWITCHES ? TO V
1544 AND @ TO H
1545 WHAT A CROCK:   REG/
1546         PUSHJ   P,ASWTCH        ;A - LIST ALL GLOBALS
1547 IFN DMNSW,<PUSHJ P,DMN2         ;B - BLOCKS DOWN SYMBOL TABLE >
1548 IFE DMNSW,<JRST LD7B            ;B - ERROR>
1549 IFE K,< PUSHJ   P,CHNC          ;C - CHAIN, START W/ COMMON>
1550 IFN K,< JRST    LD7B            ;C - ILLEGAL IN 1KLOAD>
1551         PUSHJ   P,LDDT          ;D - DEBUG OPTION, LOAD DDT
1552         TLO     N,EXEQSW        ;E - LOAD AND GO
1553         PUSHJ    P,LIBF         ;F - LIBRARY SEARCH
1554         PUSHJ    P,LD5E         ;G - GO INTO EXECUTION
1555 IFE STANSW,<IFN REENT,< PUSHJ P,HSET            ;H - REENTRANT. PROGRAM>
1556         IFE REENT,<JFCL                         ;NOT REENT AND NOT STANFORD>>
1557 IFN STANSW,<PUSHJ P,LDDTQX                      ;H - LOAD AND START RAID>
1558         PUSHJ   P,ISWTCH        ;I - IGNORE STARTING ADDRESSES
1559         TLZ     N,ISAFLG        ;J - USE STARTING ADDRESSES
1560 IFE KUTSW,<JRST LD7B            ;K - ERROR>
1561 IFN KUTSW,<MOVEM C,CORSZ        ;K - SET DESIRED CORE SIZE>
1562         PUSHJ   P,LSWTCH        ;L - ENTER LIBRARY SEARCH
1563         PUSHJ   P,PRMAP         ;M - PRINT STORAGE MAP
1564         TLZ     F,LIBSW+SKIPSW  ;N - LEAVE LIBRARY SEARCH
1565         HRR     R,D             ;O - NEW PROGRAM ORIGIN
1566         PUSHJ   P,PSWTCH        ;P - PREVENT AUTO. LIB. SEARCH
1567         TLZ     F,NSW           ;Q - ALLOW AUTO. LIB. SEARCH
1568 IFE K,< PUSHJ   P,CHNR          ;R - CHAIN, START W/ RESIDENT>
1569 IFN K,< JRST    LD7B            ;R - ILLEGAL IN 1KLOAD>
1570         PUSHJ   P,SSWTCH        ;S - LOAD WITH SYMBOLS
1571         PUSHJ   P,LDDTX         ;T - LOAD AND GO TO DDT
1572         PUSHJ   P,PMS           ;U - PRINT UNDEFINED LIST
1573 IFE STANSW,<IFN REENT,<PUSHJ P,VSWTCH   ;V - LOAD REENTRANT LIB40>
1574         IFE REENT,<JRST LD7B    ;V -NO REENT, NO STANFORD: ERROR>>
1575 IFN STANSW,<PUSHJ P,LDDTQ       ;V - LOAD RAID>
1576         TLZ     F,SYMSW+RMSMSW  ;W - LOAD WITHOUT SYMBOLS
1577         TLZ     N,ALLFLG        ;X - DO NOT LIST ALL GLOBALS
1578 IFE SAILSW,<
1579         TLO     F,REWSW         ;Y - REWIND BEFORE USE
1580 >
1581 IFN SAILSW,<
1582         PUSHJ   P,SEGLOD        ;Y - LOAD SYS:SAILOW FOR 2-SGMT SAIL
1583 >
1584         JRST    LDRSTR          ;Z - RESTART LOADER
1585
1586
1587
1588 \f; PAIRED SWITCHES ( +,-)
1589
1590 ASWTCH: JUMPL   D,.+2           ;SKIP IF /-A
1591         TLOA    N,ALLFLG        ;LIST ALL GLOBALS
1592         TLZ     N,ALLFLG        ;DON'T
1593         POPJ    P,
1594
1595 ISWTCH: JUMPL   D,.+2           ;SKIP IF /-I
1596         TLOA    N,ISAFLG        ;IGNORE STARTING ADDRESSES
1597         TLZ     N,ISAFLG        ;DON'T
1598         POPJ    P,
1599
1600 LSWTCH: JUMPL   D,.+2           ;SKIP IF /-L
1601         TLOA    F,LIBSW!SKIPSW  ;ENTER LIBRARY SEARCH
1602         TLZ     F,LIBSW!SKIPSW  ;DON'T
1603         POPJ    P,
1604
1605 PSWTCH: JUMPL   D,.+2           ;SKIP IF /-P
1606         TLOA    F,NSW           ;PREVENT AUTO. LIB SEARCH
1607         TLZ     F,NSW           ;ALLOW
1608         POPJ    P,
1609
1610 SSWTCH: JUMPL   D,.+2           ;SKIP IF /-S
1611         TLOA    F,SYMSW!RMSMSW  ;LOAD WITH SYMBOLS
1612         TLZ     F,SYMSW!RMSMSW  ;DON'T
1613         POPJ    P,
1614
1615 IFN REENT,<
1616 VSWTCH: JUMPL   D,.+2           ;SKIP IF /-V
1617         TROA    F,VFLG          ;SEARCH RE-ENTRANT LIBRARY
1618         TRZ     F,VFLG          ;DON'T
1619         POPJ    P,>
1620
1621 IFN SAILSW,<
1622 SEGLOD: PUSHJ   P,FSCN1         ;FORCE SCAN TO COMPLETION
1623         HRRZ    W,R             ;CHECK LEGAL
1624         CAILE   W,140           ; (MUST BE NOTHING LOADED EARLIER)
1625         JRST    [ERROR ,<./Y MUST APPEAR BEFORE ANY FILES ARE LOADED`.>
1626                  JRST  LD2]     ;TRY AGAIN
1627         MOVE    W,[SIXBIT /SAILOW/] ;WILL LOAD SAILOW NOW
1628         ADD     W,D             ;SAILOW, SAILOX, SAILOY, DEPENDING
1629         ;ON ARG -- W FOR SAIL, X FOR OSAIL, Y FOR NSAIL
1630         TLZ     F,SYMSW!RMSMSW  ;SET SWITCHES (SEE LDDT)
1631         PUSHJ   P,LDDT1         ;SET SYS AS DEVICE, PREPARE
1632         PUSHJ   P,LDF           ;LOAD SAILOW
1633         POPJ    P,              ;AFRAID OF `JRST LDF'
1634 >; END OF SEGMENT LOADING OPTION
1635
1636
1637 \fIFN REENT,<
1638 ; H SWITCH --- EITHER /H OR /NH
1639 HSET:   JUMPE   D,SETNUM        ;/H ALWAYS LEGAL
1640         CAIGE   D,2             ;WANT TO CHANGE SEGMENTS
1641         JRST    SETSEG          ;YES,GO DO IT
1642         TRNN    F,SEENHI        ;STARTED TO LOAD YET?
1643         JRST    HCONT           ;NO, CONTINUE.
1644         ERROR   ,<?/H ILLEGAL AFTER FIRST HISEG FILE IS LOADED@?>>
1645
1646 LDRSTR: ERROR   0,</LOADER RESTARTED@/>
1647         JRST    LD              ;START AGAIN
1648 IFN REENT,<
1649 REMPFL: ERROR   ,</?LOADER REMAP FAILURE@/>
1650         JRST LDRSTR
1651 HCONT:  HRRZ C,D
1652         ANDCMI C,1777
1653         CAIL C,400000
1654         CAIG C,(H)
1655         JRST COROVL     ;BEING SET LOWER THEN 400000 OR MORE THAN TO OF LOW SEG
1656         HRRZM C,HVAL1   ;WE HAVE REMOVED THE ODD BITS TO MAKE A 1K MULT
1657         ADDI C,JOBHDA
1658         CAILE C,(D)     ;MAKE SURE OF ENOUGH ROOM
1659         MOVE D,C
1660         HRLI D,W        ;SET UP W IN LEFT HALF
1661         MOVEM D,HVAL
1662         POPJ    P,      ;RETURN.
1663
1664 COROVL: ERROR   ,</HISEG STARTING ADDRESS TOO LOW@/>
1665         JRST LDRSTR
1666 SETNUM: TRO     F,NOHI  ;SET NO-HIGH-SEG SWITCH.
1667         POPJ    P,>
1668
1669
1670 \f;SWITCH MODE NUMERIC ARGUMENT
1671
1672 LD6C:   LSH     D,3             ;BUILD OCTAL NUMERIC ARGUMENT
1673         ADDI    D,-60(T)
1674         IMULI C,↑D10
1675         ADDI C,-"0"(T)  ;ACCUMULATE DEC AND OCTAL
1676         JRST    LD3
1677
1678 ;EXIT FROM SWITCH MODE
1679
1680 LD6D:   TLZ     F,SSW           ;CLEAR SWITCH MODE FLAG
1681         TLNE    F,FSW           ;TEST FORCED SCAN FLAG
1682         JRST    LD2D            ;SCAN FORCED, START NEW IDENT.
1683         JRST    LD3             ;SCAN NOT FORCED, USE PREV IDENT
1684 ;ILLEGAL CHARACTER, NORMAL MODE
1685
1686 LD7:    IFN SYMARG,<
1687         CAIN    T,"#"           ;DEFINING THIS SYMBOL
1688         JRST    DEFINE          ;YES
1689         TRNN    F,ARGFL         ;TREAT AS SPECIAL
1690         JRST    .+4             ;NO
1691         CAIE    T,"$"
1692         CAIN    T,"%"
1693         JRST    LD4             ;YES>
1694         CAIN    T,"Z"-100       ;TEST FOR ↑Z
1695         JRST    LD5E1           ;TREAT AS ALTMODE FOR BATCH
1696         ERROR   8,</CHAR.%/>
1697         JRST    LD2     ;TRY TO CONTINUE
1698
1699 ;SYNTAX ERROR, NORMAL MODE
1700
1701 LD7A:   ERROR   8,</SYNTAX%/>
1702         JRST    LD2
1703
1704 ;ILLEGAL CHARACTER, SWITCH MODE
1705
1706 LD7B:   CAIN T,"-"      ;SPECIAL CHECK FOR -
1707         JRST    [SETOB C,D
1708                 JRST LD3]
1709         CAIN    T,"Z"-100       ;CHECK FOR /↑Z
1710         JRST    LD5E1           ;SAME AS ↑Z
1711         ERROR   8,</SWITCH%/>
1712         JRST    LD2
1713
1714
1715 \f;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0
1716
1717 IFE K,<
1718 LD7C:   ERROR   ,<?UNCHAINABLE AS LOADED@?>
1719         JRST    LD2
1720
1721 ;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE
1722
1723 LD7D:   ERROR   ,<?NO CHAIN DEVICE@?>
1724         JRST    LD2>
1725
1726 IFN DMNSW,<
1727 DMN2:
1728 IFN ALGSW,<TRNE F,ALGFL         ;IF LOADING ALGOL
1729         POPJ    P,              ;JUST RETURN>
1730         CAIN    D,1             ;SPECIAL CASE
1731         TROA    F,HISYM         ;YES ,BLT SYMBOLS INTO HISEG
1732         JUMPL   D,.+2
1733         TROA    F,DMNFLG        ;TURN ON /B
1734 IFN KUTSW,<TRZA F,DMNFLG        ;TURN OFF IF /-B
1735         SETZM   CORSZ           ;SET TO CUT BACK CORE>
1736 IFE KUTSW,<TRZ  F,DMNFLG        ;TURN OFF IF /-B>
1737         CAMLE D,KORSP
1738         MOVEM D,KORSP
1739         POPJ    P,               ;RETURN>
1740
1741
1742
1743 \fSUBTTL CHARACTER CLASSIFICATION TABLE DESCRIPTION:
1744
1745 ;       EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE
1746 ;       PACKED IN THE CHARACTER CLASSIFICATION TABLE.  THE CHARACTER
1747 ;       CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE
1748 ;       DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.
1749 ;       CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND
1750 ;       THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS.  FOUR CODES
1751 ;       ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS
1752 ;       IN EFFECT.
1753
1754
1755 ;CLASSIFICATION BYTE CODES:
1756
1757 ;       BYTE DISP CLASSIFICATION
1758
1759 ;       00 - 00  ILLEGAL CHARACTER, SWITCH MODE
1760 ;       01 - 01  ALPHABETIC CHARACTER, SWITCH MODE
1761 ;       02 - 02  NUMERIC CHARACTER, SWITCH MODE
1762 ;       03 - 03  SWITCH MODE ESCAPE, SWITCH MODE
1763
1764 ;       00 - 04  ILLEGAL CHARACTER, NORMAL MODE
1765 ;       01 - 05  ALPHABETIC CHARACTER, NORMAL MODE
1766 ;       02 - 06  NUMERIC CHARACTER, NORMAL MODE
1767 ;       03 - 07  SWITCH MODE ESCAPE, NORMAL MODE
1768
1769 ;       04 - 10  IGNORED CHARACTER
1770 ;       05 - 11  ENTER SWITCH MODE CHARACTER
1771 ;       06 - 12  DEVICE IDENTIFIER DELIMITER
1772 ;       07 - 13  FILE EXTENSION DELIMITER
1773 ;       10 - 14  OUTPUT SPECIFICATION DELIMITER
1774 ;       11 - 15  INPUT SPECIFICATION DELIMITER
1775 ;       12 - 16  LINE TERMINATION
1776 ;       13 - 17  JOB TERMINATION
1777
1778
1779 \f;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE
1780
1781 LD8:    POINT     4,LD9(Q),3
1782         POINT     4,LD9(Q),7
1783         POINT     4,LD9(Q),11
1784         POINT     4,LD9(Q),15
1785         POINT     4,LD9(Q),19
1786         POINT     4,LD9(Q),23
1787         POINT     4,LD9(Q),27
1788         POINT     4,LD9(Q),31
1789         POINT     4,LD9(Q),35
1790
1791 ;CHARACTER CLASSIFICATION TABLE
1792
1793 LD9:    BYTE    (4)4,0,0,0,0,0,0,0,0
1794         BYTE    (4)4,4,4,4,12,0,0,0,0
1795         BYTE    (4)0,0,0,0,0,0,0,0,0
1796         BYTE    (4)13,0,0,0,0,4,0,4,0
1797 IFE SYMARG,<    BYTE    (4)0,0,0,0,5,3,0,0,11>
1798 IFN SYMARG,<    BYTE    (4)0,0,14,0,5,3,0,0,11>
1799                 BYTE    (4)0,7,5,2,2,2,2,2,2
1800 IFE SPCHN,<     BYTE    (4)2,2,2,2,6,0,0,10,0>
1801 IFN SPCHN,<     BYTE    (4)2,2,2,2,6,0,1,10,1>
1802 IFE RPGSW,<     BYTE    (4)0,0,1,1,1,1,1,1,1>
1803 IFN RPGSW,<     BYTE (4) 0,10,1,1,1,1,1,1,1>
1804         BYTE    (4)1,1,1,1,1,1,1,1,1
1805         BYTE    (4)1,1,1,1,1,1,1,1,1
1806 IFE PP,<BYTE    (4)1,0,0,0,0,10,0,1,1>
1807 IFN PP,<BYTE    (4)1,10,0,10,0,10,0,1,1>
1808         BYTE    (4)1,1,1,1,1,1,1,1,1
1809         BYTE    (4)1,1,1,1,1,1,1,1,1
1810         BYTE    (4)1,1,1,1,1,1,0,0,13
1811         BYTE    (4)13,4
1812
1813
1814 \fSUBTTL INITIALIZE LOADING OF A FILE
1815
1816 ILD:    MOVEI     W,BUF1                ;LOAD BUFFER ORIGIN
1817         MOVEM     W,JOBFF
1818         TLOE    F,ISW           ;SKIP IF INIT REQUIRED
1819         JRST    ILD6            ;DONT DO INIT
1820 ILD7:   OPEN    1,OPEN3                 ;KEEP IT PURE
1821         JRST    ILD5B
1822 ILD6:   TLZE    F,REWSW         ;SKIP IF NO REWIND
1823         MTAPE   1,1             ;REWIND
1824 ILD2:   LOOKUP    1,DTIN                ;LOOK UP FILE FROM DIRECTORY
1825         JRST    ILD3            ;FILE NOT IN DIRECTORY
1826 IFE LNSSW,<
1827 IFE K,< INBUF     1,2           ;SET UP BUFFERS>
1828 IFN K,< INBUF   1,1             ;SET UP BUFFER>>
1829 IFN LNSSW,<INBUF        1,1
1830         MOVEI   W,BUF1
1831         EXCH    W,JOBFF
1832         SUBI    W,BUF1
1833 IFE K,<MOVEI    C,4*203+1>
1834 IFN K,<MOVEI    C,203+1>
1835         IDIV    C,W
1836         INBUF   1,(C)>
1837         TLO     F,ASW           ;SET LEFT ARROW ILLEGAL FLAG
1838         TLZ     F,ESW           ;CLEAR EXTENSION FLAG
1839         POPJ    P,
1840
1841 ;       LOOKUP FAILURE
1842
1843 ILD3:   TLOE    F,ESW           ;SKIP IF .REL WAS ASSUMED
1844         JRST    ILD4            ;FATAL LOOKUP FAILURE
1845         SETZM     DTIN1         ;ZERO FILE EXTENSION
1846         JRST    ILD2            ;TRY AGAIN WITH NULL EXTENSION
1847
1848 ILD4:   IFE REENT,<IFE TEN30,<  ;PDP-6 ONLY
1849         MOVE    W,[SIXBIT /LIB40/]
1850         CAME    W,DTIN          ;WAS THIS A TRY FOR LIB40?
1851         JRST    ILD4A           ;NO
1852         TRZ     W,(SIXBIT / 0/) ;YES
1853         MOVEM   W,DTIN          ;TRY LIB4
1854         PUSHJ   P,LDDT2         ;USE .REL EXTENSION
1855         TLZ     F,ESW           ;...
1856         JRST    ILD2            ;GO TRY AGAIN
1857 ILD4A:>>
1858 IFN PP,<MOVSI   W,(SIXBIT /DSK/)
1859         CAMN    W,ILD1          ;TRIED DSK ONCE?
1860         JRST    ILD9            ;YES, FILE DOES NOT EXIST
1861         MOVEM   W,ILD1          ;SET IT UP
1862         SETZM   PPN             ;CLEAR OLD VALUE
1863         PUSHJ   P,LDDT2         ;SET UP .REL
1864         TLZ     F,ESW           ;SO WE CAN TRY BLANK EXT
1865         JRST    ILD7            ;OPEN DSK,TRY AGAIN>
1866
1867 ILD9:   ERROR   ,</CANNOT FIND#/>
1868         JRST    LD2
1869
1870 ;       DEVICE SELECTION ERROR
1871
1872 ILD5A:  SKIPA   W,LD5C1
1873 ILD5B:  MOVE    W,ILD1
1874 ILD5:   TLO     F,FCONSW        ;INSURE TTY OUTPUT
1875         PUSHJ   P,PRQ           ;START W/ ?
1876         PUSHJ   P,PWORD         ;PRINT DEVICE NAME
1877         ERROR   7,</UNAVAILABLE@/>
1878         JRST    LD2
1879
1880
1881 \fSUBTTL LIBRARY SEARCH CONTROL AND LOADER CONTROL
1882
1883 ;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>
1884
1885 LIBF:   PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION
1886         PUSH P,ILD1     ;SAVE DEVICE NAME
1887         PUSHJ   P,LIBF1                 ;LOAD SYS:JOBDAT.REL
1888 IFN SAILSW,<LIBAGN:     PUSHJ P,SALOAD  ;LOAD RELS AND SEARCH LIBS>
1889 IFN REENT,<TRNN F,SEENHI        ;IF ANY HISEG LOADED NO RE-ENT OP SYSTEM
1890         TRNN F,VFLG
1891         JRST LIBF3
1892 IFN ALGSW,<TRNE F,ALGFL ;SPECIAL ACTION IF LOADING ALGOL
1893         JRST    [MOVE C,[RADIX50 44,%ALGDR]
1894                 MOVEI W,400010  ;JOBHDA
1895                 PUSHJ P,SYMPT   ;DEFINE IT
1896                 JRST    LIBF3]  ;DON'T LOAD IMP40>
1897         MOVE W,[SIXBIT /IMP40/]
1898         PUSHJ P,LIBF2
1899 LIBF3:>
1900         TRNN    F,COBFL                 ;COBOL SEEN?
1901         SKIPA   W,[SIXBIT /LIB40/]      ;FIRST TRY AT NAME
1902         MOVE    W,[SIXBIT /LIBOL/]      ;YES, SEARCH COBOL'S LIBRARY ONLY
1903         PUSHJ   P,LIBF2                 ;LOAD SYS:LIB40.REL
1904 IFN SAILSW,<MOVE W,LIBPNT       ;SEE IF ANY MORE TO DO
1905         CAME W,[XWD -RELLEN-1,LIBFLS-1]
1906         JRST LIBAGN
1907         MOVE W,PRGPNT   ;IT COULD BE DANGEROUS TO LOAD PROGRAMS HERE
1908         CAME W,[XWD -RELLEN-1,PRGFLS-1]
1909         JRST LIBAGN     ;MORE TO DO, TRY AGAIN>
1910         POP P,ILD1      ;CALL TO LDDT1 WILL PUT IT IN OLDDEV
1911 LIBF1:  MOVE    W,[SIXBIT /JOBDAT/]     ;LOAD SYS:JOBDAT.REL
1912 LIBF2:  PUSHJ     P,LDDT1
1913 LIBGO:  JUMPGE    S,EOF2                ;JUMP IF NO UNDEFINED GLOBALS
1914         TLO     F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH
1915         TLZ     F,SYMSW ;DISABLE LOADING WITH SYMBOLS
1916         JRST    LDF             ;INITIALIZE LOADING LIB4
1917
1918
1919 \f;      LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE
1920
1921 LIB:    JUMPGE  S,EOF1          ;JUMP IF NO UNDEFINED GLOBALS
1922         TLO     F,SKIPSW        ;SET SKIPSW TO IGNORE MODE
1923 IFN DIDAL,<TRNE F,XFLG          ;INDEX IN CORE?
1924         JRST    INDEX1          ;YES>
1925         JRST    LOAD            ;CONTINUE LIB. SEARCH
1926
1927 LIB1:   CAIE    A,4             ;TEST FOR ENTRY BLOCK
1928         JRST    LIB29           ;NOT AN ENTRY BLOCK, IGNORE IT
1929 LIB2:   PUSHJ   P,RWORD         ;READ ONE DATA WORD
1930         MOVE    C,W
1931         TLO     C,040000                ;SET CODE BITS FOR SEARCH
1932         PUSHJ     P,SREQ
1933         TLZA    F,SKIPSW                ;REQUEST MATCHES ENTRY, LOAD
1934         JRST    LIB2            ;NOT FOUND
1935 LIB3:   PUSHJ     P,RWORD               ;READ AND IGNORE ONE DATA WORD
1936         JRST    LIB3            ;LOOP TO IGNORE INPUT
1937
1938 LIB29:
1939 IFN DIDAL,<CAIN A,14            ;INDEX BLOCK?
1940         JRST    INDEX0          ;YES>
1941 LIB30:  HRRZ    C,W             ;GET WORD COUNT
1942         JUMPE   C,LOAD1         ;IF NUL BLOCK RETURN
1943         CAILE   C,↑D18                ;ONLY ONE SUB-BLOCK
1944         JRST    LIB3            ;NO,SO USE OLD SLOW METHOD
1945         AOJA    C,LIB31         ;ONE FOR RELOCATION WORD
1946
1947 BLOCK0: HRRZ    C,W             ;GET WORD COUNT
1948         JUMPE   C,LOAD1         ;NOISE WORD
1949 LIB31:  CAML    C,BUFR2         ;DOES BLOCK OVERLAP BUFFERS?
1950         SOJA    C,LIB32         ;YES,ALLOW FOR INITIAL ILDB
1951         ADDM    C,BUFR1         ;ADD TO BYTE POINTER
1952         MOVNS   C               ;NEGATE
1953         ADDM    C,BUFR2         ;TO SUBTRACT C FROM WORD COUNT
1954         JRST    LOAD1           ;GET NEXT BLOCK
1955
1956 LIB32:  SUB     C,BUFR2         ;ACCOUNT FOR REST OF THIS BUFFER
1957         PUSHJ   P,WORD+1        ;GET ANOTHER BUFFERFUL
1958         JRST    LIB31           ;TRY AGAIN
1959
1960
1961 \fIFN SAILSW,<
1962
1963 COMMENT * BLOCK TYPE 15 AND 16 USED TO SPECIFY PROGRAMS AND
1964 LIBRARIES WHICH MUST BE LOADED (SEARCHED) IF THE PROGRAM
1965 IN WHICH THE BLOCK APPEARS IS LOADED. IT IS NOW TIME TO
1966 LOAD AND SEARCH THESE FILES. IF ANY MAKE REQUESTS, THEY ARE ADDED
1967 TO THE END. WE WILL COME BACK AND LOOK AGAIN IN CASE A
1968 LIBRARY PROGRAM LOAD A REL PROGRAM. ORIGINAL CODE BY DCS*
1969
1970 SALOAD: MOVE T,[XWD -RELLEN-1,PRGFLS-1] ;TO RESET WITH AT END
1971         MOVEI D,PRGPNT  ;OINTER TO UPPER LIMIT
1972         PUSHJ P,PRGPRG  ;LOAD THEM IF ANY
1973
1974 ;NOW FOR LIBRARY SEARCH
1975
1976         MOVE T,[XWD -RELLEN-1,LIBFLS-1]
1977         MOVEI D,LIBPNT
1978
1979 PRGPRG: MOVEM D,LODLIM# ;SAVE POINTER TO LIMIT
1980         MOVEM T,LODSTP# ;START FOR RESETTING
1981 PRGBAK: MOVEM T,LODPNT# ;AND START
1982         CAMN T,@LODLIM  ;GOTTEN TO END YET?
1983         JRST PRGDON     ;YES, DUMP IT
1984         SKIPN W,PRGDEV(T)       ;IS DEVICE SPECIFIED?
1985         MOVSI W,(SIXBIT /DSK/)  ;NO, DSK
1986         MOVEM W,ILD1    ;WHERE WE INIT FROM
1987         MOVSI W,(SIXBIT /REL/)  ;EXTENSION
1988         MOVEM W,DTIN1
1989         MOVE W,PRGFIL(T)
1990         MOVEM W,DTIN    ;FILE NAME
1991         MOVE W,PRGPPN(T)        ;THE PROJECT PROG
1992         MOVEM W,DTIN+3
1993         PUSH P,JRPRG    ;A RETURN ADDRESS
1994         TLZ F,ISW       ;FORCE NEW INIT
1995         HRRZ T,LODLIM
1996         CAIN T,LIBPNT   ;WHICH ONE
1997         JRST LIBGO
1998         JRST LDF
1999 PRGRET: MOVE T,LODPNT   ;RETURNS HERE, GET NEXT ONE
2000         AOBJN T,PRGBAK
2001
2002 PRGDON: MOVE T,LODSTP   ;RESTE POINTER IN CASE MORE ON OTHER LIBS
2003         MOVEM T,@LODLIM
2004 JRPRG:  POPJ P,PRGRET   ;PUSHED TO GET A RETURN ADDRESS
2005
2006 PRGFIL==1       ;REL INDEX FOR FILE NAMES
2007 PRGPPN==RELLEN+1        ;AND FOR PPNS
2008 PRGDEV==2*RELLEN+1      ;AND FOR DEVICES
2009 >       ;END OF IFN SAILSW
2010
2011
2012 \fSUBTTL LDDT LOADS <SYS:DDT.REL> AND SETS SYMSW
2013
2014
2015 IFN STANSW,<
2016 LDDTQX: TLO     N,DDSW+EXEQSW           ;WILL START RAID AFTER LOADING
2017 LDDTQ:  PUSH    P,D                     ;SAVE ARG
2018         PUSHJ   P,FSCN1                 ;SEE BELOW
2019         MOVE    W,['RAID  ']            ;LOAD RAID STATT DDT
2020 IFN DMNSW,<SETZM (P);ELSE>POP P,D       ;/0D FOR DMN2 (BELOW) !?!
2021         JRST    LDDT11                  ;JOIN FORCES
2022 >;IFN STANSW
2023
2024 LDDTX:
2025 IFN ALGSW,<TRNE F,ALGSW
2026         POPJ    P,>
2027         TLO     N,DDSW+EXEQSW           ;T - LOAD AND GO TO DDT
2028 LDDT:
2029 IFN ALGSW,<TRNE F,ALGFL
2030         POPJ    P,>
2031 IFN DMNSW,<     PUSH    P,D             ;SAVE INCASE /NNND >
2032         PUSHJ     P,FSCN1               ;FORCE SCAN TO COMPLETION
2033         MOVSI     W,444464              ;FILE IDENTIFIER <DDT>
2034 LDDT11: TLZ     F,SYMSW!RMSMSW  ;DON'T LOAD DDT WITH LOCAL SYMBOLS
2035         PUSHJ     P,LDDT1
2036         PUSHJ     P,LDF         ;LOAD <SYS:DDT.REL>
2037         TLO     F,SYMSW!RMSMSW          ;ENABLE LOADING WITH SYMBOLS
2038 IFN DMNSW,<     POP     P,D     ;RESTORE D
2039         JRST    DMN2            ;MOVE SYMBOL TABLE >
2040 IFE DMNSW,<     POPJ    P,>
2041
2042 LDDT1:  MOVEM     W,DTIN                ;STORE FILE IDENTIFIER
2043 IFN PP,<MOVE    W,ILD1          ;SAVE OLD DEV
2044         MOVEM   W,OLDDEV>
2045         MOVSI     W,637163              ;DEVICE IDENTIFIER <SYS>
2046         MOVEM     W,ILD1                ;STORE DEVICE IDENTIFIER
2047         TLZ     F,ISW+LIBSW+SKIPSW+REWSW        ;CLEAR OLD FLAGS
2048 LDDT2:  MOVSI     W,624554              ;EXTENSION IDENTIFIER <.REL>
2049 LDDT3:  MOVEM     W,DTIN1               ;STORE EXTENSION IDENTIFIER
2050 LDDT4:IFN PP,<EXCH W,PPN        ;GET PROJ-PROG #
2051         MOVEM W,DTIN+3
2052         EXCH    W,PPN   ;W MUST BE SAVED SINCE IT MAY BE USED LATER>
2053         POPJ    P,
2054
2055
2056 \fSUBTTL EOF TERMINATES LOADING OF A FILE
2057
2058 EOF:    MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER
2059 EOF1:   TLZ F,SLIBSW!SKIPSW     ;CLEAR ONE FILE LIB. SEARCH FLAG
2060 IFN DIDAL,<TRZ  F,XFLG!LSTLOD   ;CLEAR DIDAL FLAGS>
2061 EOF2:   TLNE F,RMSMSW   ;IF REMEMBER LOADING WITH SYMBOLS IS ON
2062         TLO F,SYMSW     ;THEN RESTORE SYMBOL LOADING STATE
2063         POPJ    P,
2064
2065 ;       FORCE SCAN TO COMPLETION, LOAD IF NECESSARY
2066
2067 FSCN:   PUSHJ     P,FSCN1               ;FORCED LOAD BEFORE TEST
2068         TLNN    F,FULLSW                ;TEST FOR OVERLAP
2069         POPJ    P,                      ;NO OVERLAP, RETURN
2070         MOVE    W,H             ;FETCH CORE SIZE REQUIRED
2071         SUBI W,1(S) ; COMPUT DEFICIENCY
2072         JUMPL     W,EOF2                ;JUMP IF NO OVERLAP
2073         TLO     F,FCONSW                ;INSURE TTY OUTPUT
2074         PUSHJ   P,PRQ                   ;START WITH ?
2075         PUSHJ     P,PRNUM0              ;INFORM USER
2076         ERROR   7,</WORDS OF OVERLAP#/>
2077         JRST    LD2             ;ERROR RETURN
2078
2079 IFN SPCHN,<FSCN1A:      TLNN F,NSW
2080         PUSHJ P,LIBF>
2081 FSCN1:  TLON    F,FSW           ;SKIP IF NOT FIRST CALL TO FSCN
2082         TLNN    F,CSW+DSW+ESW   ;TEST SCAN FOR COMPLETION
2083         POPJ    P,
2084 FSCN2:  PUSHJ     P,LD5B1               ;STORE FILE OR EXTENSION IDENT.
2085
2086 ;       LOADER CONTROL, NORMAL MODE
2087
2088 LDF:    PUSHJ     P,ILD         ;INITIALIZE LOADING
2089
2090
2091 \fSUBTTL LOAD SUBROUTINE
2092
2093 LOAD:   MOVEM   P,PDSAV         ;SAVE PUSHDOWN POINTER
2094 IFN WFWSW,<SETZM VARLNG         ;LENGTH OF VARIABLE AREA-ADDED TO RELOC>
2095 IFN ALGSW,<SETZM OWNLNG         ;LENGTH OF OWN AREA-ADDED TO RELOC>
2096 IFN FAILSW,<SETZM LFTHSW        ;RESET LOAD LEFT HALF FIXUP SW>
2097 LOAD1:  MOVE    P,PDSAV         ;RESTORE PUSHDOWN POINTER
2098 LOAD1A: PUSHJ   P,WORD          ;INPUT BLOCK HEADER WORD
2099         MOVNI   E,400000(W)     ;WORD COUNT - FROM RH OF HEADER
2100         HLRZ    A,W             ;BLOCK TYPE - FROM LH OF HEADER
2101 IFN FAILSW,<SKIPN POLSW         ;ERROR IF STILL DOING POLISH>
2102         CAIL    A,DISPL*2       ;TEST BLOCK TYPE NUMBER
2103         JRST    LOAD4           ;ERROR, ILLEGAL BLOCK TYPE
2104         TLNE    F,SKIPSW        ;BLOCK OK - TEST LOAD STATUS
2105         JRST    LIB1            ;RETURN TO LIB. SEARCH CONTROL
2106         HRRZ    T,LOAD2(A)      ;LOAD RH DISPATCH ENTRY
2107         CAIL    A,DISPL         ;SKIP IF CORRECT
2108         HLRZ    T,LOAD2-DISPL(A);LOAD LH DISPATCH ENTRY
2109         TLNE    F,FULLSW        ;TEST CORE OVERLAP INDICATOR
2110         SOJG    A,HIGH0         ;IGNORE BLOCK IF NOT TYPE 1
2111         JRST    @T              ;DISPATCH TO BLOCK SUBROUTINE
2112
2113 ;DISPATCH TABLE - BLOCK TYPES
2114 IFE FAILSW,<POLFIX==LOAD4A
2115         LINK==LOAD4A>
2116 IFE WFWSW,<LVARB==LOAD4A>
2117 IFE DIDAL,<INDEX==LOAD4A>
2118 IFE ALGSW!SAILSW,<ALGBLK==LOAD4A>
2119 IFE SAILSW,<LDLIB==LOAD4A>
2120
2121 LOAD2:  XWD     LOCD,   BLOCK0  ;10,,0
2122         XWD     POLFIX, PROG    ;11,,1
2123         XWD     LINK,   SYM     ;12,,2
2124         XWD     LVARB,  HISEG   ;13,,3
2125         XWD     INDEX,  LIB30   ;14,,4
2126         XWD     ALGBLK, HIGH    ;15,,5
2127         XWD     LDLIB,  NAME    ;16,,6
2128         XWD     LOAD4A, START   ;17,,7
2129
2130         DISPL==.-LOAD2
2131
2132 ;ERROR EXIT FOR BAD HEADER WORDS
2133
2134 LOAD4:  IFE K,<
2135         CAIN    A,400           ;FORTRAN FOUR BLOCK
2136         JRST    F4LD>
2137 LOAD4A: MOVE    W,A             ;GET BLOCK TYPE
2138         ERROR   ,</ILL. FORMAT BLOCK TYPE !/>
2139         PUSHJ   P,PRNUM         ;PRINT BLOCK TYPE
2140         JRST    ILC1            ;PRINT SUBROUTINE NAME
2141
2142
2143 \fSUBTTL LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
2144
2145 PROG:   MOVEI   V,-1(W)                 ;LOAD BLOCK LENGTH
2146         PUSHJ     P,RWORD               ;READ BLOCK ORIGIN
2147         ADD     V,W             ;COMPUTE NEW PROG. BREAK
2148 IFN REENT,<TLNN F,HIPROG
2149         JRST    PROGLW  ;NOT HIGH SEGMENT
2150 PROG3:  CAMGE W,HVAL1   ;CHECK TO SEE IF IN TOP SEG
2151         JRST LOWCOR
2152         MOVE T,JOBREL   ;CHECK FOR OVERFLOW ON HIGH
2153         CAIL T,@X
2154         JRST PROG2
2155         PUSHJ P,HIEXP
2156         JRST FULLC
2157         JRST PROG3>
2158
2159 PROGLW: MOVEI T,@X
2160         CAMG    H,T             ;COMPARE WITH PREV. PROG. BREAK
2161         MOVE H,T
2162         TLNE F,FULLSW
2163         JRST FULLC      ;NO ERROR MESSAGE
2164 IFN REENT,<CAML H,HVAL1
2165         JRST COROVL     ;WE HAVE OVERFLOWED THE LOW SEGMENT
2166         CAMLE T,HILOW
2167         MOVEM T,HILOW   ;HIGHEST LOW CODE LOADED INTO>
2168         CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE
2169 IFN EXPAND,<JRST [PUSHJ P,XPAND>
2170                 JRST FULLC
2171 IFN REENT,<     TLNE F,HIPROG
2172                 SUBI W,2000     ;HISEG LOADING LOW SEG>
2173 IFN EXPAND,<    JRST .-1]>
2174 PROG2:  MOVE    V,W
2175 PROG1:  PUSHJ     P,RWORD               ;READ DATA WORD
2176 IFN TEN30,<CAIN V,41    ;CHANGE FOR 10/30 JOBDAT
2177         MOVEI V,JOB41   ;JOB41 IS DIFFERENT
2178         CAIN V,74       ;SO IS JOBDAT
2179         MOVEI V,JOBDDT>
2180 IFN L,<CAML V,RINITL    ;CHECK FOR BAD STORE>
2181         MOVEM     W,@X          ;STORE DATA WORD IN PROG. AT LLC
2182         AOJA    V,PROG1         ;ADD ONE TO LOADER LOC. COUNTER
2183
2184 IFN REENT,<
2185 LOWCOR: SUB V,HIGHX     ;RELOC FOR PROPER
2186         ADD V,LOWX      ;LOADING OF LOW SEQMENT
2187         SUB W,HIGHX
2188         ADD W,LOWX
2189         JRST PROGLW>
2190
2191
2192 \fSUBTTL LOAD SYMBOLS (BLOCK TYPE 2)
2193
2194 SYM:    PUSHJ   P,PRWORD        ;READ TWO DATA WORDS
2195         PUSHJ   P,SYMPT;                PUT INTO TABLE
2196 IFN REENT,<PUSHJ P,RESTRX>
2197         JRST    SYM
2198
2199 SYMPT:  TLNE C,200000   ;GLOBAL REQUEST? WFW
2200         JUMPL C,SYM3    ;CHECK FOR 60 NOT JUST HIGH BIT WFW
2201         TLNN    C,40000
2202         JRST    SYM1A           ;LOCAL SYMBOL
2203         TLNE C,100000
2204         JRST SYM1B
2205         PUSHJ     P,SREQ                ;GLOBAL DEF., SEARCH FOR REQUEST
2206         JRST    SYM2            ;REQUEST MATCHES
2207         PUSHJ     P,SDEF                ;SEARCH FOR MULTIPLE DEFINITIONS
2208         JRST    SYM1            ;MULTIPLY DEFINED GLOBAL
2209         JRST    SYM1B
2210
2211 ;       PROCESS MULTIPLY DEFINED GLOBAL
2212
2213 SYM1:   CAMN    W,2(A)          ;COMPARE NEW AND OLD VALUE
2214         POPJ    P,;
2215         AOS     MDG             ;COUNT MULTIPLY DEFINED GLOBALS
2216         PUSHJ   P,PRQ           ;START W/ ?
2217         PUSHJ     P,PRNAM               ;PRINT SYMBOL AND VALUE
2218 IFN RPGSW,<MOVE W,JOBERR        ;RECORD THIS AS AN ERROR
2219         ADDI W,1
2220         HRRM W,JOBERR>
2221         MOVE    W,2(A)          ;LOAD OLD VALUE
2222         PUSHJ     P,PRNUM               ;PRINT OLD VALUE
2223         ERROR   7,</MUL. DEF. GLOBAL IN PROG.  !/>
2224         MOVE    C,SBRNAM        ;GET PROGRAM NAME
2225         PUSHJ   P,PRNAME        ;PRINT R-50 NAME
2226         ERROR   0,</#/>
2227         POPJ    P,              ;IGNORE MUL. DEF. GLOBAL SYM
2228
2229
2230 \f;      LOCAL SYMBOL
2231
2232 SYM1A:  TLNN    F,SYMSW         ;SKIP IF LOAD LOCALS SWITCH ON
2233         POPJ    P,;             IGNORE LOCAL SYMBOLS
2234 SYM1B:  CAIL    H,(S)           ;STORE DEFINED SYMBOL
2235 IFN EXPAND,<    PUSHJ P,XPAND7>
2236 IFE EXPAND,<    JRST SFULLC>
2237 SYM1C:  IFE K,<
2238         TLNE    N,F4SW;         FORTRAN FOUR REQUIRES A BLT
2239         PUSHJ   P,MVDWN;        OF THE TABLES>
2240         MOVEI   A,-2(S)         ;LOAD A TO SAVE INST. AT SYM2
2241 SYM1D:  SUBI    S,2;            UPDATE UNDEFINED POINTER
2242         POP     B,2(A)          ;MOVE UNDEFINED VALUE POINTER
2243         POP     B,1(A)          ;MOVE UNDEFINED SYMBOL
2244         MOVEM   W,2(B)          ;STORE VALUE
2245         MOVEM  C,1(B)           ;STORE SYMBOL
2246         POPJ    P,
2247
2248
2249 \f;      GLOBAL DEFINITION MATCHES REQUEST
2250
2251 SYM2:   PUSH    P,SYM2C ;NEXT MUST BE A SUBROUTINE FOR LATER, SET RETURN
2252 SYM2B:  MOVE    V,2(A)          ;LOAD REQUEST POINTER
2253         PUSHJ   P,REMSYM
2254         JUMPL V,SYM2W   ;ADDITIVE REQUEST? WFW
2255         PUSHJ     P,SYM4A               ;REPLACE CHAIN WITH DEFINITION
2256 SYM2W1: PUSHJ P,SREQ    ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
2257         JRST SYM2B      ;FOUND MORE
2258         MOVE A,SVA      ;RESTORE A
2259 SYM2C:  POPJ    P,SYM1D ;RETURN, SEE SYM2 FOR USE OF ADDRESS
2260
2261 ;       REQUEST MATCHES GLOBAL DEFINITION
2262
2263 SYM2A:  MOVE    V,W             ;LOAD POINTER TO CHAIN
2264         MOVE    W,2(A)          ;LOAD VALUE
2265         JUMPL V,FIXWP   ;HANDLE ATTITIVE REQUEST WFW
2266         JRST SYM4A
2267
2268 ;       PROCESS GLOBAL REQUEST
2269
2270 SYM3:   TLNE    C,040000;               COMMON NAME
2271         JRST    SYM1B
2272         TLC     C,640000;               PERMUTE BITS FROM 60 TO 04
2273         PUSHJ     P,SDEF                ;SEARCH FOR GLOBAL DEFINITION
2274         JRST    SYM2A           ;MATCHING GLOBAL DEFINITION
2275         JUMPL W,SYM3X1  ;ADDITIVE FIXUP WFW
2276         PUSHJ     P,SREQ                ;SEARCH FOR EXISTING REQUEST WFW
2277         JRST    SYM3A           ;EXISTING REQUEST FOUND WFW
2278 SYM3X1: TLNN W,100000   ;CHECK SYMBOL TABLE FIXUP
2279         JRST     SYM3X2 ;NO
2280         MOVE     V,1(B) ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL
2281         XOR      V,W            ;CHECK FOR IDENTITY
2282         TDNE     V,[XWD 77777,-1]       ;BUT IGNORE HIGH 3 BITS
2283         POPJ     P,             ;NOT SAME, ASSUME NOT LOADED LOCAL
2284         HRRI     W,2(B)         ;GET LOCATION IN RIGHT HALF
2285         TLO      W,1
2286         SUB      W,HISTRT               ;AND MAKE RELATIVE
2287 IFN FAILSW,<TLZ W,040000>
2288 SYM3X2: CAIL    H,(S)           ;STORE REQUEST IN UNDEF. TABLE WFW
2289 IFN EXPAND,<    PUSHJ P,XPAND7>
2290 IFE EXPAND,<    JRST SFULLC>
2291 SYM3X:  IFE K,<
2292         TLNE    N,F4SW;         FORTRAN FOUR
2293         PUSHJ   P,MVDWN;                ADJUST TABLES IF F4>
2294         SUB     S,SE3           ;ADVANCE UNDEFINED POINTER
2295         MOVEM     W,2(S)                ;STORE UNDEFINED VALUE POINTER
2296         MOVEM     C,1(S)                ;STORE UNDEFINED SYMBOL
2297         POPJ    P,;
2298
2299
2300 \f
2301 ;       COMBINE TWO REQUEST CHAINS
2302
2303 SYM3A:  SKIPL 2(A)      ;IS IT ADDITIVE WFW
2304         JRST SYM3A1     ;NO, PROCESS WFW
2305 SYM3A4: PUSHJ P,SDEF2   ;YES, CONTINUE WFW
2306         JRST SYM3A      ;FOUND ANOTHER WFW
2307         JRST SYM3X2     ;REALLY NO CHAIN THERE WFW
2308 SYM3A1: SKIPE   V,2(A)  ;IF ADDRESS OF CHAIN IS 0, THROW IT AWAY
2309         JRST    SYM3A2  ;AND USE THE NEW ONE, ELSE ADD THE CHAINS
2310         MOVEM   W,2(A)  ;W IS ADDRESS OF NEW CHAIN,STORE ON TOP OF OLD 0
2311         POPJ    P,
2312 SYM3A2:
2313 SYM3A3: MOVE A,2(A)
2314 SYM3B:  HRRZ V,A
2315 IFN L,<CAMGE V,RINITL
2316         HALT>
2317 IFN REENT,<CAMGE V,HVAL1
2318         SKIPA X,LOWX
2319         MOVE X,HIGHX>
2320         HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
2321         JUMPN A,SYM3B  ; JUMP IF NOT THE LAST ADDR. IN CHAIN
2322         HRRM    W,@X            ;COMBINE CHAINS
2323         POPJ    P,;
2324
2325 ;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS
2326
2327 FIXWP:  TLNN     V,100000       ;CHECK FOR SYMBOL TABLE FIXUP
2328         JRST     FIXW
2329         MOVE     T,1(B) ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED
2330         XOR      T,V            ;CHECK FO SAME
2331         TDNE     T,[XWD 77777,-1]       ;EXCEPT FOR HIGH CODE BITS
2332         POPJ     P,             ;ASSUME NON-LOADED LOCAL
2333         HRRI     V,2(B)         ;GET LOCATION
2334         SUBI     V,(X)          ;SO WE CAN USE @X
2335         JRST FIXW1
2336 FIXW:   IFN REENT,<HRRZ T,V
2337         CAMGE T,HVAL1
2338         SKIPA X,LOWX
2339         MOVE X,HIGHX>
2340 IFN L,< HRRZ T,V
2341         CAMGE R,RINITL
2342         POPJ P,>
2343 FIXW1:  TLNE    V,200000        ;IS IT LEFT HALF
2344         JRST FIXWL
2345         MOVE T,@X       ;GET WORD
2346         ADD T,W         ;VALUE OF GLOBAL
2347         HRRM T,@X       ;FIX WITHOUT CARRY
2348         MOVSI   D,200000        ;SET UP TO REMOVE DEFERED INTERNAL IF THERE
2349         JRST    SYMFIX
2350
2351
2352 \fFIXWL: HRLZ    T,W             ;UPDATE VALUE OF LEFT HALF
2353         ADDM    T,@X            ;BY VALUE OF GLOBAL
2354         MOVSI   D,400000        ;LEFT DEFERED INTERNAL
2355 SYMFIX: TLNN V,100000   ;CHECK FOR SYMBOL TABLE FIXUP
2356         POPJ P,         ;NO, RETURN
2357         ADDI V,(X)      ;GET THE LOCATION
2358 SYMFX1: MOVE T,-1(V)    ;GET THE SYMBOL NAME
2359         TLNN T,40000    ;CHECK TO SEE IF INTERNAL
2360         POPJ P,         ;NO, LEAVE
2361         ANDCAB D,-1(V)  ;REMOVE PROPER BIT
2362         TLNE D,600000   ;IS IT STILL DEFERED?
2363         POPJ P,         ;YES, ALL DONE
2364         EXCH C,D        ;NO, CHECK FOR A REQUEST FOR IT
2365         PUSHJ P,SREQ
2366         JRST CHNSYM     ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE
2367         MOVE C,D        ;GET C BACK
2368         POPJ P,
2369 CHNSYM: PUSH P,D        ;HAS THE OLD C IN IT
2370         PUSH P,W        ;WE MAY NEED IT LATER
2371         MOVE W,(V)      ;GET VALUE
2372         PUSHJ P,SYM2B   ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE
2373         POP P,W
2374         POP P,C         ;RESTORE FOR CALLER
2375         POPJ P,         ;AND GO AWAY
2376
2377 SYM2W:  IFN FAILSW,<
2378         TLNE V,40000    ;CHECK FOR POLISH
2379         JRST POLSAT>
2380         TLNN V,100000   ;SYMBOL TABLE?
2381         JRST SYM2WA
2382         ADD V,HISTRT    ;MAKE ABSOLUTE
2383         SUBI V,(X)      ;GET READY TO ADD X
2384         PUSHJ P,FIXW1
2385         JRST SYM2W1
2386 SYM2WA: PUSHJ P,FIXW    ;DO FIXUP
2387         JRST SYM2W1     ;AND LOOK FOR MORE REQUESTS
2388
2389 ;END WFW PATCH
2390
2391
2392 \f;PATCH VALUES INTO CHAINED REQUEST
2393
2394 SYM4:   IFN L,<CAMGE V,RINITL
2395         POPJ P,>
2396 IFN REENT,<CAMGE V,HVAL1
2397         SKIPA X,LOWX
2398         MOVE X,HIGHX>
2399         HRRZ    T,@X    ;LOAD NEXT ADDRESS IN CHAIN
2400         HRRM    W,@X            ;INSERT VALUE INTO PROGRAM
2401         MOVE    V,T
2402 SYM4A:  JUMPN     V,SYM4                ;JUMP IF NOT LAST ADDR. IN CHAIN
2403         POPJ    P,
2404
2405 IFE     K,<
2406 MVDWN:  HRRZ T,MLTP
2407 IFN EXPAND,<    SUBI T,2>
2408         CAIG    T,(H);          ANY ROOM LEFT?
2409 IFN EXPAND,<    JRST    [PUSHJ P,XPAND>
2410                         TLOA F,FULLSW
2411 IFN EXPAND,<            JRST MVDWN
2412                         POPJ P,]>
2413         TLNE    F,SKIPSW+FULLSW
2414         POPJ    P,      ;       ABORT BLT
2415         HRREI   T,-2
2416         ADDM    T,PLTP;         ADJUST PROGRAMMER LABEL POINTER
2417         ADDM    T,BITP;         AND BIT TABLE POINTER
2418         ADDM    T,SDSTP;        FIRST DATA STATEMENT
2419         ADDM    T,LTC
2420         ADDM    T,ITC
2421         TLNE    N,SYDAT
2422         ADDM    T,V
2423         ADDB    T,MLTP;         AND FINALLY TO MADE LABEL TABLE
2424         HRLS    T;              SET UP BLT POINTER
2425         ADD     T,[XWD 2,0]
2426         BLT     T,(S)
2427         POPJ    P,
2428 >
2429
2430
2431 \fSUBTTL HIGH-SEGMENT (BLOCK TYPE 3)
2432 ;THIS PROGRAM IS INTENDED FOR HI SEGMENT IF RUNNING ON A PDP-10.
2433 ; THIS BLOCK TYPE OCCURS AFTER ENTRY AND NAME BLOCKS.
2434
2435 HISEG:  PUSHJ   P,WORD          ;GOBBLE UP A WORD.
2436         JUMPE   W,HISEG2        ;MACRO V36
2437         PUSHJ   P,WORD          ;GET THE OFSET
2438 IFE REENT,<HISEG2==LOAD1A
2439         JUMPGE  W,LOAD1A        ;NOT TWO SEG PROG.>
2440 IFN REENT,<JUMPE W,HISEG2       ;IGNORE ZERO
2441         JUMPG   W,HISEG3        ;NEG. IF TWOSEG PSEUDO-OP>
2442         TRO     F,TWOFL         ;SET FLAG
2443 IFN REENT,<
2444         TRNE    F,NOHI!NOHI6    ;TWO SEGMENTS LEGAL?
2445         JRST    ONESEG          ;LOAD AS ONE SEGMENT
2446 HISEG3: HRRZ    D,W             ;GET START OF HISEG
2447         JUMPE   D,.+2           ;NOT SPECIFIED
2448         PUSHJ   P,HCONT         ;AS IF /H
2449 HISEG2: PUSHJ   P,HISEG1
2450         JRST    LOAD1           ;GET NEXT BLOCK
2451 FAKEHI:                         ;AS IF BLOCK TYPE 3
2452 HISEG1: TRNE    F,NOHI!NOHI6    ;LOAD REENT?
2453         POPJ    P,
2454         TLOE    F,HIPROG        ;LOADING HI PROG
2455         POPJ    P,              ;IGNORE 2'ND HISEG
2456         TRON    F,SEENHI        ;HAVE WE LOADED ANY OTHER HI STUFF?
2457         PUSHJ   P,SETUPH        ;NO,SET UP HI SEG.
2458         MOVEM R,LOWR
2459         MOVE R,HIGHR
2460         HRRM    R,2(N)          ;CALL THIS THE START OF THE PROGRAM
2461         MOVE X,HIGHX
2462         POPJ    P,
2463 SETUPH: MOVE X,HVAL1
2464         CAIGE X,-1      ;SEE IF IT HAS BEEN CHANGED FROM ORIG
2465         JRST SEENHS     ;YES, MUST HAVE SEEN /H
2466         MOVEI X,400000
2467         MOVEM X,HVAL1
2468         CAIG X,(H)      ;HAVE WE RUN OVER WITH THE LOW SEG
2469         JRST COROVL
2470         ADDI X,JOBHDA
2471         HRLI X,W
2472         MOVEM X,HVAL
2473 SEENHS: MOVE X,HVAL
2474         MOVEM X,HIGHR
2475         HRRZ X,JOBREL
2476         SUB X,HVAL1
2477         ADDI X,1
2478         HRLI X,V
2479         MOVEM X,HIGHX
2480         POPJ P,
2481
2482
2483
2484 \fSETSEG:        TRZ     F,NOHI!SEGFL    ;ALLOW HI-SEG
2485         JUMPL   D,.+2           ;/-H TURNS OFF NOHI ONLY
2486         TRO     F,SEGFL         ;/1H FORCES  HI
2487         POPJ    P,
2488 >
2489
2490 ONESEG: HLRZ    D,W             ;GET LENGTH OF HISEG
2491         SUBI    D,(W)           ;REMOVE OFSET
2492         JUMPLE  D,TWOERR        ;LENGTH NOT AVAILABLE
2493         MOVEM   R,LOWR          ;SAVE LOW SEGMENT RELOCATION
2494         ADDM    D,LOWR          ;ADD TO LOW SEG RELOCATION
2495         HRRZM   W,HVAL1         ;SO RELOC WILL WORK
2496         JRST    LOAD1           ;GET NEXT BLOCK
2497
2498 TWOERR: ERROR   7,</TWO SEGMENTS ILLEGAL#/>
2499         JRST    LDRSTR
2500
2501
2502 \fSUBTTL HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)
2503 SFULLC: TLOE    F,FULLSW        ;PREVIOUS OVERFLOW?
2504         JRST    FULLC           ;YES, DON'T PRINT MESSAGE
2505         ERROR   ,<?SYMBOL TABLE OVERLAP#?>
2506 FULLC:  TLO     F,FULLSW        ;CORE OVERLAP ERROR RETURN
2507 IFE K,< TLNE    N,F4SW
2508         POPJ    P,>
2509         JRST    LIB3            ;LOOK FOR MORE
2510 HIGH2:  PUSHJ   P,RWORD         ;GET HISEG BREAK
2511         TRZ     F,TWOFL         ;CLEAR FLAG NOW
2512 IFE REENT,<     MOVE    R,LOWR
2513         JRST    HIGH2A>
2514 IFN REENT,<     TRNE    F,NOHI!NOHI6    ;SINGLE SEGMENT LOAD?
2515         JRST    [MOVE   R,LOWR  ;YES,GET LARGER RELOC
2516                 MOVE    W,HVAL  ;ORIGINAL VALUE
2517                 MOVEM   W,HVAL1 ;RESET
2518                 JRST    HIGH2A] ;CONTINUE AS IF LOW ONLY
2519         HRR     R,W             ;PUT BREAK IN R
2520         CAMLE   R,HVAL
2521         MOVEM   R,HVAL
2522         MOVEM   R,HIGHR
2523         MOVE    R,LOWR          ;NEXT WORD IS LOW SEG BREAK
2524         TLZ     F,HIPROG        ;CLEAR HIPROG
2525         PUSHJ   P,PRWORD        ;GET WORD PAIR
2526         HRR     R,C             ;GET LOW SEG BREAK
2527         MOVEM   R,LOWR          ;SAVE IT
2528         MOVE    R,HIGHR         ;GET HIGH BREAK
2529         JRST    HIGHN3          ;AND JOIN COMMON CODE>
2530
2531 HIGH0:  CAIE    A,4             ; TEST FOR END BLOCK (OVERLAP)
2532         JRST    LIB30
2533
2534 HIGH:   TRNE    F,TWOFL         ;IS THIS A TWO SEGMENT PROGRAM?
2535         JRST    HIGH2           ;YES
2536 HIGH2A: PUSHJ   P,PRWORD        ;READ TWO DATA WORDS.
2537 IFN REENT,<     TLZE F,HIPROG
2538         JRST HIGHNP>
2539 IFN WFWSW,<ADD C,VARLNG         ;IF LOW SEG THEN VARIABLES GO AT END>
2540 IFN ALGSW,<ADD  C,OWNLNG        ;ADD IN LENGTH OF OWN BLOCK>
2541         HRR R,C         ;SET NEW PROGRAM BREAK
2542         CAMGE C,W       ;CHECK 2ND WORD (LOC PROG BRK IF PRESENT)
2543         MOVE C,W
2544 HIGH31: ADDI C,(X)
2545         CAIG H,(C)
2546         MOVEI H,(C)     ;SET UP H
2547         CAILE   H,1(S)  ;TEST PROGRAM BREAK
2548 IFN EXPAND,<PUSHJ P,[   PUSHJ P,XPAND
2549                         TLOA F,FULLSW
2550                         JRST POPJM2
2551                         POPJ    P,]>
2552 IFE EXPAND,<TLO F,FULLSW>
2553 HIGH3:  MOVEI A,F.C
2554         BLT A,B.C
2555 IFN REENT,<TRNE F,NOHI!NOHI6    ;ONE SEGMENT PROGRAM?
2556         JRST    HIGHN4          ;YES
2557         HRLZ    W,HIGHR         ;GET HIGH PROG BREAK
2558         JUMPE   W,[HRRZ W,R     ;NO HIGH SEGMENT YET
2559                 JRST    .+2]    ;SO USE LOW RELOCATION ONLY
2560         HRR     W,LOWR          ;GET LOW BREAK
2561         SETZ    C,              ;ZERO SYMBOL NAME
2562         PUSHJ   P,SYM1B         ;PUT IN SYMBOL TABLE
2563         MOVEM   S,F.C+S         ;SAVE NEW S AND B
2564         MOVEM   B,F.C+B         ;INCASE OF ERROR
2565 HIGHN4:>
2566         TLZ     F,NAMSSW        ;RELAX, RELOCATION BLOCK FOUND
2567         TLNE    F,SLIBSW+LIBSW  ;NORMAL MODE EXIT THROUGH LOAD1
2568         JRST    LIB             ;LIBRARY SEARCH EXIT
2569         JRST LOAD1
2570 IFN REENT,<
2571 HIGHNP: HRR R,C
2572 HIGHN1: CAMLE R,HVAL
2573         MOVEM R,HVAL
2574         MOVEM R,HIGHR
2575 HIGHN3: PUSH    P,W     ;SAVE W,CONTAIN HIGHEST ABSOLUTE ADDRESS
2576         ADD W,LOWX      ;LOC PROG BRK
2577         CAIGE H,(W)     ;CHECK FOR TOP OF LOW CORE
2578         MOVEI H,(W)
2579         POP     P,W     ;RESTORE
2580         CAML H,HVAL1
2581         JRST COROVL     ;OVERFLOW OF LOW SEGMENT
2582 HIGHN2: HRRZ R,HVAL
2583         SUB R,HVAL1
2584         ADD R,HISTRT
2585         CAMLE R,JOBREL
2586         JRST    [PUSHJ P,HIEXP
2587                 JRST FULLC
2588                 JRST HIGHN2]
2589         MOVE R,LOWR
2590         MOVE X,LOWX
2591 IFN WFWSW,<ADD R,VARLNG ;VARIABLES IN LOW SEG>
2592 IFN ALGSW,<ADD R,OWNLNG ;OWN BLOCK IN LOW SEGMENT>
2593         HRRZ C,R
2594         CAIGE   C,(W)   ;IS ABSOLUTE LOCATION GREATER
2595         HRR     R,W     ;YES USE IT
2596
2597
2598 \f       HRRZ    C,R     ;SET UP C AGAIN
2599         JRST HIGH31     ;GO CHECK PROGRAM BREAK
2600
2601
2602 \fSUBTTL EXPAND HIGH SEGMENT
2603
2604 HIEXP:  TLNE    F,FULLSW
2605         POPJ    P,
2606 IFN EXPAND,<PUSH P,Q>
2607         PUSH P,H
2608         PUSH P,X
2609         PUSH P,N
2610 IFE K,<HRRZ X,MLTP
2611         TLNN N,F4SW>
2612         MOVEI X,1(S)
2613         HRRZ N,X
2614         SUB N,H
2615         CAILE N,1777
2616         JRST MOVHI
2617 IFE EXPAND,<POPJ P,>
2618 IFN EXPAND,<HRRZ N,JOBREL
2619         ADDI N,2000
2620         CAMG    N,ALWCOR
2621         CORE N,
2622         JRST XPAND6
2623         PUSHJ P,ZTOP
2624         POP P,N
2625         JRST XPAND3>
2626
2627 MOVHI:  MOVEI N,-2000(X)
2628         HRL N,X
2629         HRRZ X,JOBREL
2630         BLT N,-2000(X)
2631         PUSHJ P,ZTOP
2632         MOVNI H,2000
2633 IFN EXPAND,<JRST XPAND8>
2634 IFE EXPAND,<ADDM H,HISTRT
2635         ADDM H,S
2636         ADDM H,B
2637         ADDM H,HIGHX
2638         TLNE F,HIPROG
2639         ADDM H,-1(P)
2640         POP P,N
2641         SUBI N,2000     ;ADJUST POINTER TO NAME
2642 IFE K,< TLNN F4SW
2643         JRST HIXP1
2644         ADDM H,PLTP
2645         ADDM H,BITP
2646         ADDM H,SDSTP
2647         ADDM H,MLTP
2648         TLNE N,SYDAT
2649         ADDM H,V
2650 HIXP1:>
2651         POP P,X
2652         POP P,H
2653         AOS (P)
2654         POPJ P,>
2655
2656 ZTOP:   HRRZ N,JOBREL
2657         MOVEI X,-1776(N)
2658         HRLI X,-1777(N)
2659         SETZM -1(X)
2660         BLT X,(N)
2661         POPJ P,>
2662
2663
2664 \fSUBTTL PROGRAM NAME (BLOCK TYPE 6)
2665
2666 NAME:   TLOE    F,NAMSSW        ;HAVE WE SEEN TWO IN A ROW?
2667         JRST    NAMERR          ;YES, NO END BLOCK SEEN
2668         PUSHJ   P,PRWORD        ;READ TWO DATA WORDS
2669         MOVEM   C,SBRNAM        ;SAVE SUBROUTINE NAME
2670 NCONT:  HLRE    V,W             ;GET COMPILER TYPE
2671         HRRZS   W               ;CLEAR TYPE
2672         JUMPL   V,.+3
2673         CAIGE   V,CMPLEN-CMPLER ;ONLY IF LEGAL TYPE
2674         XCT     CMPLER(V)       ;DO SPECIAL FUNCTION
2675         TLOE    N,COMFLG        ;SKIP IF COMMON NOT PREV. SET
2676         JRST    NAME1           ;SIZE OF COMMON PREV. SET
2677         MOVEM   W,COMSAV        ;STORE LENGTH OF COMMON
2678         JUMPE   W,NAME2         ;JUMP IF NO COMMON IN THIS JOB
2679         HRRI    R,@R            ;FIRST PROGRAM SET LOAD ORIGIN
2680 NAME1:  CAILE   H,-1(S)         ;TEST FOR AVAIL. SYMBOL SPACE
2681 IFN EXPAND,<    PUSHJ P,XPAND7>
2682 IFE EXPAND,<    JRST SFULLC>
2683         SUBI    S,2             ;UPDATE UNDEF. TABLE POINTER
2684         POP     B,2(S)
2685         POP     B,1(S)
2686         HRRZ    V,N             ;POINTER TO PREVIOUS NAME
2687         SUBM    B,V             ;COMPUTE RELATIVE POSITIONS
2688         HRLM    V,2(N)          ;STORE FORWARD POINTER
2689         HRR     N,B             ;UPDATE NAME POINTER
2690 NAME2:  MOVEM   C,1(B)          ;STORE PROGRAM NAME
2691         HRRZM   R,2(B)          ;STORE PROGRAM ORIGIN
2692         CAMG    W,COMSAV        ;CHECK COMMON SIZE
2693 IFE REENT,<JRST LIB3            ;COMMON OK>
2694 IFN REENT,<JRST [TRNE F,SEGFL   ;LOAD LOW IN HI-SEG
2695                 PUSHJ P,FAKEHI  ;YES
2696                 JRST    LIB3]>
2697         SKIPA   C,COMM
2698 ILC:    MOVE    C,1(A)          ;NAME
2699         PUSH    P,C             ;SAVE COMMON NAME
2700         ERROR   ,</ILL. COMMON !/>
2701         POP     P,C
2702         PUSHJ   P,PRNAME
2703 ILC1:   SKIPN   SBRNAM
2704         JRST    ILC2
2705         ERROR   0,</ PROG. !/>
2706         MOVE    C,SBRNAM        ;RECOVER SUBROUTINE NAME
2707         PUSHJ   P,PRNAME
2708 ILC2:   ERROR   0,</ #/>
2709         JRST    LD2
2710
2711 NAMERR: SETZM   DTIN            ;CLEAR WRONG FILE NAME FOR MESSAGE
2712         ERROR   ,</NO END BLOCK !/>
2713         JRST    ILC1
2714
2715
2716
2717 \f;COMPILER TYPE - DO SPECIAL FUNCTION FOR IT
2718
2719 DEFINE CTYPE (CONDITION,TRUE,FALSE)
2720 <IFN CONDITION,<TRUE>
2721 IFE CONDITION,<FALSE>>
2722
2723 CMPLER: CTYPE 1,JFCL,JFCL               ;0 MACRO
2724         CTYPE K-1,<TRO F,F4FL>,JFCL     ;1 FORTRAN
2725         CTYPE 1,<TRO F,COBFL>,JFCL      ;2 COBOL
2726         CTYPE ALGSW,<PUSHJ P,ALGNAM>,JFCL       ;3 ALGOL
2727                                         ;4 NELIAC
2728                                         ;5 PL/1
2729 CMPLEN:
2730
2731
2732
2733 \fSUBTTL STARTING ADDRESS (BLOCK TYPE 7)
2734
2735
2736 START:  PUSHJ   P,PRWORD        ;READ TWO DATA WORDS
2737         TLNN    N,ISAFLG        ;SKIP IF IGNORE SA FLAG ON
2738         HRRZM   C,STADDR        ;SET STARTING ADDRESS
2739 IFN NAMESW,<
2740         MOVE    W,DTIN          ;PICK UP BINARY FILE NAME
2741         TLNN N,ISAFLG
2742         MOVEM   W,PRGNAM        ;SAVE IT
2743         MOVE    W,1(N)          ;SET UP NAME OF THIS PROGRAM
2744         TLNN    N,ISAFLG        ;DONT SET NAME IF IGNORING SA'S
2745         PUSHJ   P,LDNAM>
2746         PUSHJ   P,PRWORD        ;**OBSCURE RETURN TO LOAD1**
2747
2748 IFN REENT,<
2749 RESTRX: TLNE F,HIPROG
2750         SKIPA X,HIGHX
2751         MOVE X,LOWX
2752         POPJ P,>
2753
2754
2755 \fSUBTTL ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)
2756
2757                                 ;PMP PATCH FOR LEFT HALF FIXUPS
2758 IFN FAILSW!WFWSW,<
2759 LOCDLH: IFN L,<CAMGE V,RINITL
2760         POPJ P,>
2761 IFN REENT,<CAMGE V,HVAL1
2762         SKIPA X,LOWX
2763         MOVE X,HIGHX>
2764         HLRZ T,@X       ;LOAD NEXT ADDRESS IN CHAIN
2765         HRLM W,@X       ;INSERT VALUE INTO PROGRAM
2766         MOVE V,T
2767 LOCDLF: JUMPN V,LOCDLH  ;JUMP IF NOT LAST ADDR. IN CHAIN
2768         POPJ    P,>
2769 IFN FAILSW,<
2770 LOCDLI: PUSHJ   P,LOCDLF
2771 IFN REENT,<PUSHJ P,RESTRX>
2772         AOSA LFTHSW     ;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP
2773 LOCDLG: SETOM LFTHSW    ;TURN ON LEFT HALF FIX SW>
2774                         ;END PMP PATCH
2775 LOCD:   PUSHJ     P,RWORD               ;READ ONE DATA WORD
2776         HLRZ    V,W             ;STORAGE POINTER IN LEFT HALF
2777 IFN FAILSW,<
2778         SKIPE LFTHSW    ;LEFT HALF CHAINED? PMP
2779         JRST LOCDLI     ;YES PMP
2780         CAMN W,[-1]     ;LEFT HALF NEXT? PMP
2781         JRST LOCDLG     ;YES, SET SWITCH PMP>
2782         PUSHJ     P,SYM4A               ;LINK BACK REFERENCES
2783 IFN REENT,<PUSHJ P,RESTRX>
2784         JRST    LOCD
2785
2786
2787 \fSUBTTL LVAR FIX-UP (BLOCK TYPE 13)
2788 IFN WFWSW,<
2789 LVARB:  PUSHJ P,PRWORD  ;THE FIRST TWO WORDS IN THE BLOCK
2790         MOVEM W,VARLNG  ;AR SPECIAL. SECOND IS LENGTH OF VARIABLES
2791 IFN REENT,<     TLNE F,HIPROG
2792                 MOVE C,LOWR     ;USE LOW RELOC IF LOADING HI SEG>
2793                 ;ELSE C HAS RELOC FOR THIS PROGRAM, USE IT
2794         HRRZM C,VARREL  ;THIS IS LOCATION 0 OF VARIABLE AREA
2795 LVLP:   PUSHJ P,PRWORD  ;THINGS COME IN PAIRS
2796         TLNE C,200000   ;BIT ON IF SYMBOL TABLE FIXUP
2797         JRST LVSYM
2798         HLRZ V,W        ;NO GET LOC FROM LEFTH HALF OF SECOND
2799         ADD W,VARREL    ;AND RELOCATE VARIABLE
2800         TLNE C,400000   ;ON FOR LEFT HALF
2801         JRST    [PUSHJ P,LOCDLF ;TAKE CARE OF IT
2802 IFN REENT,<     JRST LVLCOM]    ;RESET X>
2803 IFE REENT,<     JRST LVLP]      ;MUST BE LOW SEG X OK>
2804         PUSHJ P,SYM4A   ;RIGHT HALF CHAIN
2805 IFN REENT,<LVLCOM:      PUSHJ P,RESTRX>
2806         JRST LVLP
2807 LVSYM:  MOVE V,B        ;GET SYMBOL TABLE POINTER
2808         ADD C,VARREL    ;VALUE IS IN FIRST WORD FOR THESE
2809         TLZ W,740000    ;MAKE SURE NO BITS ON
2810         ADDI V,2        ;CORRECT POINTER TO SYMBOL TABLE
2811 SRSYM:  MOVE A,-1(V)    ;GET A NAME
2812         TLZN A,740000   ;CHECK FOR PROGRAM NAME
2813         JRST LVLP       ;LEAVE (PROBABLY A NON-LOADED LOCAL)
2814         CAMN A,W        ;IS IT THE RIGHT ONE??
2815         JRST LVSYMD     ;YES
2816         ADD V,SE3       ;CHECK NEXT ONE
2817         JUMPL V,SRSYM   ;BUT ONLY IF SOME ARE THERE
2818         JRST LVLP       ;GIVE UP
2819 LVSYMD: TLNE C,400000   ;WHICH HALF??
2820         JRST LVSYML     ;LEFT
2821         ADD C,(V)       ;ADDITIVE FIXUP
2822         HRRM C,(V)
2823         MOVSI D,200000  ;DEFERED BITS
2824 LVSM1:  PUSHJ P,COMSFX  ;GO TAKE CARE OF IT
2825         JRST LVLP       ;NEXT PLEASE
2826 LVSYML: HRLZS C
2827         ADDM C,(V)      ;WE DON'T HAVE TO WORRY ABOUT OVERFLOW HERE
2828         MOVSI D,400000  ;LEFT DEFERED BITS
2829         JRST LVSM1      ;GO WORRY ABOUT DEFERED INTERNALS>
2830
2831
2832 \fSUBTTL FAIL LOADER
2833 ;ONLY LIST IF FAILSW=1
2834         XLIST
2835 IFN FAILSW,<LIST>
2836 REPEAT 0,<IF POLISH FIXUPS CONTAIN GLOBAL REQUESTS WHICH
2837 CAN NOT BE SATISFIED WHEN THEY ARE SEEN, THEY MUST BE
2838 SAVED UNTIL THESE GLOBAL SYMBOLS BECOME DEFINED.
2839 THE POLISH FIXUP IS SAVED IN THE UNDEFINED TABLE (POINTED
2840 TO BY S). THE FIXUP IS SAVED IN TWO WORD BLOCKS THE FIRST
2841 WORD OF WHICH (THE ONE WHICH WOULD NORMALL CONTAIN THE SYMBOL)
2842 HAS SPECIAL BITS ON SO IT WILL NOT BE FOUND BY A SEARCH FOR
2843 A GLOBAL REQUEST. SINCE THE UNDEFINED TABLE MAY BE
2844 SHUFFELED INTO A RANDOM ORDER, IT IS NOT POSSIBLE TO KEEP
2845 ALL OF A POLISH FIXUP TOGETHER OR TO HAVE POINTERS IN
2846 THE USUAL SENCE FROM ONE TWO WORD BLOCK TO ANOTHER.
2847 SUFFICIENT INFORMATION IS THEREFORE GIVEN TO DETERMINE
2848 WHAT THE FIRST WORD OF THE NEXT DESIRED BLOCK IS AND THIS
2849 BLOCK IS FOUND BY SEARCHING THE UNDEFINED TABLE FOR A MATCH.
2850 EACH POLISH FIXUP WHICH IS ENTERED INTO THE UNDEFINED
2851 TABLE IS GIVEN A UNIQUE NUMBER CALLED THE "HEAD NUMBER".
2852 EACH ELEMENT OF THE FIXUP (EITHER OPERAND OR OPERATOR)
2853 IS ASSIGNED A NUMBER CALLED THE "OP NUMBER". THUS
2854 THE OP NUMBER AND HEAD NUMBER TOGETHER DETERMINE
2855 A SPECIFIC ELEMENT OF A SPECIFIC FIXUP. EACH ELEMENT
2856 (TWO WORD BLOCK) IS ARRANGED AS FOLLOWS:
2857 WORD 1:
2858         BITS 0-4  THESE ARE THE USUAL CODE BITS OF A RADIX50
2859                 SYMBOL AND CONTAIN 44 TO DISTINGUISH
2860                 AN ELEMENT OF A POLISH FIXUP FROM OTHER
2861                 SYMBOLS IN THE UNDEFINED TABLE
2862         BITS 5-17 THE HEAD NUMBER OF THIS FIXUP
2863         BITS 18-30 THE OP NUMBER OF THIS ELEMENT
2864         BITS 31-35 THE OPERAND FOR THIS ELEMENT
2865                 OPERAND 2 INDICATES A WORD OF DATA
2866 WORD 2:
2867         IF THE OPERAND IS 2 THIS WORD CONTAINS THE DATA
2868
2869         IF THIS IS NOT A DATA OPERATOR THEN THE LEFT AND
2870         RIGHT HALVES OF THIS WORD POINT TO THE TWO OPERANDS
2871         THE CONTENTS OF THE HALF WORD IS THE RIGHT HALF
2872         OF THE FIRST WORD OF THE BLOCK POINTED
2873         TO. THUS THE LEFT HALF OF THE FIRST WORD COMBINED
2874         WITH ONE OF THESE HALF WORDS IS THE FIRST WORD
2875         OF THE BLOCK POINTED TO AND CAN BE FOUND BY SEARCHING
2876
2877 EACH FIXUP ALSO HAS A HEADER BLOCK. THIS BLOCK CONTAINS THE
2878 FOLLOWING INFORMATION:
2879 WORD 1:
2880         BITS 0-17 0
2881         BITS 18-21  44
2882         BITS 22-35 THE HEAD NUMBER OF THIS FIXUP
2883
2884 WORD 2:
2885         BITS 0-17 A COUNT OF THE NUMBER OF UNDEFINED
2886                 GLOBALS REMAINING IN THIS FIXUP
2887         BITS 18-35 A HALF WORD POINTER OF THE
2888                 SAME TYPE FOUND IN OTHER ELEMENTS POINTING
2889                 TO THE FIRST ELEMENT OF POLISH
2890                 WHICH WILL BE THE STORE OPERATOR
2891
2892 THE REQUESTS FOR THE GLOBAL SYMBOLS NEEDED BY THE FIXUP ARE
2893 ENTERED AS FOLLOWS:
2894
2895 WORD 1:
2896         BITS 0-4  04
2897         BITS 5-35  RADIX 50 FOR THE NAME OF THE SYMBOL
2898
2899
2900 \f(NOTE THIS IS JUST A STANDARD GLOBAL REQUEST)
2901
2902 WORD 2:
2903         BITS 0-4 44 (THIS IDENTIFIES IT AS "ADITIVE TYPE"
2904                 AND BIT 4 INDICATES POLISH)
2905         BITS 5-17 THE HEAD NUMBER OF THE FIXUP
2906                 (THIS GIVES ENOUGH INFORMATION TO FIND THE HEADER
2907                 BLOCK AND UPDATE THE COUNT WHEN THE REQUEST IS
2908
2909
2910 \f               SATISFIED)
2911         BITS 18-35  A HALF WORD POINTER TO THE ELEMENT OF THE
2912                 FIXUP INTO WHICH THE VALUE OF
2913
2914
2915 \f               THE SYMBOL SHOULD BE STORED
2916 >
2917
2918
2919 \fIFN FAILSW,<
2920 ;POLISH FIXUPS <BLOCK TYPE 11>
2921
2922 PDLOV:  SKIPE POLSW     ;PDL OV ARE WE DOING POLISH?
2923         JRST COMPOL     ;YES
2924         ERROR ,</PUSHDOWN OVERFLOW#/>
2925         JRST LD2
2926 COMPOL: ERROR ,</POLISH TOO COMPLEX#/>
2927         JRST LD2
2928
2929
2930 ;READ A HALF WORD AT A TIME
2931
2932 RDHLF:  TLON N,HSW      ;WHICH HALF
2933         JRST NORD
2934         PUSHJ P,RWORD   ;GET A NEW ONE
2935         TLZ N,HSW       ;SET TO READ OTEHR HALF
2936         MOVEM W,SVHWD   ;SAVE IT
2937         HLRZS W         ;GET LEFT HALF
2938         POPJ P,         ;AND RETURN
2939 NORD:   HRRZ W,SVHWD    ;GET RIGHT HALF
2940         POPJ P,         ;AND RETURN
2941
2942
2943 POLFIX: MOVE D,[IOWD PPDL,PPDB] ;SET UP THE POLISH PUSHDOWN LIST
2944         MOVEI V,100     ;IN CASE OF ON OPERATORS
2945         MOVEM V,SVSAT
2946         SETOM POLSW     ;WE ARE DOING POLISH
2947         TLO N,HSW       ;FIX TO READ A WORD THE FIRST TIME
2948         SETOM GLBCNT    ;NUMBER OF GLOBALS IN THIS FIXUP
2949         SETOM OPNUM     ;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP
2950         PUSH D,[15]     ;FAKE OPERATOR SO STORE WILL NOT HACK
2951
2952 RPOL:   PUSHJ P,RDHLF   ;GET A HLAF WORD
2953         TRNE W,400000   ;IS IT A STORE OP?
2954         JRST STOROP     ;YES, DO IT
2955 IFN WFWSW,<CAIN W,15
2956         JRST    [PUSHJ P,RDHLF  ;THIS TRICK FOR VARIABLES
2957                 ADD W,VARREL    ;HOPE SOMEONE HAS DONE
2958                 HRRZ C,W        ;A BLOCK TYPE 13
2959                 JRST HLFOP]>
2960         CAIGE W,3       ;0,1,2 ARE OPERANDS
2961         JRST OPND
2962         CAILE W,14      ;14 IS HIGHEST OPERATOR
2963         JRST LOAD4A     ;ILL FORMAT
2964         PUSH D,W        ;SAVE OPERATOR IN STACK
2965         MOVE V,DESTB-3(W)       ;GET NUMBER OF OPERANDS NEEDED
2966         MOVEM V,SVSAT   ;ALSO SAVE IT
2967         JRST RPOL       ;BACK FOR MORE
2968
2969
2970
2971 \f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
2972 ;GLOBAL REQUESTS
2973
2974 OPND:   MOVE A,W        ;GET THE OPERAND TYPE HERE
2975         PUSHJ P,RDHLF   ;THIS IS AT LEAST PART OF THE OPERAND
2976         MOVE C,W        ;GET IT INTO C
2977         JUMPE A,HLFOP   ;0 IS HALF-WORD OPERAND
2978         PUSHJ P,RDHLF   ;NEED FULL WORD, GET SECOND HALF
2979         HRL C,W ;GET HALF IN RIGHT PLACE
2980         MOVSS C         ;WELL ALMOST RIGHT
2981         SOJE A,HLFOP    ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
2982         PUSHJ P,SDEF    ;SEE IF IT IS ALREADY DEFINED
2983         JRST    [MOVE C,2(A)    ;YES, WE WIN
2984                 JRST HLFOP]
2985         AOSN GLBCNT     ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
2986         AOS HEADNM      ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
2987         AOS W,OPNUM     ;GET AN OPERAND NUMBER
2988         LSH W,5         ;SPACE FOR TYPE
2989         IORI W,2        ;TYPE 2 IS GLOBAL
2990         HRL W,HEADNM    ;GET FIXUP NUMBER
2991         PUSHJ P,SYM3X2  ;AND PUT INTO UDEFINED AREA ALONG WITH NAME
2992         MOVE C,W        ;ALSO PUT THAT PART OF THE FIXUP IN
2993         PUSHJ P,SYM3X2
2994         SKIPA A,[400000]        ;SET UP GLOBAL FLAG
2995 HLFOP:  MOVEI A,0       ;VALUE OPERAND FLAG
2996 HLFOP1: SOJL V,CSAT     ;ENOUGH OPERANDS SEEN?
2997         PUSH D,C        ;NO, SAVE VALUE(OR GLOBAL NAME)
2998         HRLI A,400000   ;PUT IN A VALUE MARKER
2999         PUSH D,A        ;TO THE STACK
3000         JRST RPOL       ;GET MORE POLISH
3001
3002
3003
3004 \f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
3005
3006 CSAT:   HRRZS A         ;KEEP ONLY THE GLOBAL-VALUE HALF
3007         SKIPN SVSAT     ;IS IT UNARY
3008         JRST UNOP       ;YES, NO NEED TO GET 2ND OPERAND
3009         HRL A,(D)       ;GET GLOBAL VALUE MARKER FOR 2ND OP
3010         POP D,W
3011         POP D,W         ;VALUE OR GLOBAL NAME
3012 UNOP:   POP D,V         ;OPERATOR
3013         JUMPN A,GLOB    ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
3014         XCT OPTAB-3(V)  ;IF BOTH VALUES JUST XCT
3015         MOVE C,W        ;GET THE CURRENT VALUE
3016 SETSAT: SKIPG V,(D)     ;IS THERE A VALUE IN THE STACK
3017         MOVE V,-2(D)    ;YES, THIS MUST BE THE OPERATOR
3018         MOVE V,DESTB-3(V)       ;GET NUMBER OF OPERANDS NEEDED
3019         MOVEM V,SVSAT   ;SAVE IT HERE
3020         SKIPG (D)       ;WAS THERE AN OPERAND
3021         SUBI V,1        ;HAVE 1 OPERAND ALREADY
3022         JRST HLFOP1     ;GO SEE WHAT WE SHOULD DO NOW
3023
3024 ;HANDLE GLOBALS
3025 GLOB:   TRNE A,-1       ;IS IT IN RIGHT HALF
3026         JRST TLHG       ;NO, NEED TO PUT THIS VALUE INTO THE FIXUP LIST
3027         PUSH P,W        ;SAVE FOR A WHILE
3028         MOVE W,C        ;THE VALUE
3029         AOS C,OPNUM     ;GET AN OPERAND NUMBER
3030         LSH C,5         ;AND PUT IN TYPE
3031         IORI C,2        ;VALUE TYPE
3032         HRL C,HEADNM    ;THE FIXUP NUMBER
3033         PUSHJ P,SYM3X2
3034         POP P,W         ;RETRIEVE THE OTHER VALUE
3035 TLHG:   SKIPE SVSAT     ;WAS THIS A UNARY OPERATOR
3036         TLNE A,-1       ;WAS THERE A GLOBAL IN LEFT HALF
3037         JRST GLSET
3038         PUSH P,C        ;SAVE THE FIRST OPERAND
3039         AOS C,OPNUM     ;SEE ABOVE
3040         LSH C,5
3041         IORI C,2
3042         HRL C,HEADNM
3043         PUSHJ P,SYM3X2
3044         MOVE W,C
3045         POP P,C
3046
3047 GLSET:  EXCH C,W        ;GET THEM IN THE OTHER ORDER
3048         HRL W,C         ;SET UP THE OPERATOR LINK
3049         AOS C,OPNUM
3050         LSH C,5 ;SPACE FOR THYPE
3051         IOR C,V         ;THE OPERATOR
3052         HRL C,HEADNM
3053         PUSHJ P,SYM3X2  ;INTO THE UNDEF LIST
3054                 MOVEI A,400000  ;SET UP AS A GLOBAL VALUE
3055         JRST SETSAT     ;AND SET UP FOR NEXT OPERATOR
3056
3057
3058 \f;FINALLY WE GET TO STORE THIS MESS
3059
3060 STOROP: MOVE T,-2(D)    ;THIS SHOULD BE THE FAKE OPERATOR
3061         CAIE T,15       ;IS IT
3062         JRST LOAD4A     ;NO, ILL FORMAT
3063         HRRZ T,(D)      ;GET THE VALUE TYPE
3064         JUMPN T,GLSTR   ;AND TREAT GLOBALS SPECIAL
3065         MOVE A,W        ;THE TYPE OF STORE OPERATOR
3066         CAIGE A,-3
3067         PUSHJ P,FSYMT
3068         PUSHJ P,RDHLF   ;GET THE ADDRESS
3069         MOVE V,W        ;SET UP FOR FIXUPS
3070         POP D,W         ;GET THE VALUE
3071         POP D,W         ;AFTER IGNORING THE FLAG
3072         PUSHJ P,@STRTAB+6(A)    ;CALL THE CORRECT FIXUP ROUTINE
3073 COMSTR: SETZM POLSW     ;ALL DONE WITH POLISH
3074 IFN REENT,<PUSHJ P,RESTRX>
3075         MOVE T,OPNUM    ;CHECK ON SIZES
3076         MOVE V,HEADNM
3077         CAIG V,477777
3078         CAILE T,17777
3079         JRST COMPOL     ;TOO BIG, GIVE ERROR
3080         PUSHJ P,RWORD   ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
3081         JRST LOAD4A     ;IF NOT, SOMETHING IS WRONG
3082
3083 STRTAB: EXP ALSYM,LFSYM,RHSYM,ALSTR,LOCDLF,SYM4A,FAKESY
3084
3085 GLSTR:  MOVE A,W
3086         CAIGE A,-3
3087         PUSHJ P,FSYMT
3088         PUSHJ P,RDHLF   ;GET THE STORE LOCATION
3089         MOVEI A,23(A)
3090         POP D,V         ;GET VALUE
3091         POP D,V
3092         HRLM V,W        ;SET UP STORAGE ELEMENT
3093         AOS C,OPNUM
3094         LSH C,5
3095         IOR C,A
3096         HRL C,HEADNM
3097         PUSHJ P,SYM3X2
3098         MOVE W,C        ;NOW SET UP THE HEADER
3099         AOS V,GLBCNT    ;WHICH HAS NUMBER OF GLOBALS
3100         HRLM V,W
3101         HRRZ C,HEADNM
3102         PUSHJ P,SYM3X2
3103         JRST COMSTR     ;AND FINISH
3104
3105
3106
3107 \fALSTR1:        IFN L,<CAMGE V,RINITL
3108         POPJ P,>
3109 IFN REENT,<CAMGE V,HVAL1
3110                 SKIPA X,LOWX
3111         MOVE X,HIGHX>
3112         HRRZ T,@X
3113         MOVEM W,@X      ;FULL WORD FIXUPS
3114         MOVE V,T
3115 ALSTR:  JUMPN V,ALSTR1
3116         POPJ P,
3117 DESTB:  EXP 1,1,1,1,1,1,1,1,0,0,100
3118
3119 OPTAB:  ADD W,C
3120         SUB W,C
3121         IMUL W,C
3122         IDIV W,C
3123         AND W,C
3124         IOR W,C
3125         LSH W,(C)
3126         XOR W,C
3127         SETCM W,C
3128         MOVN W,C
3129         REPEAT 7,<JRST STRSAT>
3130
3131
3132 FSYMT:  PUSHJ P,RDHLF   ;FIRST HALF OF SYMBOL
3133         HRL V,W
3134         PUSHJ P,RDHLF
3135         HRR V,W
3136         PUSH D,A        ;SAVE STORE TYPE
3137         PUSHJ P,RDHLF   ;GET BLOCK NAME
3138         HRL C,W
3139         PUSHJ P,RDHLF
3140         HRR C,W
3141         TLO C,140000    ;MAKE BLOCK NAME
3142         PUSHJ P,SDEF    ;FIND IT
3143         CAMN A,B
3144         JRST FNOLOC     ;MUST NOT BE LOADING LOCALS
3145 FSLP:   LDB C,[POINT 32,-1(A),35]       ;GET NAME
3146         CAMN C,V
3147         JRST FNDSYM
3148         SUB A,SE3
3149         CAME A,B        ;ALL DONE?
3150         JRST FSLP       ;NO
3151 FNOLOC: POP D,A
3152         MOVEI A,0       ;SET FOR A FAKE FIXUP
3153         AOS (P)
3154         POPJ P,
3155 FNDSYM: MOVEI W,(A)     ;LOC OF SYMBOL
3156         SUB W,HISTRT
3157         POP D,A
3158         AOS (P)
3159         POPJ P,
3160
3161 LFSYM:  ADD V,HISTRT
3162         HRLM W,(V)
3163         MOVSI D,400000  ;LEFT HALF
3164         JRST COMSFX
3165 RHSYM:  ADD V,HISTRT
3166         HRRM W,(V)
3167         MOVSI D,200000
3168         JRST COMSFX
3169 FAKESY: POPJ P,         ;IGNORE
3170
3171
3172 \fPOLSAT:        PUSH P,C        ;SAVE SYMBOL
3173         MOVE C,V        ;POINTER
3174         PUSHJ P,SREQ    ;GO FIND IT
3175         SKIPA
3176         JRST LOAD4A     ;SOMETHING IS ROTTEN IN DENMARK
3177         MOVEM W,2(A)    ;STORE VALUE
3178         HLRZS C         ;NOW FIND HEADER
3179         PUSHJ P,SREQ
3180         SKIPA
3181         JRST LOAD4A
3182         HRLZI V,-1      ;AND DECREMENT COUNT
3183         ADDB V,2(A)
3184         TLNN V,-1       ;IS IT NOW 0
3185         JRST PALSAT     ;YES, GO DO POLISH
3186         POP P,C         ;RESTORE SYMBOL
3187         JRST SYM2W1     ;AND RETURN
3188
3189 PALSAT: PUSH P,W        ;SAVE VALUE
3190         MOVEM C,HDSAV   ;SAVE THE HEADER NUMBER
3191         MOVE D,[IOWD PPDL,PPDB] ;SET UP A PDL
3192         MOVE C,V        ;GET THE POINTER
3193                 HRL C,HDSAV     ;AND THE FIXUP NUMBER
3194         PUSHJ P,REMSYM  ;REMOVE THE HEADER FORM EXISTANCE
3195         PUSHJ P,SREQ    ;GO FINE THE NEXT LINK
3196         SKIPA
3197         JRST LOAD4A     ;LOSE
3198         ANDI C,37       ;GET OPERATOR TYPE
3199         HRRZ V,2(A)     ;PLACE TO STORE
3200         PUSH D,V
3201         PUSH D,[XWD 400000,0]
3202         PUSH D,C        ;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE
3203         HLRZ C,2(A)     ;GET POINTER TO POLISH CHAIN
3204 PSAT1:  PUSHJ P,REMSYM  ;REMOVE SYMBOL
3205
3206
3207
3208 \fPSAT2: HRL C,HDSAV     ;GET FIXUP NUMBER
3209         PUSHJ P,SREQ    ;LOOK FOR IT
3210         SKIPA
3211         JRST LOAD4A
3212         ANDI C,37       ;THE OPERATOR NUMBER
3213         CAIN C,2        ;IS IT AN OPERAND?
3214         JRST PSOPD      ;YES, GO PROCESS
3215         PUSH D,C        ;YES STORE IT
3216         SKIPN DESTB-3(C)        ;IS IT UNARY
3217         JRST PSUNOP     ;YES
3218         HLRZ C,2(A)     ;GET FIRST OPERAND
3219         HRLI C,600000   ;AND MARK AS VALUE
3220         PUSH D,C
3221 PSUNOP: HRRZ C,2(A)     ;OTHER OPERAND
3222         JRST PSAT1      ;AND AWAY WE GO
3223
3224 PSOPD:  MOVE C,2(A)     ;THIS IS A VALUE
3225         PUSHJ P,REMSYM  ;GET RID OF THAT PART OF THE CHAIN
3226 PSOPD1: SKIPG V,(D)     ;IS THERE A VALUE IN THE STACK
3227         JRST PSOPD2     ;YES, TAKE GOOD CARE OF IT
3228 COMOP:  POP D,V         ;NO, GET THAT OPERATOR OUT OF THERE
3229         XCT OPTAB-3(V)  ;AND DO IT
3230         MOVE C,W        ;GET RESULT IN RIGHT PLACE
3231         JRST PSOPD1     ;AND TRY FOR MORE
3232 PSOPD2: TLNE V,200000   ;IS IT A POINTER
3233         JRST DBLOP      ;YES, NEEDS MORE WORK
3234         MOVE W,C        ;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W
3235         POP D,C         ;VALUE POINTER
3236         POP D,C         ;2ND OPERAND INTO C
3237         JRST COMOP      ;GO PROCESS OPERATOR
3238
3239 DBLOP:  EXCH C,(D)      ;PUT VALUE IN STACK AND RETRIEV POINTER
3240         PUSH D,[XWD 400000,0]   ;MARK AS VALUE
3241         JRST PSAT2      ;AND GO LOOK FOR MORE TROUBLE
3242
3243 LINK:   PUSHJ P,PRWORD  ;GET TWO WORDS
3244         JUMPLE C,ENDLNK ;THIS IS AN END OF LINK WORD
3245         CAILE C,20      ;IS IT IN RANGE?
3246         JRST LOAD4A
3247         HRRZ V,W        ;GET THE ADDRESS
3248 IFN REENT,<
3249         CAMGE   V,HVAL1         ;CHECK HISEG ADDRESS
3250         SKIPA   X,LOWX          ;LOW SEGMENT
3251         MOVE    X,HIGHX         ;HIGH SEGMENT BASE
3252 >;IF REENT
3253         HRRZ W,LINKTB(C)        ;GET CURRENT LINK
3254 IFN L,< CAML V,RINITL   ;LOSE>
3255         HRRM W,@X       ;PUT INTO CORE
3256         HRRM V,LINKTB(C)        ;SAVE LINK FOR NEXT ONE
3257 IFN REENT,<
3258         PUSHJ   P,RESTRX        ;RESTORE X
3259 >;IF REENT
3260         JRST LINK       ;GO BACK FOR MORE
3261 ENDLNK: MOVNS C         ;GET ENTRY NUMBER
3262         JUMPE C,LOAD4A  ;0 IS A LOSER
3263         CAILE C,20      ;CHECK RANGE
3264         JRST LOAD4A
3265                 HRLM W,LINKTB(C)        ;SAVE END OF LINK INFO
3266         JRST LINK       ;MORE
3267
3268
3269 \fSTRSAT:        MOVE W,C        ;GET VALUE TO STORE IN W
3270         MOVE C,V        ;GET OPERATOR HERE
3271         POP D,V
3272         POP D,V         ;GET ADDRESS TO STORE
3273         PUSHJ P,@STRTAB-15(C)
3274 IFN REENT,<PUSHJ P,RESTRX>
3275         POP P,W ;RESTORE THINGS
3276         POP P,C
3277         JRST SYM2W1
3278
3279 ALSYM:  ADD V,HISTRT
3280         MOVEM W,(V)
3281         MOVSI D,600000
3282 >
3283         LIST            ;END OF FAILSW CODE
3284 IFN FAILSW!WFWSW,<
3285 COMSFX: IFN REENT,<PUSHJ P,SYMFX1       ;WAS IFE, I THINK THAT'S WRONG -- DCS
3286         JRST RESTRX>
3287 IFE REENT,<JRST SYMFX1>>                ;WAS IFN, I THINK THAT'S WRONG -- DCS
3288
3289 REMSYM: MOVE T,1(S)
3290         MOVEM T,1(A)
3291         MOVE T,2(S)
3292         MOVEM T,2(A)
3293         ADD S,SE3
3294         MOVEM A,SVA
3295         POPJ P,
3296
3297
3298
3299 \fSUBTTL LIBRARY INDEX (BLOCK TYPE 14)
3300
3301         COMMENT *       DIRECT ACCESS LIBRARY SEARCH MODE
3302         INDEX WRITTEN BY FUDGE2.SEE DIDAL DOC (100-540-001-00)
3303         DESIGN AND CODING BY D.M.NIXON  JUL-AUG 1970
3304         *
3305
3306 IFN DIDAL,<
3307
3308 INDEX8: POP     P,LSTBLK        ;SET UP LSTBLK FOR NEXT PROG
3309         PUSHJ   P,WORD          ;READ FIRST WORD
3310         HLRZ    A,W             ;BLOCK TYPE ONLY
3311         CAIE    A,14            ;IS IT AN INDEX?
3312         JRST    INDEXE          ;NO, ERROR
3313         JRST    INDEX9          ;DON'T SET FLAG AGAIN
3314
3315 INDEX0: TRO     F,XFLG          ;SIGNAL INDEX IN CORE
3316         MOVEI   A,1             ;START ON BLOCK 1 (DSK)
3317         HRROM   A,LSTBLK        ;BUT INDICATE AN INDEX
3318         MOVE    A,ILD1          ;INPUT DEVICE
3319         DEVCHR  A,
3320         TLNE    A,100           ;IS IT A DTA?
3321         TRO     F,DTAFLG        ;YES
3322 INDEX9: MOVEI   A,AUX+2         ;AUX BUFFER
3323         HRLI    A,4400          ;MAKE BYTE POINTER
3324         MOVEM   A,ABUF1         ;AND SAVE IT
3325         HRL     A,BUFR1         ;INPUT BUFFER
3326         BLT     A,AUX+201       ;STORE BLOCK
3327         TRO     F,LSTLOD        ;AND FAKE LAST PROG READ
3328 INDEX1: ILDB    T,ABUF1
3329         HLRE    A,T             ;GET WORD COUNT
3330         JUMPL   A,INDEX3        ;END OF BLOCK IF NEGATIVE
3331         CAIE    A,4             ;IS IT ENTRY
3332         JRST    INDEX
3333         HRRZS   T               ;WORD COUNT ONLY
3334 INDEX2: ILDB    C,ABUF1         ;GET NEXT SYMBOL
3335         TLO     C,040000        ;
3336         PUSHJ   P,SREQ          ;SEARCH FOR IT
3337         SOJA    T,INDEX4        ;REQUEST MATCHES
3338         SOJG    T,INDEX2        ;KEEP TRYING
3339         ILDB    T,ABUF1         ;GET POINTER WORD
3340         TRZN    F,LSTLOD        ;WAS LAST PROG LOADED?
3341         JRST    INDEX1          ;NO
3342         TRNN    F,DTAFLG        ;ALWAYS SAVE IF DTA???
3343         SKIPL   LSTBLK          ;SKIP IF LAST BLOCK WAS AN INDEX
3344         MOVEM   T,LSTBLK        ;SAVE POINTER FOR CALCULATIONS
3345         JRST    INDEX1          ;GET NEXT PROG
3346
3347
3348 \fINDEX4:        ADDM    T,ABUF1
3349         ILDB    A,ABUF1
3350         PUSH    P,A             ;SAVE THIS BLOCK
3351         TROE    F,LSTLOD        ;DID WE LOAD LAST  PROG?
3352         JRST    [SKIPGE LSTBLK  ;WAS LAST BLOCK AN INDEX?
3353                 JRST    NXTBLK  ;YES, SO GET NEXT ONE
3354                 MOVEM   A,LSTBLK
3355                 JRST    LOAD1]  ;NEXT PROG IS ADJACENT
3356         HRRZ    T,LSTBLK        ;GET LAST BLOCK NUMBER
3357         CAIN    T,(A)           ;IN THIS BLOCK?
3358         JRST    THSBLK          ;YES
3359 NXTNDX: TRNE    F,DTAFLG        ;DIFFERENT TEST FOR DTA
3360         JRST    NXTDTA          ;CHECK IF NEXT BUFFER IN CORE
3361         CAIN    T,-1(A)         ;NEXT BLOCK?
3362         JRST    NXTBLK          ;YES,JUST DO INPUT
3363 INDEX5: USETI   1,(A)           ;SET ON BLOCK
3364         WAIT    1,              ;LET I/O FINISH
3365         MOVSI   C,(1B0)         ;CLEAR RING USE BIT IF ON
3366 ; ***** THE EQUIV. OF THE NEXT INSTR. MAY WELL BE IN LATER VERSIONS.
3367 ; ***** IT WAS MISSING, AND FOULED UP THE INDEX STUFF. (DCS 7-7-71)
3368         HLLM    C,BUFR          ;INDICATE VIRGIN BUFFER
3369         HRRZ    T,BUFR
3370         SKIPL   (T)
3371         JRST    NXTBLK          ;ALL DONE NOW
3372         ANDCAM  C,(T)           ;CLEAR USE BIT
3373         HRRZ    T,(T)           ;GET NEXT BUFFER
3374         JRST    .-4             ;LOOP
3375
3376 NXTDTA: WAIT    1,              ;LET I/O RUN TO COMPLETION
3377         HRRZ    T,BUFR          ;GET POINTER TO CURRENT BUFFER
3378         HLRZ    T,1(T)          ;FIRST DATA WORD IS LINK
3379         CAIE    T,(A)           ;IS IT BLOCK WE WANT?
3380         JRST    INDEX5          ;NO
3381 NXTBLK: IN      1,
3382         JRST    NEWBLK          ;IT IS NOW
3383         JRST    WORD3           ;EOF OR ERROR
3384
3385 NEWBLK: MOVE    A,(P)           ;GET CURRENT BLOCK
3386         JUMPL   A,INDEX8        ;JUST READ AN INDEX
3387         HLRZS   A               ;GET WORD COUNT
3388 COMMENT *  DCS -- 3/15/71
3389         This code required modification to work with DEC's FUDGE2
3390   (with /X) at Stanford.  I don't know the formats, so I don't know
3391   if the bugs are unique to Stanford.
3392         In particular, the special 0 test seems to cause all the
3393   trouble -- removing it fixed it.  However, my fix may well foul
3394   up with Dectapes (see the SPR for "details?").
3395 *
3396
3397 ; 0 TEST REMOVED HERE -- DCS
3398         SKIPL   LSTBLK          ;WAS LAST BLOCK AN INDEX?
3399         AOJA    A,INDEX6        ;NO, ALWAYS ONE WORD OUT THEN
3400         HRRZ    T,AUX+3         ;GET FIRST ENTRY BLOCK TYPE COUNT
3401         HRRZ    T,AUX+4(T)      ;GET FIRST POINTER WORD
3402         MOVEM   T,LSTBLK        ;SOME WHERE TO STORE IT
3403         HRRZ    T,(P)           ;GET CURRENT BLOCK NUMBER
3404         CAME    T,LSTBLK                ;SAME BLOCK
3405         AOJA    A,INDEX6        ;NO
3406         TRNN    F,DTAFLG        ;BUFR2 OK IF DTA
3407         SOS     BUFR2           ;ONE WORD TOO MANY THOUGH
3408         JRST    INDEX6          ;YES, WORD COUNT WILL BE CORRECT
3409 ; IF A IS 0, INDEX6≡INDEX7 -- DCS
3410
3411
3412 \fTHSBLK:        SUB     A,LSTBLK        ;GET WORD DIFFERENCE
3413         MOVSS   A               ;INTO RIGHT HALF
3414 INDEX6: ADDM    A,BUFR1
3415         MOVNS   A
3416         ADDM    A,BUFR2
3417 INDEX7: POP     P,LSTBLK        ;STORE THIS AS LAST BLOCK READ
3418         JRST    LOAD1
3419
3420 INDEX3: HRRE    A,T             ;GET BLOCK # OF NEXT INDEX
3421         JUMPL   A,EOF           ;FINISHED IF -1
3422         PUSH    P,T             ;STACK THIS BLOCK
3423         HRRZ    T,LSTBLK        ;GET LAST BLOCK
3424         JRST    NXTNDX          ;CHECK IF NEXT BUFFER IN CORE
3425
3426 INDEX:  IN      1,              ;GET NEXT BUFFER
3427         SOSA    BUFR2           ;O.K. RETURN, BUT 1 WORD TOO MANY
3428         JRST    WORD3           ;ERROR OR EOF
3429         PUSHJ   P,WORD          ;READ FIRST WORD
3430 INDEXE: TRZE    F,XFLG          ;INDEX IN CORE?
3431         TTCALL  3,[ASCIZ /LIBRARY INDEX INCONSISTENT - CONTINUING
3432 /]                              ;WARNING MESSAGE
3433         JRST    LOAD1A+1        ;AND CONTINUE
3434 >
3435
3436
3437
3438 \fSUBTTL ALGOL OWN BLOCK (TYPE 15)
3439
3440 IFN ALGSW,<
3441 ALGBLK:
3442 IFN SAILSW,<TRNN F,ALGFL        ;IF NOT ALGOL
3443         JRST    LDPRG           ;MUST BE SAIL BLOCK TYPE 15>
3444         PUSHJ P,RWORD           ;READ 3RD WORD
3445         HLRZ    V,W             ;GET START OF OWN BLOCK
3446         MOVEI   C,(W)           ;GET LENGTH OF OWN BLOCK
3447         MOVEM   C,OWNLNG        ;SAVE IT TO FIX RELOC AT END
3448         PUSHJ   P,ALGB2         ;FIX AND CHECK PROG BREAK
3449         ADDI    V,(R)           ;RELOCATE
3450         MOVEI   W,(V)           ;GET CURRENT OWN ADDRESS
3451         EXCH    W,%OWN          ;SAVE FOR NEXT TIME
3452         MOVEM   W,@X            ;STORE LAST OWN ADDRESS IN LEFT HALF
3453 ALGB1:  PUSHJ   P,RWORD         ;GET DATA WORD
3454         HLRZ    V,W             ;GET ADDRESS TO FIX UP
3455         HRRZS   W               ;RIGHT HALF ONLY
3456         ADD     W,%OWN          ;ADD IN ADDRESS OF OWN BLOCK
3457         ADDM    W,@X            ;FIX UP RIGHT HALF
3458         JRST    ALGB1           ;LOOP TIL DONE
3459
3460 ALGNAM: JUMPE   W,CPOPJ         ;NOT ALGOL MAIN PROG
3461         TROE    F,ALGFL         ;SET ALGOL SEEN FLAG
3462         JRST    ALGER1          ;ONLY ONE ALGOL MAIN PROG ALLOWED
3463 IFN REENT,<TRNN F,SEENHI        ;ANYTHING IN HIGH SEGMENT?>
3464         CAME    R,[XWD W,JOBDA] ;ANYTHING LOADED IN LOW SEGMENT?
3465         JRST    ALGER2          ;YES, ERROR ALSO
3466         SETZM   %OWN            ;INITIALISE OWN AREA POINTER
3467 IFN REENT,<TRO  F,VFLG          ;DEFAULT RE-ENTRANT OP-SYSTEM>
3468 ALGB2:  ADDI    H,(W)           ;FIX PROG BREAK
3469 IFN REENT,<CAML H,HILOW
3470         MOVEM   H,HILOW         ;HIGHEST LOW CODE LOADED>
3471         CAILE   H,1(S)          ;SKIP IF SUFFICIENT CORE AVAILABLE
3472 IFN EXPAND,<JRST [PUSHJ P,XPAND>
3473                 JRST    FULLC
3474 IFN EXPAND,<    JRST    .+1]>
3475         POPJ    P,
3476
3477 ALGER1: ERROR   ,</ONLY ONE ALGOL MAIN PROGRAM ALLOWED#/>
3478         JRST    LD2
3479
3480 ALGER2: ERROR   ,</ALGOL MAIN PROGRAM MUST BE LOADED FIRST#/>
3481         JRST    LD2
3482
3483 >
3484
3485
3486 \fSUBTTL SAIL BLOCK TYPE 15
3487
3488 COMMENT * BLOCK TYPE 15 AND 16. SIXBIT FOR  FIL,PPN,DEV
3489 IN THE BLOCK. SEARCH TABLE FOR ALREADY REQUESTED. IF NOT
3490 ENTER REQUEST. ORIGINAL CODE BY DCS REWRITTEN BY WFW*
3491
3492 IFN SAILSW,<
3493 IFE ALGSW<ALGBLK:>
3494 LDPRG:  MOVEI D,PRGFLS-1        ;SET UP SOMETHING WE CAN SEARCH WITH
3495         MOVE W,PRGPNT   ;AND CURRENT POINTER
3496         PUSHJ P,LDSAV   ;GO ENTER (WILL NOT RETURN IF RUNS OUT)
3497         MOVEM D,PRGPNT
3498         JRST LDPRG      ;BACK FOR MORE
3499 LDLIB:  MOVEI D,LIBFLS-1
3500         MOVE W,LIBPNT
3501         PUSHJ P,LDSAV
3502         MOVEM D,LIBPNT
3503         JRST LDLIB      ;LOOKS JUST LIKE THE LAST ONE, DOESN'T IT
3504
3505 LDSAV:  HRLI D,-RELLEN-1        ;GET AOBJN SET UP
3506         MOVEM W,LODPN2# ;SAV IT
3507         PUSHJ P,PRWORD  ;GET FILE,PPN
3508         MOVE A,W        ;SAVE ONE
3509         PUSHJ P,RWORD   ;AND DEVICE
3510 FILSR:  CAMN D,LODPN2
3511         JRST FENT       ;HAVE GOTTEN THERE, ENTER FILE
3512         CAME C,PRGFIL(D)        ;CHECK FOR MATCH
3513         JRST NOMT       ;NOT FILE
3514         CAME A,PRGPPN(D)
3515         JRST NOMT       ;NO PPN
3516         CAME W,PRGDEV(D)
3517 NOMT:   AOBJN D,FILSR   ;AND NOT DEVICE SHOULD ALWAYS JUMP
3518         MOVE D,LODPN2
3519         POPJ P,         ;JUST RETURN CURRENT POINTER
3520 FENT:   MOVE D,LODPN2   ;ENTER IT
3521         AOBJP D,WRONG   ;THAT IS IF NOT TOO MANY
3522         MOVEM C,PRGFIL-1(D)     ;HAVE ALREADY INDEXED
3523         MOVEM A,PRGPPN-1(D)     ;HENCE THE -1
3524         MOVEM W,PRGDEV-1(D)
3525         POPJ P,
3526 WRONG:  ERROR ,</TOO MANY DEMANDED FILES#/>
3527         JRST LD2
3528 >
3529
3530
3531 \fSUBTTL SYMBOL TABLE SEARCH SUBROUTINES
3532
3533 ;       ENTERED WITH SYMBOL IN C
3534 ;       RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND
3535 ;       OTHERWISE, A SKIP ON RETURN OCCURS
3536
3537 SREQ:   JUMPGE  S,CPOPJ1        ;JUMP IF NO UNDEF. SYMBOLS
3538         SKIPA   A,S             ;LOAD REQUEST SEARCH POINTER
3539 SDEF:   MOVE    A,B             ;LOAD DEF. SYMBOL SEARCH POINTER
3540 SDEF1:  CAMN    C,1(A)
3541         POPJ    P,              ;SYMBOLS MATCH, RETURN
3542 IFE K,< TLNE    N,F4SW          ;ARE WE IN FORTRAN?
3543         JRST    SDEF2           ;YES,JUST TRY NEXT SYMBOL>
3544         TLC     C,400000        ;MIGHT BE SUPPRESSED  INTERNAL
3545         CAMN    C,1(A)          ;WAS IT?
3546         JRST    [TLO C,400000   ;YES, SO ENSURE IT'S SUPPRESSED
3547                 MOVEM C,1(A)    ;STORE SUPPRESSED DEFINITION
3548                 POPJ    P,]     ;YES
3549         TLC     C,400000        ;NO,TRY NEXT SYMBOL
3550 SDEF2:  ADD     A,SE3
3551         JUMPL   A,SDEF1
3552 IFE K,< JRST    CPOPJ1          ;SYMBOL NOT FOUND SKIPS ON RETURN>
3553 IFN K,<
3554 CPOPJ1: AOS     (P)
3555         POPJ    P,>
3556
3557
3558 \fSUBTTL RELOCATION AND BLOCK INPUT
3559
3560 PRWORD: PUSHJ   P,RWORD         ;READ A WORD PAIR
3561         MOVE    C,W             ;LOAD C WITH FIRST DATA WORD
3562         TRNE    E,377777                ;TEST FOR END OF BLOCK
3563         JRST    RWORD1          ;INPUT SECOND WORD OF PAIR
3564         MOVEI   W,0             ;NO SECOND WORD, ASSUME ZERO
3565         POPJ    P,
3566
3567 RWORD:  TRNN    E,377777        ;TEST FOR END OF BLOCK
3568         JRST    LOAD1           ;RETURN TO LOAD THE NEXT BLOCK
3569 RWORD1: AOBJN   E,RWORD2        ;JUMP IF DATA WORD NEXT
3570         PUSHJ   P,WORD          ;READ CONTROL WORD
3571         MOVE    Q,W             ;DON'T COUNT RELOCATION WORDS
3572         HRLI    E,-22           ;SET RELOCATION WORD BYTE COUNT
3573 RWORD2: PUSHJ   P,WORD          ;READ INPUT WORD
3574         JUMPGE  Q,RWORD3        ;TEST LH RELOCATION BIT
3575         TRNN    F,TWOFL         ;POSSIBLE TWO SEGMENTS?
3576         JRST    RWORD5          ;NO
3577         MOVSS   W
3578         PUSHJ   P,CHECK         ;USE CORRECT RELOCATION
3579         HRRI    W,@R
3580         MOVSS   W
3581         JRST    RWORD3          ;AND TEST RIGHT HALF
3582 RWORD5: HRLZ    T,R
3583         ADD     W,T             ;LH RELOCATION
3584 RWORD3: TLNN    Q,200000        ;TEST RH RELOCATION BIT
3585         JRST    RWORD4          ;NOT RELOCATABLE
3586         TRNE    F,TWOFL         ;POSSIBLE TWO SEGMENTS?
3587         PUSHJ   P,CHECK         ;USE CORRECT RELOCATION
3588         HRRI    W,@R            ;RH RELOCATION
3589 RWORD4: LSH     Q,2
3590         POPJ    P,
3591
3592 CHECK:  MOVE    T,HVAL1         ;START OF HISEGMENT
3593         CAIG    T,NEGOFF(W)     ;IN HISEG?
3594         JRST    [SUBI   W,(T)   ;YES REMOVE OFSET
3595                 POPJ    P,]
3596         HRRI    W,@LOWR         ;USE LOW SEG RELOC
3597         JRST    CPOPJ1          ;SKIP RETURN
3598
3599
3600 \fSUBTTL PRINT STORAGE MAP SUBROUTINE
3601
3602 PRMAP:  CAIN    D,1             ;IF /1M PRINT LOCAL SYMBOLS
3603         TROA    F,LOCAFL        ;YES,TURN ON FLAG
3604         TRZ     F,LOCAFL        ;CLEAR JUST IN CASE
3605         PUSHJ   P,FSCN1         ;LOAD OTHER FILES FIRST
3606         PUSHJ   P,CRLFLF        ;START NEW PAGE
3607         HRRZ    W,R
3608 IFN REENT,<CAIG W,JOBDA ;LOADED INTO LOW SEGMENT
3609         JRST    NOLOW           ;DON'T PRINT IF NOTHING THERE>
3610         PUSHJ     P,PRNUM0
3611 IFE REENT,<ERROR 7,<?IS THE PROGRAM BREAK@?>>
3612 IFN REENT,<ERROR 7,<?IS THE LOW  SEGMENT BREAK@?>
3613         PUSHJ   P,CRLF          ;CR-LF ON ALL BUT TTY
3614 NOLOW:  MOVE    W,HVAL          ;HISEG BREAK
3615         CAMG    W,HVAL1         ;HAS IT CHANGED
3616         JRST    NOHIGH          ;NO HI-SEGMENT
3617         TLO     F,FCONSW        ;FORCE OUT HI-SEG BREAK ALSO
3618         PUSHJ   P,PRNUM0
3619         ERROR   7,<?IS THE HIGH SEGMENT BREAK@?>
3620         PUSHJ   P,CRLF
3621 NOHIGH:>
3622 IFE NAMESW,<    MOVE    W,DTOUT ;OUTPUT NAME >
3623 IFN NAMESW,<    SKIPN   W,DTOUT
3624         MOVE    W,CURNAM        ;USE PROGRAM NAME>
3625         JUMPE   W,.+3           ;DON'T PRINT IF NOT THERE
3626         PUSHJ   P,PWORD
3627         PUSHJ   P,SPACES        ;SOME SPACES
3628         ERROR   0,<?STORAGE MAP!?>
3629         PUSHJ   P,SPACES                ;SOME SPACES
3630         PUSH    P,N
3631         PUSH    P,E
3632         MOVE    N,[POINT 6,DBUF] ;INITIALIZE DATE POINTER
3633         MSTIME  Q,              ;GET THE TIME
3634         IDIVI   Q,↑D60*↑D1000
3635         IDIVI   Q,↑D60
3636         PUSH    P,A             ;SAVE MINUTES
3637         PUSHJ   P,OTOD1         ;STORE HOURS
3638         POP     P,Q             ;GET MINUTES
3639         PUSHJ   P,OTOD          ;STORE MINUTES
3640         DATE    E,              ;GET DATE
3641         IDIVI   E,↑D31                ;GET DAY
3642         ADDI    Q,1
3643         PUSHJ   P,OTOD          ;STORE DAY
3644         IDIVI   E,↑D12                ;GET MONTH
3645         ROT     Q,-1            ;DIV BY 2
3646         HRR     A,DTAB(Q)       ;GET MNEMONIC
3647         TLNN    Q,400000
3648         HLR     A,DTAB(Q)       ;OTHER SIDE
3649         HRRM    A,DBUF+1        ;STORE IT
3650         MOVEI   Q,↑D64(E)     ;GET YEAR
3651         MOVE    N,[POINT 6,DBUF+2]
3652         PUSHJ   P,OTOD          ;STORE IT
3653         POP     P,E
3654         POP     P,N
3655         PUSHJ   P,DBUF1
3656         PUSHJ   P,CRLF
3657         SKIPN   STADDR          ;PRINT STARTING ADDRESS
3658         JRST    NOADDR          ;NO ADDRESS SEEN
3659         ERROR   0,</STARTING ADDRESS !/>
3660         PUSHJ   P,SP1
3661         MOVE    W,STADDR                ;GET ST. ADDR.
3662         PUSHJ   P,PRNUM0                ;PRINT IT
3663 IFN NAMESW,<
3664         PUSHJ   P,SP1
3665         MOVE    W,[SIXBIT / PROG /]
3666         PUSHJ   P,PWORD
3667         MOVE    W,CURNAM                ;PROG NAME
3668         PUSHJ   P,PWORD
3669         PUSHJ   P,SP1
3670         MOVE    W,ERRPT6                ;SIXBIT / FILE /
3671         PUSHJ   P,PWORD
3672         MOVE    W,PRGNAM                ;FILE NAME
3673         PUSHJ   P,PWORD>
3674 NOADDR: IFN REENT,<
3675         HRRZ    A,HVAL1         ;GET INITIAL HIGH START
3676         ADDI    A,JOBHDA        ;ADD IN OFFSET
3677         HRLI    A,JOBDA         ;LOW START
3678         MOVSM   A,SVBRKS        ;INITIAL BREAKS>
3679         HLRE    A,B
3680         MOVNS     A
3681         ADDI    A,(B)
3682 PRMAP1: SUBI    A,2
3683 IFN REENT,<SKIPN C,1(A)         ;LOAD SYMBOL SKIP IF REAL SYMBOL
3684         JRST    PRMAP4          ;IGNORE ZERO NAME(TWOSEG BREAKS)>
3685 IFE REENT,<MOVE C,1(A)          ;LOAD SYMBOL>
3686         TLNN    C,300000        ;TEST FOR LOCAL SYMBOL
3687         JRST    .+4             ;GLOBAL  (NOT LOCAL ANYWAY)
3688         TRNN    F,LOCAFL        ;PRINT LOCAL SYMBOLS?
3689         JRST    PRMAP4          ;IGNORE LOCAL SYMBOLS
3690         TLC     C,140000        ;MAKE IT LOOK LIKE INTERN
3691         TLNE    C,040000
3692         JRST    PRMP1A
3693         PUSHJ   P,CRLF
3694         PUSHJ   P,CRLF
3695         SETZM   TABCNT
3696         JRST    PRMP1B
3697
3698
3699 \fPRMP1A:        PUSHJ   P,TAB
3700 PRMP1B: PUSHJ   P,PRNAM1        ;PRINT SYMBOL AND VALUE
3701         TLNE    C,040000
3702         JRST    PRMAP4          ;GLOBAL SYMBOL
3703         HLRE    C,W             ;POINTER TO NEXT PROG. NAME
3704         HRRZS W         ;SO WE ONLY HAVE THE HALF WE WANT
3705 PRMAP7: JUMPL C,PRMP7A
3706 IFN REENT,<SKIPN 1(B)           ;IS IT A ZERO SYMBOL
3707         JRST    [MOVE   C,B     ;SET UP C
3708                 JRST    PRMAP2] ;AND GO
3709         HRRZ    T,HVAL  ;GET TO OF HI PART
3710         CAML    W,HVAL1 ;IS PROGRAM START UP THERE??
3711         JRST    PRMAP6  ;YES
3712         HRRZ    T,HILOW ;GET HIGHEST LOCATION LOADED IN LOW
3713         SUBI    T,(X)   ;REMOVE OFFSET
3714         CAIE    T,(W)   ;EQUAL IF ZERO LENGTH PROG>
3715         HRRZ T,R        ;GET LOW, HERE ON LAST PROG
3716         JRST PRMAP6     ;GO
3717
3718 PRMP7A: ADDI C,2(A)     ;POINTER TO NEXT PROGRAM NAME
3719 PRMAP2: IFN REENT,<
3720         SKIPE   1(C)    ;THIS IS A TWO SEG  FILE
3721         JRST    PRMP2A  ;NO
3722         MOVE    T,2(C)  ;GET PROG BREAKS
3723         TLNN    T,-1            ;IF NO HIGH STUFF YET
3724         HLL     T,SVBRKS        ;FAKE IT
3725         SUB     T,SVBRKS        ;SUBTRACT LAST  BREAKS
3726         HRRZ    W,T     ;LOW BREAK
3727         PUSH    P,W     ;SAVE IT
3728         JUMPGE  T,.+2   ;IF NEGATIVE
3729         TDZA    W,W     ;MAKE ZERO (FIRST TIME THRU)
3730         HLRZ    W,T     ;GET HIGH BREAK
3731         PUSHJ   P,PRNUM ;PRINT IT
3732         PUSHJ   P,TAB   ;AND TAB
3733         POP     P,W     ;LOW BREAK
3734         PUSHJ   P,PRNUM
3735         MOVE    T,2(C)
3736         CAMN    C,B             ;EQUAL IF LAST PROG
3737         SETZ    C,              ;SIGNAL END
3738         TLNN    T,-1
3739         HLL     T,SVBRKS
3740         CAMN    T,SVBRKS        ;ZERO LENGTT IF EQUAL
3741         JRST    PRMP6A          ;SEE IF LIST ALL ON
3742         MOVEM   T,SVBRKS        ;SAVE FOR NEXT TIME
3743         JRST    PRMAP3  ;AND CONTINUE
3744 PRMP2A:>
3745         HRRZ T,(C)      ;GET ITS STARTING ADRESS
3746 IFN REENT,<CAMGE W,HVAL1        ;MAKE SURE BOTH IN SAME SEGMENT
3747         CAMGE T,HVAL1
3748         CAMGE T,W
3749         JRST    [HLRE T,(C)     ;NO TRY NEXT ONE DOWN
3750                 JUMPE T,@PRMAP7 ;END GO USE PROG BREAK
3751                 ADDI C,(T)
3752                 JRST PRMAP2]    ;CHECK THIS ONE>
3753 PRMAP6: SUBM    T,W             ;SUBTRACT ORIGIN TO GET LENGTH
3754         PUSHJ     P,PRNUM               ;PRINT PROGRAM LENGTH
3755         PUSHJ     P,CRLF
3756 PRMP6A: TLNN    N,ALLFLG                ;SKIP IF LIST ALL MODE IS ON
3757         TRNE    W,777777                ;SKIP IF ZERO LENGTH PROGRAM
3758         JRST    PRMAP3
3759         HLRE    C,2(A)          ;GET BACK CORRECT LOCATION IF 0 LENGTH
3760         JUMPE   C,PRMAP5        ;JUMP IF LAST PROGRAM
3761         ADDI    C,2(A)          ;IN CASE WE SKIPPED SOME PROGRAMS
3762         SKIPA   A,C             ;SKIP GLOBALS, ZERO LENGTH PROG.
3763 PRMAP3:   PUSHJ     P,CRLF
3764 PRMAP4:   CAILE     A,(B)               ;TEST FOR END OF SYMBOL TABLE
3765         JRST    PRMAP1
3766 PRMAP5: PUSHJ   P,CRLF  ;GIVE AN XTRA CR-LF
3767
3768
3769
3770 \fSUBTTL LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS
3771
3772         PUSHJ   P,PMS1          ;PRINT UNDEFINED SYMBOLS
3773
3774 ;LIST NUMBER OF MULTIPLY DEFINED GLOBALS
3775
3776 PMS3:   SKIPN   W,MDG           ;ANY MULTIPLY DEFINED GLOBALS
3777         JRST    PMS4            ;NO, EXCELSIOR
3778         PUSHJ   P,FCRLF         ;ROOM AT THE TOP
3779         PUSHJ   P,PRQ           ;PRINT ?
3780         PUSHJ   P,PRNUM0        ;NUMBER OF MULTIPLES
3781         ERROR   7,<?MULTIPLY DEFINED GLOBALS@?>
3782 PMS4:   TLNE    N,AUXSWE        ;AUXILIARY OUTPUT DEVICE?
3783         OUTPUT  2,              ;INSURE A COMPLETE BUFFER
3784         POPJ    P,              ;RETURN
3785
3786 ;LIST UNDEFINED GLOBALS
3787
3788 PMS1:   PUSHJ   P,FSCN1         ;LOAD FILES FIRST
3789         JUMPGE  S,CPOPJ         ;JUMP IF NO UNDEFINED GLOBALS
3790         PUSHJ   P,FCRLF         ;START THE MESSAGE
3791         HLRE    W,S             ;COMPUTE NO. OF UNDEF. GLOBALS
3792         MOVMS     W
3793         LSH     W,-1            ;<LENGTH OF LIST>/2
3794         PUSHJ     P,PRNUM0
3795         ERROR   7,</UNDEFINED GLOBALS@/>
3796         MOVE    A,S             ;LOAD UNDEF. POINTER
3797 PMS2:   SKIPL W,1(A)
3798         TLNN W,40000
3799         JRST PMS2A
3800         PUSHJ     P,FCRLF
3801         PUSHJ     P,PRNAM0              ;PRINT SYMBOL AND POINTER
3802 PMS2A:  ADD     A,SE3
3803         JUMPL   A,PMS2
3804 CPOPJ:  POPJ    P,
3805
3806 PMS:    PUSHJ   P,PMS1  ;PRINT UNDEFINED SYMBOLS
3807         JUMPGE  S,CPOPJ         ;NO UNDEFINED SYMBOLS
3808         PUSHJ   P,CRLF          ;NEW LINE,MAKE ? VISIBLE
3809         PUSHJ   P,PRQ           ;FIX FOR BATCH TO PRINT ALL SYMBOLS
3810         JRST    CRLF            ;SPACE AFTER LISTING
3811
3812
3813 \fSUBTTL ENTER FILE ON AUXILIARY OUTPUT DEVICE
3814
3815 IAD2:   PUSH    P,A             ;SAVE A FOR RETURN
3816         MOVE    A,LD5C1         ;GET AUX. DEV.
3817         DEVCHR  A,              ;GET DEVCHR
3818         TLNN    A,4             ;DOES IT HAVE A DIRECTORY
3819         JRST    IAD2A           ;NO SO JUST RETURN
3820         MOVE    A,DTOUT         ;GET OUTPUT NAME
3821         CAME    A,[SIXBIT /JOBDAT/] ;DON'T USE JOBDAT
3822         JUMPN   A,IAD2A         ;USE ANYTHING NON-ZERO
3823         MOVSI   A,(SIXBIT /DSK/) ;DEFAULT DEVICE
3824         CAMN    A,LD5C1         ;IS IT AUX. DEV.
3825         JRST    .+5             ;YES LEAVE WELL ALONE
3826         CLOSE   2,              ;CLOSE OLD AUX. DEV.
3827         MOVEM   A,LD5C1         ;SET IT TO DSK
3828         OPEN    2,OPEN2         ;OPEN IT FOR DSK
3829         JRST    IMD4            ;FAILED
3830 IFN NAMESW,<    SKIPN   A,CURNAM        ;USE PROG NAME>
3831         MOVSI   A,(SIXBIT /MAP/)        ;AN UNLIKELY NAME
3832         MOVEM   A,DTOUT         ;SO ENTER WILL NOT FAIL
3833 IAD2A:  POP     P,A             ;RECOVER A
3834         SETZM   DTOUT+2         ;CLEAR PROTECTION (LEVEL D)
3835         ENTER   2,DTOUT         ;WRITE FILE NAME IN DIRECTORY
3836         JRST    IMD3            ;NO MORE DIRECTORY SPACE
3837         POPJ    P,
3838
3839 IMD3:   ERROR   ,</DIR. FULL@/>
3840         JRST    LD2
3841
3842 IMD4:   MOVE    P,[XWD -40,PDLST]       ;RESTORE STACK
3843         TLZ     N,AUXSWE!AUXSWI ;NO AUX.DEV.NOW
3844         ERROR   ,</NO MAP DEVICE@/>
3845         JRST    PRMAP5          ;CONTINUE TO LOAD
3846
3847
3848
3849 \fSUBTTL PRINT SUBROUTINES
3850
3851 ;PRINT THE 6 DIGIT OCTAL ADDRESS IN W
3852
3853 ;       ACCUMULATORS USED: D,T,V
3854
3855 PRNAM0:   MOVE  C,1(A)          ;LOAD SYMBOL
3856 PRNAM1:   MOVE  W,2(A)          ;LOAD VALUE
3857 PRNAM:  PUSHJ     P,PRNAME
3858 PRNUM:
3859         TRNN    F,TTYFL
3860         PUSHJ   P,SP1
3861         PUSHJ   P,SP1
3862 PRNUM0:   MOVE  V,PRNUM2                ;LOAD BYTE POINTER TO RH. OF W
3863         MOVNI     D,6           ;LOAD CHAR. COUNT
3864 PRNUM1:   ILDB  T,V             ;LOAD DIGIT TO BE OUTPUT
3865         ADDI    T,60            ;CONVERT FROM BINARY TO ASCII
3866         PUSHJ     P,TYPE2
3867         AOJL    D,PRNUM1                ;JUMP IF MORE DIGITS REMAIN
3868         POPJ    P,
3869
3870 PRNUM2:   XWD   220300,W
3871
3872
3873
3874 \f
3875 IFN NAMESW,<
3876 LDNAM:  MOVE T,[POINT 6,CURNAM] ;POINTER
3877         MOVNI D,6       ;SET COUNT
3878         TLZ W,740000    ;REMOVE CODE BITS
3879 SETNAM: IDIVI W,50      ;CONVERT FROM RAD 50
3880         HRLM C,(P)
3881         AOJGE D,.+2
3882         PUSHJ P,SETNAM
3883         HLRZ C,(P)
3884         JUMPE C,INAM
3885         ADDI C,17
3886         CAILE C,31
3887         ADDI C,7
3888         CAIG C,72       ;REMOVE SPECIAL  CHARS. (. $ %)
3889         IDPB C,T
3890 INAM:   POPJ P, >
3891
3892
3893 ;YE OLDE RECURSIVE NUMBER PRINTER
3894 ;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T
3895
3896 RCNUM:  IDIVI Q,12              ;RADIX DECIMAL
3897         ADDI A,"0"
3898         HRLM A,(P)
3899         JUMPE Q,.+2
3900         PUSHJ P,RCNUM
3901         HLRZ T,(P)
3902         JRST TYPE2
3903
3904
3905 SPACES: PUSHJ   P,SP1
3906 SP1:    PUSHJ   P,SPACE
3907 SPACE:  MOVEI   T,40
3908         JRST    TYPE2
3909
3910
3911 \f;      ACCUMULATORS USED: Q,T,D
3912
3913 PWORD:  MOVNI   Q,6             ;SET CHARACTER COUNT TO SIX
3914 PWORD1: MOVE    D,LSTPT         ;ENTER HERE WITH Q PRESET
3915 PWORD2: ILDB    T,D             ;LOAD NEXT CHAR. TO BE OUTPUT
3916         PUSHJ     P,TYPE                ;OUTPUT CHARACTER
3917         AOJL    Q,PWORD2
3918         POPJ    P,
3919
3920
3921 ;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII
3922 ;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT
3923 ;DEVICE
3924
3925 CRLFLF: PUSHJ   P,CRLF
3926 FCRLF:  TLO     F,FCONSW        ;INSURE TTY OUTPUT
3927 CRLF:   MOVEI   T,15            ;CARRIAGE RETURN LINE FEED
3928         PUSHJ   P,TYPE2
3929         TRCA    T,7             ;CR.XOR.7=LF
3930 TYPE:   MOVEI   T,40(T)         ;CONVERT SIXBIT TO ASCII
3931 TYPE2:  TLNN    N,AUXSWI        ;IS THER AN AUXILIARY DEVICE?
3932         JRST    TYPE3           ;NO, DONT OUTPUT TO IT
3933         TLON    N,AUXSWE        ;IS AUX. DEV. ENTERED?
3934         PUSHJ   P,IAD2          ;NOPE, DO SO!
3935         SOSG    ABUF2           ;SPACE LEFT IN BUFFER?
3936         OUTPUT  2,              ;CREATE A NEW BUFFER
3937         IDPB    T,ABUF1         ;DEPOSIT CHARACTER
3938         TLNN    F,FCONSW        ;FORCE OUTPUT TO CONSOLE TOO?
3939         POPJ    P,              ;NOPE
3940 TYPE3:  IFN RPGSW,<
3941         TRNE    F,NOTTTY        ;IF TTY IS ANOTHER DEVICE
3942         POPJ    P,              ;DON'T OUTPUT TO IT>
3943         SKIPN   BUFO2           ;END OF BUFFER
3944         OUTPUT  3,              ;FORCE OUTPUT NOW
3945         IDPB    T,BUFO1         ;DEPOSIT CHARACTER
3946         CAIN    T,12            ;END OF LINE
3947         OUTPUT  3,              ;FORCE AN OUTPUT
3948         POPJ    P,
3949
3950
3951 \fSUBTTL SYMBOL PRINT - RADIX 50
3952
3953 ;       ACCUMULATORS USED: D,T
3954
3955 PRNAME: MOVE    T,C             ;LOAD SYMBOL
3956         TLZ     T,740000        ;ZERO CODE BITS
3957         PUSH    P,T
3958         PUSH    P,C
3959         MOVEI   C,6
3960         MOVEI   D,1
3961         IDIVI   T,50
3962         JUMPN   V,.+2
3963         IMULI   D,50
3964         SOJN    C,.-3
3965         POP     P,C
3966         POP     P,T
3967         IMUL    T,D
3968         MOVNI   D,6             ;LOAD CHAR. COUNT
3969 SPT:    IDIVI   T,50            ;THE REMAINDER IS THE NEXT CHAR.
3970         HRLM    V,(P)           ;STORE IN LH. OF PUSHDOWN LIST
3971         AOJGE   D,.+2           ;SKIP IF NO CHARS. REMAIN
3972         PUSHJ   P,SPT           ;RECURSIVE CALL FOR NEXT CHAR.
3973         HLRZ    T,(P)           ;LOAD FROM LH. OF PUSHDOWN LIST
3974         JUMPE   T,TYPE          ;BLANK
3975         ADDI    T,60-1
3976         CAILE   T,71
3977         ADDI    T,101-72
3978         CAILE   T,132
3979         SUBI    T,134-44
3980         CAIN    T,43
3981         MOVEI   T,56
3982         JRST    TYPE2
3983
3984 TAB1:   SETZM   TABCNT
3985         PUSHJ   P,CRLF
3986 TAB:    AOS     T,TABCNT
3987         CAIN    T,5
3988         JRST    TAB1
3989         TRNE    F,TTYFL
3990         JRST    SP1
3991         MOVEI   T,11
3992         JRST    TYPE2
3993
3994
3995
3996 \f
3997 OTOD:   IBP     N
3998 OTOD1:  IDIVI   Q,↑D10
3999         ADDI    Q,20            ;FORM SIXBIT
4000         IDPB    Q,N
4001         ADDI    A,20
4002         IDPB    A,N
4003         POPJ    P,
4004
4005 DTAB:   SIXBIT  /JANFEB/
4006         SIXBIT  /MARAPR/
4007         SIXBIT  /MAYJUN/
4008         SIXBIT  /JULAUG/
4009         SIXBIT  /SEPOCT/
4010         SIXBIT  /NOVDEC/
4011
4012
4013
4014 \fSUBTTL ERROR MESSAGE PRINT SUBROUTINE
4015
4016 ;       FORM OF CALL:
4017
4018 ;       JSP     A,ERRPT
4019 ;       SIXBIT    /<MESSAGE>/
4020
4021 ;       ACCUMULATORS USED: T,V,C,W
4022
4023 ERRPT:  TLO     F,FCONSW        ;INSURE TTY OUTPUT
4024         PUSHJ   P,CRLF          ;ROOM AT THE TOP
4025         PUSHJ   P,PRQ           ;START OFF WITH ?
4026 ERRPT0: PUSH    P,Q             ;SAVE Q
4027         SKIPA   V,ERRPT5
4028 ERRPT1: PUSHJ   P,TYPE
4029         ILDB    T,V
4030         CAIN    T,"@"-40
4031         JRST    ERRPT4
4032         CAIN    T,"%"-40
4033         JRST    ERRPT9
4034         CAIN    T,"!"-40
4035         JRST    ERRP42          ;JUST RETURN,LEAVE FCONSW ON
4036         CAIE    T,"#"-40
4037         JRST    ERRPT1
4038         SKIPN   C,DTIN
4039         JRST    ERRPT4
4040         MOVNI   Q,14
4041         MOVEI   W,77
4042 ERRPT2: TDNE    C,W
4043         JRST    ERRPT3
4044         LSH     W,6
4045         AOJL    Q,ERRPT2
4046 ERRPT3: MOVE    W,ERRPT6
4047         PUSHJ   P,PWORD1
4048         SKIPN   W,DTIN1
4049         JRST    ERRPT4
4050         LSH     W,-6
4051         TLO     W,160000
4052         MOVNI   Q,4
4053         PUSHJ   P,PWORD1
4054 ERRPT4: PUSHJ   P,CRLF
4055 ERRP41: TLZ     F,FCONSW        ;ONE ERROR PER CONSOLE
4056 ERRP42: POP     P,Q             ;***DMN*** FIX FOR ILC MESSAGE
4057         AOJ     V,              ;PROGRAM BUMMERS BEWARE:
4058         JRST    @V              ;V HAS AN INDEX OF A
4059
4060 ERRPT5: POINT     6,0(A)
4061 ERRPT6: SIXBIT    / FILE /
4062
4063
4064 \fERRPT8:        TLO     F,FCONSW        ;INSURE TTY OUTPUT
4065         PUSHJ   P,PRQ           ;START WITH ?
4066         CAIGE   T,140           ;IS IT A NON-PRINTING CHAR?
4067         CAIL    T,40
4068         JRST    ERRP8
4069         PUSH    P,T
4070         MOVEI     T,136         ;UP ARROW
4071         PUSHJ     P,TYPE2
4072         POP     P,T
4073         TRC     T,100           ;CONVERT TO PRINTING CHAR.
4074 ERRP8:  PUSHJ     P,TYPE2
4075 ERRPT7:   PUSHJ     P,SPACE
4076         JRST    ERRPT0
4077
4078 ERRPT9: MOVEI   V,@V
4079         PUSH    P,V
4080         ERROR   7,<?ILLEGAL -LOADER@?>
4081         POP     P,V
4082         JRST    ERRP41
4083
4084 ;PRINT QUESTION MARK
4085
4086 PRQ:    PUSH    P,T             ;SAVE
4087         MOVEI   T,"?"           ;PRINT ?
4088         PUSHJ   P,TYPE2         ;...
4089         POP     P,T             ;RESTORE
4090         POPJ    P,              ;RETURN
4091
4092
4093 \fSUBTTL INPUT - OUTPUT INTERFACE
4094
4095 ;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W
4096 IFE K,<
4097 WORDPR: PUSHJ   P,WORD          ;GET FIRST WORD OF PAIR
4098         MOVE    C,W             ;KEEP IT HANDY>
4099 WORD:   SOSGE   BUFR2           ;SKIP IF BUFFER NOT EMPTY
4100         JRST    WORD2
4101 WORD1:  ILDB    W,BUFR1         ;PICK UP 36 BIT WORD
4102         POPJ    P,
4103
4104 WORD2:  IN      1,              ;GET NEXT BUFFER LOAD
4105         JRST    WORD            ;DATA OK - CONTINUE LOADING
4106 WORD3:  STATZ   1,IODEND        ;TEST FOR EOF
4107         JRST    EOF             ;END OF FILE EXIT
4108         ERROR   ,< /INPUT ERROR#/>
4109         JRST    LD2             ;GO TO ERROR RETURN
4110
4111
4112 SE3:    XWD     2,2             ;SYMBOL POINTER INCREMENT
4113 PDLPT:  XWD     -41,PDLST-1;    INITIAL PUSHDOWN POINTER
4114 COMM:   SQUOZE    0,.COMM.
4115 LSTPT:  POINT   6,W             ;CHARACTER POINTER TO W
4116
4117 IOBKTL==40000
4118 IOIMPM==400000
4119 IODERR==200000
4120 IODTER==100000
4121 IODEND==20000
4122
4123 IOBAD==IODERR!IODTER!IOBKTL!IOIMPM
4124
4125
4126
4127 \fSUBTTL IMPURE CODE
4128 IFN SEG2SW,<    RELOC
4129 LOWCOD: RELOC>
4130 IFN PURESW,<HICODE:
4131 IFN SEG2SW,<    PHASE LOWCOD>
4132 IFE SEG2SW,<    PHASE   140>>
4133
4134
4135 DBUF1:  JSP     A,ERRPT7
4136 DBUF:   SIXBIT  /TI:ME DY-MON-YR @/
4137         POPJ    P,
4138
4139 ;DATA FOR PURE OPEN UUO'S
4140
4141 IFN SPCHN,<
4142 CHNENT: 0
4143         SIXBIT .CHN.
4144         0
4145         0
4146 CHNOUT: 17
4147         SIXBIT /DSK/
4148         0
4149 >
4150 IFN RPGSW,<
4151 OPEN1:  EXP     1
4152 RPG1:   Z
4153         XWD     0,CTLIN
4154 >
4155
4156 OPEN2:  EXP     1
4157 LD5C1:  Z
4158         XWD     ABUF,0
4159
4160 OPEN3:  EXP     14
4161 ILD1:   Z
4162         XWD     0,BUFR
4163
4164 IFN PURESW,<DEPHASE
4165 CODLN=.-HICODE>
4166
4167
4168 \fSUBTTL DATA STORAGE
4169
4170 IFN PURESW,<
4171 IFE SEG2SW,<LOC 140>
4172 IFN SEG2SW,<RELOC>
4173 LOWCOD: BLOCK CODLN>
4174
4175 PDSAV:  BLOCK 1                 ;SAVED PUSHDOWN POINTER
4176 COMSAV: BLOCK 1                 ;LENGTH OF COMMON
4177 MDG:    BLOCK 1                 ;COUNTER FOR MUL DEF GLOBALS
4178 PDLST:  BLOCK   40
4179
4180 F.C:    BLOCK 1
4181         BLOCK 1 ;STORE N HERE
4182         BLOCK 1 ;STORE X HERE
4183         BLOCK 1 ;STORE H HERE
4184         BLOCK 1 ;STORE S HERE
4185         BLOCK 1 ;STORE R HERE
4186 B.C:    BLOCK 1
4187
4188 STADDR: BLOCK 1 ;HOLDS STARTING ADDRESS
4189
4190 IFN NAMESW,<
4191 PRGNAM: BLOCK 1 ;STORE BINARY FILE NAME-USED TO MAKE SYSTAT MORE MEANINGFUL
4192 >
4193 IFN REENT,<
4194 HIGHX:  BLOCK 1
4195 HIGHR:  BLOCK 1 ;HOLD X AND R WHILE LOADING LOW SEG PIECES
4196 LOWX:   BLOCK 1
4197 HILOW:  BLOCK 1 ;HIGHEST NON-BLOCK STMT IN LOW SEG
4198 HVAL:   BLOCK 1 ;ORG OF HIGH SEG>
4199 HVAL1:  BLOCK 1 ;ACTUAL ORG OF HIGH SEG
4200 LOWR:   BLOCK 1 ;HOLD X AND R WHILE LOADING HISEG PIECES
4201 IFN KUTSW,<CORSZ:       BLOCK 1>
4202 IFN DMNSW,<KORSP:       BLOCK 1>
4203 IFN LDAC,<BOTACS:       BLOCK 1>
4204 IFN WFWSW,<VARLNG:      BLOCK 1
4205 VARREL: BLOCK 1>
4206 IFN SAILSW,<LIBFLS:     BLOCK   RELLEN*3
4207 PRGFLS: BLOCK   RELLEN*3>
4208
4209
4210 \fPT1:   BLOCK 1
4211 SVA:    BLOCK 1
4212 IFN RPGSW,<
4213 NONLOD: BLOCK 1
4214 SVRPG:  BLOCK 1
4215 IFN TEMP,<
4216 TMPFIL: BLOCK 2
4217 TMPFLG: BLOCK 1>
4218 >
4219 IFN  NAMESW,<
4220 CURNAM: BLOCK 1
4221 >
4222 IFN PP,<
4223 OLDDEV: BLOCK 1
4224 PPN:    BLOCK 1
4225 PPNE:   BLOCK 1
4226 PPNV:   BLOCK 1
4227 PPNW:   BLOCK 1
4228         >
4229 IFN FAILSW,<
4230 GLBCNT: BLOCK 1
4231 HDSAV:  BLOCK 1
4232 HEADNM: BLOCK 1
4233 LFTHSW: BLOCK 1
4234 OPNUM:  BLOCK 1
4235 POLSW:  BLOCK 1
4236 SVHWD:  BLOCK 1
4237 SVSAT:  BLOCK 1
4238 PPDB:   BLOCK PPDL+1
4239 LINKTB: BLOCK 21
4240 >
4241 HISTRT: BLOCK 1 ;JOBREL AT START OF LOADING
4242 IFN L,<
4243 LSPXIT: BLOCK 1
4244 RINITL: BLOCK 1
4245 OLDJR:  BLOCK 1>
4246 IFN SPCHN,<
4247 CHNTAB: BLOCK 1
4248 BEGOV:  BLOCK 1
4249 CHNACN: BLOCK 1
4250 CHNACB: BLOCK 1>
4251 TABCNT: BLOCK 1
4252 LIMBO:  BLOCK   1       ;WHERE OLD CHARS. ARE STORED
4253 IFN DIDAL,<LSTBLK:      BLOCK   1       ;POINTER TO LAST PROG LOADED>
4254 IFN EXPAND,<ALWCOR:     BLOCK   1       ;CORE AVAILABLE TO USER>
4255 IFN ALGSW,<%OWN: BLOCK  1       ;ADDRESS OF ALGOL OWN AREA
4256         OWNLNG: BLOCK   1       ;LENGTH OF OWN BLOCK>
4257 IFN REENT,<SVBRKS:      BLOCK   1       ;XWD HIGH,LOW (PROG BREAKS)>
4258
4259
4260 \fSUBTTL BUFFER HEADERS AND HEADER HEADERS
4261
4262 BUFO:   BLOCK 1                 ;CONSOLE INPUT HEADER HEADER
4263 BUFO1:  BLOCK 1
4264 BUFO2:  BLOCK 1
4265
4266 BUFI:   BLOCK 1                 ;CONSOLE OUTPUT HEADER HEADER
4267 BUFI1:  BLOCK 1
4268 BUFI2:  BLOCK 1
4269
4270 ABUF:   BLOCK 1                 ;AUXILIARY OUTPUT HEADER HEADER
4271 ABUF1:  BLOCK 1
4272 ABUF2:  BLOCK 1
4273
4274 BUFR:   BLOCK 1                 ;BINARY INPUT HEADER HEADER
4275 BUFR1:  BLOCK 1
4276 BUFR2:  BLOCK 1
4277
4278 DTIN:   BLOCK 1                 ;DECTAPE INPUT BLOCK
4279 DTIN1:  BLOCK 3
4280
4281 DTOUT:  BLOCK 1                 ;DECTAPE OUTPUT BLOCK
4282 DTOUT1: BLOCK 3
4283
4284         TTYL==52                        ;TWO TTY BUFFERS
4285 IFN STANSW,< TTYL==70   ;;;STANFORD, JUST TO BE DIFFERENT, HAS BIG TTY BFRS>
4286
4287 IFE LNSSW,<
4288 IFE K,< BUFL==406               ;TWO DTA BUFFERS FOR LOAD>
4289 IFN K,< BUFL==203               ;ONE DTA BUFFER FOR LOAD>
4290         ABUFL==203              ;ONE DTA BUFFER FOR AUX DEV>
4291 IFN LNSSW,<
4292 IFE K,<BUFL==4*203+1>
4293 IFN K,<BUFL==203+1>
4294 ABUFL==2*203+1>
4295
4296 TTY1:   BLOCK   TTYL            ;TTY BUFFER AREA
4297 BUF1:   BLOCK   BUFL            ;LOAD BUFFER AREA
4298 AUX:    BLOCK   ABUFL           ;AUX BUFFER AREA
4299
4300
4301 IFN RPGSW,<
4302 CTLIN:  BLOCK 3
4303 CTLNAM: BLOCK 3
4304 CTLBUF: BLOCK 203+1
4305 >
4306
4307
4308 \fSUBTTL FORTRAN DATA STORAGE
4309
4310 IFN STANSW,<PATCH:      BLOCK   20              ;STANFORD HAS SEMI-INFINITE CORE>
4311
4312 IFE K,<
4313 TOPTAB: BLOCK 1 ;TOP OF TABLES
4314 CTAB:   BLOCK 1;        COMMON
4315 ATAB:   BLOCK 1;        ARRAYS
4316 STAB:   BLOCK 1;        SCALARS
4317 GSTAB:  BLOCK 1;        GLOBAL SUBPROGS
4318 AOTAB:  BLOCK 1;        OFFSET ARRAYS
4319 CCON:   BLOCK 1;        CONSTANTS
4320 PTEMP:  BLOCK 1;        PERMANENT TEMPS
4321 TTEMP:  BLOCK 1;        TEMPORARY TEMPS
4322 COMBAS: BLOCK 1;        BASE OF COMMON
4323 LLC:    BLOCK 1;        PROGRAM ORIGIN
4324 BITP:   BLOCK 1;        BIT POINTER
4325 BITC:   BLOCK 1;        BIT COUNT
4326 PLTP:   BLOCK 1;        PROGRAMMER LABEL TABLE
4327 MLTP:   BLOCK 1;        MADE LABEL TABLE
4328 SDS:    BLOCK 1 ;START OF DATA STATEMENTS
4329 SDSTP:  BLOCK 1 ;START OF DATA STATEMENTS POINTER
4330 BLKSIZ: BLOCK 1;        BLOCK SIZE
4331 MODIF:  BLOCK 1;        ADDRESS MODIFICATION +1
4332 SVFORH: BLOCK 1 ;SAVE H WHILE LOADING F4 PROGRAMS
4333
4334 IOWDPP: BLOCK 2>
4335 SBRNAM: BLOCK 1
4336
4337 IFE K,<
4338 CT1:    BLOCK 1         ;TEMP FOR C
4339 LTC:    BLOCK 1
4340 ITC:    BLOCK 1
4341 ENC:    BLOCK 1
4342 WCNT:   BLOCK 1         ;DATA WORD COUNT
4343 RCNT:   BLOCK 1         ;DATA REPEAT COUNT
4344
4345 LTCTEM: BLOCK 1         ;TEMP FOR LTC
4346 DWCT:   BLOCK 1         ;DATA WORD COUNT>
4347
4348         VAR     ;DUMP VARIABLES
4349 IFN PURESW,<RELOC>
4350
4351
4352
4353 \fSUBTTL REMAP UUO
4354 IFN REENT,<
4355 IFN PURESW,<HHIGO:      PHASE   BUF1    ;DON'T NEED BUF1 NOW>
4356
4357 HIGO:   CORE    V,              ;CORE UUO
4358         JFCL                    ;NEVER FAILS
4359 HINOGO: MOVE    D,HVAL
4360         CAMG    D,HVAL1         ;ANYTHING IN HI-SEG
4361         JRST    0               ;NO
4362         MOVE    V,HISTRT        ;NOW REMAP THE HISEG.
4363         REMAP   V,              ;REMAP UUO.
4364         JRST    HIGET           ;FATAL ERROR.
4365 HIRET:  JRST    0               ;EXECUTE CODE IN ACC'S
4366
4367 HIGET:  HRRZI   V,SEGBLK        ;DATA FOR
4368         GETSEG  V,              ;GETSEG UUO
4369         SKIPA                   ;CANNOT CONTINUE NO HISEG
4370         JRST    REMPFL          ;REGAINED LOADER HISEG
4371                                 ;GO PRINT MESSAGE
4372         TTCALL  3,SEGMES        ;PRINT SEGMES
4373         EXIT                    ;AND DIE
4374
4375 SEGBLK: SIXBIT  /SYS/
4376         SIXBIT  /LOADER/
4377         EXP     0,0,0,0
4378
4379
4380 SEGMES: ASCIZ   /?CANNOT FIND LOADER.SHR
4381 /
4382
4383 IFN PURESW,<HIGONE:     DEPHASE>>
4384
4385
4386 \fSUBTTL LISP LOADER
4387
4388 ;END HERE IF 1K LOADER REQUESTED.
4389 IFN K,<IFE L,<END BEG>
4390 IFE L,< XLIST   >
4391
4392 IFN L,<    LIT
4393                 VAR
4394         LODMAK: MOVEI A,LODMAK
4395         MOVEM A,137
4396         INIT 17
4397         SIXBIT /DSK/
4398         0
4399         HALT
4400         ENTER LMFILE
4401         HALT
4402         OUTPUT [IOWD 1,LMLST    ;OUTPUT LENGTH OF FILE
4403                 0]
4404         OUTPUT LMLST
4405         STATZ 740000
4406         HALT
4407         RELEASE
4408         CALL [SIXBIT /EXIT/]
4409
4410 LMFILE: SIXBIT /LISP/
4411         SIXBIT /LOD/
4412         0
4413         0
4414
4415 LMLST:  IOWD LODMAK+1-LD,137
4416         0
4417
4418         END LODMAK>>
4419
4420
4421         LIST
4422
4423
4424 \fSUBTTL  FORTRAN FOUR LOADER
4425
4426 F4LD:   TLNE    F,SKIPSW!FULLSW ;ARE WE IN SKIP MODE
4427         JRST    REJECT          ;YES,DON'T LOAD ANY OF THIS
4428         MOVEI   W,-2(S);        GENERATE TABLES
4429         CAIG    W,(H)           ;NEED TO EXPAND?
4430 IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
4431                 TLOA    F,FULLSW
4432                 JRST    POPJM3
4433                 POPJ    P,]>
4434 IFE EXPAND,<    TLO     F,FULLSW>
4435 ;IFN REENT,<TRO F,F4FL!VFLG     ;RE-ENTRANT LIB40>
4436         TLO     N,F4SW;         SET FORTRAN FOUR FLAG
4437         HRRZ    V,R;            SET PROG BREAK INTO V
4438         MOVEM   V,LLC;          SAVE FIRST WORD ADDRESS
4439         HRRZM   W,MLTP;         MADE LABELS
4440         HRRZM   W,PLTP;         PROGRAMMER LABELS
4441         ADD     W,[POINT 1,1];  GENERATE BIT-BYTE POINTER
4442         MOVEM   W,BITP
4443         MOVEM   W,SDSTP;        FIRST DATA STATEMENT
4444         AOS     SDSTP;
4445         HRREI   W,-↑D36;      BITS PER WORDUM
4446         MOVEM   W,BITC;         BIT COUNT
4447         PUSHJ   P,BITWX         ;MAKE SURE OF ENOUGH SPACE
4448         MOVE    W,[JRST ALLOVE] ;LAST DATA STATEMENT
4449         MOVEM   W,(S)
4450
4451 TEXTR:  PUSHJ   P,WORD;         TEXT BY DEFAULT
4452         HLRZ    C,W
4453         CAIN    C,-1
4454         JRST    HEADER;         HEADER
4455         MOVEI   C,1;            RELOCATABLE
4456         TLNN    F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
4457         PUSHJ   P,BITW;         SHOVE AND STORE
4458         JRST    TEXTR;          LOOP FOR NEXT WORD
4459
4460 ABS:    SOSG    BLKSIZ; MORE TO GET
4461         JRST    TEXTR;          NOPE
4462 ABSI:   PUSHJ   P,WORD;
4463         MOVEI   C,0;            NON-RELOCATABLE
4464         TLNN    F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
4465         PUSHJ   P,BITW;         TYPE 0
4466         JRST    ABS
4467
4468
4469 \fSUBTTL PROCESS TABLE ENTRIES
4470
4471 MDLB:   TLNE    F,FULLSW+SKIPSW;        MADE LABEL PROC
4472         JRST    GLOBDF;         NO ROOM AT THE IN
4473         HLRZ    C,MLTP;         GET PRESENT SIZE
4474         CAMGE   C,BLKSIZ;       IF NEW SIZE BIGGER, STR-R-RETCH
4475         PUSHJ   P,SMLT
4476         HRRZ    C,MLTP;         GET BASE
4477 MLPLC:  ADD     C,BLKSIZ;       MAKE INDEX
4478         TLNN    F,FULLSW+SKIPSW;        DONT LOAD
4479         HRRZM   V,(C);          PUT AWAY DEFINITION
4480 GLOBDF: PUSHJ   P,WORD
4481         TLNE    F,FULLSW+SKIPSW ;SKIPPING THIS PROG?
4482         JRST    TEXTR           ;YES, DON'T DEFINE
4483         MOVEI   C,(V);          AND LOC
4484         EXCH    W,C
4485         PUSHJ   P,SYMXX;        PUT IN DDT-SYMBOL TABLE
4486         PUSHJ   P,BITWX
4487         JRST    TEXTR
4488
4489 PLB:    TLNE    F,FULLSW+SKIPSW
4490         JRST    GLOBDF
4491         HLRZ    C,PLTP;         PRESENT SIZE
4492         CAMGE   C,BLKSIZ
4493         PUSHJ   P,SPLT
4494         HRRZ    C,PLTP
4495         JRST    MLPLC
4496
4497
4498 \fSUBTTL STORE WORD AND SET BIT TABLE
4499
4500 BITW:   MOVEM   W,@X;           STORE AWAY OFFSET
4501         IDPB    C,BITP;         STORE BIT
4502         AOSGE   BITC;           STEP BIT COUNT
4503         AOJA    V,BITWX;        SOME MORE ROOM LEFT
4504         HRREI   C,-↑D36;      RESET COUNT
4505         MOVEM   C,BITC
4506         SOS     PLTP
4507         SOS     BITP;           ALL UPDATED
4508 IFE EXPAND,<HRL C,MLTP
4509         SOS     MLTP
4510         HRR     C,MLTP>
4511 IFN EXPAND,<HRRZ        C,MLTP;         TO ADDRESS
4512         SUBI    C,1
4513         CAIG C,(H)
4514         PUSHJ P,[PUSHJ P,XPAND
4515                 POPJ P,
4516                 ADDI C,2000
4517                 JRST POPJM2]
4518         SOS     MLTP
4519         HRLI C,1(C)>
4520         HRRZ    T,SDSTP;        GET DATA POINTER
4521         BLT     C,-1(T);        MOVE DOWN LISTS
4522         AOJ     V,;             STEP LOADER LOCATION
4523 BITWX:  IFN REENT,<
4524         TLNE    F,HIPROG
4525         JRST    FORTHI>
4526         CAIGE H,@X
4527         MOVEI H,@X      ;KEEP H SET RIGHT FOR HISEG STUFF
4528 BITWX2: HRRZ    T,MLTP
4529         CAIG    T,(H);          OVERFLOW CHECK
4530 IFE EXPAND,<TLO F,FULLSW>
4531 IFN EXPAND,<PUSHJ P,    [PUSHJ P,XPAND
4532                         TLOA F,FULLSW
4533                         JRST POPJM3
4534                         POPJ P,]>
4535         POPJ    P,;
4536
4537 SMLT:   SUB     C,BLKSIZ;       STRETCH
4538         MOVS    W,MLTP          ;LEFT HALF HAS OLD BASE
4539         ADD     C,MLTP          ;RIGHT HALF HAS NEW BASE
4540 IFN EXPAND,<    HRRZS C ;GET RID OF COUNT
4541                 CAIG C,(H)
4542                 PUSHJ P,[PUSHJ P,XPAND
4543                         POPJ P,
4544                         ADD W,[XWD 2000,0]
4545                         ADDI C,2000
4546                         JRST POPJM2]>
4547         HRRM C,MLTP             ;PUT IN NEW MLTP
4548         HLL     C,W             ;FORM BLT POINTER
4549         ADDI    W,(C)           ;LAST ENTRY OF MLTP
4550         HRL     W,BLKSIZ        ;NEW SIZE OF MLTP
4551         HLLM    W,MLTP          ;...
4552 SLTC:   BLT     C,0(W);         MOVE DOWN (UP?)
4553         POPJ    P,;
4554
4555 SPLT:   SUB     C,BLKSIZ
4556         MOVS    W,MLTP;
4557         ADDM    C,PLTP
4558         ADD     C,MLTP
4559 IFN EXPAND,<    HRRZS C
4560                 CAIG C,(H)
4561                 PUSHJ P,[PUSHJ P,XPAND
4562                         POPJ P,
4563                         ADD W,[XWD 2000,0]
4564                         ADDI C,2000
4565                         JRST POPJM2]>
4566         HRRM C,MLTP             ;PUT IN NEW MLTP
4567         HLL     C,W
4568         HLRZ    W,PLTP          ;OLD SIZE OF PL TABLE
4569         ADD     W,PLTP          ;NEW BASE OF PL TABLE
4570         HRL     W,BLKSIZ        ;NEW SIZE OF PL TABLE
4571         HLLM    W,PLTP          ;INTO POINTER
4572         JRST    SLTC
4573
4574
4575 IFN REENT,<
4576 FORTHI: HRRZ T,JOBREL   ;CHECK FOR CORE OVERFLOW
4577         CAIGE T,@X
4578         PUSHJ   P,[PUSHJ P,HIEXP
4579                 TLOA F,FULLSW
4580                 JRST POPJM3     ;CHECK AGAIN
4581                 POPJ P,]
4582         JRST BITWX2>
4583
4584
4585 \fSUBTTL PROCESS END CODE WORD
4586
4587 ENDS:   PUSHJ   P,WORD;         GET STARTING ADDRESS
4588         JUMPE   W,ENDS1;        NOT MAIN
4589         ADDI    W,(R);          RELOCATION OFFSET
4590         TLNE    N,ISAFLG;       IGNORE STARTING ADDRESS
4591         JRST ENDS1
4592         HRRZM   W,STADDR        ;STORE STARTING ADDRESS
4593 IFN NAMESW,<MOVE W,1(N) ;SET UP NAME
4594         PUSHJ   P,LDNAM
4595         MOVE W,DTIN
4596         MOVEM W,PRGNAM>
4597 ENDS1:  PUSHJ   P,WORDPR        ;DATA STORE SIZE
4598         HRRZM   C,PTEMP         ;NUMBER OF PERMANENT TEMPS
4599         MOVEM   V,CCON;         START OF CONSTANTS AREA
4600         JUMPE   W,E1;           NULL
4601         MOVEM   W,BLKSIZ        ;SAVE COUNT
4602         MOVEI   W,0(V)          ;DEFINE CONST.
4603         MOVE    C,CNR50         ;...
4604         TLNN    F,SKIPSW!FULLSW
4605         PUSHJ   P,SYMPT         ;...
4606         PUSHJ   P,GSWD          ;STORE CONSTANT TABLE
4607 E1:     MOVEI   W,0(V);         GET LOADER LOC
4608         EXCH    W,PTEMP;        STORE INTO PERM TEMP POINTER
4609         ADD     W,PTEMP;        FORM TEMP TEMP ADDRESS
4610         MOVEM   W,TTEMP;        POINTER
4611         MOVEM   V,GSTAB;        STORE LOADER LOC IN GLOBSUB
4612         MOVEM H,SVFORH
4613         MOVE    C,TTR50         ;DEFINE %TEMP.
4614         TLNE    F,SKIPSW!FULLSW
4615         JRST    E1A
4616         PUSHJ   P,SYMPT         ;...
4617         MOVE    C,PTR50         ;DEFINE (IF EXTANT) TEMP.
4618         MOVEI   W,0(V)          ;...
4619         CAME    W,TTEMP         ;ANY PERM TEMPS?
4620         PUSHJ   P,SYMPT         ;YES, DEFINE
4621 E1A:    PUSHJ   P,WORD;         NUMBER OF GLOBSUBS
4622         JUMPE   W,E11
4623         MOVEM   W,BLKSIZ        ;SIZE OF GLOBSUB
4624         PUSHJ   P,GSWD          ;STORE GLOBSUB TABLE
4625 E11:    MOVEM   V,STAB;         SCALARS
4626         PUSHJ   P,WORD;         HOW MANY?
4627         JUMPE   W,E21;          NONE
4628         PUSHJ   P,GSWDPR        ;STORE SCALAR TABLE
4629 E21:    MOVEM   V,ATAB;         ARRAY POINTER
4630         PUSHJ   P,WORD;         COMMENTS FOR SCALARS APPLY
4631         JUMPE   W,E31
4632         PUSHJ   P,GSWDPR        ;STORE ARRAY TABLE
4633 E31:    MOVEM   V,AOTAB;        ARRAYS OFFSET
4634         PUSHJ   P,WORD;         SAME COMMENTS AS ABOVE
4635         JUMPE   W,E41
4636         PUSHJ   P,GSWDPR        ;STORE ARRAY OFFSET TABLE
4637 E41:    PUSHJ   P,WORD;         TEMP, SCALAR, ARRAY SIZE
4638         TLNE    F,FULLSW!SKIPSW ;SKIPPING THIS PROG?
4639         MOVEI   W,0             ;DON'T ACCEPT GLOB SUBPROG REQUESTS
4640         MOVEM   V,CTAB;         SETUP COMMON TABLE POINTER
4641         ADD     W,GSTAB;        GLOBAL SUBPROG BASE
4642         MOVEM   W,COMBAS;       START OF COMMON
4643         PUSHJ   P,WORD;         COMMON BLOCK SIZE
4644         HRRZM   W,BLKSIZ
4645         JUMPE   W,PASS2;        NO COMMON
4646 COMTOP: PUSHJ   P,WORDPR        ;GET A COMMON PAIR
4647         TLNE    F,SKIPSW!FULLSW ;IF SKIPPING
4648         JRST    COMCO1          ;DON'T USE
4649         PUSHJ   P,SDEF;         SEARCH
4650         JRST    COMYES;         ALREADY THERE
4651         HRLS    W
4652         HRR     W,COMBAS;       PICK UP THIS COMMON LOC
4653         TLNN    F,SKIPSW!FULLSW
4654         PUSHJ   P,SYMXX;        DEFINE IT
4655         MOVS    W,W;            SWAP HALFS
4656         ADD     W,COMBAS;       UPDATE COMMON LOC
4657         HRRM    W,COMBAS;       OLD BASE PLUS NEW SIZE
4658         HLRZS   W;              RETURN ADDRESS
4659         TLZ     C,400000
4660         TLNN F,SKIPSW!FULLSW
4661         PUSHJ   P,SYMXX
4662 COMCOM: PUSHJ   P,CWSTWX        ;STORE A WORD PAIR
4663 COMCO1: SOS     BLKSIZ
4664         SOSLE   BLKSIZ
4665         JRST    COMTOP
4666         JRST    PASS2
4667
4668 COMYES: HLRZ    C,2(A);         PICK UP DEFINITION
4669         CAMLE   W,C;            CHECK SIZE
4670         JRST    ILC;            ILLEGAL COMMON
4671         MOVE    C,1(A);         NAME
4672         HRRZ    W,2(A); BASE
4673         JRST    COMCOM
4674
4675
4676 \f
4677 PRSTWX: PUSHJ   P,WORDPR        ;GET A WORD PAIR
4678 CWSTWX: EXCH    C,W             ;SPACE TO STORE FIRST WORD OF PAIR?
4679         PUSHJ   P,WSTWX         ;...
4680         EXCH    C,W             ;THERE WAS; IT'S STORED
4681 WSTWX:  TLNE    F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD?
4682         POPJ    P,              ;NOPE, RETURN
4683         MOVEM   W,@X            ;YES, STORE IT.
4684         AOJA    V,BITWX         ;TELL THE TABLES ABOUT IT; THEN RETURN
4685
4686
4687 GSWD:   PUSHJ   P,WORD          ;GET WORD FROM TABLE
4688         PUSHJ   P,WSTWX         ;STASH IT
4689         SOSE    BLKSIZ          ;FINISHED?
4690         JRST    GSWD            ;NOPE, LOOP
4691         POPJ    P,              ;TRA 1,4
4692
4693 GSWDPR: MOVEM   W,BLKSIZ        ;KEEP COUNT
4694 GSWDP1: PUSHJ   P,PRSTWX        ;GET AND STASH A PAIR
4695         SOS     BLKSIZ          ;FINISHED?
4696         SOSLE   BLKSIZ          ;...
4697         JRST    GSWDP1          ;NOPE, LOOP
4698         POPJ    P,              ;TRA 1,4
4699
4700
4701 \fSUBTTL BEGIN HERE PASS2 TEXT PROCESSING
4702
4703 PASS2:  ADDI V,(X)
4704 IFN REENT,<TLNE F,HIPROG
4705         HRRZ V,H>
4706         MOVEM V,TOPTAB  ;SAVE FOR OVERLAP CHECKING
4707         TLNE    F,FULLSW+SKIPSW;        ABORT?
4708         JRST    ALLOVE;         YES
4709         MOVE    V,LLC           ;PICK UP PROGRAM ORIGIN
4710         CAML    V,CCON          ;IS THIS A PROGRAM?
4711         JRST    FBLKD           ;NO, GO LOOK FOR FIRST BLK DATA
4712         TLOE    N,PGM1          ;YES, IS THIS FIRST F4 PROG?
4713         JRST    NOPRG           ;NO
4714         HRR     W,COMBAS        ;YES, PLACE PROG BREAK IN LH
4715 IFE L,<IFN REENT,<TLNN F,HIPROG ;DON'T BOTHER IF IN HISEG, CHAIN NOT SMART ENOUGH>
4716         HRLM    W,JOBCHN(X)     ;FOR CHAIN>
4717 NOPRG:  HRRZ    W,PLTP;         GET PROG TABLE BASE
4718         HLRZ    C,PLTP;         AND SIZE
4719         ADD     W,C;            COMPUTE END OF PROG TABLE
4720         ADD     W,[POINT 1,1];  AND BEGINNING OF BIT TABLE
4721         EXCH    W,BITP;         SWAP POINTERS
4722 PASS2B: ILDB    C,BITP;         GET A BIT
4723         JUMPE   C,PASS2C;       NO PASS2 PROCESSING
4724         PUSHJ   P,PROC;         PROCESS A TAG
4725         JRST    PASS2B;         MORE TO COME
4726         JRST    ENDTP;
4727
4728 PROC:   LDB     C,[POINT 6,@X,23];      TAG
4729         SETZM   MODIF;          ZERO TO ADDRESS MODIFIER
4730         TRZE    C,40
4731         AOS     MODIF
4732         MOVEI   W,TABDIS;       HEAD OF TABLE
4733         HRLI W,-TABLNG  ;SET UP FOR AOBJN
4734         HLRZ    T,(W);          GET ENTRY
4735         CAME    T,C;            CHECK
4736         AOBJN W,.-2
4737         JUMPGE W,LOAD4A ;RAN OUT OF ENTRIES
4738         HRRZ    W,(W);          GET DISPATCH
4739         LDB     C,[POINT 12,@X,35]
4740         JRST    (W);            DISPATCH
4741
4742
4743 PASS2C: PUSHJ   P,PASS2A
4744         JRST    PASS2B
4745         JRST    ENDTP
4746
4747
4748 \f
4749 TABDIS: XWD 11,PCONS;           CONSTANTS
4750         XWD 06,PGS;             GLOBAL SUBPROGRAMS
4751         XWD 20,PST;             SCALARS
4752         XWD 22,PAT;             ARRAYS
4753         XWD 01,PATO;            ARRAYS OFFSET
4754         XWD 00,PPLT;            PROGRAMMER LABELS
4755         XWD 31,PMLT;            MADE LABESL
4756         XWD 26,PPT;             PERMANENT TEMPORARYS
4757         XWD 27,PTT;             TEMPORARY TEMPORARYS
4758 TABLNG==.-TABDIS
4759 ;DISPATCH ON A HEADER
4760
4761 HEADER: CAMN    W,[EXP -2];     END OF PASS ONE
4762         JRST    ENDS
4763         LDB     C,[POINT 12,W,35];      GET SIZE
4764         MOVEM   C,BLKSIZ
4765         ANDI    W,770000
4766         JUMPE   W,PLB;  PROGRAMMER LABEL
4767         CAIN    W,500000;       ABSOLUTE BLOCK
4768         JRST    ABSI;
4769         CAIN    W,310000;       MADE LABEL
4770         JRST    MDLB;           MADE LABEL
4771         CAIN    W,600000
4772         JRST    GLOBDF
4773         CAIN    W,700000;       DATA STATEMENT
4774         JRST    DATAS
4775         JRST    LOAD4A;         DATA STATEMENTS WILL GO HERE
4776
4777 TTR50:  RADIX50 10,%TEMP.
4778 PTR50:  RADIX50 10,TEMP.
4779 CNR50:  RADIX50 10,CONST.
4780
4781
4782 \fSUBTTL ROUTINES TO PROCESS POINTERS
4783
4784 PCONS:  ADD     C,CCON;         GENERATE CONSTANT ADDRESS
4785         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY
4786
4787 PSTA:   PUSHJ   P,SWAPSY        ;NON-COMMON SCALARS AND ARRAYS
4788         ADDI    C,(R);          RELOCATE
4789 PCOM1:  PUSHJ   P,SYDEF         ;...
4790 PCOMX:  ADD     C,MODIF         ;ADDR RELOC FOR DP
4791         HRRM    C,@X;           REPLACE ADDRESS
4792 PASS2A: AOJ     V,;             STEP READOUT POINTER
4793         CAML    V,CCON          ;END OF PROCESSABLES?
4794 CPOPJ1: AOS     (P);            SKIP
4795         POPJ    P,;
4796
4797 PAT:    SKIPA   W,ATAB          ;ARRAY TABLE BASE
4798 PST:    MOVE    W,STAB          ;SCALAR TABLE  BASE
4799         ROT     C,1             ;SCALE BY 2
4800         ADD     C,W             ;ADD IN TABLE BASE
4801         ADDI    C,-2(X);        TABLE ENTRY
4802         HLRZ    W,(C);          CHECK FOR COMMON
4803         JUMPE   W,PSTA;         NO COMMON
4804         PUSHJ   P,COMDID        ;PROCESS COMMON
4805         JRST    PCOM1
4806
4807 COMDID: LSH     W,1             ;PROCESS COMMON TABLE ENTRIES
4808         ADD     W,CTAB;         COMMON TAG
4809         ADDI    W,-2(X);        OFFSET
4810         PUSHJ   P,SWAPSY;       GET SYMBOL AND SET TO DEFINED
4811         ADD     C,1(W);         BASE OF COMMON
4812         POPJ    P,              ;RETURN
4813
4814 PATO:   ROT     C,1
4815         ADD     C,AOTAB;        ARRAY OFFSET
4816         ADDI    C,-2(X);        LOADER OFFSET
4817         MOVEM   C,CT1;          SAVE CURRENT POINTER
4818         HRRZ    C,1(C);         PICK UP REFERENCE POINTER
4819         ANDI    C,7777; MASK TO ADDRESS
4820         ROT     C,1;            ALWAYS A ARRAY
4821         ADDI    C,-2(X)
4822         ADD     C,ATAB
4823         HLRZ    W,(C);          COMMON CHECK
4824         JUMPE   W,NCO
4825         PUSHJ   P,COMDID        ;PROCESS COMMON
4826         PUSHJ   P,SYDEF
4827         MOVE    C,CT1
4828         HRRE    C,(C)
4829         ADD     C,1(W)
4830         JRST    PCOMX
4831
4832
4833 \fNCO:   PUSHJ   P,SWAPSY;
4834         ADDI    C,(R)           ;DEFINE SYMBOL IN TRUE LOC
4835         PUSHJ   P,SYDEF         ;...
4836         MOVE    C,CT1
4837         HRRZ    C,(C)           ;OFFSET ADDRESS PICKUP
4838         ADDI    C,(R)           ;WHERE IT WILL BE
4839         JRST    PCOMX           ;STASH ADDR AWAY
4840
4841 PTT:    ADD     C,TTEMP;        TEMPORARY TEMPS
4842         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY
4843
4844 PPT:    ADD     C,PTEMP;        PERMANENT TEMPS
4845         SOJA    C,PCOMX         ;ADJUST FOR 1 AS FIRST ENTRY
4846
4847 PGS:    ADD     C,GSTAB;        GLOBSUBS
4848         ADDI    C,-1(X);        OFFSET
4849         MOVE    C,(C)
4850         TLC     C,640000;       MAKE A REQUEST
4851         PUSHJ P,TBLCHK          ;CHECK FOR OVERLAP
4852         MOVEI   W,(V);          THIS LOC
4853         HLRM    W,@X;           ZERO RIGHT HALF
4854         PUSHJ   P,SYMXX
4855         JRST    PASS2A
4856
4857 SYDEF:  TLNE    N,SYDAT         ;SYMBOL WANTS DEFININITION?
4858         POPJ    P,              ;NO, GO AWAY
4859         PUSH    P,C             ;SAVE THE WORLD
4860         PUSH    P,W
4861         PUSHJ P,TBLCHK  ;CHECK FOR OVERLAP
4862         MOVE    W,C
4863         SKIPE   C,T     ;PICKUP VALUE
4864         PUSHJ   P,SYMXX
4865         POP     P,W
4866         POP     P,C
4867         POPJ    P,;
4868
4869 PMLT:   ADD     C,MLTP
4870         JRST    .+2
4871 PPLT:   ADD     C,PLTP
4872         HRRZ    C,(C)
4873         JRST    PCOMX
4874
4875 SYMXX:  PUSH    P,V
4876         PUSHJ   P,SYMPT
4877         POP     P,V
4878 IFE REENT,<POPJ P,>
4879 IFN REENT,<JRST RESTRX>
4880
4881
4882 \f
4883 SWAPSY: MOVEI   T,0;            SET TO EXCHANGE DEFS
4884         EXCH    T,1(C);         GET NAME
4885         HRRZ    C,(C)           ;GET VALUE
4886         POPJ    P,
4887 TBLCHK: HRRZ W,MLTP     ;GETT TOP OV TABLES
4888         SUBI W,2
4889         CAMG W,TOPTAB   ;WILL IT OVERLAP
4890 IFE EXPAND,<TLO F,FULLSW>
4891 IFN EXPAND,<JRST [PUSHJ P,XPAND
4892                 TLOA F,FULLSW
4893                 JRST TBLCHK
4894                 POPJ P,]>
4895         POPJ P,
4896
4897
4898 \fSUBTTL END OF PASS2
4899
4900 ALLOVE: TLZ     N,F4SW          ;END OF F4 PROG
4901         HRRZ V,SDSTP    ;GET READY TO ZERO OUT DATA STMTS
4902         SETZM (V)       ;AT LEAST ONE THERE
4903         CAIL V,(S)      ;IS THERE MORE THAN ONE??
4904         JRST NOMODS     ;NO
4905         HRLS V
4906         ADDI V,1        ;SET UP BLT
4907         BLT V,(S)       ;ZERO OUT ALL OF IT
4908 NOMODS: MOVE H,SVFORH
4909         TLNE    F,FULLSW!SKIPSW
4910         JRST    HIGH3A
4911         HRR     R,COMBAS        ;TOP OF THE DATA
4912         CAMG    H,SDS           ;HIGHEST LOC GREATER THAN DATA STATEMENTS?
4913         JRST    HIGH3A          ;NO, RETURN
4914         ADDI    H,1(S)          ;YES, SET UP MEANINGFUL ERROR COMMENT
4915         SUB     H,SDS           ;...
4916         TLO     F,FULLSW        ;INDICATE OVERFLO
4917 HIGH3A: IFN REENT,<SETZ W,      ;CAUSES TROUBLE OTHERWISE
4918         TLZE F,HIPROG
4919         JRST HIGHN1
4920         HRRZ V,GSTAB
4921         MOVEI V,@X
4922         CAMLE V,HILOW
4923         MOVEM V,HILOW>
4924         HRRZ C,R
4925         JRST    HIGH31          ;RETURN
4926
4927 DATAS:  TLNE    F,FULLSW+SKIPSW
4928         JRST    DAX
4929         MOVEI   C,(S)           ;ADDR OF WORD UNDER SYMBOL TABLE
4930         MOVN    W,BLKSIZ        ;HOW FAR DOWN TO BLT
4931         ADDM    W,PLTP          ;UPDATE TABLE POINTERS
4932         ADDM    W,BITP          ;...
4933         ADDM    W,SDSTP         ;...
4934         ADD     C,W             ;RH(C):= WHEN TO STOP BLT
4935         HRL     C,MLTP          ;SOURCE OF BLTED DATA
4936         ADD     W,MLTP          ;UPDATE, GET DESTINATION OF BLT DATA
4937 IFN EXPAND,<    HRRZS W ;GET RID OF LEFT HALF
4938                 CAIG W,(H)
4939                 PUSHJ P,[PUSHJ P,XPAND
4940                         POPJ P,
4941                         ADDI W,2000
4942                         ADD C,[XWD 2000,2000]
4943                         JRST POPJM2]>
4944         HRRM    W,MLTP  ;NO SET THIS SO EXTRA CORE NOT ZEROED
4945         HLL     W,C             ;FORM BLT POINTER
4946         BLT     W,-1(C)         ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)
4947         PUSHJ   P,BITWX
4948 DAX:    PUSHJ   P,WORD;         READ ONE WORD
4949         TLNN    F,FULLSW+SKIPSW
4950         MOVEM   W,(C)
4951         SOSLE   BLKSIZ          ;COUNT OF DATA SEQUENCE SIZE
4952         AOJA    C,DAX           ;INCREMENT DATA SEQUENCE DEPOSIT LOC
4953         JRST    TEXTR;          DONE
4954
4955
4956 \fFBLKD: TLOE    N,BLKD1         ;IS THIS FIRST BLOCK DATA?
4957         JRST    ENDTP           ;NO
4958         HRR     V,COMBAS        ;PLACE PROG BREAK IN RH FOR
4959 IFE L,<IFN REENT,<      TLNN F,HIPROG>
4960         HRRM    V,JOBCHN(X)     ;CHAIN>
4961 ENDTP:  TLNE    F,FULLSW+SKIPSW
4962         JRST    ALLOVE
4963         HRR     V,GSTAB
4964 ENDTP0: CAML    V,STAB;         ANY MORE GLOBSUBS
4965         JRST    ENDTP2;         NO
4966         MOVE    C,@X;           GET SUBPROG NAME
4967         PUSHJ   P,SREQ;         IS IT ALLREADY REQUESTED
4968         AOJA    V,ENDTP0;       YES
4969         PUSHJ   P,SDEF;         OR DEFINED
4970         AOJA    V,ENDTP0;       YES
4971         PUSHJ   P,TBLCHK
4972         MOVEI   W,0             ;PREPARE DUMMY LINK
4973         TLNN    F,FULLSW+SKIPSW ;ABORT
4974         PUSHJ   P,SYM3X;        PUT IN DUMMY REQUEST
4975         PUSHJ   P,BITWX;        OVERLAP CHECK
4976         AOJA    V,ENDTP0
4977 ENDTP2: SETZM   PT1
4978 ENDTPW: HRRZ    V,SDSTP
4979 IFN EXPAND,<IFN REENT,<TLNE F,HIPROG
4980                 JRST ENDTPI>
4981                 SUBI V,(X)
4982                 CAMG V,COMBAS
4983                 JRST    [SUB V,COMBAS
4984                         MOVNS   V
4985                         PUSHJ P,XPAND9
4986                         TLO F,FULLSW
4987                         JRST .+1]
4988 ENDTPH:         HRR V,SDSTP>
4989         HRRZM   V,SDS           ;DATA STATEMENT LOC
4990 ENDTP1: SUBI    V,(X);          COMPENSATE FOR OFFSET
4991         MOVE    W,@X;   GET WORD
4992         TLNE    W,-1;           NO LEFT HALF IMPLIES COUNT
4993         JRST    DODON;          DATA DONE
4994         ADD     W,[MOVEI W,3]
4995         ADDI    W,@X
4996         EXCH    W,@X
4997         AOJ     V,
4998         ADD     W,@X;           ITEMS COUNT
4999         MOVEM   W,ITC
5000         MOVE    W,[MOVEM W,LTC]
5001         MOVEM   W,@X;           SETUP FOR DATA EXECUTION
5002         AOJ     V,
5003         MOVSI   W,(MOVEI W,0)
5004         EXCH    W,@X
5005         MOVEM   W,ENC;          END COUNT
5006         AOJ     V,
5007         MOVEI   W,@X
5008         ADDM    W,ITC
5009 LOOP:   MOVE    W,@X
5010         HLRZ    T,W;            LEFT HALF INST.
5011         ANDI    T,777000
5012         CAIN    T,254000        ;JRST?
5013         JRST    WRAP            ;END OF DATA
5014         CAIN    T,260000        ;PUSHJ?
5015         JRST    PJTABL(W)       ;DISPATCH VIA TABLE
5016         CAIN    T,200000;       MOVE?
5017         AOJA    V,INNER
5018         CAIN    T,270000;       ADD?
5019         JRST    ADDOP
5020         CAIN    T,221000;       IMULI?
5021         AOJA    V,LOOP
5022         CAIE    T,220000;       IMUL?
5023         JRST    LOAD4A;         NOTA
5024 INNER:  HRRZ    T,@X;           GET ADDRESS
5025         TRZE    T,770000;       ZERO TAG?
5026         SOJA    T,CONPOL;       NO, CONSTANT POOL
5027         JUMPE T,FORCNF
5028         SUB     T,PT1;          SUBTRACT INDUCTION NUMBER
5029         ASH     T,1
5030         SUBI T,1
5031         HRRM    T,@X
5032         HLRZ    T,@X
5033         ADDI    T,P
5034         HRLM    T,@X
5035         AOJA    V,LOOP
5036 IFN EXPAND,<IFN REENT,<ENDTPI:  HRRZ V,COMBAS
5037         MOVEI V,@X
5038         CAMLE V,JOBREL
5039         JRST    [PUSHJ P,HIEXP
5040                 TLOA F,FULLSW
5041                 JRST ENDTPI
5042                 JRST ENDTPH]
5043         JRST ENDTPH>>
5044 FORCNF: ERROR   ,</FORTRAN CONFUSED ABOUT DATA STATEMENTS#/>
5045         JRST LD2
5046
5047
5048 \fCONPOL:        ADD     T,ITC;  CONSTANT BASE
5049         HRRM    T,@X
5050         AOJA    V,LOOP
5051
5052 ADDOP:  HRRZ    T,@X
5053         TRZE    T,770000
5054         SOJA    T,CONPOL
5055 SKIPIN: AOJA    V,LOOP
5056
5057 PJTABL: JRST    DWFS            ;PUSHJ 17,0
5058         AOSA    PT1             ;INCREMENT DO COUNT
5059         SOSA    PT1;            DECREMENT DO COUNT
5060         SKIPA   W,[EXP DOINT.]
5061         MOVEI   W,DOEND.
5062         HRRM    W,@X
5063         AOJA    V,SKIPIN        ;SKIP A WORD
5064
5065 DWFS:   MOVEI   W,DWFS.
5066         HRRM    W,@X
5067         AOJ     V,
5068         TLO     N,SYDAT
5069         PUSHJ   P,PROC;         PROCESS THE TAG
5070         JRST    LOAD4A          ;DATA STATEMENT BELOW CODE TOP
5071         JRST    LOOP            ;PROPER RETURN
5072
5073 DOINT.: POP     P,V;            GET ADDRESS OF INITIAL VALUE
5074         PUSH    P,(V);          STORE INDUCTION VARIABLE
5075         AOJ     V,
5076         PUSH    P,V;            INITIAL ADDRESS
5077         JRST    (V)
5078
5079 DOEND.: HLRE    T,@(P)          ;RETAIN SIGN OF INCREMENT
5080         ADDM    T,-2(P);        INCREMENT
5081         HRRZ    T,@(P);         GET FINAL VALUE
5082         SUB     T,-2(P)         ;FINAL - CURRENT
5083         IMUL    T,@(P)          ;INCLUDE SIGN OF INCREMENT
5084         JUMPL   T,DODONE        ;SIGN IS ONLY IMPORTANT THING
5085         POP     P,(P);          BACK UP POINTER
5086         JRST    @(P)
5087
5088
5089 \fDODONE:        POP     P,-1(P);        BACK UP ADDRESS
5090         POP     P,-1(P)
5091         JRST    CPOPJ1          ;RETURN
5092
5093 WRAP:   MOVE    W,ENC;          NUMBER OF CONSTANTS
5094         ADD     W,ITC;          CONSTANT BASE
5095         MOVEI   C,(W);          CHAIN
5096         HRRM    C,@X
5097         MOVEI   V,(W);          READY TO GO
5098         JRST    ENDTP1
5099
5100 DODON:  TLZ     N,RCF!SYDAT!DZER        ;DATA STATEMENT FLAGS
5101         MOVE    W,PTEMP         ;TOP OF PROG
5102         ADDI    W,(X)           ;+OFFSET
5103         HRRZ C,SDS
5104 IFE EXPAND,<SUBI C,(X)  ;CHECK FOR ROOM
5105         CAMGE C,COMBAS  ;IS IT THERE
5106         TLO F,FULLSW    ;NO (DONE EARLIER IF EXPAND)
5107         HRRZ C,SDS>
5108         SUBI C,1        ;GET ONE LESS (TOP LOCATION TO ZERO)
5109 IFN REENT,<TLNE F,HIPROG
5110         MOVE C,JOBREL>
5111 SECZER: CAMLE   W,C             ;ANY DATA TO ZERO?
5112         JRST    @SDS            ;NO, DO DATA STATEMENTS
5113                                 ;FULLSW IS ON IF COMBAS GT. SDS
5114         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?
5115         SETZM   (W)             ;YES, DO SO
5116         TLON    N,DZER          ;GO BACK FOR MORE?
5117         AOJA    W,SECZER        ;YES, PLEASE
5118         HRLI    W,-1(W)         ;SET UP BLT POINTER TO ZERO DATA
5119         TLNN    F,FULLSW+SKIPSW ;SHOULD WE ZERO?
5120         BLT     W,(C)           ;YES, DO SO
5121         JRST    @SDS            ;GO DO DATA STATEMENTS
5122
5123 DATAOV: ERROR   0,</DATA STATEMENT OVERFLOW#/>
5124         JRST    LD2
5125
5126
5127 \fDREAD: TLNE    N,RCF;          NEW REPEAT COUNT NEEDED
5128         JRST    FETCH;          NO
5129         MOVE    W,LTC
5130         MOVEM   W,LTCTEM
5131         MOVE    W,@LTC;         GET A WORD
5132         HLRZM   W,RCNT;         SET REPEAT COUNT
5133         HRRZM   W,WCNT;         SET WORD COUNT
5134         POP     W,(W);          SUBTRACT ONE FROM BOTH HALFS
5135         HLLM    W,@LTC;         DECREMENT REPEAT COUNT
5136         AOS     W,LTC;          STEP READOUT
5137         TLO     N,RCF
5138 FETCH:  MOVE    W,@LTC
5139         AOS     LTC
5140         SOSE    WCNT
5141         POPJ    P,;
5142         SOSN    RCNT
5143         JRST    DOFF.
5144         MOVE    V,LTCTEM;       RESTORE READOUT
5145         MOVEM   V,LTC
5146 DOFF.:  TLZ     N,RCF;          RESET DATA REPEAT FLAG
5147         POPJ    P,;
5148
5149 DWFS.:  MOVE    T,(P)
5150         AOS     (P)
5151         MOVE    T,(T);          GET ADDRESS
5152         HLRZM   T,DWCT;         DATA WORD COUNT
5153         HRRZS   T
5154         ADDI    T,(W);          OFFSET
5155 IFN REENT,<HRRZS T              ;CLEAR LEFT HALF INCASE OF CARRY
5156         CAML T,HVAL1
5157         JRST    [ADD T,HIGHX
5158                 HRRZS T ;MUST GET RID OF LEFT HALF
5159                 CAMLE T,JOBREL
5160                 JRST DATAOV     ;IN CASE FORTRAN GOOFS ON LIMITS
5161                 JRST DWFS.1]
5162         ADD T,LOWX
5163         HRRZS T>
5164 IFE REENT,<ADDI T,(X)>
5165         CAML T,SDS
5166         JRST DATAOV
5167 DWFS.1: PUSHJ   P,DREAD         ;GET A DATA WORD
5168         HRRZS T
5169 IFN REENT,<CAMG T,JOBREL        ;JUST TO MAKE SURE>
5170         CAMN T,SDS
5171         JRST DATAOV
5172         TLNN    F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?
5173         MOVEM   W,(T)           ;YES, STORE IT
5174         SOSE    W,DWCT;         STEP DOWN AND TEST
5175         AOJA T,DWFS.1           ;ONE MORE TIME, MOZART BABY!
5176         POPJ    P,
5177
5178
5179 \fSUBTTL ROUTINE TO SKIP FORTRAN OUTPUT
5180
5181 ;SUBSECTION OF THE ROUTINE TO HANDLE OUTPUT FROM THE
5182 ;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
5183 ;LOOK FOR THE END BLOCK. CODE TAKEN FROM FUDGE2.
5184
5185 MACHCD: HRRZ    C,W             ;GET THE WORD COUNT
5186         PUSHJ   P,WORD          ;INPUT A WORD
5187         SOJG    C,MACHCD        ;LOOP BACK FOR REST OF THE BLOCK
5188                                 ;GO LOOK FOR NEXT BLOCK
5189
5190 REJECT: PUSHJ   P,WORD          ;READ A FORTRAN BLOCK HEADER
5191         TLC     W,-1            ;TURN ONES TO ZEROES IN LEFT HALF
5192         TLNE    W,-1            ;WAS LEFT HALF ALL ONES?
5193         JRST    REJECT          ;NO, IT WAS CALCULATED MACHINE CODE
5194         CAIN    W,-2            ;YES, IS RIGHT HALF = 777776?
5195         JRST    ENDST           ;YES, PROCESS F4 END BLOCK
5196         LDB     C,[POINT 6,W,23];GET CODE BITS FROM BITS 18-23
5197         TRZ     W,770000        ;THEN WIPE THEM OUT
5198         CAIE    C,70            ;IS IT A DATA STATEMENT?
5199         CAIN    C,50            ;IS IT ABSOLUTE MACHINE CODE?
5200         JRST    MACHCD          ;YES, TREAT IT LIKE DATA STATEMENTS
5201         PUSHJ   P,WORD          ;NO, ITS A LABEL OF SOME SORT
5202         JRST    REJECT          ;WHICH CONSISTS OF ONE WORD
5203                                 ;LOOK FOR NEXT BLOCK HEADER
5204
5205 ENDST:  MOVEI   C,1             ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
5206         MOVEI   T,6             ;TO GO
5207 F4LUP1: PUSHJ   P,WORD          ;GET TABLE MEMBER
5208 F4LUP3: SOJGE   C,F4LUP1        ;LOOP WITHIN A TABLE
5209         JUMPL   T,LOAD1         ;LAST TABLE - RETURN
5210         SOJG    T,F4LUP2        ;FIRST TWO WORDS AND FIVE TABLES
5211         JUMPE   T,F4LUP1        ;COMMON LENGTH WORD
5212 F4LUP2: PUSHJ   P,WORD          ;READ HEADER WORD
5213         MOVE    C,W             ;COUNT TO COUNTER
5214         JRST    F4LUP3          ;STASH
5215
5216
5217 \fSUBTTL LISP LOADER
5218
5219 IFE L,< END     BEG>
5220 IFN L,<
5221         LIT
5222         VAR
5223 LODMAK: MOVEI A,LODMAK
5224         MOVEM A,137
5225         INIT 17
5226         SIXBIT /DSK/
5227         0
5228         HALT
5229         ENTER LMFILE
5230         HALT
5231         OUTPUT [IOWD 1,LMLST    ;OUTPUT LENGTH OF FILE
5232                 0]
5233         OUTPUT LMLST
5234         STATZ 740000
5235         HALT
5236         RELEASE
5237         CALL [SIXBIT /EXIT/]
5238
5239 LMFILE: SIXBIT /LISP/
5240         SIXBIT /LOD/
5241         0
5242         0
5243
5244 LMLST:  IOWD LODMAK+1-LD,137
5245         0
5246
5247         END LODMAK>
5248
5249
5250
5251 \f