src/dtboot.mac

   1 TITLE DTBOOT - V003 - DECTAPE BOOTSTRAP (BIG TENDMP)    -\r
   2 SUBTTL R. CLEMENTS /RCC/JEF - 16 MAR 71\r
   3 \r
   4 ;(C) COPYRIGHT DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS 1971\r
   5 \r
   6 ;"THESE BOOTS WERE MADE FOR WALKIN'." - N.S.\r
   7 \r
   8 ;AC'S\r
   9 \r
  10 F=0     ;FLAGS\r
  11 A=1     ;GENERAL AC'S\r
  12 B=2     ; ..\r
  13 C=3     ; ..\r
  14 X=4     ;MEMORY ADDRESS COUNTER\r
  15 W=5     ;WORD RETURNED BY RWORD OR SIXBRD\r
  16 NAME=6  ;NAME OF FILE BEING SEARCHED FOR\r
  17 EXT=7   ;EXTENSION OF FILE BEING SEARCHED FOR\r
  18 Q=10    ;COUNTER TO STEP THROUGH BUFFER OF 200 DATA WORDS\r
  19 N=12    ;NUMBER ASSEMBLER IN TYPEIN, COUNTER IN SEARCH,RDBLK,WRBLK\r
  20 M=13    ;MEMORY AOBJN POINTER FOR READING THE DATA TO CORE\r
  21 FN=14   ;FILE NUMBER, 1 TO NFILES\r
  22 BP=15   ;POINTER TO CURRENT DIR BYTE (ALSO SIXBIT INPUT)\r
  23 LBN=16  ;TAPE BLOCK NUMBER TO READ\r
  24 P=17    ;STACK POINTER\r
  25 \f;CORE ALLOCATION\r
  26 IFNDEF REL,<REL=0>              ;REL=1 CAUSES A RELOCATABLE ASSEMBLY\r
  27 IFG REL,<BASE: CORE=BASE+1000>\r
  28 IFNDEF CORE,<CORE=200000>       ;ASSUME 64K\r
  29 \r
  30 ZZ=CORE-2000+140                ;SET ABOVE JOB DATA AREA OF TOP K\r
  31 \r
  32 CLRTOP=ZZ-1                     ;WHEN CLEARING CORE, CLEAR TO HERE\r
  33 \r
  34 DEFINE U(Z)<\r
  35         UU(Z,1)>                ;ONE WORD ALLOCATION\r
  36 DEFINE UU(Z,N)< Z=ZZ\r
  37 ZZ=ZZ+N\r
  38 IFGE <ZZ-CORE+1000>,<\r
  39 PRINTX ALLOCATION ERROR\r
  40 >>\r
  41 \r
  42 OPDEF PJRST [JRST]\r
  43 IFE REL,<LOC CORE-1000          ;ABSOLUTE ASSEMBLY\r
  44 RIM10B>                         ;PAPER TAPE FORMAT\r
  45 \r
  46 U(DEVICE)                       ;DEVICE NAME FROM COMMAND\r
  47 U(FNAME)                        ;FILE NAME FROM COMMAND\r
  48 U(FEXT)                         ;FILE EXTENSION FROM COMMAND\r
  49 U(SWITCH)                       ;SWITCHES FROM COMMAND\r
  50 U(TAPEID)                       ;TAPE NAME FOR Z COMMAND\r
  51 U(PRVLBN)                       ;LBN SOUGHT ON PREVIOUS SEARCH\r
  52 U(FBN)                          ;FIRST BLOCK NUMBER, FOR LINK\r
  53 \r
  54 UU(HBUF,200)                    ;DIRECTORY OF DTA\r
  55 UU(DBUF,200)                    ;DATA BUFFER\r
  56 FIRSTW==20                      ;FIRST LOCATION CONSIDERED ON WRITE\r
  57 PDLL==20                        ;STACK LENGTH\r
  58 \r
  59 \f;I/O DEVICE PARAMETERS\r
  60 \r
  61 DTC==320                        ;DEVICE CODE FOR DTA CONTROL\r
  62 DTS==324                        ;DEVICE CODE FOR DTA STATUS\r
  63 O.NOP==0                        ;OPCODES FOR THE DTA CONTROL CONO\r
  64 O.SRCH==200                     ;SEARCH\r
  65 O.READ==300                     ;READ\r
  66 O.WRIT==700                     ;WRITE\r
  67 C.STOP==400000                  ;CONO BITS\r
  68 C.FWD==200000                   ;GO FORWARD\r
  69 C.REV==100000                   ;GO REVERSE\r
  70 C.NDEL==040000                  ;NO DELAY AFTER CONO\r
  71 C.SEL==020000                   ;SELECT A UNIT\r
  72 C.DSEL==010000                  ;DESELECT CURRENT UNIT\r
  73 S.DAT==1                        ;DATA DONE FLAG\r
  74 S.INT==2                        ;INT REQ FLAG\r
  75 S.END==020000                   ;END ZONE HIT\r
  76 S.JOBD==100000                  ;JOB DONE FLAG\r
  77 S.ERR==653300                   ;ERRORS TO GIVE UP ON.\r
  78 ;FLAGS, LEFT HALF OF F\r
  79 \r
  80 L.DOT=1                         ;DOT SEEN IN FILE SPEC\r
  81 L.UPA==2                        ;UPARROW (TAPE ID)\r
  82 L.SLA==10                       ;SLASH SEEN IN FILE SPEC\r
  83 L.ALL==13                       ;ABOVE FLAGS TOGETHER.\r
  84 L.UPA2==20                      ;UPARROW AGAIN FOR READING AT ZERO ROUTINE\r
  85 L.REV==400000                   ;TAPE MOVING IN REVERSE. SIGN BIT REQ?\r
  86 L.REVA==40                      ;ALLOCATION PASS IS GOING IN REVERSE\r
  87 L.TURN==100                     ;ALLOCATION PASS HAD TO TURN AROUND\r
  88 \r
  89 ;FLAGS, RIGHT HALF OF F\r
  90 \r
  91 R.MRG==1                        ;MERGE, NOT LOAD.\r
  92 R.WEOF==2                       ;ON WHILE WRITING JRST WORD(S) IN LAST BLK\r
  93 R.DIRI==4                       ;DIRECTORY IN CORE IS VALID\r
  94 R.STRT==10                      ;ON IF LOAD AND GO. OFF IF JUST LOAD\r
  95 \r
  96 ;SYSTEM PARAMETERS WHICH MUST AGREE WITH TIMESHARING SYSTEM\r
  97 \r
  98 DIRBLK==144                     ;WHERE DIRECTORY IS ON TAPE\r
  99 D.BYT==0                        ;WORD OF BYTES IN DIRECTORY\r
 100 D.NAM==123                      ;FIRST NAME IN DIRECTORY\r
 101 D.EXT==151                      ;START OF EXTENSIONS IN DIR\r
 102 NFILES==26                      ;HOW MANY FILES FIT IN DIR\r
 103 MAXBLK==1101                    ;LAST BLOCK ON THE TAPE\r
 104 BLKFAC==2                       ;BLOCKING FACTOR - WRITE ONE OF N BLKS\r
 105 \f;START HERE\r
 106 \r
 107 GO:     MOVEI F,0               ;CLEAR ALL FLAGS\r
 108         CONO 200000             ;I/O BUS RESET\r
 109         CONO 4,10400            ;CLEAR PI SYSTEM\r
 110         SETZM DEVICE            ;CLEAR REQUESTED DEVICE NAME\r
 111 REGO:   MOVE P,PDP              ;INITIAL STACK POINTER\r
 112         ANDI F,R.DIRI   ;CLEAR OUT RANDOM FLAGS\r
 113         SETZM FNAME             ;CLEAR REQUESTED FILE NAME\r
 114         SETZM FEXT              ;CLEAR REQUESTED FILE EXTENSION\r
 115         SETZM SWITCH            ;CLEAR COMMAND SWITCHES\r
 116         PUSHJ P,CRLF            ;SAY HELLO\r
 117 GOL:    MOVE BP,SIXPTR          ;POINTER TO THE WORD.\r
 118         SETZB N,W               ;CLEAR ANSWERS.\r
 119 SIXBRL: CONSO TTY,40            ;WAIT FOR A KEY TO BE ST(R)UCK\r
 120         JRST .-1                ; ..\r
 121         DATAI TTY,C             ;GET THE CHAR\r
 122         PUSHJ P,TYO             ;ECHO IT\r
 123         ANDI C,177              ;ONLY 7 BITS\r
 124         CAIN C,177              ;RUBOUT?\r
 125         JRST REGO               ;YES. QUIT.\r
 126         CAIG C,172              ;CHECK FOR LOWER CASE\r
 127         CAIGE C,140             ; ..\r
 128         SKIPA                   ;NOT L.C.\r
 129         TRZ C,40                ;L.C., MAKE U.C.\r
 130         CAIG C,"Z"              ;LETTER?\r
 131         CAIGE C,"A"             ; ..\r
 132         SKIPA                   ;NOT A LETTER.\r
 133         JRST SIXLTR             ;LETTER.\r
 134         CAIG C,"9"              ;NUMBER?\r
 135         CAIGE C,"0"             ; ..\r
 136         JRST GO0                ;NO. RETURN WITH BREAK CHAR.\r
 137         LSH N,3                 ;BUILD OCTAL NUMBER\r
 138         ADDI N,-60(C)           ;ADD IN THIS DIGIT\r
 139 SIXLTR: TRC C,40                ;MAKE SIXBIT\r
 140         TLNE BP,770000          ;ONLY 6 CHARS\r
 141         IDPB C,BP               ;STORE CHAR IN W\r
 142         JRST SIXBRL             ;LOOP FOR MORE.\r
 143 \fGO0:   CAIE C,":"              ;UNIT DELIMITER?\r
 144         JRST GO1                ;NO.\r
 145         TRZ F,R.DIRI            ;DIRECTORY NO GOOD, SELECTING A TAPE\r
 146         ANDI N,7                ;JUST THREE BITS OF UNIT NUMBER\r
 147         MOVEM N,DEVICE          ;YES. SAVE NUMBER OF DEVICE\r
 148         JRST GOL                ;GO READ MORE.\r
 149 GO1:    TLNN F,L.ALL            ;ANY SYNTAX REQUESTS?\r
 150         JRST GO6                ;NO. SEE IF FILE NAME.\r
 151         TLZE F,L.DOT            ;WAS THERE A DOT?\r
 152         HLLOM W,FEXT            ;YES. STORE EXT. RH IS FLAG IF BLANK.\r
 153         TLZE F,L.UPA            ;UPARROW?\r
 154         MOVEM W,TAPEID          ;YES. SAVE TAPE NAME.\r
 155         TLZE F,L.SLA            ;SLASH SWITCH?\r
 156         MOVEM W,SWITCH          ;YES. SAVE SWITCH WORD\r
 157 GO7:    CAIGE C,175             ;ALTMODE?\r
 158         CAIG C,40               ;SPACE OR CONTROL CHAR?\r
 159         JRST DO                 ;YES. GO PROCESS COMMAND\r
 160         CAIE C,"."              ;FILE EXTENSION REQUEST?\r
 161         JRST GO3                ;NO.\r
 162         TLO F,L.DOT             ;YES. REMEMBER THAT\r
 163         JRST GOL                ;AND READ ON.\r
 164 \r
 165 GO3:    CAIE C,"/"              ;SLASH?\r
 166         JRST GO5                ;NO.\r
 167         TLO F,L.SLA             ;YES. MARK SWITCH COMING\r
 168         JRST GOL                ;RETURN TO SCAN\r
 169 GO5:    CAIN C,"^"              ;UPARROW?\r
 170         TLO F,L.UPA+L.UPA2      ;YES. NOTE IT.\r
 171         JRST GOL                ;LOOP FOR MORE.\r
 172 GO6:    SKIPE W                 ;NO PUNCTUATION. NAME TYPED?\r
 173         MOVEM W,FNAME           ;YES. STORE NAME\r
 174         JRST GO7                ;GO CHECK PUNCTUATION\r
 175 \f;HERE WHEN COMMAND STRING SUCCESSFULLY READ. DO THE JOB.\r
 176 \r
 177 DO:     PUSHJ P,CRLF            ;SIGNAL STARTING I/O\r
 178         LDB A,SWPTR             ;GET FIRST CHAR OF SWITCHES\r
 179         CAIN A,"Z"-40           ;ZERO COMMAND?\r
 180         JRST ZERO               ;YES.\r
 181         CAIN A,"G"-40           ;GO COMMAND?\r
 182 PROGSA: JRST GO                 ;YES. *** RH MODIFIED ***\r
 183         CAIL A,"0"-40           ;NUMERIC?\r
 184         CAILE A,"7"-40          ; OCTAL, THAT IS,\r
 185         SKIPA                   ;NO.\r
 186         JRST SETSA              ;YES. GO SET STARTING ADDRESS\r
 187         PUSHJ P,RDDIR           ;REST OF COMMANDS NEED DIRECTORY\r
 188         LDB A,SWPTR             ;GET FIRST CHAR OF SWITCHES\r
 189         CAIN A,"M"-40           ;MERGE?\r
 190         TROA F,R.MRG            ;YES. SKIP INTO LOAD, FLAGGING MERGE ONLY\r
 191         CAIN A,"L"-40           ;LOAD COMMAND?\r
 192         JRST LOAD               ;YES.\r
 193         CAIN A,"D"-40           ;DUMP COMMAND?\r
 194         JRST DUMP\r
 195         CAIN A,"F"-40           ;FILE DIRECTORY?\r
 196         JRST FILDIR             ;YES.\r
 197         CAIN A,"K"-40           ;KILL A FILE (DELETE)?\r
 198         JRST KILL               ;YES.\r
 199         JUMPE A,RUN             ;IF NO SWITCH, ASSUME LOAD AND RUN\r
 200         PUSHJ P,ERROR           ;NO OTHERS IMPLEMENTED\r
 201 \r
 202 SETSA:  HRRM N,PROGSA           ;STORE PROGRAM STARTING ADDR\r
 203         JRST REGO               ;AND WAIT FOR ANOTHER COMMAND\r
 204 \r
 205 FILDIR: MOVSI N,-NFILES         ;LIST A QUICK DIRECTORY\r
 206 FILDL:  SKIPN B,HBUF+D.NAM(N)   ;GET A NAME, IF ANY IN THIS SLOT\r
 207         JRST FILDN              ;NONE HERE\r
 208         PUSHJ P,SIXOUT          ;TYPE C(B) IN SIXBIT\r
 209         HLLZ B,HBUF+D.EXT(N)    ;GET EXTENSION\r
 210         JUMPE B,FILD1           ;IF NOT BLANK,\r
 211         MOVEI C,"."             ;DOT\r
 212         PUSHJ P,TYO             ;TYPE DOT\r
 213         PUSHJ P,SIXOUT          ;TYPE EXT\r
 214 FILD1:  PUSHJ P,CRLF            ;A CARRIAGE RETURN\r
 215 FILDN:  AOBJN N,FILDL           ;LOOP FOR ALL NAMES\r
 216         JRST REGO1              ;STOP TAPE AND GO FOR NEXT COMMAND\r
 217 \f;LOAD AND RUN COMMANDS\r
 218 \r
 219 RUN:    TRO F,R.STRT            ;LOAD AND START PROGRAM\r
 220 LOAD:   MOVSI FN,-NFILES        ;SEARCH TO SEE IF ONLY ONE SAV FILE ON DT\r
 221         MOVEI A,0               ;WHERE NAME WILL GO IF FOUND\r
 222 RUN5:   HLRZ EXT,HBUF+D.EXT(FN) ;CHECK AN EXTENSION\r
 223         CAIN EXT,(SIXBIT /SAV/) ;IS IT A SAV FILE?\r
 224         JRST RUN2               ;YES. GO NOTE IT\r
 225 RUN4:   AOBJN FN,RUN5           ;LOOP THRU COUNTING ALL FILES\r
 226         SKIPN A                 ;WAS ONE AND ONLY ONE FOUND?\r
 227 RUN3:   MOVE A,SYSTEM           ;DEFAULT READ-FILE NAME\r
 228         SKIPN FNAME             ;NAME SUPPLIED?\r
 229         MOVEM A,FNAME           ;NO. PLUG IN DEFAULT.\r
 230         PUSHJ P,LOOK            ;TRY TO FIND FILE\r
 231           PUSHJ P,ERROR         ;NOT THERE. FAIL.\r
 232         MOVEI LBN,1             ;HAVE TO FIND A BLOCK OF FILE\r
 233         MOVE BP,BYTPTR          ;LOOK THRU DIRECTORY\r
 234 RUNL:   ILDB N,BP               ;GET A BYTE\r
 235         CAIN N,0(FN)            ;BELONG TO THIS FILE?\r
 236         JRST RUN1               ;YES.\r
 237         CAIL LBN,MAXBLK         ;LOOKED TOO FAR?\r
 238          PUSHJ P,ERROR          ;YES. NO BLKS IN FILE!\r
 239         AOJA LBN,RUNL           ;LOOK FURTHER\r
 240 RUN1:   PUSHJ P,RDDAT1          ;READ THE DATA BLOCK TO FIND FBN\r
 241         LDB A,[POINT 10,DBUF+0,27]      ;FIRST BLOCK OF FILE\r
 242         HRLM A,DBUF+0           ;PUT IT IN LINK SLOT TO BE READ NEXT\r
 243 RFILE:  SETZB Q,40              ;CLEAR CORE BEFORE READING FILE\r
 244                                 ;AND INITIALLY NO WORDS IN DATA BUFFER\r
 245         MOVE A,BLTXWD           ; ..\r
 246         TRNN F,R.MRG            ;UNLESS MERGE ONLY,\r
 247         BLT A,CLRTOP            ;CLEAR UP TO BASE OF THIS PROGRAM\r
 248 RFILL1: PUSHJ P,RWORD           ;READ A POINTER OR JRST WORD\r
 249         SKIPL M,W               ;WHICH IS IT?\r
 250         JRST STARTQ             ;TRANSFER WORD\r
 251 RFILL2: PUSHJ P,RWORD           ;READ A WORD OF DATA\r
 252         MOVEM W,1(M)            ;STORE IT IN CORE\r
 253         AOBJN M,RFILL2          ;COUNT THE CORE POINTER.\r
 254         JRST RFILL1             ;IT RAN OUT. GET ANOTHER.\r
 255 \r
 256 RUN2:   JUMPN A,RUN3            ;IF ALREADY ONE, THIS IS 2. QUIT.\r
 257         MOVE A,HBUF+D.NAM(FN)   ;FIRST SAV FILE. GET ITS NAME.\r
 258         JRST RUN4               ;AND SEE IF ANY MORE.\r
 259 \fSTARTQ:        HRRM W,PROGSA           ;SAVE THE STARTING ADDRESS\r
 260 REGO1:  CONO DTC,C.STOP         ;STOP THE TAPE\r
 261         TRNE F,R.STRT           ;LOAD OR START?\r
 262         JRST 0(W)               ;START\r
 263         JRST REGO               ;JUST LOAD. GO GET ANOTHER COMMAND\r
 264 \r
 265 ;SUBROUTINE TO READ A DATA WORD FROM THE FILE.\r
 266 \r
 267 RWORD1: MOVE Q,DBUFP            ;PREPARE TO COUNT DATA WORDS\r
 268 RWORD:  JUMPGE Q,RWNXTB         ;NEED ANOTHER BLOCK?\r
 269         MOVE W,0(Q)             ;NO. GET A WORD.\r
 270         AOBJN Q,.+1             ;COUNT IT.\r
 271         POPJ P,0                ;RETURN FROM RWORD\r
 272 RWNXTB: PUSHJ P,RDDATA          ;NO. READ NEXT DATA BLOCK, IF ANY\r
 273         JRST RWORD1             ;READ FROM THIS BLOCK\r
 274 \r
 275 DUMP:   MOVE A,CRASH            ;DEFAULT FILE NAME\r
 276         SKIPN FNAME             ;NAME ALREADY SET?\r
 277         MOVEM A,FNAME           ;NO. USE DEFAULT\r
 278         PUSHJ P,ENTR            ;TRY TO FIND THE FILE.\r
 279          PUSHJ P,ERROR          ;NO FREE SLOTS (OR MAYBE NO BLKS LEFT)\r
 280         MOVEM LBN,FBN           ;SAVE AS FIRST BLOCK NUMBER\r
 281         MOVEI Q,0               ;INITIALIZE DATA BLOCK COUNTER\r
 282         MOVEI M,FIRSTW-1        ;AND CORE ADDRESS COUNTER\r
 283 DUMPL2: HRRZS X,M               ;START OF A BLOCK\r
 284 DUMPL1: SKIPN 1(X)              ;THIS WORD ZERO IN CORE?\r
 285         JRST DUMP1              ;YES. SEE IF END OF A BLOCK.\r
 286         CAIGE X,CLRTOP          ;LOOKED AT ALL OF CORE?\r
 287         AOJA X,DUMPL1           ;NO. COUNT PART OF THIS BLOCK, LOOK ON.\r
 288 DUMP1:  MOVEI W,0(M)            ;END OF BLOCK. IS BLOCK EMPTY?\r
 289         SUBI W,0(X)             ;START MINUS END OF BLK\r
 290         JUMPE W,DUMP2           ;JUMP IF BLOCK EMPTY\r
 291         HRL M,W                 ;MAKE -COUNT,,START-1 FOR COUNTER\r
 292         MOVE W,M                ;AND FOR DATA IN FILE\r
 293         PUSHJ P,WWORD           ;WRITE IT OUT AS DATA\r
 294 DUMPL3: MOVE W,1(M)             ;GET THE WORD FROM CORE\r
 295         PUSHJ P,WWORD           ;OUTPUT TO FILE\r
 296         AOBJN M,DUMPL3          ;OUTPUT ALL OF BLOCK\r
 297 DUMP2:  CAIGE X,CLRTOP          ;CONSIDERED ALL OF CORE?\r
 298         AOJA M,DUMPL2           ;NO. MOVE ON.\r
 299         TRO F,R.WEOF            ;FLAG WRITING LAST BLK, SO NO ALLOC\r
 300         MOVE W,PROGSA           ;YES. APPEND STARTING ADDRESS\r
 301         PUSHJ P,WWORD           ;WRITE OUT THIS WORD\r
 302         JUMPL Q,.-1             ;IF MORE TO GO IN BLOCK, WRITE AGAIN\r
 303         JRST CLS                ;WRITE OUT THE DIRECTORY\r
 304                                 ;AND RESTART PROGRAM FOR NEXT COMMAND\r
 305 \f;SUBROUTINE TO WRITE A WORD INTO THE FILE\r
 306 \r
 307 WWORD:  SKIPL Q                 ;NEED A NEW POINTER?\r
 308         MOVE Q,DBUFP            ;YES.\r
 309         MOVEM W,0(Q)            ;PUT WORD INTO BUFFER\r
 310         AOBJN Q,CPOPJ           ;COUNT POINTER. DONE?\r
 311         MOVE A,FBN              ;GET FIRST BLOCK NUMBER\r
 312         LSH A,10                ;PUT IN RIGHT PLACE\r
 313         TRO A,177               ;DECLARE 127 WORDS IN BLOCK USED\r
 314         HRRZM A,DBUF+0          ;PUT IN LINK WORD\r
 315         TRNE F,R.WEOF           ;WRITING LAST BLK?\r
 316         JRST WWORD1             ;YES. DONT ALLOCATE ANOTHER\r
 317         PUSH P,LBN              ;SAVE BLOCK ABOUT TO WRITE\r
 318         PUSHJ P,ALLOC           ;GET NEXT BLOCK OF FILE\r
 319          PUSHJ P,ERROR          ;NONE AVAILABLE\r
 320         HRLM LBN,DBUF+0         ;PUT IN LINK WORD\r
 321         POP P,LBN               ;RESTORE BLOCK FOR WRITING NOW\r
 322 WWORD1: PUSHJ P,WRDATA          ;OUTPUT BLOCK, IF POSSIBLE\r
 323         HLRZ LBN,DBUF+0         ;GET LINK TO NEXT BLOCK IN LBN\r
 324         POPJ P,0                ;OK. RETURN.\r
 325 \r
 326 ;SUBROUTINE TO LOOK FOR FILE\r
 327 \r
 328 LOOK:   MOVE NAME,FNAME         ;GET DESIRED FILENAME\r
 329         MOVSI EXT,(SIXBIT /SAV/)        ;DEFAULT EXTENSION\r
 330         SKIPE FEXT              ;ANY SUPPLIED?\r
 331         HLLZ EXT,FEXT           ;YES. USE IT.\r
 332 SRCHFD: MOVSI FN,-NFILES        ;MAKE AOBJN COUNTER\r
 333 SCHL2:  MOVE B,HBUF+D.NAM(FN)   ;GET A FILE NAME\r
 334         CAME B,NAME             ;IS NAME RIGHT?\r
 335         JRST SCHN2              ;NO. MOVE ON.\r
 336         HLLZ B,HBUF+D.EXT(FN)   ;CHECK THE EXTENSION\r
 337         CAMN B,EXT              ;IS IT RIGHT TOO?\r
 338         AOJA FN,CPOPJ1          ;YES. GOOD RETURN, ANSWER IS FILE NUMBER IN FN\r
 339 SCHN2:  AOBJN FN,SCHL2          ;COUNT FILE, EXT. CHECK NEXT FILE IN FD\r
 340         POPJ P,0                ;FAIL RETURN, NOT FOUND.\r
 341 \f;SUBROUTINE TO READ NEXT BLOCK OF DATA INTO DBUF\r
 342 \r
 343 RDDATA: HLRZ LBN,DBUF+0         ;LINK\r
 344         JUMPE LBN,ERROR         ;JUMP IF END OF FILE\r
 345 RDDAT1: MOVEI A,DBUF            ;SELECT DATA BUFFER\r
 346 RDBLK:  PUSHJ P,PROCBK          ;PROCESS A BLOCK\r
 347          CONO DTC,O.READ        ;ARGS TO PROCBK\r
 348          DATAI DTC,0(A)         ; TO CAUSE IT TO READ THE BLOCK\r
 349         POPJ P,0                ;SUCCESS. RETURN\r
 350 \r
 351 RDDIR:  TRNE F,R.DIRI           ;IS THE DIRECTORY IN CORE OK?\r
 352         POPJ P,0                ;YES. DONT READ IT AGAIN\r
 353         MOVEI A,HBUF            ;MUST READ. WHERE TO PUT IT.\r
 354         MOVEI LBN,DIRBLK        ;BLOCK ON TAPE TO READ\r
 355         PUSHJ P,RDBLK           ;READ IT\r
 356         CONO DTC,C.STOP         ;STOP TAPE IN CASE OF /F COMMAND\r
 357         TRO F,R.DIRI            ;HAVE A GOOD DIRECTORY IN CORE NOW\r
 358         POPJ P,0                ;RETURN FROM RDDIR\r
 359 \r
 360 ZERO:   MOVE A,TAPEID           ;COPY TAPE NAME IF ANY\r
 361         MOVEM A,HBUF+177        ; ..\r
 362         TLZN F,L.UPA2           ;WAS ONE THERE?\r
 363         PUSHJ P,RDDIR           ;NO. GET THE ONE ON TAPE\r
 364         SETZM HBUF              ;CLEAR OUT REST OF DIR\r
 365         MOVE A,[XWD HBUF,HBUF+1] ; ..\r
 366         BLT A,HBUF+176          ; ..\r
 367         MOVSI A,(<36B4+36B9>)   ;ALLOCATE BLOCKS 1 AND 2\r
 368         MOVEM A,HBUF+D.BYT+0    ; ..\r
 369         MOVSI A,(36B9)          ;AND BLOCK 144\r
 370         MOVEM A,HBUF+D.BYT+16   ; ..\r
 371         HRLOI A,7               ;AND THE NONEXISTENT ONES\r
 372         MOVEM A,HBUF+D.BYT+122  ; ..\r
 373 CLS:    PUSHJ P,WRDIR           ;WRITE OUT THE DIRECTORY\r
 374         JRST REGO1              ;STOP TAPE AND RETURN TO COMMAND SCANNER\r
 375 \r
 376 WRDIR:  MOVEI LBN,DIRBLK        ;BLOCK TO WRITE\r
 377         MOVEI A,HBUF            ;DATA TO WRITE\r
 378         PJRST WRBLK             ;WRITE IT\r
 379 \r
 380 WRDATA: MOVEI A,DBUF            ;WRITE FROM DATA BUFFER\r
 381 WRBLK:  PUSHJ P,PROCBK          ;PROCESS THE BLOCK\r
 382          CONO DTC,O.WRIT        ;ARGS TO PROCBK TO CAUSE IT\r
 383          DATAO DTC,0(A)         ;TO WRITE THE BLOCK ONTO TAPE\r
 384         POPJ P,0                ;RETURN FROM WRBLK\r
 385 \fPROCBK:        PUSHJ P,SEARCH          ;ROUTINE TO READ OR WRITE A BLOCK OF TAPE\r
 386                                 ; FIRST FIND THE BLOCK (EITHER DIRECTION)\r
 387         MOVEI N,200             ;NUMBER OF WORDS IN A BLOCK\r
 388         TLNE F,L.REV            ;WHICH WAY WE GOING?\r
 389         ADDI A,177              ;BACKWARDS. WRITE FROM TOP OF CORE DOWN\r
 390         XCT @0(P)               ;CONO WRITE OR READ\r
 391         AOS 0(P)                ;COUNT ON TO DATAI OR DATAO\r
 392 PROCLP: CONSZ DTS,S.ERR!S.END   ;TROUBLE?\r
 393         PUSHJ P,ERROR           ;YES. QUIT\r
 394         CONSO DTS,S.DAT         ;WANT DATA MOVED YET?\r
 395         JRST PROCLP             ;NO. WAIT SOME MORE.\r
 396         XCT @0(P)               ;YES. DATAI OR DATAO TO/FROM BUFFER\r
 397         ADDI A,1                ;COUNT BUFFER POINTER\r
 398         TLNE F,L.REV            ;GOING BACKWARDS?\r
 399         SUBI A,2                ;YES. THEN COUNT POINTER BACKWARDS TOO\r
 400         SOJG N,PROCLP           ;TRANSFERRED WHOLE BLOCK?\r
 401         CONO DTS,1              ;YES. TELL IT TO DO CHECKSUMMING AND QUIT\r
 402         CONSO DTS,S.JOBD        ;DONE?\r
 403         JRST .-1                ;NOT YET. WAIT.\r
 404         JRST CPOPJ1             ;YES. RETURN AFTER THE DATAI/O ARGUMENT\r
 405 \r
 406 SEARCH: MOVE C,DEVICE           ;GET DRIVE NUMBER\r
 407         LSH C,11                ;PUT IN UNIT DIGIT FOR CONO\r
 408         CONSZ DTC,C.FWD!C.REV   ;TAPE GOING AT THE MOMENT?\r
 409         JRST SRCHC              ;YES.\r
 410         TRO C,C.FWD!C.DSEL      ;NO. MAKE IT GO FORWARD\r
 411         TLZ F,L.REV             ;AND GET THE FLAG TO SAY THAT\r
 412 SRCHC:  CONO DTC,O.SRCH!C.SEL(C) ;MAKE IT SEARCH\r
 413 SRCHW:  CONSZ DTS,S.END         ;AT END ZONE?\r
 414         JRST SRCHTA             ;YES. TURN AROUND.\r
 415         CONSZ DTS,S.ERR         ;ANY ERRORS?\r
 416          PUSHJ P,ERROR          ;YES. QUIT.\r
 417         CONSO DTS,S.DAT         ;BLOCK NUMBER FOUND?\r
 418         JRST SRCHW              ;NO. WAIT FOR IT\r
 419         DATAI DTC,N             ;YES. SEE WHAT BLOCK WE ARE AT\r
 420         ANDI N,7777             ;JUST FOR SAFETY, MASK JUNK OUT\r
 421         SUBI N,0(LBN)           ;GET THE DISTANCE TO GO\r
 422         JUMPE N,CPOPJ           ;IF FOUND, RETURN WITH TAPE ROLLING INTO DESIRED BLK\r
 423         TLNE F,L.REV            ;NOT THERE. WHICH WAY WE GOING?\r
 424         MOVNS N                 ;BACKWARDS. NEGATE.\r
 425         JUMPL N,SEARCH          ;IF SHOULD KEEP GOING, ITS MINUS.\r
 426 SRCHTA: CONO DTC,C.FWD!C.REV    ;MUST TURN AROUND (END ZONE OR PASSED)\r
 427         TLC F,L.REV             ;COMPLEMENT DIRECTION FLAG\r
 428         JRST SEARCH             ;SEARCH SOME MORE\r
 429 \fDELETE:        PUSHJ P,LOOK            ;SEE IF FILE EXISTS ALREADY\r
 430          POPJ P,0               ;NO. FAIL RETURN\r
 431         SETZB B,HBUF+D.NAM-1(FN)        ;FOUND IT. CLEAR NAME\r
 432         SETZM HBUF+D.EXT-1(FN)  ;AND EXT IN DIRECTORY\r
 433         MOVE BP,BYTPTR          ;INITIAL BYTE POINTER TO DIRECTORY BYTES\r
 434         MOVEI N,MAXBLK          ;SEARCH ALL BYTES FOR THIS FILE\r
 435         ILDB A,BP               ;GET A DIRECTORY BYTE\r
 436         CAIN A,0(FN)            ;BELONG TO THIS FILE?\r
 437         DPB B,BP                ;YES. CLEAR IT OUT, ITS FREE NOW\r
 438         SOJG N,.-3              ;LOOP FOR WHOLE DIRECTORY\r
 439 CPOPJ1: AOS 0(P)                ;SUCCESSFUL RETURN\r
 440 CPOPJ:  POPJ P,0                ;RETURN.\r
 441 \r
 442 KILL:   PUSHJ P,DELETE          ;REMOVE FILE FROM DIRECTORY\r
 443          PUSHJ P,ERROR          ;NOT THERE, GIVE A BELL\r
 444         JRST CLS                ;WRITE DIRECTORY AND RETURN TO CMD SCAN\r
 445 \r
 446 ENTR:   PUSHJ P,DELETE          ;FIRST REMOVE OLD FILE BY THIS NAME\r
 447          JFCL                   ;MAY NOT HAVE BEEN ONE, THATS OK\r
 448         MOVSI FN,-NFILES        ;SEARCH FOR A FREE SLOT\r
 449         SKIPN HBUF+D.NAM(FN)    ;SLOT FREE?\r
 450         AOJA FN,ENTR1           ;YES. CONVERT RH TO FILE NUMBER, GO USE.\r
 451         AOBJN FN,.-2            ;LOOK FOR ANOTHER\r
 452         POPJ P,0                ;NONE FREE. WE LOSE.\r
 453 \fENTR1: MOVEM NAME,HBUF+D.NAM-1(FN)     ;STORE THE FILE NAME IN FREE SLOT\r
 454         HLLZM EXT,HBUF+D.EXT-1(FN)      ;AND THE EXTENSION\r
 455 ALLOCI: SETZM PRVLBN            ;INITIALIZE POINTERS FOR ALLOCATOR\r
 456         MOVE BP,BYTPTR          ;START HAVING CHECKED BLK 0.\r
 457         TLZ F,L.REVA            ;NOT REVERSE ALLOCATING\r
 458 ALLOC:  TLZ F,L.TURN            ;ALLOCATOR HASNT TURNED AROUND\r
 459         MOVE LBN,PRVLBN         ;RESTORE PREVIOUS LBN\r
 460 ALLOCP: TLNE F,L.REVA           ;WHICH WAY WE LOOKING?\r
 461         JRST ALCN2              ;NEXT BACK\r
 462         JRST ALCN1              ;NEXT FORWARD\r
 463 \fALCL1: ILDB N,BP               ;GET A BLOCK BYTE\r
 464         JUMPE N,ALLOC1          ;IF ITS FREE, MAY USE IT\r
 465 ALCN1:  CAIGE LBN,MAXBLK        ;LOOKED ALL THRU FORWARD?\r
 466         AOJA LBN,ALCL1          ;NO. TRY ANOTHER\r
 467 ALLOCT: TLOE F,L.TURN           ;TURN SEARCH AROUND. BETTER NOT BE SECOND TURN\r
 468          POPJ P,0               ;LOOKED THRU AND DIDNT FIND ANYTHING. QUIT.\r
 469         TLC F,L.REVA            ;LOOK THE OTHER WAY\r
 470         JRST ALLOCP             ;GO SEE WHICH WAY NOW\r
 471 \r
 472 ALCL2:  ADD BP,[XWD 050000,0]   ;MOVE LEFT A BYTE\r
 473         SKIPGE BP               ;OFF THE END OF THE WORD?\r
 474         SUB BP,[XWD 430000,1]   ;YES. BACK A WORD, RIGHT 35 BITS\r
 475         LDB N,BP                ;GET THIS BYTE\r
 476         JUMPE N,ALLOC1          ;IF ITS FREE MAY USE IT.\r
 477 ALCN2:  CAILE LBN,1             ;GONE ALL THE WAY TO THE FRONT?\r
 478         SOJA LBN,ALCL2          ;NO, LOOK FURTHER\r
 479         JRST ALLOCT             ;YES. MUST TURN ALLOCATOR AROUND\r
 480 \r
 481 ALLOC1: MOVE N,PRVLBN           ;HAVE A FREE ONE. WANT IT?\r
 482         SUBI N,0(LBN)           ;FIND DISTANCE FROM LAST ONE\r
 483         MOVMS N                 ;WHICHEVER DIRECTION\r
 484         CAIGE N,BLKFAC          ;IS IT FAR ENOUGH AWAY?\r
 485         TLNE F,L.TURN           ;OR ARE WE TURNING ALLOCATOR AROUND?\r
 486         JRST ALLOCY             ;YES. USE THIS ONE.\r
 487         JRST ALLOCP             ;NO. PROCEED TO ANOTHER BLOCK\r
 488 \r
 489 ALLOCY: DPB FN,BP               ;PUT THIS FILE NUMBER IN THE BLOCK'S BYTE\r
 490         MOVEM LBN,PRVLBN        ;SAVE AS PREVIOUS BLOCK ALLOCATED\r
 491         JRST CPOPJ1             ;AND RETURN WITH LBN SET UP\r
 492 \f;TTY I/O SUBRS\r
 493 \r
 494 ERROR:  MOVEI C,207             ;MAKE A BELL, EVEN PARITY\r
 495         PUSHJ P,TYO             ;TYPE IT OUT\r
 496         JRST GO                 ;AND RESTART.\r
 497 \r
 498 CRLF:   MOVEI C,215             ;CR, EVEN\r
 499         PUSHJ P,TYO             ;TYPE IT.\r
 500         MOVEI C,12              ;LF, EVEN\r
 501 TYO:    DATAO TTY,C             ;SEND OUT CHAR\r
 502         CONSZ TTY,20            ;WAIT FOR IDLE\r
 503         JRST .-1                ; ..\r
 504         POPJ P,0                ;DONE.\r
 505 \r
 506 SIXOUT: MOVEI C,0               ;SO DONT SHIFT IN JUNK\r
 507         ROTC B,6                ;GET A SIXBIT CHAR IN C\r
 508         ADDI C,40               ;MAKE IT ASCII\r
 509         PUSHJ P,TYO             ;TYPE IT\r
 510         JUMPN B,SIXOUT          ;IF ANY MORE, TYPE THEM\r
 511         POPJ P,0                ;AND RETURN\r
 512 \f;CONSTANTS AND TEMPS.\r
 513 \r
 514 SYSTEM: SIXBIT /SYSTEM/         ;DEFAULT FILENAME\r
 515 CRASH:  SIXBIT /CRASH/          ;DEFAULT DUMP NAME\r
 516 DBUFP:  XWD -177,DBUF+1         ;POINTER TO DATA BLOCK\r
 517 BLTXWD: XWD 40,41               ;FOR CORE-CLEARING\r
 518 SIXPTR: XWD 440600,W            ;POINTER FOR SIXBIT NAME\r
 519 BYTPTR: POINT 5,HBUF+D.BYT      ;POINTER TO BYTES IN DIRECTORY\r
 520 SWPTR:  POINT 6,SWITCH,5        ;POINTER TO FIRST SWITCH CHARACTER\r
 521 \r
 522 LIT\r
 523 \r
 524 UU(PDL,PDLL)                    ;STACK\r
 525 PDP:    XWD -PDLL,PDL-1         ;STACK POINTER\r
 526 \r
 527 UU(ZZMAX,0)\r
 528 \r
 529 SLOP==576-<.-GO>                ;MUST BE POSITIVE IF WANT\r
 530                                 ;THIS TO FIT IN BLKS 0,1,2 OF DTA\r
 531                                 ;THREE BLOCKS INCLUDING HRI BLKI WD AND JRST WD\r
 532         END GO\r
 533 \f