src/loader.v57

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