src/fudge2.mac

   1 TITLE   FUDGE2  V.011\r
   2 SUBTTL  2-OCT-70        ED YOURDON/VJC/DMN\r
   3 ;FILE UPDATE GENERATOR\r
   4 ;"COPYRIGHT 1968,1969,DIGITAL EQUIPMENT CORP. MAYNARD,MASS. U.S.A."\r
   5 \r
   6         VFUDGE==11              ;VERSION NUMBER\r
   7         VPATCH==0               ;DEC PATCH LEVEL\r
   8         VCUSTOM==0              ;NON-DEC PATCH LEVEL\r
   9 \r
  10         JOBVER==137\r
  11         LOC     JOBVER\r
  12         XWD VCUSTOM,VFUDGE+VPATCH*1000\r
  13         RELOC\r
  14         MLON\r
  15 \r
  16 ;FUDGE ACCUMULATOR DEFINITIONS\r
  17 \r
  18         A=      1               ;GENERAL COMMUNICATION AC\r
  19         B=      2               ;SCRATCH ACCUMULATOR\r
  20         T=      3               ;USED IN /C AND /X ONLY\r
  21         C=      4               ;SCRATCH ACCUMULATOR\r
  22         D=      5               ;IO DEVICE NUMBER ACCUMULATOR\r
  23         E=      6               ;SCRATCH ACCUMULATOR\r
  24         F=      7               ;FLAG ACCUMULATOR\r
  25         G=      10              ;DEVICE CHARACTERISTICS AC\r
  26         H=      11              ;USED IN GETCHR AND GETCMN\r
  27         P=      12              ;PUSHDOWN POINTER AC\r
  28         R=      13              ;PROGRAM NAME-USED IN READ,WRITE\r
  29         S=      14              ;SIXBIT SYMBOL ACCUMULATOR\r
  30         DIS=    15              ;DISPATCH ACCUMULATOR\r
  31         EXT=    16              ;FILE NAME EXTENSION ACCUMULATOR\r
  32         SW=     17              ;SWITCH UUO AC\r
  33 \r
  34 \f;FUDGE FLAG DEFINITIONS (RIGHT HALF OF ACCUMULATOR F)\r
  35 \r
  36         DESTB== 1               ;1-DESTINATION DEVICE SEEN\r
  37         SAVEB== 2               ;1-SWITCH SEEN,BUT NOT EXECUTED\r
  38         SWTB==  4               ;1-SWITCH MODE ENTERED IN GETCHR\r
  39         SLSHB== 10              ;1-SWITCH MODE ENTERED WITH </>\r
  40         TTYOB== 20              ;1-NON-TTY OUTPUT;USED BY IO\r
  41         TTYCB== 40              ;1-NON-TTY OUTPUT;USED BY COMMAND\r
  42         PROGB== 100             ;1-PROGRAM NAME SEEN IN SPECIFICATION\r
  43         NOLOCB==200             ;1-DELETE LOCAL SYMBOLS ***VJC\r
  44         DEVB==  400             ;1-DEVICE NAME SEEN IN SPEC.\r
  45         EXTB==  1000            ;1-EXPLICIT FILE NAME EXTENSION\r
  46         ERRB==  2000            ;1-ERROR IN ENTRY BLOCK CHECK\r
  47         INFOB== 4000            ;1-VALID INFORMATION IN COMMAND\r
  48         CONB==  10000           ;1-CONTEXT OF <.> IS PROGRAM NAME\r
  49                                 ;0-CONTEXT OF <.> IS FILE NAME\r
  50         F4IB==  20000           ;1-IGNORE F4 OUTPUT\r
  51         CRLFTY==40000           ;1-CR,LF TYPED (FOR ERROR MSG)\r
  52         POPBAK==100000          ;1-XCT POPJ P,  ;TO RETURN TO CALLING SEQ.\r
  53         XFLG==  200000          ;1-INDEX THIS FILE\r
  54         DTAFLG==400000          ;1-OUTPUT DEVICE IS DTA (SPECIAL INDEX)\r
  55 \f\r
  56 \r
  57 \r
  58 ;HANDY BITS FOR CALLS TO DEVCHR FOR DEVICE CHARACTERISTICS\r
  59         OUTBIT==1               ;1-DEVICE CAN DO OUTPUT\r
  60         INBIT== 2               ;1-DEVICE CAN DO INPUT\r
  61         DRCTRB==4               ;1-DEVICE HAS A DIRECTORY\r
  62         TTYBIT==10              ;1-DEVICE IS A TTY\r
  63         DTABIT==100             ;1-DEVICE IS A DTA\r
  64         LPTBIT==40000           ;1-DEVICE IS LPT\r
  65         DSKBIT==200000          ;1-DEVICE IS DSK\r
  66 \r
  67 ;OTHER USEFUL PARAMETER ASSIGNMENTS\r
  68         N==     200             ;SIZE OF MASTER AND TRAN BUFFERS\r
  69         XP==    20              ;SIZE OF PUSHDOWN LIST\r
  70         SIZE==  500             ;SIZE OF PURE ENTRY BLOCK\r
  71         X==     SIZE+5          ;SIZE OF ENTRY AND SAVE BLOCKS\r
  72         IOEOF== 20000           ;1-END-OF-FILE HAS BEEN SEEN\r
  73         IOBKTL==40000           ;1-BLOCK-TOO-LARGE ERROR\r
  74         IODATA==100000          ;1-DATA ERROR\r
  75         IODEV== 200000          ;1-DEVICE ERROR\r
  76         IOBOT== 4000            ;1-MAG TAPE IS AT BEGINNING OF TAPE\r
  77 \r
  78         RIBALC==11              ;NUMBER OF BLOCKS ALLOCATED\r
  79 \r
  80 ;EXTERNAL SYMBOLS\r
  81         EXTERN  JOBFF, JOBREL, JOBSYM, JOBSA\r
  82 \r
  83 OPDEF   JSR     [PUSHJ  P,]     ;PURE FOR RE-ENTRANT FUDGE\r
  84 \r
  85 \fSUBTTL INITIALIZE AND SETUP OF FUDGE2\r
  86 ;THIS SECTION OF CODING DOES THE FOLLOWING THINGS\r
  87 ;       1.RESETS ALL IO DEVICES BY CALLING [SIXBIT /RESET/]\r
  88 ;       2.INITIALIZES THE TELETYPE IN ASCII-LINE MODE\r
  89 ;       3.TYPES A * TO SIGNIFY READINESS FOR INPUT FROM USER\r
  90 ;       4.SETS UP A PUSHDOWN LIST\r
  91 ;       5.INITIALIZES VARIOUS ACCUMULATORS, CLEARS THE FLAGS,\r
  92 ;         AND INITIALIZES THE MSTBUF AND TRNBUF COUNTERS\r
  93 \r
  94 FUDGE2: JFCL                    ;INCASE OF CCL ENTRY\r
  95         RESET                   ;RESET I/O DEVICES   \r
  96         MOVE    [XWD LOW,LOW+1]\r
  97         SETZM   LOW             ;CLEAR DATA AREA\r
  98         BLT     LOWTOP-1\r
  99         MOVE    [XWD 17,11]     ;TEST FOR LEVEL D\r
 100         SETZ                    ;FAILED, NOT LEVEL D\r
 101         TLNN    (7B9)           ;IS IT LEVEL D OR LATER?\r
 102         TDZA                    ;NO\r
 103         HRROI   -2              ;THIS IS LEVEL D\r
 104         MOVEM   LEVEL           ;STORE STATE\r
 105         SETZ                    ;CLEAR ACC'S\r
 106         MOVEI   17,1            ;WITH A BLT OF ZERO\r
 107         BLT     17,17           ;FROM 0-17\r
 108         INIT    0,1             ;INITIALIZE TTY, CHANNEL 0\r
 109         SIXBIT  /TTY/           ;TTY\r
 110         XWD     OBUF, IBUF      ;ADDRESSES FOR BUFFER HEADERS\r
 111         HALT    .               ;ILLEGAL INSTRUCTION IF NO TTY\r
 112         OUTPUT  0,              ;DUMMY OUTPUT ON TTY\r
 113         MOVEI   A, "*"          ;PICK UP A <*>\r
 114         IDPB    A, OBUF+1       ;TYPE IT OUT\r
 115         OUTPUT  0,              ;EMPTY THE BUFFER\r
 116         MOVE    P, XPDLST       ;SET UP A PUSHDOWN POINTER\r
 117         HRROI   D,1             ;INITIALIZE DEVICE BUFFER\r
 118         MOVEM   D, DEVBUF       ;...\r
 119         MOVSI   A, -N           ;GET COUNT OF MSTBUF AND TRNBUF\r
 120         HRRI    A, FILBUF+1     ;INITIALIZE POINTER IN FILBUF\r
 121         MOVEM   A, FILBUF       ;SET UP COUNT IN FILE BUFFER\r
 122         HRRI    A, PRGBUF+1     ;INITIALIZE POINTER IN PRGBUF\r
 123         MOVEM   A, PRGBUF       ;...\r
 124         HRRI    A,PPNBUF        ;INITIAL POINTER IN PPNBUF\r
 125         MOVEM   A,PPNBUF\r
 126 \fSUBTTL FUDGE2 COMMAND STRING DISPATCHING\r
 127 ;THIS ROUTINE PICKS UP CHARACTERS FROM THE TELETYPE BUFFER AND\r
 128 ;DISPATCHES TO THE PROPER ROUTINE DEPENDING ON THE TYPE OF\r
 129 ;CHARACTER.A TABLE OF BYTES AND BYTE POINTERS ALLOWS EACH\r
 130 ;CHARACTER IN THE ASCII SET TO BE TREATED INDIVIDUALLY. THE\r
 131 ;ROUTINE MAY BE ENTERED AT GETCHR IF IT IS DESIRED TO ACCUMULATE\r
 132 ;A 6-LETTER SIXBIT SYMBOL IN AC S. SYMBOLS OF DIFFERENT LENGTHS\r
 133 ;MAY BE ACCUMULATED IN DIFFERENT REGISTERS BY SETTING THE CONTENTS\r
 134 ;OF AC B TO THE DESIRED LENGTH, AND PUTTING A BYTE POINTER IN E\r
 135 ;AND ENTERING THE ROUTINE AT GETCHR+4.\r
 136 \r
 137 GETCHR: TRZE    F,POPBAK        ;IMMEDIATE RETURN?\r
 138         POPJ    P,              ;YES\r
 139         MOVEI   B, 6            ;SET COUNT OF SYMBOL TO 6\r
 140         MOVE    E, SYMPTR       ;SET UP A BYTE POINTER FOR AC S\r
 141         MOVEI   S, 0            ;INITIALIZE SYMBOL ACCUMULATOR\r
 142 GETCMN: SOSG    IBUF+2          ;IS TTY BUFFER EMPTY?\r
 143         INPUT   0,              ;YES, FILL IT UP\r
 144         ILDB    A, IBUF+1       ;GET A CHARACTER\r
 145         MOVE    G, A            ;GET A COPY OF IT IN AC G\r
 146         MOVE    0, CURCHR       ;SAVE PREVIOUS CHAR\r
 147         MOVEM   0, LSTCHR       ;AS LAST CHAR\r
 148         MOVEM   A, CURCHR       ;SAVE CURRENT CHAR\r
 149         IDIVI   G, 11           ;TRANSLATE TO 4-BIT CODE\r
 150         LDB     G, TABLE(H)     ;USE PROPER BYTE POINTER\r
 151         CAIGE   G, 4            ;MODIFY CODE IF .GE. 4\r
 152         TRNN    F, SWTB         ;MODIFY CODE IF IN SWITCH MODE\r
 153         ADDI    G, 4            ;CHANGE DISPATCH BY ADDING 4\r
 154         HRRZ    H, DSPTCH(G)    ;GET PROPER DISPATCH ADDRESS\r
 155         CAIL    G, 10           ;BUT CHANGE IF NOT CORRECT\r
 156         HLRZ    H, DSPTCH-10(G) ;TO A LEFT HALF DISPATCH\r
 157         JRST    (H)             ;EXIT TO APPROPRIATE ROUTINE\r
 158 \r
 159 \fSUBTTL COMMAND DISPATCH TABLE AND BYTE POINTERS\r
 160 DSPTCH: XWD     GETCMN,ERR16    ;IGNORED CHAR, BAD CHAR(SWITCH)\r
 161         XWD     SWTCH, SWTCHA   ;<(>, LETTER(SWITCH MODE)\r
 162         XWD     COLON, ERR16    ;<:>, NUMBER(SWITCH MODE)\r
 163         XWD     PERIOD,SWTCHE   ;<.>, <)>ESCAPE SWITCH MODE\r
 164         XWD     LFTARW,ERR17    ;<?>OR<=>, BAD CHAR (NORMAL MODE)\r
 165         XWD     COMMA, STORE    ;<,>, ALPHABETIC CHARACTER(NORMAL)\r
 166         XWD     ALTMOD,STORE    ;<$>,NUMERIC CHARACTER(NORMAL)\r
 167         XWD     SLASH, ERR17    ;</>, <)> ILLEGAL ESCAPE\r
 168         XWD     LBRACK, 0       ;LEFT ANGLE BRACKET, OR "["\r
 169         XWD     RBRACK, 0       ;RIGHT ANGLE BRACKET\r
 170 \r
 171 TABLE:  POINT   4, BITE(G), 3\r
 172         POINT   4, BITE(G), 7\r
 173         POINT   4, BITE(G), 11\r
 174         POINT   4, BITE(G), 15\r
 175         POINT   4, BITE(G), 19\r
 176         POINT   4, BITE(G), 23\r
 177         POINT   4, BITE(G), 27\r
 178         POINT   4, BITE(G), 31\r
 179         POINT   4, BITE(G), 35\r
 180 \f SUBTTL BYTE TABLE FOR DISPATCHING\r
 181 ;CLASSIFICATION BYTE CODES\r
 182 ;       BYTE    DISP    CLASSIFICATION\r
 183 \r
 184 ;       00      00      ILLEGAL CHARACTER, SWITCH MODE\r
 185 ;       01      01      ALPHABETIC CHARACTER, SWITCH MODE\r
 186 ;       02      02      NUMERIC CHARACTER, SWITCH MODE\r
 187 ;       03      03      SWITCH MODE ESCAPE, SWITCH MODE\r
 188 \r
 189 ;       00      04      ILLEGAL CHARACTER, NORMAL MODE\r
 190 ;       01      05      ALPHABETIC CHARACTER, NORMAL MODE\r
 191 ;       02      06      NUMERIC CHARACTER, NORMAL MODE\r
 192 ;       03      07      SWITCH MODE ESCAPE, SWITCH MODE\r
 193 \r
 194 ;       04      10      IGNORED CHARACTER\r
 195 ;       05      11      ENTER SWITCH MODE WITH A <(>\r
 196 ;       06      12      DEVICE DELIMITER, <:>\r
 197 ;       07      13      FILE EXTENSION DELIMITER, <.>\r
 198 ;                       (CAN ALSO BE PART OF A PROGRAM NAME)\r
 199 ;       10      14      OUTPUT SPECIFICATION, <LFT ARW> OR <=>\r
 200 ;       11      15      FILE DELIMITER, <,>\r
 201 ;       12      16      COMMAND TERMINATOR, <ALT MODE>=33,175,176\r
 202 ;       13      17      ENTER SWITCH MODE WITH A </>\r
 203 ;       14      20      CHANGE CONTEXT OF PERIOD TO PROG NAME, <<> ,OR "["\r
 204 ;       15      21      CHANGE CONTEXT OF PERIOD TO FILE NAME, <>>\r
 205 \r
 206 ;BYTE TABLE CORRESPONDING TO 128 ASCII CHARS\r
 207 \r
 208 BITE:   BYTE    (4)     4,0,0,0,0,0,0,0,0       ;NUL\r
 209         BYTE    (4)     4,4,4,4,4,0,0,0,0\r
 210         BYTE    (4)     0,0,0,0,0,0,0,0,12      ;?Z=$\r
 211         BYTE    (4)     12,0,0,0,0,11,0,4,0     ;$\r
 212         BYTE    (4)     0,0,0,0,5,3,1,0,11      ;***DMN\r
 213         BYTE    (4)     0,7,13,2,2,2,2,2,2      ;-,.,/,0,1,2,3,4,5\r
 214         BYTE    (4)     2,2,2,2,6,0,14,10,15    ;6,7,8,9,:,;,<,=,>\r
 215         BYTE    (4)     0,0,1,1,1,1,1,1,1       ; , , ,B,C,D,E,F,G\r
 216         BYTE    (4)     1,1,1,1,1,1,1,1,1       ;H,I,J,K,L,M,N,O,P\r
 217         BYTE    (4)     1,1,1,1,1,1,1,1,1       ;Q,R,S,T,U,V,W,X,Y\r
 218         BYTE    (4)     1,14,0,0,0,10,0,1,1     ;Z,[, ,], ,?, ,A,B\r
 219         BYTE    (4)     1,1,1,1,1,1,1,1,1       ;C,D,E,F,G,H,I,J,K\r
 220         BYTE    (4)     1,1,1,1,1,1,1,1,1       ;L,M,N,O,P,Q,R,S,T\r
 221         BYTE    (4)     1,1,1,1,1,1,0,0,12      ;U,V,W,X,Y,Z, , ,$\r
 222         BYTE    (4)     12,4                    ;$,DEL\r
 223 \r
 224 \fSUBTTL ROUTINES TO HANDLE 0-9,A-Z,. CHARACTERS\r
 225 ;IN THE COMMAND STRING. IN NORMAL MODE, THE CHARACTER IS\r
 226 ;DEPOSITED TO FORM A SIXBIT SYMBOL. NOTE THAT "." IS LEGAL IN A PROGRAM NAME.\r
 227 ;E.G. <EXP.1,ALLIO.>, IF ENCLOSED IN< >. IN SWITCH MODE, THE PROPER\r
 228 ;INSTRUCTION IS EXECUTED WITH THE AID OF A DISPATCH TABLE.\r
 229 ;THEN, IF SWITCH MODE WAS ENTERED WITH A SLASH, FUDGE2 EXITS\r
 230 ;FROM SWITCH MODE.\r
 231 \r
 232 STORE:  TRO     F,INFOB         ; INDICATE VALID INFO SEEN\r
 233         SOJL    B, GETCMN       ; JUMP IF NO ROOM FOR CHARACTER\r
 234         CAIGE   A,141           ;WORRY ABOUT LOWER CASE LETTERS\r
 235         SUBI    A, 40           ;CONVERT FROM ASCII TO SIXBIT\r
 236         IDPB    A, E            ;STORE CHARACTER ACCORDING TO BYTE\r
 237         JRST    GETCMN          ;RETURN FOR NEXT CHARACTER\r
 238 \r
 239 SWTCHA: MOVSI   SW, 072000      ;GET AN MTAPE OPCODE\r
 240         CAIL    A,141           ;ACCEPT LOWER CASE SWITCHES\r
 241         SUBI    A,40\r
 242         XCT     SLIST-101(A)    ;EXECUTE PROPER SWITCH INSTRUCTION\r
 243         TRZE    F, SLSHB        ;SWITCH MODE ENTERED WITH A </>?\r
 244         TRZ     F, SWTB         ;YES, EXIT FROM SWITCH MODE\r
 245         JRST    GETCMN          ;RETURN FOR MORE CHARACTERS\r
 246 \r
 247 \r
 248 ;THE FOLLOWING THREE ROUTINES HANDLE THE CONTROL CHARACTERS IN\r
 249 ;THE COMMAND STRING WHICH CAUSE FUDGE2 TO ENTER INTO AND EXIT\r
 250 ;FROM SWITCH MODE. THERE ARE TWO TYPES OF SWITCH MODE, DEPENDING\r
 251 ;ON WHETHER THE IT IS ENTERED WITH A </> OR A <(>.\r
 252 \r
 253 SLASH:  TRO     F, SLSHB        ;ENTER SWITCH MODE WITH A </>\r
 254 SWTCH:  TROA    F, SWTB         ;ENTER SWITCH MODE WITH A <(>\r
 255 SWTCHE: TRZ     F, SWTB         ;EXIT FROM SWITCH MODE WITH A <)>\r
 256         JRST    GETCMN          ;RETURN FOR MORE CHARACTERS\r
 257 \r
 258 \fSUBTTL LEFT ARROW PROCESSOR\r
 259 ;THE LEFT ARROW PROCESSOR IS ENTERED BY A DISPATCH FROM THE\r
 260 ;COMMAND STRING. IT SIGNALS THE END OF THE DESTINGATION DEVICE\r
 261 ;SPECIFICATION. IF THE SIXBIT SYMBOL ACCUMULATOR S IS NON-\r
 262 ;ZERO, IT ASSUMES THAT THE USER HAS OMITTED THE FILE NAME DE-\r
 263 ;LIMITER, AND CALLS THE FILE NAME ROUTINE. A PROGRAM NAME \r
 264 ;SPECIFICATION IN THE OUTPUT DEVICE IS ILLEGAL.\r
 265 ;FLAG SETTINGS: THE DESTINATION FLAG (DESTB) IS SET TO ONE,\r
 266 ;THE DEVICE FLAG IS SET TO ZERO, AND THE PROGR?M NAME FLAG (PROGB)\r
 267 ;IS SET TO ONE SO THAT THE FIRST DEVICE AFTER THE LEFT ARROW\r
 268 ;WILL NOT RESULT IN A CALL TO PUTDEV.\r
 269 ;IF NO OUTPUT DEVICE IS SEEN DSK IS ASSUMED.\r
 270 ;POPBAK IS SET SO CONTROL RETURNS FRON COLON VIA GETCHR\r
 271 \r
 272 NODEV:  PUSH    P,S             ;SAVE FILE NAME\r
 273         MOVSI   S,(SIXBIT /DSK/);DSK IS DEFAULT DEVICE\r
 274         TRO     F,POPBAK        ;RETURN FROM GETCHR\r
 275         PUSHJ   P,COLON         ;FAKE A DEVICE SEEN\r
 276         POP     P,S             ;RESTORE FILE NAME\r
 277         POPJ    P,              ;RETURN\r
 278 \r
 279 \r
 280 LFTARW: PUSHJ   P, SEMICP       ;DO A LOOKUP IF NECESSARY\r
 281         TRZ     F, DEVB         ;SET THE DEVICE FLAG TO ZERO\r
 282         TRO     F, PROGB+DESTB  ;SET PROGRAM AND DESTINATION FLAGS\r
 283         JRST    GETCHR          ;RETURN FOR NEXT SYMBOL\r
 284 \r
 285 \r
 286 \fSUBTTL THIS CODE PROCESSES PROJECT-PROGRAMMER NUMBERS\r
 287 \r
 288 LSQB:   SETZ    T,              ;START WITH ZERO\r
 289         PUSH    P,T             ;AND STORE IT\r
 290 LSQB1:  PUSHJ   P,TTYIN         ;GET NEXT CHAR.\r
 291         CAIN    A,"]"           ;MATCHING SQB.?\r
 292         JRST    RSQB            ;YES\r
 293         CAIN    A,","           ;COMMA?\r
 294         JRST    SQBCMA          ;YES,SORT OUT XWD\r
 295         CAIL    A,"0"           ;IS IT AN OCTAL NUMBER?\r
 296         CAILE   A,"9"           ;...\r
 297         JRST    ERRISQ          ;NO,ERROR\r
 298         LSH     T,3             ;MAKE SPACE FOR NEXT CHAR.\r
 299         ADDI    T,-60(A)        ;ADDI IN NEW DIGIT\r
 300 \r
 301 \r
 302         JRST    LSQB1           ;BACK FOR MORE\r
 303 \r
 304 SQBCMA: HRLZM   T,(P)           ;STORE LEFT HALF ON STACK\r
 305         SETZ    T,              ;START AFRESH\r
 306         JRST    LSQB1           ;AND GET RIGHT HALF\r
 307 \r
 308 RSQB:   HRRM    T,(P)           ;PUT RIGHT HALF ON STACK\r
 309         POP     P,T             ;AND POP XWD OFF\r
 310         MOVEM   T,PRJPRG        ;SAVE DEFAULT PROJ-PROG\r
 311         JUMPN   S,GETCMN        ;AFTER A FILE NAME IS ONLY TEMP.\r
 312         MOVEM   T,DEFPPN        ;PERMANENT DEFAULT PPN\r
 313         JRST    GETCMN          ;GET NEXT CHAR.\r
 314 \r
 315 TTYIN:  SOSG    IBUF+2          ;BUFFER EMPTY\r
 316         INPUT   0,              ;YES, FILL IT UP\r
 317         ILDB    A,IBUF+1        ;GET A CHARACTER\r
 318         POPJ    P,              ;AND RETURN\r
 319 \r
 320 ERRISQ: MOVEI   B,[ASCIZ /?Illegal project-programmer number/]\r
 321         JRST    ERROR\r
 322 \fSUBTTL DISPATCH TABLE FOR SWITCHES\r
 323 \r
 324 SLIST:  MOVEI   DIS, APPEND     ;A - APPEND INSTRUCTION\r
 325         PUSHJ   P, BSWTCH       ;B - BACKSPACE ONE FILE\r
 326         MOVEI   DIS, DELCPY     ;C - COPY AND DELETE LOCAL SYMBOLS ***VJC\r
 327         MOVEI   DIS, DELETE     ;D - DELETE INSTRUCTION\r
 328         MOVEI   DIS, EXTRCT     ;E - EXTRACT INSTRUCTION\r
 329         JRST    ERR16           ;F - ERROR\r
 330         JRST    ERR16           ;G - ERROR\r
 331         JRST    ERR16           ;H - ERROR\r
 332         MOVEI   DIS, INSERT     ;I - INSERT INSTRUCTION\r
 333         JRST    ERR16           ;J - ERROR\r
 334         PUSHJ   P, KSWTCH       ;K - SKIPFILE\r
 335         MOVEI   DIS, LIST       ;L - LIST COMMAND\r
 336         JRST    ERR16           ;M - ERROR\r
 337         JRST    ERR16           ;N - ERROR\r
 338         JRST    ERR16           ;O - ERROR\r
 339         JRST    ERR16           ;P - ERROR\r
 340         JRST    ERR16           ;Q - ERROR\r
 341         MOVEI   DIS, REPLCE     ;R - REPLACE INSTRUCTION\r
 342         JRST    ERR16           ;S - ERROR\r
 343         PUSHJ   P, TSWTCH       ;T - SKIP TO LOGICAL END OF TAPE\r
 344         JRST    ERR16           ;U - ERROR\r
 345         JRST    ERR16           ;V - ERROR\r
 346         PUSHJ   P, WSWTCH       ;W - REWIND MAG TAPE\r
 347         MOVEI   DIS,INDEX       ;X - INDEX THIS LIBRARY\r
 348         JRST    ERR16           ;Y - ERROR\r
 349         PUSHJ   P, ZSWTCH       ;Z - CLEAR DIRECTORY ON DECTAPE\r
 350 \r
 351 \r
 352 ;MAGTAPE AND DECTAPE DEVICE SWITCH HANDLERS\r
 353 ;THE FOLLOWING ROUTINES HANDLE THE B,K,T,W, AND Z SWITCHES\r
 354 ;BY ASSEMBLING THE PROPER CALL OR UUO INSTRUCTION. IF A \r
 355 ;DEVICE HAS ALREADY BEEN SEEN, THE CHANNEL NUMBER IS LOADED\r
 356 ;INTO THE COMMAND, AND THE INSTRUCTION IS EXECUTED. OTHER-\r
 357 ;WISE, EXECUTION IS DEFERRED BY SETTING A FLAG AND STORING\r
 358 ;THE PARTIALLY ASSEMBLED INSTRUCTION. THE INSTRUCTION IS\r
 359 ;EXECUTED LATER, AFTER THE DEVICE HAS BEEN SEEN.\r
 360 \r
 361 BSWTCH: ADDI    SW, 1           ;CODE FOR BACKSPACE IS 17\r
 362 KSWTCH: ADDI    SW, 6           ;CODE FOR SKIPFILE IS 16\r
 363 TSWTCH: ADDI    SW, 7           ;CODE FOR SKIP TO L.E.O.T. IS 10\r
 364 WSWTCH: AOJA    SW,.+2          ;CODE FOR REWIND IS 1\r
 365 ZSWTCH: MOVE    SW, DTCLR       ;DIFFERENT UUO FOR /Z\r
 366         TRO     F, SAVEB        ;TURN ON THE SWITCH BIT\r
 367         POPJ    P,              ;EXIT\r
 368 \fSUBTTL PERIOD PROCESSOR\r
 369 ;THE PERIOD PROCESSOR IS CALLED BY A DISPATCH FROM GETCHR. IT \r
 370 ;PRECEDES A FILE NAME EXTENSION, UNLESS THE CONTEXT BIT CONB IS\r
 371 ;A ONE (CONB=1), IN WHICH CASE, THE PERIOD WAS FOUND INSIDE AN\r
 372 ;ANGLE BRACKET, INDICATING THAT IT IS PART OF A PROGRAM NAME.\r
 373 ;THE EXTENSION NAME IS GOTTEN BY ENTERING THE GETCHR ROUTINE\r
 374 ;WITH THE LENGTH SET TO THREE CHARACTERS, AND A BYTE POINTER\r
 375 ;SET TO STORE THE SYMOL IN ACCUMULATOR EXT. THE EXTENSION\r
 376 ;FLAG IS SET BY THIS ROUTINE.\r
 377 \r
 378 PERIOD: TRNE    F, CONB         ;IS PERIOD PART OF A PROGRAM NAME?\r
 379         JRST    STORE           ;YES, STORE IT IN SYMBOL\r
 380         TRO     F, EXTB         ;NO, SET EXTENSION FLAG\r
 381         MOVE    E, EXTPTR       ;GET ANOTHER BYTE POINTER\r
 382         MOVEI   B, 3            ;ASSEMBLE A 3-CHARACTER WORD\r
 383         JRST    GETCMN          ;BUT DONT DESTROY S\r
 384 \r
 385 \fSUBTTL ROUTINES TO PROCESS ANGLE BRACKETS\r
 386 ;THE FOLLOWING ROUTINES PROCESS THE LEFT ANGLE BRACKET "<"\r
 387 ;AND RIGHT ANGLE BRACKET ">" CHARACTERS. THEY ARE ENTERED BY\r
 388 ;A DISPATCH FROM THE GETCHR ROUTINE. THE ANGLE BRACKETS\r
 389 ;CAN ACT AS FILE NAME OR PROGRAM NAME DELIMITERS, SO A CHECK\r
 390 ;IS MADE TO SEE IF THE SYMBOL ACCUMULATOR IS NON-ZERO. THE\r
 391 ;MAIN FUNCTION OF THE ROUTINES IS TO SET OR CLEAR THE CONTEXT\r
 392 ;BIT CONB, WHOSE INTERPRETATION IS AS FOLLOWS:\r
 393 ;SETTING OF BIT MEANING\r
 394 ;       0               COMMAS DELIMIT FILE NAMES, AND PERIODS\r
 395 ;                       DELIMIT FILE NAME EXTENSIONS\r
 396 ;       1               COMMAS DELIMIT PROGRAM NAMES, AND PERIODS\r
 397 ;                       ARE PART OF A PROGRAM NAME\r
 398 \r
 399 LBRACK: TRNN    F, DESTB        ;IS THIS THE OUTPUT DEVICE?\r
 400         JRST    ERROR1          ;YES, SYNTAX ERROR\r
 401         CAIN    A,"["           ;PROJECT-PROGRAMMER PAIR?\r
 402         JRST    LSQB            ;YES, HANDLE IT\r
 403         MOVE    0,SDEVCHR       ;GET SAVED DEV CHRSTCS\r
 404         TLNN    0,DTABIT+DSKBIT ;LAST DEVICE DSK OR DTA?\r
 405         JRST    LBRACA          ;NO\r
 406         MOVE    0,LSTCHR        ;GET LAST CHAR\r
 407         CAIN    0,72            ;WAS IT COLON?\r
 408         JRST    ERROR1          ;YES,:< ILLEGAL\r
 409 LBRACA:                         ;NO CONTINUE\r
 410         PUSHJ   P, SEMICP       ;PROCESS THE FILE NAME\r
 411         TRO     F, CONB         ;SET CONTEXT TO PROGRAM NAMES\r
 412         AOS     MATCH           ;ADD ONE FOR EACH LEFT < ***VJC\r
 413         JRST    GETCHR          ;RETURN FOR MORE CHARACTERS\r
 414 \r
 415 RBRACK: JUMPE   S,.+2           ;IS THERE A SYMBOL TO HANDLE?\r
 416         PUSHJ   P,COMMAP        ;YES,PROCESS THE FILE NAME\r
 417         TRZ     F,CONB          ;SET CONTEXT TO FILE NAMES\r
 418         SOS     MATCH           ;SUBTRACT ONE FOR EACH RIGHT > ***VJC\r
 419         JRST    GETCHR          ;RETURN FOR MORE CHARACTERS\r
 420 \r
 421 \fSUBTTL COMMA PROCESSOR\r
 422 ;THE COMMA ROUTINE IS ENTERED BY A DISPATCH FROM GETCHR.\r
 423 ;IT DETERMINES WHETHER THE COMMA DELIMITS A FILE NAME OR A\r
 424 ;PROGRAM NAME, AND TRANSFERS CONTROL EITHER TO SEMICP OR TO\r
 425 ;COMMAP.\r
 426 \r
 427 COMMA:  TRNN    F, CONB         ;FILE NAME OR PRGRAM NAME?\r
 428         JRST    COMMAX          ;FILE NAME\r
 429         PUSHJ   P, COMMAP       ;PROGRAM NAME\r
 430         JRST    GETCHR          ;RETURN FOR MORE CHARACTERS\r
 431 \r
 432 COMMAX: PUSHJ   P, SEMICP       ;FILE NAME, DO A LOOKUP\r
 433         SETZM   PRJPRG          ;CLEAR TEMP. PPN\r
 434         JRST    GETCHR          ;RETURN FOR MORE CHARACTERS\r
 435 \r
 436 \fSUBTTL COLON PROCESSOR\r
 437 ;THIS ROUTINE IS ENTERED BY A DISPATCH FROM THE GETCHR\r
 438 ;ITS PURPOSE IS TO INITIALIZE DEVICES USED BY FUDGE2 AND\r
 439 ;ASSIGN THEM A CHANNEL NUMBER. IF THE DEVICE IS THE TTY, THE\r
 440 ;ROUTINE EXITS IMMEDIATELY, SINCE THE TTY HAS ALREADY BEEN\r
 441 ;INITIALIZED. IF A PROGRAM WAS NOT SEEN IN THE PREVIOUS DEVICE\r
 442 ;SPECIFICATION, THEN THE PRECEDING FILE HAD NO PROGRAMS\r
 443 ;FOLLOWING IT, AND A ZERO IS PLACED IN THE LIST STRUCTURE IN\r
 444 ;THE 3-WORD FILE BLOCK, SO THAT THE GETDEV ROUTINE WILL\r
 445 ;KNOW THAT THE ENTIRE FILE IS DESIRED. IF THE COLON ROUTINE\r
 446 ;IS CALLED WITH 0 IN ACCUMULATOR S, THE ROUTINE ASSUMES\r
 447 ;THAT SOMETHING LIKE "DTA3:FOO?DTA4:BAR<X,Y,Z>,MTA0:::/R"\r
 448 ;WAS TYPED, AND IT PUTS A PHONY FILE NAME IN FILBUF TO KEEP\r
 449 ;THE BOOK-KEEPING STRAIGHT.\r
 450 \r
 451 COLON:  TRO     F, DEVB         ;DEVICE WAS SEEN IN THIS SPEC.\r
 452         TRNE    F,POPBAK        ;DEFAULT "DSK" BEING SET\r
 453         JRST    .+3             ;SO DON'T CLEAR PROJ-PROG\r
 454         SETZM   DEFPPN          ;CLEAR PERMANENT PPN\r
 455         SETZM   PRJPRG          ;AND TEMP. ALSO\r
 456         JUMPE   S, COLONC       ;NULL S IMPLIES FILES ON MTA,PTR\r
 457         MOVEM   S, COLON2       ;SAVE DEVICE FOR INIT\r
 458         MOVE    G, S            ;GET A COPY OF THE DEVICE NAME\r
 459         DEVCHR  G,              ;GET ITS CHARACTERISTICS\r
 460         MOVEM   G,SDEVCHR       ;SAVE DEV CHRSTCS ***VJC\r
 461         TLNE    G,TTYBIT!LPTBIT ;IF EITHER TTY OR LPT\r
 462         SETZM   LEVEL           ;DON'T DO EXTENDED LOOKUPS EVER\r
 463         TLNE    G, TTYBIT       ;IS THE DEVICE A TTY?\r
 464         JRST    GETCHR          ;YES, RETURN IMMEDIATELY\r
 465         TRNN    F, DESTB        ;IS THIS THE OUTPUT DEVICE?\r
 466         JRST    COLON4          ;YES, GO CHECK SEPARATE THINGS\r
 467         MOVE    D, DEVBUF       ;GET POINTER TO DEVICE NAME TABLE\r
 468 COLON6: AOBJP   D, COLON7       ;MORE DEVICES TO CHECK?\r
 469         CAMN    S, DEVBUF(D)    ;HAS DEVICE ALREADY BEEN INITTED?\r
 470         JRST    GETCHR          ;YES, DON'T RE-INIT IT\r
 471         JRST    COLON6          ;CHECK SOME MORE\r
 472 \f\r
 473 COLON7: MOVEM   S, DEVBUF(D)    ;STORE THE NEW DEVICE NAME\r
 474         MOVSI   A, -1           ;FIX UP THE COUNT IN THE BUFFER\r
 475         ADDM    A, DEVBUF       ;...\r
 476         TLNN    G, INBIT        ;CAN DEVICE DO INPUT?\r
 477         JRST    ERROR4          ;NO, ERROR\r
 478         MOVEI   S, 0            ;CLEAR OUT THE SYMBOL WORD\r
 479         TRON    F, PROGB        ;WAS A PROGRAM NAME SEEN?\r
 480         PUSHJ   P, STNULL       ;NO, STORE A NULL IN FILE BLOCK\r
 481         MOVE    A, D            ;CALCULATE BUFFER HEADER POSITION\r
 482         IMULI   A, 3            ;3 WORDS PER BUFFER HEADER\r
 483         ADDI    A, IBUF         ;ALL BUFFER HEADERS IN IBUF BLOCK\r
 484 COLON8: AOS     NUMDEV          ;ONE MORE DEVICE SEEN\r
 485         MOVEM   A, COLON3       ;SAVE WORD FOR INIT\r
 486         MOVEI   A, 14           ;SET MODE TO BINARY\r
 487         TLNE    G,LPTBIT        ;IS DEVICE THE LPT?\r
 488         MOVEI   A, 0            ;YES, RESTORE MODE TO ASCII\r
 489         HRRM    A, COLON0       ;SAVE MODE FOR INIT\r
 490         DPB     D, [POINT 4,COLON1,12]\r
 491         XCT     COLON1          ;DO OPEN ON DEVICE\r
 492         JRST    ERROR9          ;DEVICE NOT AVAILABLE\r
 493         TRNN    F, DESTB        ;IS THIS THE OUTPUT DEVICE?\r
 494         JRST    GETCHR          ;YES, NO MORE CHECKING - EXIT\r
 495         TLNN    G, DRCTRB       ;DOES DEVICE HAVE A DIRECTORY?\r
 496 COLONC: PUSHJ   P, COLONB       ;NO, GIVE IT A PHONY FILE NAME\r
 497         JRST    GETCHR          ;RETURN FOR MORE CHARACTERS\r
 498 \r
 499 ;OUTPUT DEVICE ONLY\r
 500 \r
 501 COLON4: MOVEM   S, DEVBUF+1     ;SAVE THE DEVICE NAME\r
 502         MOVEI   D, 1            ;SET DEVICE NUMBER TO 1\r
 503         TLNN    G, OUTBIT       ;CAN DEVICE DO OUTPUT?\r
 504         JRST    ERROR4          ;NO, ERROR\r
 505         TLNE    G,DTABIT        ;IS DEVICE DTA?\r
 506         TRO     F,DTAFLG        ;YES, SET IN CASE INDEXING\r
 507         MOVSI   A, OBUF+3       ;CALCULATE BUFFER HEADER ADDRESS\r
 508         TRO     F, TTYCB        ;INDICATE NON-TTY IO\r
 509         JRST    COLON8          ;ENTER MAIN PROCESSING LOOP\r
 510 \r
 511 COLONB: MOVEI   S, 465757       ;FILE NAME OF "FOO"\r
 512                                 ;FALLS THROUGH TO SEMICP ROUTINE\r
 513 \fSUBTTL FILE NAME PROCESSOR\r
 514 ;THIS ROUTINE IS CALLED BY THE COMMA ROUTINE WHEN IT HAS\r
 515 ;BEEN DETERMINED THAT THE CONTEXT OF THE COMMA IS THAT OF A\r
 516 ;FILE NAME. NULL FILES ARE IGNORED BY THE ROUTINE, AND CAUSE\r
 517 ;AN IMMEDIATE RETURN TO GETCHR. FOR OUTPUT DEVICES, AN ENTER\r
 518 ;IS PERFORMED, WHILE FOR INPUT DEVICES, THE FLOW OF CONTROL IS\r
 519 ;AS FOLLOWS:\r
 520 ;       1. IF THE PREVIOUS FILE HAD NO PROGRAMS, A ZERO IS\r
 521 ;          STORED IN THE 3RD WORD OF THE FILE BLOCK OF THAT\r
 522 ;          FILE - THE WORD THAT ORDINARILY POINTS TO THE \r
 523 ;          PROGRAM SUBLIST.\r
 524 ;       2. THE PROGRAM LIST FOR THE PREVIOUS FILE IS TERMINATED\r
 525 ;          BY PUTTING A ZERO IN THE PROGRAM BUFFER, AND PUTTING\r
 526 ;          A POINTER TO THE ZERO IN THE 3RD WORD OF THIS FILE\r
 527 ;          BLOCK (NOT THE PREVIOUS BLOCK)\r
 528 ;       3. THE FILE NAME AND FILE NAME EXTENSION AND THE DEVICE\r
 529 ;          CHANNEL NUMBER OF THE CURRENT FILE ARE STORED.\r
 530 \r
 531 SEMICP: TRNN    F,DEVB          ;HAS A DEVICE BEEN SEEN?\r
 532         PUSHJ   P,NODEV         ;NO, SO ASSUME "DSK"\r
 533         CAME    SW,DTCLR        ;Z SWITCH? YES, OPERATE ON OUTPUT ONLY\r
 534         DPB     D, [POINT 4,SW,12]\r
 535         TRZE    F, SAVEB        ;IS THERE A SWITCH TO PROCESS?\r
 536         XCT     SW              ;YES, EXECUTE IT\r
 537         JUMPE   S, SEMIC3       ;IGNORE NULL FILES\r
 538 \r
 539 SEMICA: TRZN    F, EXTB         ;EXPLICIT EXTENSION SEEN?\r
 540         HRLI    EXT, 624554     ;NO, REPLACE WITH REL"\r
 541         TRNN    F, DESTB        ;OUTPUT DEVICE?\r
 542         JRST    SEMIC2          ;YES, PROCESS SEPARATELY\r
 543         PUSH    P, S            ;SAVE FILE NAME\r
 544         MOVEI   S, 0            ;PUT IN A ZERO\r
 545         TRZN    F, PROGB        ;WAS A PROGRAM SEEN IN PREVIOUS?\r
 546         PUSHJ   P, STNULL       ;NO, CLOSE OUT PREVIOUS FILE\r
 547         PUSHJ   P, PUTPRG       ;YES, CLOSE OUT PREVIOUS PRGLST\r
 548 SEMIC4: POP     P, S            ;RESTORE FILE NAME\r
 549         CAMN    S,[12B5]        ;IS IT * ?***DMN\r
 550         JRST    ASTRSK          ;YES ***DMN\r
 551         PUSHJ   P, PUTFIL       ;NO, STORE FILENAME\r
 552         MOVE    S,DEFPPN        ;GET GLOBAL PPN\r
 553         PUSHJ   P,PUTPPN        ;SAVE IT\r
 554         MOVE    S, EXT          ;GET FILE NAME EXTENSION\r
 555         PUSHJ   P, PUTFIL       ;STORE IT\r
 556         HRRM    D, (A)          ;STORE CHANNEL NUMBER, ALSO\r
 557         MOVE    S,PRJPRG        ;GET TEMP. PPN\r
 558         PUSHJ   P,PUTPPN        ;SAVE IT ALSO\r
 559         HRRZ    S, PRGBUF       ;GET A POINTER TO PROGRAM LIST\r
 560         JRST    PUTFIL          ;STORE IT AND EXIT\r
 561 \r
 562 STNULL: HRRZ    A, FILBUF       ;GET ADDRESS OF CURRENT BLOCK\r
 563         SETZM   (A)             ;CLOSE OUT THE FILE\r
 564         POPJ    P,              ;EXIT\r
 565 \r
 566 \fSUBTTL ENTER ON OUTPUT DEVICE DIRECTORY\r
 567 \r
 568 SEMIC2: MOVEM   S, EBLOCK       ;SAVE FILE NAME FOR ENTER\r
 569         MOVEM   EXT, EBLOCK+1   ;SAVE FILE NAME EXTENSION\r
 570         DPB     D, [POINT 4,SEMIC1,12]\r
 571         SETZM   EBLOCK+2        ;CLEAR DATA AND PROTECTION\r
 572         MOVE    T,SDEVCHR       ;GET CHARACTERISTICS\r
 573         TLNN    T,DSKBIT        ;IF NOT A DSK\r
 574         SETZM   LEVEL           ;CLEAR LEVEL D FLAG\r
 575         SKIPE   T,LEVEL         ;EITHER -2 OR 0\r
 576         JRST    DEFENT          ;SAVE ENTRY BLOCK\r
 577         XCT     SEMIC1          ;DO AN ENTER ON THE OUTPUT DEVICE\r
 578         JRST    ERR14           ;DIRECTORY FULL\r
 579 SEMIC3: POPJ    P,              ;EXIT\r
 580 \r
 581 DEFENT: MOVE    T,[XWD EBLOCK,SVENTR]\r
 582         BLT     T,SVENTR+1      ;SAVE EBLOCK\r
 583         MOVEI   T,RIBALC        ;SET FOR 11 WORD LOOKUP\r
 584         MOVEM   T,EBLOCK-2      ;IN EXTENDED LOOKUP\r
 585         JRST    SEMIC3          ;DEFER ENTRY TIL AFTER LOOKUP\r
 586 \fSUBTTL THE PROGRAM NAME PROCESSOR\r
 587 ;THE COMMAP ROUTINE IS ENTERED BY A CALL FROM THE COMMA\r
 588 ;ROUTINE WHEN THE CONTEXT OF A COMMA IS THAT OF A PROGRAM NAME\r
 589 ;DELIMITER. ITS PURPOSE IS TO SAVE UP THE PROGRAM NAMES IT SEES\r
 590 ;IN THE PROGRAM BUFFER PRGBUF. THE PROGRAM NAMES ARE CONVERTED\r
 591 ;TO RADIX 50 REPRESENTATION, AND A CALL TO PUTPRG STORES THE\r
 592 ;PROGRAM NAME FOR LATER REFERENCE BY THE VARIOUS FUDGE SUBROUTINES\r
 593 ;------------------------------------------------------------------\r
 594 ;RADIX50 - SIXBIT CODE CONVERSION TABLE\r
 595 \r
 596 ;CHARACTER      SIXBIT          RADIX50\r
 597 \r
 598 ;0-9            20-31           01-12\r
 599 ;A-Z            41-72           13-44\r
 600 ;BLANK          00              00\r
 601 ;PERIOD         16              45\r
 602 ;$              04              46\r
 603 ;-------------------------------------------------------------------\r
 604 ;THE SYMBOL IS ASSUMED TO LEFT-JUSTIFIED UPON ENTERING, AND\r
 605 ;IS RIGHT-JUSTIFIED BEFORE CONVERSION TO RADIX 50.\r
 606 \r
 607 ;FLAG SETTINGS: THE PROGRAM BIT PROGB IS SET TO 1, AND THE FILE\r
 608 ;BIT FILEB IS SET TO 0.\r
 609 COMMAP: TRO     F, PROGB        ;SET PROGRAM BIT\r
 610         TRNN    F, DESTB        ;IS THIS THE OUTPUT DEVICE?\r
 611         JRST    ERROR1          ;YES, SYNTAX ERROR\r
 612         MOVE    E, SYMPTR       ;SET UP A BYTE POINTER TO S\r
 613         MOVEI   B, 6            ;SET COUNTER TO SIX\r
 614         MOVEI   C, 0\r
 615         JUMPE   S, COMMA1       ;NULL SYMBOL?\r
 616 COMMA3: TRNE    S, 77           ;IS SYMBOL RIGHT-JUSTIFIED YET?\r
 617         JRST    COMMA1          ;YES, GO CONVERT TO RADIX 50\r
 618         ROT     S, -6           ;NO, SHIFT IT ONE PLACE RIGHT\r
 619         JRST    COMMA3          ;CHECK AGAIN\r
 620 COMMA1: IMULI   C, 50           ;CONVERT TO RADIX50\r
 621         ILDB    A, E            ;PICK UP NEXT CHARACTER IN S\r
 622         JUMPE   A, COMMA4       ;A BLANK IS A BLANK IS A BLANK!\r
 623         CAIN    A, 4            ;IS IT A <$>?\r
 624         ADDI    A, 70           ;YES, COMPENSATE FOR SUBTRACTION\r
 625         CAIN    A, 16           ;IS IT A <.>?\r
 626         ADDI    A, 55           ;YES, COMPENSATE FOR SUBTRACTION\r
 627         CAILE   A, 31           ;TRANSLATE TO RADIX 50 CODE\r
 628         SUBI    A, 7            ;LETTER - SUBTRACT 26\r
 629         SUBI    A, 17           ;NUMBER - SUBTRACT 17\r
 630         ADD     C, A            ;COMBINE WITH PARTIAL WORD\r
 631 COMMA4: SOJG    B, COMMA1       ;LOOP FOR SIX CHARACTERS\r
 632         MOVE    S, C            ;PUT SYMBOL BACK IN S\r
 633         JRST    PUTPRG          ;STORE IT AND EXIT\r
 634 \r
 635 \fSUBTTL THE ALTMODE PROCESSOR\r
 636 ;THE ALTMODE SUBROUTINE IS CALLED BY A DISPATCH FROM THE\r
 637 ;GETCHR ROUTINE WHEN A $ IS SEEN IN THE COMMAND STRING. IT SIGNALS\r
 638 ;THE END OF THE COMMAND STRING. A CHECK IS MADE ON THE SYNTAX\r
 639 ;OF THE COMMAND STRING, TO SEE IF AN OUTPUT DEVICE WAS SPEC-\r
 640 ;IFIED, AND TO SEE IF A COMMAND WAS GIVEN. THE LIST\r
 641 ;STRUCTURE FOR THE FILE NAMES AND PROGRAM NAMES IS TERMINATED\r
 642 ;BY TWO CALLS TO SEMICP, THE LAST OF WHICH HAS A FILE NAME OF 0.\r
 643 ;THE POINTERS AT THE TOP OF THE FILBUF,PRGBUF AND DEVBUF BUFFERS\r
 644 ;ARE RESET FOR LATER USER BY THE VARIOUS SUBROUTINES.\r
 645 \r
 646 ALTMOD: TRNN    F,INFOB         ; IS THERE A COMMAND?\r
 647         JRST    FUDGE2          ; NO, RESTART\r
 648         PUSHJ   P,CRLF          ; ACKNOWLEDGE WITH A CR LF\r
 649         TRO     F,CRLFTY        ;INDICATE CR,LF TYPED\r
 650         PUSHJ   P, SEMICP       ;STORE THIS FILE NAME\r
 651         MOVEI   S, 0            ;MAKE A NULL FILE NAME\r
 652         PUSHJ   P, SEMICA       ;TERMINATE THE LIST STRUCTURE\r
 653         MOVE    A, FILXWD       ;SET UP A BLT POINTER TO FIX\r
 654         BLT     A, FILBUF+3     ;THE MASTER FILE PART,1ST WORD OF\r
 655         SETZM   FILBUF+4        ;FILBUF WAS JUNK,NOW 4TH WORD=0\r
 656         MOVEI   A, FILBUF+5     ;RESET POINTER TO TRANS. FILES\r
 657         MOVEM   A, FILBUF       ;...\r
 658         MOVEI   A,PPNBUF+1      ;RESET PPNBUF\r
 659         MOVEM   A,PPNBUF        ;AS IT WAS AT START\r
 660         JUMPE   DIS, ERROR1     ;NO COMMAND SEEN?\r
 661         TRNN    F, DESTB        ;NO OUTPUT FILE MENTIONED?\r
 662         JRST    ERROR1          ;SYNTAX ERROR\r
 663         SKIPE   MATCH           ;LEFT < EQU RIGHT > ?***VJC\r
 664         JRST    ERROR1          ;SYNTAX ERROR ***VJC\r
 665         TRNE    F, TTYCB        ;CHANGE OUTPUT IF ON TTY\r
 666         TRO     F, TTYOB        ;...\r
 667                                 ;AND FALL INTO INBUF0\r
 668 \r
 669 \f\r
 670 ;SEE HOW MANY 204(8) WORD BLOCKS FIT IN JOBREL-JOBFF.\r
 671 ;DIVIDE THIS NUMBER BY THE NUMBER OF DEVICES\r
 672 ;IN DEVBUF TABLE. THIS GIVES THE NO. OF BLOCKS\r
 673 ;THAT CAN BE ASSIGNED TO EACH DEVICE, IF ZERO,\r
 674 ;NEED MORE CORE. THE REMAINDER OF THE DIVISION\r
 675 ;INDICATES EXTRA BLOCKS THAT MAY BE\r
 676 ;ALLOCATED TO OUTPUT OR INPUT DEVICES\r
 677 \r
 678 INBUF0: HRRZ    A, JOBREL       ;GET TOP OF JOB AREA\r
 679         SUB     A,JOBFF         ;BUFFER AREA AVAILABLE\r
 680         IDIVI   A, 204          ;NUMBER OF DECTAPE BLOCKS\r
 681         IDIV    A,NUMDEV        ;DIVIDED BY NUMBER OF DEVICES\r
 682         JUMPE   A,INBUFG        ;NOT ENOUGH CORE\r
 683         MOVEI   E,2             ;START INBUFS ON DEVICE #2\r
 684         TRNE    F, TTYCB        ;IS OUTPUT ON TTY?\r
 685         JRST    INBUF1          ;NO, DO AN OUTBUF\r
 686 INBUF2: MOVE    C, A            ;PICK UP NUMBER OF BLOCKS\r
 687         SOJL    A+1,.+2         ;ANY EXTRA BLOCKS? (REMAINDER)\r
 688         AOJ     C,              ;YES, USE THEM\r
 689         DPB     E, [POINT 4, INBUF3,12]\r
 690         XCT     INBUF3          ;PERFORM THE INBUF\r
 691         CAMGE   E, D            ;MORE DEVICES TO TAKE CARE OF?\r
 692         AOJA    E, INBUF2       ;YES, PROCESS THEM\r
 693         JRST    (DIS)           ;NO, GO TO APPROPRIATE SUBROUTINE\r
 694 \r
 695 \r
 696 INBUF1: MOVE    C, A            ;PICK UP NUMBER OF BLOCKS\r
 697         SOJL    A+1,.+2         ;ANY EXTRA BLOCKS?\r
 698         AOJ     C,              ;YES, GIVE ONE TO OUTPUT\r
 699 INBUF4: OUTBUF  1,(C)           ;OUTBUF ON DEVICE #1\r
 700         JRST    INBUF2          ;GO DO SOME INBUFS\r
 701 ;ASK FOR MORE CORE\r
 702 \r
 703 INBUFG: HRRZ    A,JOBREL        ;GET ANOTHER K OF CORE\r
 704         ADDI    A,2000\r
 705         CORE    A,\r
 706         JRST    ERR22           ;NOT AVAILABLE\r
 707         JRST    INBUF0          ;TRY TO SET UP BUFFERS\r
 708 \fSUBTTL FUDGE2 COMMAND PROCESSORS\r
 709 \r
 710 ;LIST PROCESSOR\r
 711 ;THIS ROUTINE PROCESSES THE L COMMAND IN FUDGE2. BINARY\r
 712 ;PROGRAMS ARE READ, AND THEIR NAMES OUTPUT, UNTIL AN END\r
 713 ;OF FILE IS REACHED.\r
 714 \r
 715 LIST:   TRNN    F,TTYOB         ;OUTPUT TO TTY?\r
 716         JRST    LIST1           ;MODE MUST BE ASCII\r
 717         GETSTS  1,T             ;GET STATUS\r
 718         TRZN    T,14            ;BINARY MODE SET?\r
 719         JRST    LIST1           ;NO, MUST BE ASCII\r
 720         SETSTS  1,(T)           ;CHANGE MODE TO ASCII\r
 721         MOVSI   T,700           ;SET UP NEW BYTE POINTER\r
 722         MOVEM   T,OBUF+4        ;SO WORD COUNT WILL BE CORRECT\r
 723 LIST1:  PUSHJ   P, MSTGET       ;GET THE MASTER DEVICE\r
 724         JRST    ERROR6          ;NOT ENOUGH ARGUMENTS\r
 725         SETOM   NOWARN          ;DON'T GIVE WARNING MESSAGE IF INDEX SEEN\r
 726 LIST2:  PUSHJ   P, READ         ;READ A PROGRAM NAME\r
 727         JRST    EXIT            ;ALL DONE\r
 728         MOVE    B, A            ;GET THE PROGRAM NAME IN B\r
 729         PUSHJ   P, PTYPO        ;TYPE IT OUT\r
 730         PUSHJ   P, CRLF         ;TYPE A CRLF\r
 731         JRST    LIST2           ;RETURN FOR MORE PROGRAM NAMES\r
 732 \r
 733 \r
 734 ;REPLACE PROCESSOR\r
 735 ;THIS ROUTINE PROCESSES THE R COMMAND IN FUDGE2. THE TOTAL\r
 736 ;COMMAND STRING IS BROKEN INTO A LIST OF PROGRAMS FOR THE MASTER\r
 737 ;DEVICE, AND A LIST OF PROGRAMS FOR THE TRANSACTION DEVICES.\r
 738 ;THE ROUTINE READS THE MASTER FILE UNTIL ONE OF THE DESIRED\r
 739 ;REPLACEMENT PROGRAMS IS REACHED, THEN SWITCHES TO THE \r
 740 ;TRANSACTION DEVICE TO FIND THE PROGRAM WHICH IS TO REPLACE THE\r
 741 ;PROGRAM IN THE MASTER FILE. AFTER THE REPLACEMENT HAS BEEN\r
 742 ;EFFECTED, RESET IS CALLED TO RESTORE THE MASTER DEVICE TO ITS\r
 743 ;OLD POSITION.\r
 744 \r
 745 REPLCE: PUSHJ   P, MSTGET       ;GET A PROGRAM FROM MASTER DEVICE\r
 746         JRST    IPROC7          ;NO MORE, COPY REST OF MASTER\r
 747         PUSHJ   P, COPYTO       ;COPY UP TO THE PROGRAM NAME\r
 748         PUSHJ   P, TRNGET       ;GET A PROGRAM FROM TRANSACTION\r
 749         JRST    ERROR5          ;USER DID NOT SUPPLY ENOUGH\r
 750         PUSHJ   P, FINDCP       ;FIND THE PROGRAM AND COPY IT\r
 751         CAIN    D, 2            ;HAS THE MASTER DEVICE BEEN MOVED?\r
 752         PUSHJ   P, RESET        ;YES, RESET IT\r
 753         JRST    REPLCE          ;LOOK FOR MORE REPLACEMENTS\r
 754 \fSUBTTL INSERT PROCESSOR\r
 755 ;THIS SUBROUTINE PROCESSES THE I COMMAND IN FUDGE. IT READS AND\r
 756 ;WRITES PROGRAMS FROM THE MASTER FILE UNTIL IT FINDS THE\r
 757 ;PROGRAM NAME CURRENTLY POINTED TO, AT WHICH TIME IT STARTS READING\r
 758 ;FROM THE TRANSACTION DEVICE, MAKING AN INSERTION AT THE\r
 759 ;PROPER PLACE.\r
 760 \r
 761 INSERT: PUSHJ   P, MSTGET       ;GET A PROGRAM FROM MASTER FILE\r
 762         JRST    IPROC7          ;NO MORE, COPY REST OF MASTER\r
 763         PUSHJ   P, COPYTO       ;COPY UP TO A PROGRAM NAME\r
 764         MOVEM   C, SAVEAC       ;SAVE SPECIAL ACCUMULATOR\r
 765         MOVE    D, [XWD ENTBLK,SVEBLK]\r
 766         BLT     D, X+1(C)       ;MOVE ENTRY BLOCK INTO SAFE PLACE\r
 767         PUSHJ   P, TRNGET       ;GET NEXT TRANSACTION FILE\r
 768         JRST    ERROR5          ;NOT ENOUGH TRANSACTION FILES\r
 769         PUSHJ   P, FINDCP       ;FIND TRANSACTION FILE AND COPY\r
 770         CAIE    D, 2            ;HAS MASTER FILE BEEN JIGGLED?\r
 771         JRST    FIXUP           ;NO, RESTORE THE ENTRY BLOCK\r
 772         PUSHJ   P, RESET        ;YES, RESET IT\r
 773         JRST    INSER1          ;WRITE OUTGO BACK FOR MORE INSERTIONS\r
 774 \r
 775 FIXUP:  MOVE    C, SAVEAC       ;RESTORE SPECIAL AC\r
 776         MOVS    D, [XWD ENTBLK,SVEBLK]\r
 777         BLT     D, (C)          ;RESTORE ENTRY BLOCK\r
 778         MOVEI   D, 2            ;SET UP CHANNEL AC\r
 779         MOVEI   DIS, 6          ;SET UP BUFFER HEADER INDEX\r
 780 INSER1: PUSHJ   P, WRITE        ;WRITE OUT THE CURRENT FILE\r
 781         JRST    INSERT          ;GO BACK FOR MORE INSERTIONS\r
 782 \r
 783 IPROC7: PUSHJ   P, COPY         ;COPY REST OF MASTER FILE\r
 784         JRST    EXIT            ;EXIT\r
 785 \f SUBTTL EXTRACT PROCESSOR\r
 786 ;THIS ROUTINE PROCESSES THE E COMMAND IN FUDGE. RATHER THAN\r
 787 ;ONE MASTER AND SEVERAL TRANSACTION FILES, ALL FILES ARE\r
 788 ;TREATED THE SAME. AFTER A CALL TO EITHER MSTGET OR TRNGET\r
 789 ;PROGRAMS ARE SEARCHED FOR AND WRITTEN ON THE OUTPUT DEVICE.\r
 790 \r
 791 EXTRCT: SETOM   NOWARN          ;NO WARNING MESSAGE\r
 792         PUSHJ   P, MSTGET       ;GET A PROGRAM FROM MASTER DEVICE\r
 793         JRST    EPROC1          ;ALL DONE WITH MASTER DEVICE\r
 794         JUMPN   R,.+3           ;ANY PROGRAMS THIS FILE? **VJC\r
 795         PUSHJ   P,COPY          ;NO, COPY ENTIRE FILE ***VJC\r
 796         JRST    EPROC1          ; ***VJC\r
 797         PUSHJ   P, FINDCP       ;FIND THE PROGRAM AND COPY IT\r
 798         JRST    EXTRCT          ;RETURN FOR MORE MASTER PROGRAMS\r
 799 EPROC1: MOVEI   A, FILBUF+5     ;GET PROGRAM FROM TRANS BUFFER\r
 800         MOVEM   A, FILBUF       ;INITIALIZE POINTER FIRST\r
 801 EPROC2: PUSHJ   P, GETDEV       ;...\r
 802         JRST    EXIT            ;ALL DONE\r
 803         JUMPN   R,.+3           ;ANY PROGRAMS THIS FILE?  ***VJC\r
 804         PUSHJ   P,COPY          ;NO, COPY ENTIRE FILE ***VJC\r
 805         JRST    EPROC2          ; ***VJC\r
 806         PUSHJ   P, FINDCP       ;FIND THE PROGRAM AND COPY IT\r
 807         JRST    EPROC2          ;RETURN FOR MORE TRANS FILES\r
 808 \fSUBTTL DELETE PROCESSOR\r
 809 ;THIS ROUTINE PROCESSES THE D COMMAND IN FUDGE2.  ONLY ONE\r
 810 ;INPUT FILE WILL BE READ, AND THE PROGRAM NAMES ASSOCIATED\r
 811 ;WITH ITS LIST WILL BE DELETED.\r
 812 \r
 813 DELETE: PUSHJ   P, MSTGET       ;GET A PROGRAM TO BE DELETED\r
 814         JRST    IPROC7          ;FINISH OFF THE MASTER FILE\r
 815 DPROC1: PUSHJ   P, READ         ;READ A PROGRAM\r
 816         JRST    ERROR7          ;EOF - CANT FIND IT\r
 817         CAMN    R, A            ;CORRECT PROGRAM?\r
 818         JRST    DELETE          ;YES, GET THE NEXT ONE\r
 819         PUSHJ   P, WRITE        ;NO, WRITE THIS ONE OUT\r
 820         JRST    DPROC1          ;TRY AGAIN\r
 821 \r
 822 ;APPEND PROCESSOR\r
 823 ;THIS ROUTINE HANDLES THE A COMMAND IN FUDGE2. IT WILL COPY\r
 824 ;THE ENTIRE MASTER FILE, THEN START OBTAINING TRANSACTION\r
 825 ;DEVICES WITH CALLS TO TRNGET, APPENDING ONE OR MORE\r
 826 ;PROGRAMS FROM EACH FILE.\r
 827 \r
 828 APPEND: PUSHJ   P, MSTGET       ;GET A PROGRAM FROM MASTER FILE\r
 829         JRST    ERROR6          ;NOT ENOUGH ARGUMENTS\r
 830         PUSHJ   P, COPY         ;COPY ENTIRE FILE\r
 831         MOVEI   A, FILBUF+5     ;INITIALIZE POINTER FOR TRANS\r
 832         MOVEM   A, FILBUF       ;...\r
 833 APROC3: PUSHJ   P, GETDEV       ;GET A PROGRAM NAME\r
 834         JRST    EXIT            ;ALL DONE\r
 835         PUSHJ   P, FINDCP       ;FIND THE PROGRAM AND COPY IT\r
 836         JRST    APROC3          ;GET NEXT APPENDATION\r
 837 \f\r
 838 ;THIS ROUTINE PROCESSES THE X COMMAND (INDEX LIBRARY)\r
 839 ;AND FALLS INTO DELETE LOCAL SYMBOLS CODE.\r
 840 ;IF NOT DESIRED SKIP TO DELCPY+1\r
 841 \r
 842 INDEX:  MOVE    A,DEVBUF+1      ;GET OUTPUT DEVICE\r
 843         DEVCHR  A,              ;GET ITS CHARACTERISTICS\r
 844         TLNN    A,DSKBIT!DTABIT ;ONLY ALLOW DSK AND DTA AS LIBRARY DEVICES\r
 845         JRST    ERR23           ;GIVE ERROR MESSAGE\r
 846         SETOM   NOWARN          ;NO WARNING MESSAGE IF /X\r
 847         TRO     F,XFLG          ;SET INDEX FLAG\r
 848 ;       TROA    F,XFLG          ;SET /X BUT NOT /C\r
 849 \r
 850 ;DELETE LOCAL SYMBOLS AND COPY PROCESSOR\r
 851 ;THIS ROUTINE PROCESSES THE C COMMAND\r
 852 ;ONLY THE MASTER FILE IS HANDLED\r
 853 \r
 854 DELCPY: TRO     F, NOLOCB       ;SET FLAG TO DELETE LOCAL SYMBOLS\r
 855         PUSHJ   P, MSTGET       ;GET A PROGRAM FROM MASTER FILE\r
 856         JRST    ERROR6          ;NOT ENOUGH ARGUMENTS\r
 857         PUSHJ   P, COPY         ;COPY ENTIRE FILE\r
 858         TRNN    F,XFLG          ;INDEX FLAG ON?\r
 859         JRST    EXIT            ;ALL DONE\r
 860         JRST    INDEX3          ;YES DO PASS 2\r
 861 \fSUBTTL FUDGE2 IO SUBROUTINES\r
 862 \r
 863 ;ROUTINES TO COPY FILES, COPY UP TO A GIVEN PROGRAM IN A FILE\r
 864 ;AND TO FIND A GIVEN PROGRAM IN A FILE AND COPY IT.\r
 865 \r
 866 ;THE COPY ROUTINE WILL COPY BINARY PROGRAMS FROM WHEREVER THE\r
 867 ;INPUT DEVICE HAPPENS TO BE WHEN IT IS CALLED, UP TO THE\r
 868 ;END OF FILE. SINCE COPY IS CALLED WITH A PUSHJ, THE END-OF-\r
 869 ;FILE EXIT IN INGET WILL EXIT TO THE PLACE THAT CALLED COPY.\r
 870 \r
 871 COPY:   PUSHJ   P, READ         ;READ A PROGRAM\r
 872         POPJ    P,              ;EXIT WHEN ALL THROUGH FILE\r
 873         PUSHJ   P, WRITE        ;WRITE OUT THE PROGRAM\r
 874         JRST    COPY            ;RETURN FOR MORE PROGRAMS\r
 875 \r
 876 ;THE COPYTO ROUTINE WILL READ AND WRITE PROGRAMS FROM THE\r
 877 ;INPUT DEVICE UNTIL THE PROGRAM WHOSE NAME IS IN ACCUMULATOR\r
 878 ;R IS FOUND, AT WHICH TIME IT EXITS\r
 879 \r
 880 COPYTO: PUSHJ   P, READ         ;READ A PROGRAM\r
 881         JRST    ERROR7          ;EOF - CANT FIND IT\r
 882         CAMN    R, A            ;IS IT THE CORRECT PROGRAM?\r
 883         POPJ    P,              ;YES, EXIT\r
 884         PUSHJ   P, WRITE        ;NO, WRITE IT OUT\r
 885         JRST    COPYTO          ;READ SOME MORE PROGRAMS\r
 886 \f\r
 887 ;THE FINDCP ROUTINE WILL SEARCH THE INPUT FILE FOR A PROGRAM\r
 888 ;WHOSE NAME IS IN ACCUMULATOR R, AND HAVING FOUND IT, WILL\r
 889 ;WRITE IT OUT. IF THE CONTENTS OF AC R ARE ZERO, THE ENTIRE\r
 890 ;FILE IS COPIED.\r
 891 \r
 892 FINDCP: JUMPE   R, COPY         ;COPY ENTIRE FILE?\r
 893 FIND1:  PUSHJ   P, READ         ;READ A PROGRAM FROM INPUT FILE\r
 894         JRST    FIND2           ;EOF, TRY REWINDING AND TRYING AGAIN\r
 895         CAME    R, A            ;IS THIS THE RIGHT ONE?\r
 896         JRST    FIND1           ;NO, TRY AGAIN\r
 897         JRST    WRITE           ;YES, WRITE IT OUT AND EXIT\r
 898 \r
 899 FIND2:  JUMPE   A,ERROR7        ;V3 IF EOF OUTPUT ERROR MESSAGE\r
 900         PUSHJ   P, BACKSP       ;BACKSPACE THE MAG TAPE\r
 901         HRRZ    A, FILBUF       ;PICK UP THE FILE POINTER\r
 902         HLLM    A, 3(A)         ;CLEAR THE LOOKUP FLAG FOR DECTAPE\r
 903         PUSHJ   P, GETDEV       ;SET UP THE PROGRAM AGAIN\r
 904         JRST    ERROR3          ;IMPOSSIBLE ERROR RETURN\r
 905 FIND3:  PUSHJ   P, READ         ;READ A PROGRAM FROM INPUT FILE\r
 906         JRST    ERROR7          ;EOF - REALLY CANT FIND IT\r
 907         CAME    R, A            ;IS THIS THE RIGHT ONE?\r
 908         JRST    FIND3           ;NO, TRY AGAIN\r
 909         JRST    WRITE           ;YES, WRITE IT OUT AND EXIT\r
 910 \f;ROUTINE MSTGET RETRIEVES A PROGRAM NAME FROM THE MASTER\r
 911 ;DEVICE SPECIFICATIONS. IT SAVES THE POINTER IN FILBUF, \r
 912 ;CHANGES IT TO POINT TO ITS OWN BLOCK, THEN CALLS GETDEV\r
 913 \r
 914 MSTGET: MOVE    A, FILBUF       ;GET THE POINTER TO CURRENT FILE\r
 915         MOVEM   A, FILSAV       ;SAVE THE CURRENT POINTER\r
 916         MOVEI   A, FILBUF+1     ;CHANGE IT TO POINT TO MASTER\r
 917         MOVEM   A, FILBUF       ;...\r
 918         JRST    GETDEV          ;CALL COMMON ROUTINE\r
 919 \r
 920 \r
 921 ;ROUTINE TRNGET RETRIEVES A PROGRAM NAME FROM THE TRANSACTION\r
 922 ;FILES. IT RESETS THE POINTER THAT MSTGET WIPED OUT, AND CALLS\r
 923 ;THE COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.\r
 924 \r
 925 TRNGET: MOVE    A, FILSAV       ;GET SAVED POINTER\r
 926         MOVEM   A, FILBUF       ;RESTORE IT TO ITS PLACE\r
 927         JRST    GETDEV          ;CALL COMMON ROUTINE\r
 928 \r
 929 ;ROUTINE RESET RESTORES THE STATE OF THE MASTER DEVICE TO\r
 930 ;WHAT IT WAS JUST AFTER THE LAST TIME MSTGET WAS CALLED. IT\r
 931 ;SETS THE POINTER OF THE MASTER FILE BACK TO THE PREVIOUS\r
 932 ;PROGRAM, CALLS MSTGET, AND FINDS THE PROGRAM AGAIN\r
 933 \r
 934 RESET:  MOVEI   A,FILBUF+5      ;START OF TRANSACTION LIST  ***DMN\r
 935         HLLM    A, FILBUF+3     ;NOW CLEAR LOOKUP FLAG ON MASTER\r
 936         SOS     FILBUF+3        ;MOVE POINTER BACK ONE PROGRAM\r
 937 RESET2: SKIPN   (A)             ;ANY TRANSACTION FILES ?    ***DMN\r
 938         JRST    RESET3          ;NO-ALL DONE                ***DMN\r
 939         HLLM    A,2(A)          ;CLEAR LOOKUP FLAG ON IT    ***DMN\r
 940         ADDI    A,3             ;NEXT FILE                  ***DMN\r
 941         JRST    RESET2          ;GO BACK FOR MORE           ***DMN\r
 942 RESET3: PUSHJ   P, MSTGET       ;SET UP THE MASTER DEVICE\r
 943         JRST    ERROR3          ;FUDGE ERROR-NO MASTER!\r
 944         PUSHJ   P, BACKSP       ;BACKSPACE IN CASE ITS A MAG TAPE\r
 945         MOVE    A, FILSAV       ;DIDDLE THE POINTERS, BECAUSE MSTGET\r
 946         MOVEM   A, FILBUF       ;WILL BE CALLED AGAIN IMMEDIATELY\r
 947 RESET1: PUSHJ   P, READ         ;READ A PROGRAM FROM MASTER FILE\r
 948         JRST    ERROR3          ;FUDGE ERROR-CANT FIND PROGRAM\r
 949         CAME    R, A            ;IS IT THE RIGHT PROGRAM NAME?\r
 950         JRST    RESET1          ;NO, LOOK AGAIN\r
 951         POPJ    P,              ;YES, EXIT\r
 952 BACKSP: DPB     D, [POINT 4, BACK0,12]\r
 953         DPB     D, [POINT 4, BACK1, 12]\r
 954         DPB     D, [POINT 4, BACK2,12]\r
 955         DPB     D, [POINT 4,BACK3,12]\r
 956         JRST    BACK0           ;GO TO POSITION MAGTAPE\r
 957 \fSUBTTL COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.\r
 958 ;THIS PROGRAM USES VARIOUS POINTERS AND BITS OF INFORMATION\r
 959 ;IN FILBUF AND PRG BUF TO RETURN TO THE USER A RADIX 50\r
 960 ;PROGRAM NAME AS SEEN IN THE COMMAND STRING. THE STRUCTURE\r
 961 ;OF INFORMATION IN THESE TWO BUFFERS IS AS FOLLOWS:\r
 962 \r
 963 ;FILBUF IS A LIST OF 3-WORD BLOCKS OF DATA ABOUT EACH FILE.\r
 964 ;THE FIRST WORD IN FILBUF IS A POINTER WHICH POINTS TO THE\r
 965 ;FIRST WORD OF THE BLOCK CURRENTLY BEING WORKED ON BY\r
 966 ;THE VARIOUS SUBROUTINES OF FUDGE. WHEN THE COMMAND STRING\r
 967 ;IS BEING PROCESSED AND INFORMATION IS BEING STORED IN FILBUF,\r
 968 ;THIS POINTER IS IN THE FORM OF AN AOBJN WORD SO THAT A CHECK\r
 969 ;CAN BE MADE FOR BUFFER OVERFLOW. THE CONTENTS OF THE 3-WORD\r
 970 ;FILE BLOCK IS AS FOLLOWS:\r
 971 ;       1ST WORD - SIXBIT FILE NAME, OR ZERO IF THIS IS THE\r
 972 ;                  END OF THE LIST .\r
 973 ;       2ND WORD - LEFT HALF CONTAINS A SIXBIT FILE NAME EXTENSION\r
 974 ;                  RIGHT HALF CONTAINS THE CHANNEL NUMBER FOR\r
 975 ;                  THIS FILE.\r
 976 ;       3RD WORD - LEFT HALF IS ZERO IS A LOOKUP HAS NOT BEEN\r
 977 ;                  DONE ON THIS FILE NAME, AND -1 IF IT HAS. A\r
 978 ;                  LOOKUP CAN THUS BE FORECED BY ZEROING OUT THE\r
 979 ;                  LEFT HALF OF THE WORD.\r
 980 ;                  RIGHT HALF CONTAINS A POINTER TO THE LAST\r
 981 ;                  PROGRAM NAME IN PRGBUF THAT WAS REFERENCED. THE\r
 982 ;                  RIGHT HALF IS ZERO IF THERE ARE NO PROGRAM\r
 983 ;                  NAMES ASSOCIATED WITH THE FILE.\r
 984 \r
 985 ;PRGBUF IS A LIST OF PROGRAM NAMES USED BY THE FILES IN FILBUF.\r
 986 ;THE FIRST WORD OF PRGBUF IS A POINTER WORD WHOSE USE IS THE\r
 987 ;SAME AS THE FIRST WORD OF FILBUF.THE ENTRIES IN PRGBUF CONSIST\r
 988 ;OF A LIST OF RADIX50 SYMBOLS, ONE TO A WORD, TERMINATED BY\r
 989 ;A ZERO WORD.\r
 990 \r
 991 ;FUDGE2 WORKS WITH FILBUF AND PRGBUF IN TWO DISTINCTLY \r
 992 ;DIFFERENT WAYS: ONCE WHEN IT IS PROCESSING THE COMMAND STRING\r
 993 ;AND STORING THE VARIOUS FILE NAMES AND PROGRAM NAMES, AND\r
 994 ;ONCE WHEN IT IS USING THE INFORMATION IN THE FILES TO PROCESS\r
 995 ;A FUDGE COMMAND. WHEN A FILE NAME IS SEEN IN THE COMMAND STRING,\r
 996 ;THE STATUS OF THE PREVIOUS FILE IS CHECKED. IF THE PREVIOUS\r
 997 ;FILE HAD NO PROGRAM NAMES, THEN ITS POINTER WORD (3RD WORD) IS\r
 998 ;ZEROED OUT TO INDICATE THE ABSCENCE OF ANY PROGRAMS IN PRGBUF.\r
 999 ;OTHERWISE, PROCESSING BEGINS ON THE CURRENT FILE: THE FILE\r
1000 ;NAME, FILE NAME EXTENSION, AND CHANNEL NUMBER ARE STORED. THE\r
1001 ;CONTENTS OF THE POINTER WORD IN PRGBUF ARE STORED IN THE\r
1002 ;POINTER WORD OF THE FILE BLOCK\r
1003 ;ROOM IS LEFT IN FILBUF SO THAT WHEN THE CARRIAGE RETURN IS\r
1004 ;SEEN, FUDGE2 CAN SHUFFLE THE FIRST FILE BLOCK UP ONE WORD AND\r
1005 ;INSERT ANOTHER NULL. THE EFFECT OF THIS KLUDGE IS THAT WE NOW\r
1006 ;HAVE TWO SEPARATE LISTS IN FILBUF, A MASTER LIST, AND A \r
1007 ;TRANSACTION LIST.\r
1008 \fGETDEV:        MOVE    B, FILBUF       ;GET POINTER TO FILE BLOCK\r
1009         SKIPN   (B)             ;END OF LIST? (ZERO TERMINATES)\r
1010         POPJ    P,              ;YES, EXIT\r
1011         MOVE    A,PPNBUF        ;GET POINTER TO PPN'S\r
1012         MOVE    D,(A)           ;GET GLOBAL PPN\r
1013         MOVEM   D,DEFPPN        ;SAVE AS DEFAULT PPN\r
1014         MOVE    D,1(A)          ;GET TEMP. PPN\r
1015         MOVEM   D,PRJPRG        ;SAVE AS TEMP. PPN\r
1016         ADDI    A,2             ;INCREMENT POINTER\r
1017         MOVEM   A,PPNBUF        ;SAVE NEW POINTER\r
1018         HRRZ    D, 1(B)         ;GET DEVICE NUMBER FOR THIS DEVICE\r
1019         SKIPL   2(B)            ;HAS A LOOKUUP BEEN DONE?\r
1020         JRST    GET3            ;NO, GO DO LOOKUP\r
1021 GET0:   MOVEI   DIS, 3          ;SET UP AC DIS\r
1022         IMUL    DIS, D          ;C(DIS) = 3*C(D)\r
1023         HRRZ    A, 2(B)         ;GET  POINTER TO  PROGRAM NAMES\r
1024         JUMPE   A, GET1         ;NULL PROGRAM LIST (NO POINTER)?\r
1025         AOS     A, 2(B)         ;NO, INCREMENT POINTER BY ONE\r
1026         MOVE    R, (A)          ;GET A PROGRAM NAME\r
1027         JUMPN   R, CPOPJ1       ;END OF PROGRAM LIST?\r
1028         ADDI    B, 3            ;YES, INCREMENT FILBUF POINTER\r
1029         MOVEM   B, FILBUF       ;SAVE NEW POINTER\r
1030         JRST    GETDEV          ;TRY NEXT FILE BLOCK\r
1031 \r
1032 GET1:   MOVEI   R, 0            ;NO PROGRAMS, RETURN ZERO\r
1033         ADDI    B, 3            ;MOVE FILBUF POINTER TO NEXT BLOCK\r
1034         MOVEM   B, FILBUF       ;SAVE THE POINTER\r
1035 CPOPJ1: AOSA    (P)             ;GOOD RETURN\r
1036 POPOUT: POP     P,(P)           ;POP UP ONE LEVEL\r
1037 CPOPJ:  POPJ    P,              ;EXIT\r
1038 \f\r
1039 GET3:   DPB     D, [POINT 4,GET3A,12]\r
1040         XCT     GET3A           ;CLOSE CURRENT FILE BEFORE DOING...\r
1041         MOVE    A, (B)          ;GET FILE NAME OF NEXT FILE\r
1042         MOVEM   A, EBLOCK       ;SET UP FOR LOOKUP\r
1043         HLLZ    A, 1(B)         ;GET FILE NAME EXTENSION\r
1044         MOVEM   A, EBLOCK+1     ;SAVE IT FOR LOOKUP\r
1045         HRROS   A, 2(B)         ;SET FLAG IN LEFT HALF OF 3RD WORD\r
1046         DPB     D, [POINT 4,GET4A,12]\r
1047         SKIPN   A,PRJPRG        ;GET TEMP. PPN\r
1048         MOVE    A,DEFPPN        ;USE PERMANENT IF NO TEMP.\r
1049         MOVEM   A,EBLOCK+3      ;SAVE IT\r
1050         MOVEM   A,EBLOCK-1      ;FOR LEVEL D ALSO\r
1051         MOVE    A,DEVBUF(D)     ;GET DEVICE\r
1052         DEVCHR  A,              ;GET ITS CHARACTERISTICS\r
1053         TLNN    A,DSKBIT        ;IF NOT A DSK\r
1054         TDZA    T,T             ;NO EXTENDED LOOKUP\r
1055         MOVE    T,LEVEL         ;GET LEVEL\r
1056 GET4:   XCT     GET4A           ;DO A LOOKUP ON NEW FILE\r
1057         JRST    .+3             ;NOT FOUND, TRY WITH BLANKS EXT.\r
1058         SETZM   EBLOCK+3        ;CLEAR PROJ-PROG\r
1059         JRST    DOENTR          ;SUCCESSFUL RETURN FROM LOOKUP\r
1060         HLRZ    A, 1(B)         ;GET THE FILE NAME EXTENSION\r
1061         CAIE    A, 624554       ;IS IT "REL" ?\r
1062         JRST    ERROR8          ;NO,  DON'T GIVE HIM ANOTHER CHANCE\r
1063         HLLM    A, 1(B)         ;YES, TRY LOOKUP WITH 0 EXTENSION\r
1064         SETZM   EBLOCK+1        ;CLEAR EXTENSION IN LOOKUP BLOCK\r
1065         JRST    GET4            ;TRY AGAIN\r
1066 \r
1067 DOENTR: SKIPN   LEVEL           ;IF NOT LEVEL D\r
1068         JRST    DOXSWT          ;ENTER DONE ALREADY\r
1069         MOVS    T,[XWD EBLOCK,SVENTR]\r
1070         BLT     T,EBLOCK+1      ;RESTORE EBLOCK\r
1071         MOVSI   T,777000        ;MASK FOR PROTECTION\r
1072         ANDM    T,EBLOCK+2      ;CLEAR DATE AND TIME\r
1073         SETZM   EBLOCK-1        ;CLEAR PPN\r
1074         MOVE    T,LEVEL\r
1075         XCT     SEMIC1          ;DO ENTER\r
1076         JRST    [HRRZ T,EBLOCK+1 ;GET ERROR CODE\r
1077                 CAIN    T,17    ;PARTIAL ALLOCATION ONLY?\r
1078                 JRST    .+1     ;YES, JUST CONTINUE\r
1079                 JRST    ERR14]  ;ERROR\r
1080         SETZM   LEVEL           ;NEVER AGAIN\r
1081 DOXSWT: TRNE    F,XFLG          ;INDEX FLAG ON?\r
1082         PUSHJ   P,INDEX0        ;YES, SET UP POINTERS AND CORE\r
1083         JRST    GET0            ;AND CONTINUE\r
1084 \f\r
1085 ;SHORT ROUTINES TO STORE WORDS IN THE FILE BUFFER AND PROGRAM\r
1086 ;BUFFER\r
1087 ;ROUTINE PUTFIL STORES THE CONTENTS OF ACCUMULATOR S IN THE\r
1088 ;NEXT FREE LOCATION IN FILBUF. IT CHECKS FOR OVERFLOW.\r
1089 \r
1090 PUTFIL: MOVE    A, FILBUF       ;GET POINTER WORD FOR FILBUF\r
1091         AOBJP   A, ERROR2       ;INCREMENT, CHECK FOR OVERFLOW\r
1092         MOVEM   A, FILBUF       ;SAVE NEW POINTER\r
1093         MOVEM   S, (A)          ;SAVE FILE NAME ENTRY\r
1094         POPJ    P,              ;EXIT\r
1095 \r
1096 \r
1097 ;ROUTINE PUTPRG STORES THE CONENTS OF ACCUMULATOR S IN THE\r
1098 ;NEXT FREE LOCATION IN PRGBUF. IT CHECKS FOR OVERFLOW.\r
1099 \r
1100 PUTPRG: MOVE    A, PRGBUF       ;GET POINTER WORD FOR BUFFER\r
1101         AOBJP   A, ERROR2       ;INCREMENT, CHECK FOR OVERFLOW\r
1102         MOVEM   A, PRGBUF       ;SAVE NEW POINTER WORD\r
1103         MOVEM   S, (A)          ;SAVE PROGRAM NAME\r
1104         POPJ    P,              ;EXIT\r
1105 \r
1106 ;ROUTINE PUTPPN STORE THE TWO PPPN NUMBER IN PPNBUF\r
1107 \r
1108 PUTPPN: MOVE    A,PPNBUF        ;GET POINTER WORD FOR BUFFER\r
1109         AOBJP   A,ERROR2\r
1110         MOVEM   A,PPNBUF        ;SAVE NEW POINTER WORD\r
1111         MOVEM   S,(A)           ;SAVE PPN\r
1112         POPJ    P,              ;EXIT\r
1113 \fSUBTTL ROUTINE TO INPUT ONE PROGRAM AT A TIME\r
1114 ;THE FIRST WORD THAT THE PROGRAM READS WILL BE A BLOCK HEADER.\r
1115 ;BLOCKS ARE READ UNTIL AN ENTRY BLOCK IS FOUND, AND THE ENTIRE\r
1116 ;ENTRY BLOCK IS STORED IN AN INTERNAL BUFFER,SIZE PERMITTING.\r
1117 ;FOLLOWING THAT, THE NAME BLOCK IS READ, AND THE NAME OF THE \r
1118 ;PROGRAM IS RETURNED IN ACCUMULATOR A. PROVISION IS MADE FOR\r
1119 ;BLOCKS OF WORD COUNT ZERO. THE SECTION OF CODING AROUND READ2\r
1120 ;DELIBERATELY OMITS THIS CHECK IN ORDER TO READ IN THE NEXT\r
1121 ;BLOCK HEADER WITH A MINIMUM OF INSTRUCTIONS. ORDINARILY, EACH\r
1122 ;PROGRAM WILL BEGIN WITH AN ENTRY BLOCK, BUT THE ROUTINE WILL\r
1123 ;ALSO ALLOW THE PROGRAM TO BEGIN WITH A NAME BLOCK IF NO\r
1124 ;ENTRY BLOCK IS SEEN.\r
1125 \r
1126 READ:   MOVEI   C, ENTBLK       ;SET UP POINTER TO BUFFER\r
1127 READ6:  JSR     GETIN           ;GET A BLOCK HEADER\r
1128         HLRZ    B, A            ;GET THE BLOCK CODE\r
1129         CAIN    B,14            ;IS IT AN INDEX BLOCK?\r
1130         JRST    READX           ;YES, GET RID OF IT\r
1131         CAIN    B, 4            ;IS IT AN ENTRY BLOCK?\r
1132         JRST    READ1           ;YES, PROCESS IT\r
1133         CAIN    B, 6            ;IS IT A NAME BLOCK?\r
1134         JRST    READ7           ;YES, PROCESS IT\r
1135         CAIN    B,400           ;F4 SIGNAL WORD?\r
1136         JRST    F4I             ;YES, PROCESS F4 BLOCKS\r
1137         PUSHJ   P, COUNT        ;CALCULATE SIZE OF BLOCK\r
1138         JUMPE   B, READ6        ;WORD COUNT OF ZERO?\r
1139 READ6A: CAML    B, IBUF+2(DIS)  ;DOES BLOCK OVERLAP IO BUFFERS?\r
1140         JRST    READ6B          ;ADJUST B AND GET ANOTHER BUFFER\r
1141         MOVE    A, IBUF+2(DIS)  ;NO, DIDDLE BUFFER HEADER COUNT\r
1142         SUB     A, B            ;ELIMINATE BLOCK OF LENGTH C(B)\r
1143         MOVEM   A, IBUF+2(DIS)  ;PUT NEW WORD COUNT BACK\r
1144         ADDM    B, IBUF+1(DIS)  ;MOVE BYTE POINTER PAST BLOCK\r
1145         JRST    READ6           ;GET NEXT BLOCK\r
1146 READ6B: SUB     B, IBUF+2(DIS)  ;ACCOUNT FOR REST OF THIS BUFFER\r
1147         SETZM   IBUF+2(DIS)     ;FORCE ANOTHER INBUF\r
1148         JSR     GETIN           ;GET ANOTHER BUFFER OF INPUT\r
1149         JRST    READ6A          ;CHECK AGAIN\r
1150 \r
1151 \r
1152 ; THIS CODE MODIFIED 3-21-71 BY DCS (STANFORD) TO HANDLE\r
1153 ;  MORE THAN ONE ENTRY BLOCK (FAIL AND SAIL BOTH ISSUE\r
1154 ;  MULTIPLE ENTRY BLOCKS).\r
1155 \r
1156 SIZZ==SIZE-<<SIZE+21>/22>-4     ;ACCOUNT FOR HDR BLKS, RELOC WRDS, PROGNAME\r
1157 READ1:  SETZM   ENTBLK          ;SAME AS (C) AT PRESENT\r
1158         HRLI    C,-1            ;AOBJN WILL OVERFLOW FIRST TIME\r
1159 \r
1160 ; BACK HERE FOR EACH NEW ENTRY BLOCK\r
1161 \r
1162 READ2:  MOVNI   B,400000(A)     ;-1 IN LH, 377777-CT IN RH\r
1163         HRRZS   A\r
1164         ADD     A,ENTBLK        ;NEW COUNT IF IT FITS\r
1165         CAILE   A,SIZZ          ;TOO MUCH NOW?\r
1166          TROA    F,ERRB         ; YES, MARK ENTRY BLOCK TOO BIG\r
1167         MOVEM   A,ENTBLK        ;NO, UPDATE USED COUNT\r
1168 ; HERE FOR EACH NEW WORD\r
1169 READ23: TRNN    B,377777        ;END THIS LOADER BLOCK?\r
1170          JRST    READ55         ; YES, CHECK NEXT\r
1171         AOBJN   B,NXTWRD        ;TIME FOR SOME RELOC BITS?\r
1172         JSR     GETIN           ;YES, GET THEM AND TOSS THEM\r
1173         HRLI    B,-22           ;AND RESET COUNT\r
1174 NXTWRD: JSR     GETIN           ;GET A DATA WORD\r
1175 ; (ROUTINE COURTESY OF DEC LOADER)\r
1176 \r
1177         AOBJN   C,READ22        ;NEED TO INSERT RELOC WORD?\r
1178         TRNN    F,ERRB          ;YES, UNLESS NOT INSERTING\r
1179          SETZM   (C)            ; ALL ENTRY RELOCS ARE 0\r
1180         ADD     C,[XWD -22,1]   ;LH 0 BEFORE ADD, SET UP NEXT\r
1181 READ22: TRNN    F,ERRB          ;ARE WE INSERTING?\r
1182          MOVEM   A,(C)          ; YES, PUT IT AWAY\r
1183         JRST    READ23          ;LOOP\r
1184 \r
1185 \r
1186 READ55: JSR     GETIN           ;GET NEXT HEADER WORD\r
1187         HLRZ    B,A             ;TYPE\r
1188         CAIN    B,4             ;ANOTHER ENTRY?\r
1189          JRST    READ2          ; YES, STORE IT\r
1190 \r
1191 ; PROGRAM NAME -- FINISH ENTRY BLOCK OUT\r
1192         MOVEI   B,4             ;ENTRY BLOCK TYPE\r
1193         HRLM    B,ENTBLK        ;NOW CORRECT TYPE,,COUNT\r
1194         HRLI    C,0             ;CLEAR LH COUNT\r
1195         AOJA    C,READ7         ;STORE NAME BLOCK HEADER AND CONTINUE\r
1196 ; END OF DCS PATCH 3-21-71\r
1197 \fREAD5: PUSHJ   P, COUNT        ;CALCULATE SIZE OF BLOCK\r
1198         JUMPE   B, READ9        ;WORD COUNT OF ZERO?\r
1199 READ3:  JSR     GETIN           ;GET A WORD\r
1200         MOVEM   A, (C)          ;STORE IT\r
1201         AOJ     C,              ;INCREMENT BUFFER POINTER\r
1202         SOJG    B, READ3        ;DONE READING YET?\r
1203         CAIN    G+1, 2          ;IS THERE A COMMON WORD?\r
1204         MOVE    A, -2(C)        ;GET PROGRAM NAME IN A\r
1205         JUMPE   A, READ9        ;IGNORE WORD OF ZERO\r
1206         MOVE    B, A            ;GET RID OF EXTRA BLANKS\r
1207 READ8:  IDIVI   B, 50           ;TRY DIVIDING IT BY 50\r
1208         JUMPN   B+1, READ9      ;FILTERED OUT ALL THE BLANKS?\r
1209         MOVE    A, B            ;NO, STORE SYMBOL AGAIN\r
1210         JRST    READ8           ;TRY ANOTHER DIVISION\r
1211 \r
1212 READ9:  TRNE    F, ERRB         ;ERROR CONDITION?\r
1213         JRST    ERR10           ;YES\r
1214         TRNN    F,XFLG          ;INDEX FLAG ON?\r
1215         JRST    CPOPJ1          ;NO, SKIP EXIT\r
1216         JRST    INDEX1          ;YES SAVE ENTRIES\r
1217 \r
1218 READ7:  MOVEM   A, (C)          ;STORE NAME BLOCK HEADER\r
1219         AOJA    C, READ5        ;GO READ NAME BLOCK\r
1220 \r
1221 F4I:    TRO     F,F4IB          ;DONT OUTPUT DURING F4 SEARCH\r
1222         PUSH    P,C             ;SAVE ENTRY BLOCK\r
1223         PUSHJ   P,F4            ;PASS F4 BLOCKS\r
1224         POP     P,C             ;RESTORE ENTRY BLOCK\r
1225         TRZ     F,F4IB          ;TURN OFF IGNORE BIT\r
1226         JRST    READ6           ;GO PROCESS NEXT PROGRAM\r
1227 \r
1228 READX:  SKIPN   NOWARN          ;DO WE WANT A MESSAGE?\r
1229         TTCALL  3,[ASCIZ /WARNING NO INDEX ON OUTPUT FILE - CONTINUING\r
1230 /]\r
1231         SETOM   NOWARN          ;ONCE IS ENOUGH\r
1232         SETZM   IBUF+2(DIS)     ;FORCE ANOTHER INBUF\r
1233         JSR     GETIN           ;INPUT THE NEXT BLOCK\r
1234         SOS     IBUF+2(DIS)     ;WORD COUNT OUT BY ONE\r
1235         JRST    READ6+1         ;AND RETURN TO CODE\r
1236 \fSUBTTL ROUTINE TO OUTPUT ONE PROGRAM AT A TIME\r
1237 ;THE WRITE SUBROUTINE WILL OUTPUT AN ENTIRE BINARY RE-\r
1238 ;LOCATABLE PROGRAM AS WRITTEN BY MACRO6. IT ASSUMES THAT THE\r
1239 ;ENTRY BLOCK AND NAME BLOCK FOR THE PROGRAM ARE IN THE\r
1240 ;INTERNAL BUFFER ENTBLK, AND OUTPUTS THESE BEFORE PICKING UP\r
1241 ;MORE BLOCKS FROM THE CURRENT INPUT DEVICE. BLOCKS ARE READ\r
1242 ;AND WRITTEN UNTIL THE END BLOCK HAS BEEN PROCESSED. PROVISION I\r
1243 ;IS MADE FOR BLOCKS WITH A WORD COUNT OF ZERO.\r
1244 \r
1245 WRITE:  SUBI    C, ENTBLK       ;GET COUNT OF ENTRY BLOCK\r
1246         JUMPE   C, WRITE3       ;NOTHING TO OUTPUT?\r
1247         MOVEI   B, ENTBLK       ;GET A POINTER IN B\r
1248 WRITE2: MOVE    A, (B)          ;GET A BINARY WORD\r
1249         PUSHJ   P, OUT          ;OUTPUT IT\r
1250         AOJ     B,              ;INCREMENT POINTER\r
1251         SOJG    C, WRITE2       ;KEEP GOING UNTIL BUFFER EMPTY\r
1252 WRITE3: JSR     GETIN           ;GET A BLOCK HEADER\r
1253         HLRZ    B,A             ;GET THE BLOCK TYPE CODE ***VJC\r
1254         TRNN    F,NOLOCB        ;DELETE LOCAL SYMBOLS? ***VJC\r
1255         JRST    .+3             ;NO\r
1256         CAIN    B,2             ;IS IT A SYMBOL BLOCK? ***VJC\r
1257         JRST    DELLOC          ;GO DELETE LOCAL SYMBOL ***VJC\r
1258                                 ;COME BACK TO WRITE3 ***VJC\r
1259                                 ;UNLESS EXIT ON END-OF-FILE ***VJC\r
1260 \r
1261         PUSHJ   P, OUT          ;OUTPUT IT\r
1262         CAIN    B, 400          ;IS THIS A FORTRAN IV SIGNAL WORD?\r
1263         JRST    F4              ;YES, PROCESS F4 OUTPUT\r
1264         MOVEM   B, SAVEBT       ;SAVE THE BLOCK TYPE\r
1265         PUSHJ   P, COUNT        ;NO, GET SIZE OF BLOCK\r
1266         JUMPE   B, WRITE3       ;WORD COUNT OF ZERO?\r
1267 WRITE4: JSR     GETIN           ;OUTPUT THE BLOCK\r
1268         PUSHJ   P, OUT          ;...\r
1269         SOJG    B, WRITE4       ;LOOP BACK UNTIL DONE\r
1270         MOVE    A, SAVEBT       ;RETRIEVE THE BLOCK TYPE\r
1271         CAIE    A, 5            ;WAS IT AN END BLOCK?\r
1272         JRST    WRITE3          ;NO, RETURN FOR MORE BLOCKS\r
1273         POPJ    P,              ;YES, EXIT\r
1274 \f\r
1275 ;THE COUNT SUBROUTINE CALCULATES THE LENGTH OF THE VARIOUS \r
1276 ;BLOCKS READ BY THE WRITE AND READ SUBROUTINES. THE POSITIVE\r
1277 ;WORD COUNT IS FOUND IN THE RIGHT HALF OF THE ENTRY BLOCK \r
1278 ;HEADER, WHICH IS ASSUMED TO BE IN AC A UPON ENTERING. THE\r
1279 ;LENGTH WILL BE RETURNED IN AC B, AND INCLUDES THE DATA WORDS\r
1280 ;(SYMBOLS, ENTRY WORDS, ETC.) AND THE SUBHEADERS, OF WHICH\r
1281 ;THERE IS ONE FOR EVERY 18 (DECIMIAL) DATA WORDS. THE BLOCK\r
1282 ;HEADER IS DESTROYED, AND IS NOT INCLUDED IN THE LENGTH.\r
1283 \r
1284 COUNT:  HRRZ    G, A            ;GET NUMBER OF WORDS\r
1285         IDIVI   G, 22           ;1SUBHEADER/18 DATA WORDS\r
1286         ADDI    G,(A)           ;ADD INTO WORD COUNT\r
1287         JUMPE   G+1,.+2         ;1 EXTRA SUBHEADER FOR\r
1288         AOJ     G,              ;STRAY ONES\r
1289         MOVE    B, G            ;RESULTS IN AC B\r
1290         POPJ    P,              ;EXIT\r
1291 \fSUBTTL ROUTINE TO HANDLE FORTRAN OUTPUT\r
1292 \r
1293 ;SUBSECTION OF THE WRITE ROUTINE TO HANDLE OUTPUT FROM THE\r
1294 ;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO\r
1295 ;LOOK FOR THE END BLOCK. OTHER BLOCKS ARE MERELY COPIED OUT.\r
1296 ;THE BLOCK TYPES ARE GIVEN BY THE FOLLOWING TABLE\r
1297 ;----------------------------------------------------------------\r
1298         ;BITS 0-17      BITS18-23       BITS 24-35              TYPE\r
1299 \r
1300 ;777777         70              N                  DATA STATEMENT\r
1301 ;777777         50              N           ABSOLUTE MACHINE CODE\r
1302 ;777777         0               -           PROGRAMMER LABELS\r
1303 ;777777         31              -           MADE LABELS\r
1304 ;777777         60              -           ENTRY LABELS\r
1305 ;777777                 777776              END BLOCK\r
1306 ;-----------------------------------------------------------------\r
1307 F4:     JSR     GETIN           ;GET A FORTRAN IV BLOCK HEADER\r
1308         PUSHJ   P, OUT4         ;OUTPUT IT\r
1309         TLC     A, -1           ;TURN ONES TO ZEROES IN LEFT HALF\r
1310         TLNE    A, -1           ;NO, WAS LEFT HALF ALL ONES?\r
1311         JRST    F4              ;NO, IT WAS CALCULATED MACHINE CODE\r
1312         CAIN    A, -2           ;YES, IS RIGHT HALF = 777776?\r
1313         JRST    ENDST           ;YES, PROCESS F4 END BLOCK\r
1314         LDB     B, [POINT 6,A,23];GET CODE BITS FROM BITS 18-23\r
1315         TRZ     A, 770000       ;THEN WIPE THEM OUT\r
1316         CAIE    B, 70           ;IS IT A DATA STATEMENT?\r
1317         CAIN    B, 50           ;IS IT ABSOLUTE MACHINE CODE?\r
1318         JRST    MACHCD          ;YES, TREAT IT LIKE DATA STATEMENTS\r
1319         JSR     GETIN           ;NO, ITS A LABEL OF SOME SORT\r
1320         PUSHJ   P, OUT4         ;WHICH CONSISTS OF ONE WORD\r
1321         JRST    F4              ;LOOK FOR NEXT BLOCK HEADER\r
1322 \r
1323 MACHCD: HRRZ    B, A            ;GET THE WORD COUNT IN AC B\r
1324         JSR     GETIN           ;INPUT A WORD\r
1325         PUSHJ   P, OUT4         ;OUTPUT IT\r
1326         SOJG    B, MACHCD       ;LOOP BACK FOR REST OF THE BLOCK\r
1327         JRST    F4              ;GO LOOK FOR NEXT BLOCK\r
1328 \r
1329 ENDST:  MOVEI   B,1             ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE\r
1330         MOVEI   C,6             ;TO GO\r
1331 F4LUP1: JSR     GETIN           ;GET TABLE MEMBER\r
1332 F4LUP3: PUSHJ   P,OUT4          ;OUTPUT WORD\r
1333         SOJGE   B,F4LUP1        ;LOOP WITHIN A TABLE\r
1334         JUMPL   C,CPOPJ         ;LAST TABLE - RETURN\r
1335         SOJG    C,F4LUP2        ;FIRST TWO WORDS AND FIVE TABLES\r
1336         JUMPE   C,F4LUP1        ;COMMON LENGTH WORD\r
1337 F4LUP2: JSR     GETIN           ;READ HEADER WORD\r
1338         MOVE    B,A             ;COUNT TO COUNTER\r
1339         JRST    F4LUP3          ;STASH\r
1340 \r
1341 OUT4:   TRNN    F,F4IB          ;DONT DO OUTPUT?\r
1342         PUSHJ   P,OUT           ;YES, DO OUTPUT\r
1343         POPJ    P,              ;RETURN\r
1344 \fSUBTTL ROUTINE TO DELETE LOCAL SYMBOLS FROM SYMBOL BLOCK\r
1345 \r
1346 ;ALL LOCAL AND SUPPRESSED LOCAL SYMBOLS ARE DELETED\r
1347 ;EXTERNALS,INTERNAL AND SUPPRESSED INTERNALS ARE NOT DELETED.\r
1348 \r
1349 DELLOC: HRRZM   A,BSZ           ;SIZE OF SYMBOL BBLE\r
1350         PUSHJ   P,DELINI        ;CLEAR NEW HEADER & RELOC WORDS\r
1351                                 ;SET PB = SYMBLK+2\r
1352 DELGTR: JSR     GETIN           ;GET RELOCATION WORD\r
1353         MOVEM   A,RELOCS        ;SAVE IT\r
1354         MOVE    A,PTGR          ;INIT POINTER TO GET\r
1355         MOVEM   A,PTGRS         ;RELOCATION WORD\r
1356 \r
1357 DELGT1: JSR     GETIN           ;GET FIRST WORD OF PAIR\r
1358         ILDB    0,PTGRS         ;GET RELOCATION BITS & HOLD\r
1359         TLNE    A,(1B2)         ;IS SYMBOL  LOCAL?\r
1360         JRST    DELDEC          ;YES, DON'T COPY\r
1361         MOVEM   A,0(T)          ;STORE FIRST WORD\r
1362         JSR     GETIN           ;GET SECOND WORD INTO A\r
1363         MOVEM   A,1(T)          ;STORE SECOND WORD\r
1364         IDPB    0,PTSRS         ;STORE RELOCATION BITS\r
1365         MOVEI   A,2             ;COUNT WORDS STORED\r
1366         ADDM    A,SYMBLK        ;I.E. UPDATE WORD COUNT\r
1367         ADDI    T,2             ;UPDATE NEXT LOCATION TO STORE\r
1368         MOVE    A,PTSRS         ;HAVE WE STORED 9\r
1369         TLNN    A,770000        ;SYMBOL PAIRS?\r
1370         PUSHJ   P,DELWRT        ;YES, WRITE IT OUT\r
1371         JRST    DELDEC+1        ;ALREADY HAVE 2ND WORD\r
1372 \r
1373 DELDEC: JSR     GETIN           ;GET SECOND WORD INTO A\r
1374         SOS     BSZ             ;HAVE WE EXHAUSTED\r
1375         SOSG    BSZ             ;ALL WORDS IN BLOCK?\r
1376         JRST    DELFIN          ;YES, NONE LEFT\r
1377         MOVE    A,PTGRS         ;HAVE WE GOT 9\r
1378         TLNE    A,770000        ;SYMBOL PAIRS YET?\r
1379         JRST    DELGT1          ;NO, GET NEXT PAIR\r
1380         JRST    DELGTR          ;YES, GET RELOCATION\r
1381 \r
1382 DELFIN: PUSHJ   P,DELWRT        ;ORIGINAL BLOCK EMPTY NOW\r
1383         JRST    WRITE3          ;GET NEXT BLOCK\r
1384 \r
1385 \r
1386 \fSUBTTL ROUTINE TO WRITE OUT NEW SYMBOL BBLE\r
1387 \r
1388 DELWRT: SKIPN   A,SYMBLK        ;ANYTHING TO WRITE\r
1389         JRST    DELINI          ;NO, CAN LEAVE\r
1390         HRRZ    0,A             ;GET WORD COUNT\r
1391         HRLI    A,2             ;PUT IN BLOCK TYPE\r
1392         PUSHJ   P,OUT           ;WRITE BLOCK HEADER\r
1393         MOVEI   B,SYMBLK        ;LOC OF FIRST WORD\r
1394 DELWRU: ADDI    B,1             ;LOC OF RELOC WORD\r
1395         MOVE    A,0(B)          ;GET WORD\r
1396         PUSHJ   P,OUT           ;OUTPUT\r
1397         SOJGE   0,DELWRU        ;ALL THROUGH?\r
1398 \r
1399 ;ROUTINE TO INITIALIZE NEW SYMBOL BBLE\r
1400 DELINI: SETZM   SYMBLK          ;YES, CLEAR COUNT\r
1401         SETZM   SYMBLK+1        ;CLEAR RELOCATION\r
1402         MOVE    A,PTSR          ;INIT POINTER\r
1403         MOVEM   A,PTSRS         ;FOR STORING NEW RELOC\r
1404         MOVEI   T,SYMBLK+2      ;SET TO STORE FIRST GLOBAL\r
1405         POPJ    P,\r
1406 \fSUBTTL ROUTINES TO INDEX THE LIBRARY\r
1407 \r
1408 COMMENT *       THE INDEXING OF LIBRARY FILES IS DONE IN TWO PASSES.\r
1409         ON PASS 1 THE LIBRARY FILE IS COPIED AND ALL ENTRIES STORED\r
1410         IN CORE ALLONG WITH A POINTER TO THE BEGINING OF THE BLOCK.\r
1411         A DUMMY INDEX BLOCK (TYPE 14) IS OUTPUT AT THE BEGINING OF THE\r
1412         NEW LIBRARY AND ONE IS OUTPUT WHENEVER THE CURRENT INDEX BLOCK\r
1413         FILLS A BUFFER.\r
1414         ON PASS 2 THE DUMMY INDEX BLOCKS ARE REPLACED BY REAL ONES.\r
1415         FUDGE2 USED USETO'S AND DUMP MODE.\r
1416         IF THE OUTPUT DEVICE IS DTA FUDGE2 USES UGETF UUO'S TO FIND\r
1417         THE NEXT BLOCK AND NON-STANDARD DUMP MODE TO WRITE THE INDICES.\r
1418         DESIGN AND CODING BY D.M.NIXON JULY 1970\r
1419 *\r
1420 \r
1421 INDEX0: MOVE    A,INDEXH        ;BLOCK HEADER\r
1422         AOS     BLKCNT          ;START ON BLOCK #1\r
1423         PUSHJ   P,OUT1          ;OUTPUT IT\r
1424         OUTPUT  1,              ;FORCE OUTPUT\r
1425         MOVE    T,OBUF+5        ;BUFFER SIZE\r
1426         MOVEM   T,XCOUNT\r
1427         MOVEM   T,BUFSIZ        ;SAVE IT AWAY\r
1428         AOS     T,JOBREL        ;TO GET 1K MORE\r
1429         MOVEM   T,XPNTR\r
1430         MOVEM   T,XBEG          ;START OF INDEX BUFFERS\r
1431         CORE    T,\r
1432         JRST    ERR22           ;NOT ENUF CORE\r
1433         MOVEI   A,1             ;START ON BLOCK #1 (IF DSK)\r
1434         MOVEM   A,@XPNTR        ;STORE FIRST BLOCK #\r
1435         AOS     XPNTR\r
1436         MOVE    A,INDEXH\r
1437         MOVEM   A,@XPNTR\r
1438         AOS     XPNTR\r
1439         SOS     XCOUNT\r
1440         SOS     XCOUNT          ;RESERVE SPACE FOR NEXT LINK WORD\r
1441         POPJ    P,              ;RETURN\r
1442 \f;HERE ON PASS 1 TO STORE ENTRIES AND POINTERS.\r
1443 \r
1444 INDEX1: AOS     (P)             ;SET SKIP RETURN\r
1445         HRRZ    T,ENTBLK        ;GET SIZE OF BLOCK\r
1446         MOVN    A,T\r
1447         ADDI    T,1             ;WORD OF INFO\r
1448         CAML    T,XCOUNT        ;ENUF ROOM IN BLOCK?\r
1449         JRST    NOROOM          ;NO\r
1450         MOVE    T,ENTBLK        ;GET HEADER WORD\r
1451         MOVEM   T,@XPNTR\r
1452         AOS     XPNTR\r
1453         SOS     XCOUNT\r
1454         HRLS    A\r
1455         HRRI    A,ENTBLK+1\r
1456 INDEXA: SKIPN   T,(A)\r
1457         AOJA    A,.-1\r
1458         MOVEM   T,@XPNTR\r
1459         SOS     XCOUNT\r
1460         AOS     XPNTR\r
1461         AOBJN   A,INDEXA\r
1462 INDEX2: MOVE    T,BUFSIZ\r
1463         SUB     T,OBUF+5\r
1464         MOVSS   T\r
1465         HRR     T,BLKCNT\r
1466         MOVEM   T,@XPNTR\r
1467         SOS     XCOUNT\r
1468         AOS     XPNTR\r
1469         POPJ    P,\r
1470 \r
1471 ;HERE WHEN CURRENT INDEX BLOCK IS FULL.\r
1472 \r
1473 NOROOM: MOVE    A,INDEXH        ;HEADER BLOCK OF INDEX FOR LOADER\r
1474         PUSHJ   P,OUTGO\r
1475         OUTPUT  1,\r
1476         MOVE    T,BLKCNT        ;GET INDEX BLOCK #\r
1477         HRROM   T,@XPNTR        ;STORE IT WITH -1 IN LEFT HALF\r
1478         MOVE    A,XCOUNT\r
1479         ADDM    A,XPNTR\r
1480         MOVE    A,BUFSIZ\r
1481         MOVEM   A,XCOUNT\r
1482                                 ;MARK IT AS AN INDEX INCASE BLOCK FULL\r
1483         HRROM   T,@XPNTR        ;SAVE BLOCK # FOR PASS 2\r
1484         AOS     XPNTR\r
1485         TRNN    F,DTAFLG        ;NOT IF DTA\r
1486         AOS     BLKCNT          ;ONE FOR OUTPUT\r
1487         MOVE    A,INDEXH\r
1488         MOVEM   A,@XPNTR\r
1489         AOS     XPNTR\r
1490         SOS     XCOUNT\r
1491         SOS     XCOUNT          ;SPACE FOR LINK WORD TO NEXT INDEX\r
1492         JRST    INDEX1+1\r
1493 \r
1494 \f;HERE FOR PASS 2. WRITE OUT THE INDEX BLOCKS\r
1495 \r
1496 INDEX3: SETOM   @XPNTR          ;TERMINATE WITH END OF INDEX MARKER\r
1497         OUTPUT  1,              ;SO LAST BLOCK IS WRITTEN\r
1498         TRNE    F,DTAFLG        ;IS IT DTA?\r
1499         JRST    INDEX5          ;YES, TREAT DIFFERENTLY\r
1500         SETSTS  1,16\r
1501         MOVNI   A,200\r
1502         HRLM    A,XBEG\r
1503 INDEX4: SETZM   XBEG+1\r
1504         MOVE    A,@XBEG\r
1505         USETO   1,(A)\r
1506         OUTPUT  1,XBEG\r
1507         STATZ   1,760000\r
1508         JRST    ERR15\r
1509         MOVEI   A,200\r
1510         ADDB    A,XBEG\r
1511         HRRZS   A\r
1512         CAMG    A,XPNTR\r
1513         JRST    INDEX4\r
1514         JRST    EXIT\r
1515 \r
1516 INDEX5: CLOSE   1,              ;AND A SEPARATE EOF BLOCK\r
1517         SETSTS  1,116           ;NONE STANDARD MODE\r
1518         MOVNI   A,200           ;IOWD COUNT\r
1519         HRLM    A,XBEG          ;SET IT UP FOR OUTPUT\r
1520         USETI   1,@BLKCNT       ;SET ON LAST BLOCK\r
1521         INPUT   1,DIRIOW        ;READ IT IN\r
1522         LDB     A,[POINT 10,DIRBLK,27]  ;GET FIRST BLOCK #\r
1523         HRRM    A,@XBEG         ;STORE IT FOR COMMON LOOP\r
1524         SETZM   XBEG+1          ;MAKE SURE IT'S ZERO\r
1525 INDEX6: MOVE    A,@XBEG         ;GET BLOCK NUMBER\r
1526         USETI   1,(A)           ;SET FOR INPUT\r
1527         INPUT   1,DIRIOW        ;INPUT BLOCK\r
1528         MOVE    T,DIRBLK        ;TO FIND LINK WORD\r
1529         EXCH    T,@XBEG         ;PUT IT IN OUTPUT BLOCK\r
1530         SOS     XBEG            ;BACK UP POINTER\r
1531         USETO   1,(A)           ;NOW FOR OUTPUT\r
1532         OUTPUT  1,XBEG          ;OUT IT GOES\r
1533         STATZ   1,760000        ;UNLESS IN ERROR\r
1534         JRST    ERR15           ;DEVICE ERROR\r
1535         MOVEI   A,200           ;GET TO NEXT DUMP BLOCK\r
1536         ADDB    A,XBEG          ;ADVANCE POINTER\r
1537         HRRZS   A               ;JUST WORD LOCATION\r
1538         CAMG    A,XPNTR         ;ALL DONE?\r
1539         JRST    INDEX6          ;NO, LOOP\r
1540         SETSTS  1,16            ;BACK TO STANDARD MODE TO UPDATE DIR.\r
1541         JRST    EXIT            ;YES, FINISH UP\r
1542 \r
1543 INDEXH: XWD     14,177          ;USED TO SIGNAL INDEX BLOCK TO LOADER\r
1544 \r
1545 \fSUBTTL INPUT SERVICE ROUTINE\r
1546 ;THE INPUT ROUTINE GETS CHARACTERS FROM THE DEVICE WHOSE\r
1547 ;CHANNEL NUMBER IS IN ACCUMULATOR D. IT CALCULATES THE POSITION\r
1548 ;OF THE BUFFER HEADER OF THE DEVICE, THEN EITHER LOADS AC A\r
1549 ;FROM THE BYTE POINTER, OR DOES AN INPUT. IF AN END OF FILE\r
1550 ;IS FOUND, THE ROUTINE EXITS WITH A POPJ, SINCE THE READ ROUTINE\r
1551 ;IS CALLED WITH A PUSHJ, FOLLOWED BY AN EOF RETURN. THE NORMAL\r
1552 ;EXIT FROM GETIN IS BY A JRST @GETIN.\r
1553 \r
1554 GETIN:  SOSG    IBUF+2(DIS)     ;IS APPROPRIATE BUFFER EMPTY?\r
1555         JRST    INGET           ;YES, GET ANOTHER BUFFER\r
1556 GETIN1: ILDB    A, IBUF+1(DIS)  ;LOAD AC A WITH A CHARACTER\r
1557         POPJ    P,\r
1558 \r
1559 INGET:  DPB     D,[POINT 4,INGET2,12]\r
1560         DPB     D,[POINT 4,INGET3,12]\r
1561         JRST    INGET2          ;INPUT A BUFFER OF DATA\r
1562 \r
1563 \r
1564 ;OUTPUT SERVICE ROUTINE\r
1565 ;THE OUT ROUTINE CHECKS THE TTYOB FLAG TO SEE IF THE OUTPUT\r
1566 ;SHOULD BE ON THE TTY. IF SO, IT TRANSFERS CONTROL IMMEDIATELY.\r
1567 ;OTHERWISE, IT ASSUMES OUTPUT IS ON DEVICE #1.\r
1568 \r
1569 OUT:    TRNN    F, TTYOB        ;SHOULD OUTPUT BE ON TTY?\r
1570         JRST    TYPO            ;YES\r
1571 OUT1:   SOSG    OBUF+5          ;IS OUTPUT BUFFER EMPTY?\r
1572         JRST    OUTGO           ;YES, OUTPUT A BUFFER\r
1573 OUT2:   IDPB    A, OBUF+4       ;DEPOSIT CHARACTER\r
1574         POPJ    P,              ;EXIT\r
1575 \r
1576 OUTGO:  TRNN    F,XFLG          ;IF NOT INDEXING\r
1577         JRST    OUTG            ;DON'T WASTE TIME\r
1578         TRNN    F,DTAFLG        ;IF DTA SKIP\r
1579         AOSA    BLKCNT          ;INCR. COUNT IF DSK\r
1580         UGETF   1,BLKCNT        ;GET NEXT BLOCK IF DTA\r
1581 OUTG:   OUT     1,              ;OUTPUT A BUFFER\r
1582         JRST    OUT2            ;NO ERRORS\r
1583         MOVEI   D, 1            ;YES, SET CHANNEL TO OUTPUT\r
1584         JRST    ERR15           ;GO TO ERROR ROUTINE\r
1585 \r
1586 \fSUBTTL ROUTINE TO HANDLE ASTERISK FILE NAME *.EXT\r
1587 ;THE DIRECTORY IS SEARCHED FOR FILE NAMES WITH GIVEN EXTENSION OR\r
1588 ;EXTENSION REL IF NONE SPECIFIED. THESE ARE STORED IN FILBUF\r
1589 ;ENTERED BY JRST FROM SEMICP\r
1590 ;EXIT BY POPJ\r
1591 ;DMN 23 MAY 1969\r
1592 \r
1593 \r
1594 ASTRSK: MOVE    B,COLON2        ;GET DEVICE LAST SEEN\r
1595         MOVEM   B,DSKINI+1      ;SAVE IT IN CASE DSK\r
1596         DEVCHR  B,              ;GET ITS CHARACTERISTICS\r
1597         TLNE    B,DTABIT        ;IS IT A DTA\r
1598         JRST    DTAAST          ;YES\r
1599         TLNN    B,DSKBIT        ;IS IT THE DSK?\r
1600         JRST    ERR18           ;MUST BE ONE OR THE OTHER\r
1601                                 ;FALL INTO DSKAST IF OK\r
1602 \r
1603 DSKAST: PUSH    P,JOBFF         ;SAVE OLD JOBFF\r
1604         MOVEI   B,DSKHDR        ;WHERE BUFFER WILL GO\r
1605         MOVEM   B,JOBFF         ;SET IT UP\r
1606 \r
1607         OPEN    11,DSKINI       ;11 IS SAFE CH.NO.\r
1608         JRST    ERR19           ;CONNOT INIT DSK\r
1609         INBUF   11,1            ;FORCE SINGLE BUFFERING\r
1610         MOVE    B,COLON2        ;GET DEVICE\r
1611         DEVPPN  B,              ;GET PROJ-PROG INCASE SYS: ETC.\r
1612         GETPPN  B,              ;FAILED, GET USER PROJ,PROG PAIR\r
1613         MOVEM   B,EBLOCK        ;SAVE IT FOR LOOKUP OF UFD\r
1614         MOVSI   B,(SIXBIT/UFD/) ;EXTENSION\r
1615         MOVEM   B,EBLOCK+1\r
1616         MOVE    B,[XWD 1,1]     ;TO GET UFD ***VJC\r
1617         MOVEM   B,EBLOCK+3      ;ENTRY BLOCK SET UP\r
1618         LOOKUP  11,EBLOCK       ;DO LOOKUP\r
1619         JRST    ERR20           ;CANNOT DO IT\r
1620 \r
1621 DSKLUP: PUSHJ   P,DSKINP        ;INPUT A WORD\r
1622         MOVEM   S,SAVNAM        ;SAVE NAME FOR LATER\r
1623         PUSHJ   P,DSKINP        ;GET EXT AS WELL\r
1624         HLLZM   S,SAVEXT        ;SAVE EXT, CLEAR RH ***VJC\r
1625         SKIPN   SAVNAM          ;IS THERE A NAME\r
1626         JRST    DSKLUP          ;NO GET NEXT PAIR\r
1627         CAME    EXT,SAVEXT      ;EXTENSIONS MATCH\r
1628         JRST    DSKLUP          ;NO GET NEXT PAIR\r
1629         PUSHJ   P,STNULL        ;CLOSE OUT OLD FILE\r
1630         MOVE    S,SAVNAM        ;RECALL NAME\r
1631         PUSHJ   P,PUTFIL        ;STORE IT IN FILBUF\r
1632         MOVE    S,SAVEXT        ;RECALL EXTENSION\r
1633         PUSHJ   P,PUTFIL\r
1634         HRRM    D,(A)           ;GET CHANNEL\r
1635         HRRZ    S,PRGBUF        ;POINTER TO PRGBUF\r
1636         PUSHJ   P,PUTFIL        ;SAVE IT AS 3RD WORD\r
1637         JRST    DSKLUP          ;GO LOOP ROUND ALL\r
1638 \r
1639 \f;ROUTINE TO GET NEXT WORD FROM UFD\r
1640 \r
1641 DSKINP: SOSGE   DIRBUF+2        ;USUAL INPUT ROUTINE\r
1642         JRST    DSKIN1          ;GET ANOTHER BUFFER\r
1643         ILDB    S,DIRBUF+1      ;GET A WORD \r
1644         POPJ    P,              ;RETURN\r
1645 \r
1646 DSKIN1: IN      11,0            ;DO INPUT\r
1647         JRST    DSKINP          ;NO ERRORS\r
1648         STATO   11,20000        ;END OF FILE?\r
1649         JRST    ERR21           ;NO, READ ERROR\r
1650 \r
1651 FIN:    POP     P,JOBFF         ;POP UP ONE LEVEL\r
1652         POP     P,JOBFF         ;RESTORE JOBFF\r
1653         POPJ    P,              ;RETURN TO COMMAND SCAN\r
1654 \r
1655 \r
1656 DTAAST: LDB     B,[POINT 4,COLON1,12]   ;GET CHANNEL\r
1657         DPB     B,[POINT 4,DP+0,12]     ;DEPOSIT IT\r
1658         DPB     B,[POINT 4,DP+1,12]\r
1659         DPB     B,[POINT 4,DP+2,12]\r
1660         DPB     B,[POINT 4,DP+3,12]\r
1661         DPB     B,[POINT 4,DP+5,12]\r
1662         SETZ    B,              ;INITIAL CONDITION\r
1663         JRST    DP              ;INPUT DIRECTORY\r
1664 \r
1665 DTALUP: CAIL    B,26            ;END OF DIRECTORY\r
1666         POPJ    P,              ;YES- FINISHED\r
1667         HLLZ    S,DIREXT(B)     ;GET EXTENSION\r
1668         SKIPE   DIRNAM(B)       ;IF NAME ZERO DON'T BOTHER\r
1669         CAME    S,EXT           ;IS EXTENSION SAME\r
1670         AOJA    B,DTALUP        ;NO GET NEXT ENTRY\r
1671         PUSHJ   P,STNULL        ;TERMINATE LAST ENTRY\r
1672         MOVE    S,DIRNAM(B)     ;GET NAME\r
1673         PUSHJ   P,PUTFIL        ;STORE IT IN FILBUF\r
1674         HLLZ    S,DIREXT(B)     ;AND EXTENSION\r
1675         PUSHJ   P,PUTFIL        ;STORE IT\r
1676         HRRM    D,(A)           ;SAVECH.\r
1677         HRRZ    S,PRGBUF        ;SAVE PRGBUF POINTER\r
1678         PUSHJ   P,PUTFIL        ;STORE IT\r
1679         AOJA    B,DTALUP        ;GET NEXT ENTRY\r
1680 \r
1681 \fSUBTTL ERROR ROUTINES\r
1682 \r
1683 ERROR1: MOVEI   B, EMES1        ;FUDGE COMMAND ERROR\r
1684         JRST    ERROR           ;TYPE IT AND EXIT\r
1685 \r
1686 ERROR2: MOVEI   B, EMES2        ;TOO MANY PROGRAM NAMES\r
1687         JRST    ERROR           ;TYPE IT AND EXIT\r
1688 \r
1689 ERROR3: MOVEI   B, EMES3        ;FUDGE SYSTEM ERROR\r
1690         JRST    ERROR           ;TYPE A MESSAGE AND EXIT\r
1691 \r
1692 ERROR4: PUSHJ   P, DTYPOQ       ;TYPE DEVICE NAME\r
1693         MOVEI   B, EMES4        ;"CANNOT DO IO AS REQUESTED"\r
1694         JUMPN   G,ERROR         ;TYPE IT\r
1695         MOVEI   B,EMES24        ;NO SUCH DEVICE IF G=0\r
1696         JRST    ERROR           ;TYPE IT AND EXIT\r
1697 \r
1698 ERROR5: MOVEI   B, EMES5        ;UNEQUAL NUMBER OF MASTER AND TR.\r
1699         JRST    ERROR           ;TYPE IT AND EXIT\r
1700 \r
1701 ERROR6: MOVEI   B, EMES6        ;NOT ENOUGH ARGUMENTS\r
1702         JRST    ERROR           ;TYPE IT AND EXIT\r
1703 \r
1704 ERROR7: PUSHJ   P, DTYPOQ       ;TYPE OUT THE DEVICE NAME\r
1705         MOVEI   A, 72           ;ASCII COLON\r
1706         PUSHJ   P, TYPO         ;TYPE IT OUT\r
1707         PUSHJ   P, FTYPO        ;TYPE  OUT THE FILE NAME\r
1708         MOVEI   A, 74           ;ASCII LEFT ANGLE BRACKET\r
1709         PUSHJ   P, TYPO         ;TYPE IT  OUT\r
1710         MOVE    B, R            ;GET PROGRAM NAME\r
1711         TRZ     F, TTYOB        ;SET IO BACK TO TTY\r
1712         PUSHJ   P, PTYPO        ;TYPE  OUT THE PROGRAM NAME\r
1713         MOVEI   A, 76           ;ASCII RIGHT ANGLE BRACKET\r
1714         PUSHJ   P, TYPO         ;TYPE IT OUT\r
1715         MOVEI   B, EMES7        ;GET AN ERROR MESSAGE\r
1716         JRST    ERROR           ;TYPE IT OUT AND EXIT\r
1717 \r
1718 ERROR8: PUSHJ   P, DTYPOQ       ;TYPE OUT THE DEVICE NAME\r
1719         MOVEI   A, 72           ;ASCII COLON\r
1720         PUSHJ   P, TYPO         ;TYPE IT OUT\r
1721         PUSHJ   P, FTYPO        ;TYPE  OUT FILE NAME\r
1722         MOVEI   A, 56           ;ASCII PERIOD\r
1723         PUSHJ   P, TYPO         ;TYPE IT OUT\r
1724         HRRZ    A, FILBUF       ;GET THE POINTER TO CURRENT FILE\r
1725         HLRZ    S, 1(A)         ;GET FILE NAME EXTENSION\r
1726         PUSHJ   P, DTYPO1       ;TYPE IT OUT\r
1727         MOVE    T,SDEVCHR       ;GET CHARACTERISTICS\r
1728         TLNE    T,DSKBIT        ;IS IT A DSK?\r
1729         JRST    ERR8A           ;YES\r
1730         MOVEI   B, EMES7        ;GET ERROR MESSAGE "NOT FOUND"\r
1731         JRST    ERROR           ;TYPE IT OUT AND EXIT\r
1732 \fERROR9:        PUSHJ   P, DTYPOQ       ;TYPE DEVICE NAME\r
1733         MOVEI   B, EMES9B       ;GET REMAINDER OF MESSAGE\r
1734         JRST    ERROR           ;TYPE IT AND EXIT\r
1735 \r
1736 ERR10:  MOVE    C, A            ;SAVE PROGRAM NAME IN C\r
1737         MOVEI   B, EMES10       ;"ENTRY BLOCK TOO LARGE, PROGRAM"\r
1738         PUSHJ   P, ETYPO        ;TYPE BEGINNING OF MESSAGE\r
1739         MOVE    B, C            ;GET PROGRAM NAME IN B\r
1740         PUSHJ   P, PTYPO        ;TYPE IT OUT\r
1741         JRST    EXIT1           ;EXIT\r
1742 \r
1743 ERR11:  MOVEI   B, EMES11       ;TRANSMISSION ERROR ON INPUT\r
1744         PUSHJ   P, ETYPO        ;TYPE THE MESSAGE\r
1745         PUSHJ   P, DTYPO        ;TYPE NAME OF OFFENDIN DEVICE\r
1746         JRST    EXIT1           ;EXIT\r
1747 \r
1748 ERR14:  MOVE    T,SDEVCHR       ;GET DEVICE CHARACTERISTICS\r
1749         TLNE    T,DSKBIT        ;IS IT A DSK\r
1750         JRST    ERROR8          ;YES\r
1751         MOVEI   B, EMES14       ;DIRECTORY FULL ON OUTPUT\r
1752         JRST    ERROR           ;TYPE IT AND EXIT\r
1753 \r
1754 ERR8A:  HRRZ    T,EBLOCK+1      ;GET ERROR CODE\r
1755         CAIL    T,TABLND-ETABLE ;LEGAL ERROR?\r
1756         SKIPA   B,TABLND        ;NO, USE CATCH ALL MESSAGE\r
1757         MOVE    B,ETABLE(T)     ;PICK UP MESSAGE\r
1758         JRST    ERROR\r
1759 \r
1760 \fETABLE:        [ASCIZ /(0) file was not found/]\r
1761         [ASCIZ /(1) no such project-programmer number/]\r
1762         [ASCIZ /(2) protection failure/]\r
1763         [ASCIZ /(3) file was being modified/]\r
1764         [ASCIZ /(4) rename file name already exists/]\r
1765         [ASCIZ /(5) illegal sequence of UUOs/]\r
1766         [ASCIZ /(6) bad UFD or bad RIB/]\r
1767         [ASCIZ /(7) not a SAV file/]\r
1768         [ASCIZ /(10) not enough core/]\r
1769         [ASCIZ /(11) device not available/]\r
1770         [ASCIZ /(12) no such device/]\r
1771         [ASCIZ /(13) not two reloc reg. capability/]\r
1772         [ASCIZ /(14) no room or quota exceeded/]\r
1773         [ASCIZ /(15) write lock error/]\r
1774         [ASCIZ /(16) not enough monitor table space/]\r
1775         [ASCIZ /(17) partial allocation only/]\r
1776         [ASCIZ /(20) block not free on allocation/]\r
1777 \r
1778 TABLND: [ASCIZ /(?) lookup,enter,or rename error/]\r
1779 \fERR15: MOVEI   B, EMES15       ;DEVICE ERROR ON OUTPUT\r
1780         PUSHJ   P, ETYPO        ;TYPE THE MESSAGE\r
1781         PUSHJ   P, DTYPO        ;TYPE NAME OF OFFENDING DEVICE\r
1782         JRST    EXIT1           ;GO AWAY\r
1783 \r
1784 ERR16:  MOVE    B,A             ;SAVE OFFENDING LETTER\r
1785         PUSHJ   P,CRLF\r
1786         MOVEI   A,77            ;TYPE OUT "?"\r
1787         PUSHJ   P, OUT\r
1788         MOVE    A, B            ;GET BACK OFFENDING LETTER\r
1789         PUSHJ   P, OUT          ;TYPE OFFENDING LETTER\r
1790         MOVEI   B, EMES16       ;"X" IS AN ILLEGAL SWITCH\r
1791         TRO     F,CRLFTY\r
1792         JRST    ERROR           ;TYPE IT AND EXIT\r
1793 \r
1794 ERR17:  MOVE    B, A\r
1795         PUSHJ   P,CRLF\r
1796         MOVEI   A, 77\r
1797         PUSHJ   P, OUT\r
1798         MOVE    A, B\r
1799         PUSHJ   P, OUT          ;TYPE OFFENDING LETTER\r
1800         MOVEI   B, EMES17       ;"X" IS AN ILLEGAL CHARACTER\r
1801         TRO     F,CRLFTY\r
1802         JRST    ERROR           ;TYPE IT AND EXIT\r
1803 \r
1804 ERR18:  MOVEI   B,EMES18\r
1805         JRST    ERROR\r
1806 \r
1807 ERR19:  MOVEI   B,EMES19\r
1808         JRST    ERROR\r
1809 \r
1810 ERR20:  MOVEI   B,EMES20\r
1811         JRST    ERROR\r
1812 \r
1813 ERR21:  MOVEI   B,EMES21\r
1814         JRST    ERROR\r
1815 \r
1816 ERR22:  MOVEI   B,EMES22\r
1817         JRST    ERROR\r
1818 \r
1819 ERR23:  MOVEI   B,EMES23\r
1820         JRST    ERROR\r
1821 \fSUBTTL VARIOUS ERROR ROUTINES AND SMALL TYPE-OUT ROUTINES\r
1822 \r
1823 ETYPO:  HRLI    B, 440700       ;MAKE A BYTE POINTER\r
1824 ETYPO2: ILDB    A, B            ;GET A CHARACTER\r
1825         JUMPE   A,CPOPJ         ;EXIT IF NULL\r
1826         PUSHJ   P, TYPO         ;NO, TYPE IT\r
1827         JRST    ETYPO2          ;RETURN FOR MORE CHARACTERS\r
1828 \r
1829 DTYPOQ: TRON    F,CRLFTY        ;IS CR,LF TYPED OUT?\r
1830         PUSHJ   P,CRLF          ;YES\r
1831         MOVEI   A,77            ;TYPE OUT ? FOR BATCH\r
1832         PUSHJ   P,TYPO\r
1833 \r
1834 \r
1835 DTYPO:  MOVE    S, DEVBUF(D)    ;GET DEVICE NAME FROM BUFFER\r
1836 DTYPO1: MOVE    C, SYMPTR       ;BYTE POINTER TO SYMBOL NAME\r
1837         MOVEI   B, 6            ;LOOP COUNTER FOR 6 CHARACTERS\r
1838 DTYPO2: ILDB    A, C            ;GET A CHARACTER\r
1839         JUMPE   A, DTYPO3       ;IGNORE BLANKS\r
1840         ADDI    A, 40           ;CONVERT TO 7-BIT ASCII\r
1841         PUSHJ   P, TYPO         ;TYPE IT\r
1842 DTYPO3: SOJG    B, DTYPO2       ;ALL DONE?\r
1843         POPJ    P,              ;EXIT\r
1844 \r
1845 FTYPO:  MOVE    S, @FILBUF      ;PICK UP THE FILE NAME\r
1846         JRST    DTYPO1          ;JUMP INTO DTYPO ROUTINE\r
1847 \r
1848 PTYPO:  MOVEI   A, 6            ;SIX CHARACTERS TO GET\r
1849 PTYPO2: IDIVI   B, 50           ;CONVERT TO SIXBIT CODE\r
1850         HRLM    B+1, (P)        ;STORE CHARACTER ON PD LIST\r
1851         SOJLE   A,.+2           ;ALL DONE?\r
1852         PUSHJ   P, PTYPO2       ;NO, DIVIDE SOME MORE\r
1853         HLRZ    A, (P)          ;POP CHARACTERS OFF STACK\r
1854         JUMPE   A, CPOPJ        ;IGNORE BLANKS\r
1855         CAILE   A, 12           ;LETTER OR NUMBER?\r
1856         ADDI    A, 7            ;LETTER - ADD 66\r
1857         ADDI    A, 57           ;NUMBER - ADD 57\r
1858         CAIN    A, 134          ;DOLLAR SIGN?\r
1859         SUBI    A, 70           ;YES, SPECIAL CASE\r
1860         CAIN    A, 133          ;PERIOD?\r
1861         SUBI    A, 55           ;YES, SPECIAL CASE\r
1862         JRST    OUT             ;RECURSIVE EXIT FOR MORE CHARS\r
1863 \r
1864 TYPO:   IDPB    A, OBUF+1       ;STORE CHARACTER IN BUFFER\r
1865         CAIN    A, 12           ;LINE FEED?\r
1866         OUTPUT  0,              ;YES, EMPTY BUFFER\r
1867         POPJ    P,              ;EXIT\r
1868 \fCRLF:  MOVEI   A, 15           ;CARRIAGE RETURN\r
1869         PUSHJ   P, OUT          ;OUTPUT IT\r
1870         MOVEI   A, 12           ;LINE FEED\r
1871         JRST    OUT             ;OUTPUT IT AND EXIT\r
1872 \r
1873 ERROR:  TRZ     F,TTYOB         ;JUST IN CASE , SET OUTPUT TO TTY\r
1874         TRON    F,CRLFTY\r
1875         PUSHJ   P,CRLF\r
1876         PUSHJ   P, ETYPO        ;TYPE LAST MESSAGE OF ERROR\r
1877 EXIT1:  TRZ     F,TTYOB         ;ENSURE TTY OUTPUT OF CR-LF\r
1878         PUSHJ   P,CRLF          ;FINISH WITH CR-LF\r
1879         CLOSE   0,              ;FORCE OUTPUT OF LAST LINE\r
1880         JRST    FUDGE2          ;START AGAIN\r
1881 \r
1882 EXIT:   CLOSE   1,              ;CLOSE OUT THE OUTPUT CHANNEL\r
1883         JRST    FUDGE2          ;RESTART\r
1884 \r
1885 \fSUBTTL ERROR MESSAGES\r
1886 EMES1:  ASCIZ   "?FUDGE2 SYNTAX ERROR"\r
1887 EMES2:  ASCIZ   "?TOO MANY FILE NAMES OR PROGRAM NAMES"\r
1888 EMES3:  ASCIZ   "?PROGRAM ERROR WHILE RESETTING MASTER DEVICE"\r
1889 EMES4:  ASCIZ   " CANNOT DO IO AS REQUESTED"\r
1890 EMES5:  ASCIZ   "?UNEQUAL NUMBER OF MASTER AND TRANSACTION PROGRAMS"\r
1891 EMES6:  ASCIZ   "?NOT ENOUGH ARGUMENTS"\r
1892 EMES7:  ASCIZ   " NOT FOUND"\r
1893 EMES9B: ASCIZ   " NOT AVAILABLE"\r
1894 EMES10: ASCIZ   "?ENTRY BLOCK TOO LARGE, PROGRAM "\r
1895 EMES11: ASCIZ   "?TRANSMISSION ERROR ON INPUT DEVICE "\r
1896 EMES14: ASCIZ   "?DIRECTORY FULL ON OUTPUT DEVICE "\r
1897 EMES15: ASCIZ   "?DEVICE ERROR ON OUTPUT DEVICE "\r
1898 EMES16: ASCIZ   " IS AN ILLEGAL SWITCH"\r
1899 EMES17: ASCIZ   " IS AN ILLEGAL CHARACTER"\r
1900 EMES18: ASCIZ "?DEVICE FOR * COMMAND MUST BE DSK OR DTA"\r
1901 EMES19: ASCIZ "?CANNOT INIT DSK"\r
1902 EMES20: ASCIZ "?LOOKUP FAILURE ON DSK"\r
1903 EMES21: ASCIZ "?ERROR WHILE READING UFD"\r
1904 EMES22: ASCIZ "?NOT ENOUGH CORE AVAILABLE "\r
1905 EMES23: ASCIZ   "?OUTPUT DEVICE MUST BE DSK OR DTA"\r
1906 EMES24: ASCIZ   " DOES NOT EXIST"\r
1907 \fSUBTTL IMPURE CODE\r
1908 \r
1909 \r
1910 COLON1: OPEN    ,COLON0         ;INITIALIZATION SEQUENCE\r
1911 SEMIC1: ENTER   , EBLOCK(T)\r
1912 INBUF3: INBUF   ,(C)\r
1913 \r
1914 BACK0:  MTAPE   , 17            ;BACKSPACE MAG TAPE ONE FILE\r
1915 BACK3:  MTAPE   ,0              ;WAIT FOR BACKSPACE TO FIN.\r
1916 BACK1:  STATO   , IOBOT         ;ARE WE AT BEGINNING OF TAPE\r
1917 BACK2:  MTAPE   , 16            ;NO, SKIP FILE\r
1918         POPJ    P,              ;EXIT\r
1919 \r
1920 GET3A:  CLOSE   ,\r
1921 GET4A:  LOOKUP  , EBLOCK(T)\r
1922 \r
1923 INGET2: IN      0,              ;INPUT A BUFFER OF DATA\r
1924         JRST    GETIN1          ;NO ERRORS\r
1925 INGET3: STATZ   , IOEOF         ;END OF FILE?\r
1926         JRST    POPOUT          ;YES, HIGH LEVEL EXIT\r
1927         JRST    ERR11           ;ERROR\r
1928 \r
1929 DP:     SETSTS  ,117            ;DUMP MODE NON-STANDARD\r
1930         USETI   ,144            ;DIRECTORY BLOCK\r
1931         INPUT   ,DIRIOW         ;ONE BLOCK ONLY\r
1932         STATZ   ,760000         ;CHECK ERRORS\r
1933         JRST    DP              ;TRY AGAIN\r
1934         SETSTS  ,14             ;BACK TO BINARY\r
1935         JRST    DTALUP\r
1936 \r
1937 DSKINI: EXP     14\r
1938         SIXBIT  /DSK/           ;MAY GET MODIFIED\r
1939         EXP     DIRBUF\r
1940 \r
1941 DIRIOW: IOWD    200,DIRBLK      ;IOWD FOR DIRECTORY INPUT\r
1942         0                       ;MUST BE IN LOW SEGMENT\r
1943 \r
1944 \fSUBTTL STORAGE AND BUFFERS\r
1945 \r
1946 LOW:\r
1947 \r
1948 FILSAV: BLOCK   1\r
1949 BLKCNT: BLOCK   1               ;NUMBER OF BUFFERS OUTPUT\r
1950 SAVEAC: BLOCK   1\r
1951 SAVEBT: BLOCK   1\r
1952 COLON0: BLOCK   1               ;MODE\r
1953 COLON2: BLOCK   1               ;DEVICE NAME\r
1954 COLON3: BLOCK   1               ;BUFFER HEADER\r
1955 FILBUF: BLOCK   N\r
1956 PRGBUF: BLOCK   N\r
1957 PPNBUF: BLOCK   N\r
1958 DEVBUF: BLOCK   10\r
1959 ENTBLK: BLOCK   X+1\r
1960 SVEBLK: BLOCK   X+1\r
1961 PDLIST: BLOCK   XP\r
1962         BLOCK   2               ;FOR EXTENDED LOOKUP AND ENTERS\r
1963 EBLOCK: BLOCK   4\r
1964         BLOCK   <RIBALC-6+1>    ;MORE EXTENDED STUFF\r
1965 OBUF:   BLOCK   6               ;TTY:, OUTPUT DEV:\r
1966 IBUF:   BLOCK   30              ;INPUT DEVICES (10)\r
1967 \r
1968 SAVNAM: BLOCK   1       ;SAVED FILE NAME FROM UFD\r
1969 SAVEXT: BLOCK   1       ;SAVED EXT NAME FROM UFD\r
1970 DIRBUF: BLOCK 3         ;DIRECTORY BUFFER HEADER\r
1971 DSKHDR: BLOCK N+2       ;TWO WORDS OF OVERHEAD [P,P]+EXT\r
1972 DIRBLK=DSKHDR+2\r
1973 DIRNAM=DIRBLK+123       ;FILENAMES IN DTA DIRECTORY START HERE\r
1974 DIREXT=DIRNAM+26        ;EXTENSIONS IN DTA DIRECTORY START HERE\r
1975 \r
1976 BSZ:    BLOCK   1               ;SIZE OF OLD SYMBOL BLOCK\r
1977 PTGRS:  BLOCK   1               ;PTGR SAVED\r
1978 PTSRS:  BLOCK   1               ;PTSR SAVED\r
1979 RELOCS: BLOCK   1               ;ORIGINAL RELOC\r
1980 SYMBLK: BLOCK   ^D20            ;NEW SYMBOL BLOCK\r
1981 \r
1982 MATCH:  BLOCK   1               ;COUNT OF <'S - >'S ***VJC\r
1983 \r
1984 CURCHR: BLOCK   1               ;SAVED CURRENT CHAR OF CS\r
1985 LSTCHR: BLOCK   1               ;SAVED LAST CHAR OF CS\r
1986 SDEVCH: BLOCK   1       ;SAVED DEVICE CHARACTERS\r
1987 NUMDEV: BLOCK   1       ;NUMBER OF DEVICES\r
1988 XCOUNT: BLOCK   1\r
1989 XPNTR:  BLOCK   1\r
1990 BUFSIZ: BLOCK   1\r
1991 XBEG:   BLOCK   2\r
1992 LEVEL:  BLOCK   1       ;-2 IF LEVEL D\r
1993 DEFPPN: BLOCK   1       ;DEFAULT PROJ-PROG\r
1994 PRJPRG: BLOCK   1       ;TEMP. PROJ-PROG\r
1995 SVENTR: BLOCK   2       ;PLACE TO SAVE EBLOCK,+1\r
1996 NOWARN: BLOCK   1       ;SIGNAL TO PRINT MESSAGE ABOUT INDEX\r
1997         VAR             ;JUST IN CASE\r
1998 \r
1999 LOWTOP:\r
2000 \fSUBTTL CONSTANTS,POINTERS AND LITERALS\r
2001 \r
2002 SYMPTR: POINT   6, S\r
2003 EXTPTR: POINT   6, EXT\r
2004 PTSR:   POINT   4,SYMBLK+1      ;TO STORE RELOCATION\r
2005 PTGR:   POINT   4,RELOCS        ;TO GET RELOCATION\r
2006 DTCLR:  UTPCLR  1,\r
2007 FILXWD: XWD     FILBUF+2, FILBUF+1\r
2008 XPDLST: XWD     -XP,PDLIST-1\r
2009 \r
2010         END     FUDGE2\r
2011 \f\r
2012 \r