Fixed some typos and added COPY and DTBOOT.
[retro-software/dec/tops10/v4.5.git] / src / dtboot.mac
diff --git a/src/dtboot.mac b/src/dtboot.mac
new file mode 100644 (file)
index 0000000..027d458
--- /dev/null
@@ -0,0 +1,533 @@
+TITLE DTBOOT - V003 - DECTAPE BOOTSTRAP (BIG TENDMP)   -\r
+SUBTTL R. CLEMENTS /RCC/JEF - 16 MAR 71\r
+\r
+;(C) COPYRIGHT DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS 1971\r
+\r
+;"THESE BOOTS WERE MADE FOR WALKIN'." - N.S.\r
+\r
+;AC'S\r
+\r
+F=0    ;FLAGS\r
+A=1    ;GENERAL AC'S\r
+B=2    ; ..\r
+C=3    ; ..\r
+X=4    ;MEMORY ADDRESS COUNTER\r
+W=5    ;WORD RETURNED BY RWORD OR SIXBRD\r
+NAME=6 ;NAME OF FILE BEING SEARCHED FOR\r
+EXT=7  ;EXTENSION OF FILE BEING SEARCHED FOR\r
+Q=10   ;COUNTER TO STEP THROUGH BUFFER OF 200 DATA WORDS\r
+N=12   ;NUMBER ASSEMBLER IN TYPEIN, COUNTER IN SEARCH,RDBLK,WRBLK\r
+M=13   ;MEMORY AOBJN POINTER FOR READING THE DATA TO CORE\r
+FN=14  ;FILE NUMBER, 1 TO NFILES\r
+BP=15  ;POINTER TO CURRENT DIR BYTE (ALSO SIXBIT INPUT)\r
+LBN=16 ;TAPE BLOCK NUMBER TO READ\r
+P=17   ;STACK POINTER\r
+\f;CORE ALLOCATION\r
+IFNDEF REL,<REL=0>             ;REL=1 CAUSES A RELOCATABLE ASSEMBLY\r
+IFG REL,<BASE: CORE=BASE+1000>\r
+IFNDEF CORE,<CORE=200000>      ;ASSUME 64K\r
+\r
+ZZ=CORE-2000+140               ;SET ABOVE JOB DATA AREA OF TOP K\r
+\r
+CLRTOP=ZZ-1                    ;WHEN CLEARING CORE, CLEAR TO HERE\r
+\r
+DEFINE U(Z)<\r
+       UU(Z,1)>                ;ONE WORD ALLOCATION\r
+DEFINE UU(Z,N)<        Z=ZZ\r
+ZZ=ZZ+N\r
+IFGE <ZZ-CORE+1000>,<\r
+PRINTX ALLOCATION ERROR\r
+>>\r
+\r
+OPDEF PJRST [JRST]\r
+IFE REL,<LOC CORE-1000         ;ABSOLUTE ASSEMBLY\r
+RIM10B>                                ;PAPER TAPE FORMAT\r
+\r
+U(DEVICE)                      ;DEVICE NAME FROM COMMAND\r
+U(FNAME)                       ;FILE NAME FROM COMMAND\r
+U(FEXT)                                ;FILE EXTENSION FROM COMMAND\r
+U(SWITCH)                      ;SWITCHES FROM COMMAND\r
+U(TAPEID)                      ;TAPE NAME FOR Z COMMAND\r
+U(PRVLBN)                      ;LBN SOUGHT ON PREVIOUS SEARCH\r
+U(FBN)                         ;FIRST BLOCK NUMBER, FOR LINK\r
+\r
+UU(HBUF,200)                   ;DIRECTORY OF DTA\r
+UU(DBUF,200)                   ;DATA BUFFER\r
+FIRSTW==20                     ;FIRST LOCATION CONSIDERED ON WRITE\r
+PDLL==20                       ;STACK LENGTH\r
+\r
+\f;I/O DEVICE PARAMETERS\r
+\r
+DTC==320                       ;DEVICE CODE FOR DTA CONTROL\r
+DTS==324                       ;DEVICE CODE FOR DTA STATUS\r
+O.NOP==0                       ;OPCODES FOR THE DTA CONTROL CONO\r
+O.SRCH==200                    ;SEARCH\r
+O.READ==300                    ;READ\r
+O.WRIT==700                    ;WRITE\r
+C.STOP==400000                 ;CONO BITS\r
+C.FWD==200000                  ;GO FORWARD\r
+C.REV==100000                  ;GO REVERSE\r
+C.NDEL==040000                 ;NO DELAY AFTER CONO\r
+C.SEL==020000                  ;SELECT A UNIT\r
+C.DSEL==010000                 ;DESELECT CURRENT UNIT\r
+S.DAT==1                       ;DATA DONE FLAG\r
+S.INT==2                       ;INT REQ FLAG\r
+S.END==020000                  ;END ZONE HIT\r
+S.JOBD==100000                 ;JOB DONE FLAG\r
+S.ERR==653300                  ;ERRORS TO GIVE UP ON.\r
+;FLAGS, LEFT HALF OF F\r
+\r
+L.DOT=1                                ;DOT SEEN IN FILE SPEC\r
+L.UPA==2                       ;UPARROW (TAPE ID)\r
+L.SLA==10                      ;SLASH SEEN IN FILE SPEC\r
+L.ALL==13                      ;ABOVE FLAGS TOGETHER.\r
+L.UPA2==20                     ;UPARROW AGAIN FOR READING AT ZERO ROUTINE\r
+L.REV==400000                  ;TAPE MOVING IN REVERSE. SIGN BIT REQ?\r
+L.REVA==40                     ;ALLOCATION PASS IS GOING IN REVERSE\r
+L.TURN==100                    ;ALLOCATION PASS HAD TO TURN AROUND\r
+\r
+;FLAGS, RIGHT HALF OF F\r
+\r
+R.MRG==1                       ;MERGE, NOT LOAD.\r
+R.WEOF==2                      ;ON WHILE WRITING JRST WORD(S) IN LAST BLK\r
+R.DIRI==4                      ;DIRECTORY IN CORE IS VALID\r
+R.STRT==10                     ;ON IF LOAD AND GO. OFF IF JUST LOAD\r
+\r
+;SYSTEM PARAMETERS WHICH MUST AGREE WITH TIMESHARING SYSTEM\r
+\r
+DIRBLK==144                    ;WHERE DIRECTORY IS ON TAPE\r
+D.BYT==0                       ;WORD OF BYTES IN DIRECTORY\r
+D.NAM==123                     ;FIRST NAME IN DIRECTORY\r
+D.EXT==151                     ;START OF EXTENSIONS IN DIR\r
+NFILES==26                     ;HOW MANY FILES FIT IN DIR\r
+MAXBLK==1101                   ;LAST BLOCK ON THE TAPE\r
+BLKFAC==2                      ;BLOCKING FACTOR - WRITE ONE OF N BLKS\r
+\f;START HERE\r
+\r
+GO:    MOVEI F,0               ;CLEAR ALL FLAGS\r
+       CONO 200000             ;I/O BUS RESET\r
+       CONO 4,10400            ;CLEAR PI SYSTEM\r
+       SETZM DEVICE            ;CLEAR REQUESTED DEVICE NAME\r
+REGO:  MOVE P,PDP              ;INITIAL STACK POINTER\r
+       ANDI F,R.DIRI   ;CLEAR OUT RANDOM FLAGS\r
+       SETZM FNAME             ;CLEAR REQUESTED FILE NAME\r
+       SETZM FEXT              ;CLEAR REQUESTED FILE EXTENSION\r
+       SETZM SWITCH            ;CLEAR COMMAND SWITCHES\r
+       PUSHJ P,CRLF            ;SAY HELLO\r
+GOL:   MOVE BP,SIXPTR          ;POINTER TO THE WORD.\r
+       SETZB N,W               ;CLEAR ANSWERS.\r
+SIXBRL:        CONSO TTY,40            ;WAIT FOR A KEY TO BE ST(R)UCK\r
+       JRST .-1                ; ..\r
+       DATAI TTY,C             ;GET THE CHAR\r
+       PUSHJ P,TYO             ;ECHO IT\r
+       ANDI C,177              ;ONLY 7 BITS\r
+       CAIN C,177              ;RUBOUT?\r
+       JRST REGO               ;YES. QUIT.\r
+       CAIG C,172              ;CHECK FOR LOWER CASE\r
+       CAIGE C,140             ; ..\r
+       SKIPA                   ;NOT L.C.\r
+       TRZ C,40                ;L.C., MAKE U.C.\r
+       CAIG C,"Z"              ;LETTER?\r
+       CAIGE C,"A"             ; ..\r
+       SKIPA                   ;NOT A LETTER.\r
+       JRST SIXLTR             ;LETTER.\r
+       CAIG C,"9"              ;NUMBER?\r
+       CAIGE C,"0"             ; ..\r
+       JRST GO0                ;NO. RETURN WITH BREAK CHAR.\r
+       LSH N,3                 ;BUILD OCTAL NUMBER\r
+       ADDI N,-60(C)           ;ADD IN THIS DIGIT\r
+SIXLTR:        TRC C,40                ;MAKE SIXBIT\r
+       TLNE BP,770000          ;ONLY 6 CHARS\r
+       IDPB C,BP               ;STORE CHAR IN W\r
+       JRST SIXBRL             ;LOOP FOR MORE.\r
+\fGO0:  CAIE C,":"              ;UNIT DELIMITER?\r
+       JRST GO1                ;NO.\r
+       TRZ F,R.DIRI            ;DIRECTORY NO GOOD, SELECTING A TAPE\r
+       ANDI N,7                ;JUST THREE BITS OF UNIT NUMBER\r
+       MOVEM N,DEVICE          ;YES. SAVE NUMBER OF DEVICE\r
+       JRST GOL                ;GO READ MORE.\r
+GO1:   TLNN F,L.ALL            ;ANY SYNTAX REQUESTS?\r
+       JRST GO6                ;NO. SEE IF FILE NAME.\r
+       TLZE F,L.DOT            ;WAS THERE A DOT?\r
+       HLLOM W,FEXT            ;YES. STORE EXT. RH IS FLAG IF BLANK.\r
+       TLZE F,L.UPA            ;UPARROW?\r
+       MOVEM W,TAPEID          ;YES. SAVE TAPE NAME.\r
+       TLZE F,L.SLA            ;SLASH SWITCH?\r
+       MOVEM W,SWITCH          ;YES. SAVE SWITCH WORD\r
+GO7:   CAIGE C,175             ;ALTMODE?\r
+       CAIG C,40               ;SPACE OR CONTROL CHAR?\r
+       JRST DO                 ;YES. GO PROCESS COMMAND\r
+       CAIE C,"."              ;FILE EXTENSION REQUEST?\r
+       JRST GO3                ;NO.\r
+       TLO F,L.DOT             ;YES. REMEMBER THAT\r
+       JRST GOL                ;AND READ ON.\r
+\r
+GO3:   CAIE C,"/"              ;SLASH?\r
+       JRST GO5                ;NO.\r
+       TLO F,L.SLA             ;YES. MARK SWITCH COMING\r
+       JRST GOL                ;RETURN TO SCAN\r
+GO5:   CAIN C,"^"              ;UPARROW?\r
+       TLO F,L.UPA+L.UPA2      ;YES. NOTE IT.\r
+       JRST GOL                ;LOOP FOR MORE.\r
+GO6:   SKIPE W                 ;NO PUNCTUATION. NAME TYPED?\r
+       MOVEM W,FNAME           ;YES. STORE NAME\r
+       JRST GO7                ;GO CHECK PUNCTUATION\r
+\f;HERE WHEN COMMAND STRING SUCCESSFULLY READ. DO THE JOB.\r
+\r
+DO:    PUSHJ P,CRLF            ;SIGNAL STARTING I/O\r
+       LDB A,SWPTR             ;GET FIRST CHAR OF SWITCHES\r
+       CAIN A,"Z"-40           ;ZERO COMMAND?\r
+       JRST ZERO               ;YES.\r
+       CAIN A,"G"-40           ;GO COMMAND?\r
+PROGSA:        JRST GO                 ;YES. *** RH MODIFIED ***\r
+       CAIL A,"0"-40           ;NUMERIC?\r
+       CAILE A,"7"-40          ; OCTAL, THAT IS,\r
+       SKIPA                   ;NO.\r
+       JRST SETSA              ;YES. GO SET STARTING ADDRESS\r
+       PUSHJ P,RDDIR           ;REST OF COMMANDS NEED DIRECTORY\r
+       LDB A,SWPTR             ;GET FIRST CHAR OF SWITCHES\r
+       CAIN A,"M"-40           ;MERGE?\r
+       TROA F,R.MRG            ;YES. SKIP INTO LOAD, FLAGGING MERGE ONLY\r
+       CAIN A,"L"-40           ;LOAD COMMAND?\r
+       JRST LOAD               ;YES.\r
+       CAIN A,"D"-40           ;DUMP COMMAND?\r
+       JRST DUMP\r
+       CAIN A,"F"-40           ;FILE DIRECTORY?\r
+       JRST FILDIR             ;YES.\r
+       CAIN A,"K"-40           ;KILL A FILE (DELETE)?\r
+       JRST KILL               ;YES.\r
+       JUMPE A,RUN             ;IF NO SWITCH, ASSUME LOAD AND RUN\r
+       PUSHJ P,ERROR           ;NO OTHERS IMPLEMENTED\r
+\r
+SETSA: HRRM N,PROGSA           ;STORE PROGRAM STARTING ADDR\r
+       JRST REGO               ;AND WAIT FOR ANOTHER COMMAND\r
+\r
+FILDIR:        MOVSI N,-NFILES         ;LIST A QUICK DIRECTORY\r
+FILDL: SKIPN B,HBUF+D.NAM(N)   ;GET A NAME, IF ANY IN THIS SLOT\r
+       JRST FILDN              ;NONE HERE\r
+       PUSHJ P,SIXOUT          ;TYPE C(B) IN SIXBIT\r
+       HLLZ B,HBUF+D.EXT(N)    ;GET EXTENSION\r
+       JUMPE B,FILD1           ;IF NOT BLANK,\r
+       MOVEI C,"."             ;DOT\r
+       PUSHJ P,TYO             ;TYPE DOT\r
+       PUSHJ P,SIXOUT          ;TYPE EXT\r
+FILD1: PUSHJ P,CRLF            ;A CARRIAGE RETURN\r
+FILDN: AOBJN N,FILDL           ;LOOP FOR ALL NAMES\r
+       JRST REGO1              ;STOP TAPE AND GO FOR NEXT COMMAND\r
+\f;LOAD AND RUN COMMANDS\r
+\r
+RUN:   TRO F,R.STRT            ;LOAD AND START PROGRAM\r
+LOAD:  MOVSI FN,-NFILES        ;SEARCH TO SEE IF ONLY ONE SAV FILE ON DT\r
+       MOVEI A,0               ;WHERE NAME WILL GO IF FOUND\r
+RUN5:  HLRZ EXT,HBUF+D.EXT(FN) ;CHECK AN EXTENSION\r
+       CAIN EXT,(SIXBIT /SAV/) ;IS IT A SAV FILE?\r
+       JRST RUN2               ;YES. GO NOTE IT\r
+RUN4:  AOBJN FN,RUN5           ;LOOP THRU COUNTING ALL FILES\r
+       SKIPN A                 ;WAS ONE AND ONLY ONE FOUND?\r
+RUN3:  MOVE A,SYSTEM           ;DEFAULT READ-FILE NAME\r
+       SKIPN FNAME             ;NAME SUPPLIED?\r
+       MOVEM A,FNAME           ;NO. PLUG IN DEFAULT.\r
+       PUSHJ P,LOOK            ;TRY TO FIND FILE\r
+         PUSHJ P,ERROR         ;NOT THERE. FAIL.\r
+       MOVEI LBN,1             ;HAVE TO FIND A BLOCK OF FILE\r
+       MOVE BP,BYTPTR          ;LOOK THRU DIRECTORY\r
+RUNL:  ILDB N,BP               ;GET A BYTE\r
+       CAIN N,0(FN)            ;BELONG TO THIS FILE?\r
+       JRST RUN1               ;YES.\r
+       CAIL LBN,MAXBLK         ;LOOKED TOO FAR?\r
+        PUSHJ P,ERROR          ;YES. NO BLKS IN FILE!\r
+       AOJA LBN,RUNL           ;LOOK FURTHER\r
+RUN1:  PUSHJ P,RDDAT1          ;READ THE DATA BLOCK TO FIND FBN\r
+       LDB A,[POINT 10,DBUF+0,27]      ;FIRST BLOCK OF FILE\r
+       HRLM A,DBUF+0           ;PUT IT IN LINK SLOT TO BE READ NEXT\r
+RFILE: SETZB Q,40              ;CLEAR CORE BEFORE READING FILE\r
+                               ;AND INITIALLY NO WORDS IN DATA BUFFER\r
+       MOVE A,BLTXWD           ; ..\r
+       TRNN F,R.MRG            ;UNLESS MERGE ONLY,\r
+       BLT A,CLRTOP            ;CLEAR UP TO BASE OF THIS PROGRAM\r
+RFILL1:        PUSHJ P,RWORD           ;READ A POINTER OR JRST WORD\r
+       SKIPL M,W               ;WHICH IS IT?\r
+       JRST STARTQ             ;TRANSFER WORD\r
+RFILL2:        PUSHJ P,RWORD           ;READ A WORD OF DATA\r
+       MOVEM W,1(M)            ;STORE IT IN CORE\r
+       AOBJN M,RFILL2          ;COUNT THE CORE POINTER.\r
+       JRST RFILL1             ;IT RAN OUT. GET ANOTHER.\r
+\r
+RUN2:  JUMPN A,RUN3            ;IF ALREADY ONE, THIS IS 2. QUIT.\r
+       MOVE A,HBUF+D.NAM(FN)   ;FIRST SAV FILE. GET ITS NAME.\r
+       JRST RUN4               ;AND SEE IF ANY MORE.\r
+\fSTARTQ:       HRRM W,PROGSA           ;SAVE THE STARTING ADDRESS\r
+REGO1: CONO DTC,C.STOP         ;STOP THE TAPE\r
+       TRNE F,R.STRT           ;LOAD OR START?\r
+       JRST 0(W)               ;START\r
+       JRST REGO               ;JUST LOAD. GO GET ANOTHER COMMAND\r
+\r
+;SUBROUTINE TO READ A DATA WORD FROM THE FILE.\r
+\r
+RWORD1:        MOVE Q,DBUFP            ;PREPARE TO COUNT DATA WORDS\r
+RWORD: JUMPGE Q,RWNXTB         ;NEED ANOTHER BLOCK?\r
+       MOVE W,0(Q)             ;NO. GET A WORD.\r
+       AOBJN Q,.+1             ;COUNT IT.\r
+       POPJ P,0                ;RETURN FROM RWORD\r
+RWNXTB:        PUSHJ P,RDDATA          ;NO. READ NEXT DATA BLOCK, IF ANY\r
+       JRST RWORD1             ;READ FROM THIS BLOCK\r
+\r
+DUMP:  MOVE A,CRASH            ;DEFAULT FILE NAME\r
+       SKIPN FNAME             ;NAME ALREADY SET?\r
+       MOVEM A,FNAME           ;NO. USE DEFAULT\r
+       PUSHJ P,ENTR            ;TRY TO FIND THE FILE.\r
+        PUSHJ P,ERROR          ;NO FREE SLOTS (OR MAYBE NO BLKS LEFT)\r
+       MOVEM LBN,FBN           ;SAVE AS FIRST BLOCK NUMBER\r
+       MOVEI Q,0               ;INITIALIZE DATA BLOCK COUNTER\r
+       MOVEI M,FIRSTW-1        ;AND CORE ADDRESS COUNTER\r
+DUMPL2:        HRRZS X,M               ;START OF A BLOCK\r
+DUMPL1:        SKIPN 1(X)              ;THIS WORD ZERO IN CORE?\r
+       JRST DUMP1              ;YES. SEE IF END OF A BLOCK.\r
+       CAIGE X,CLRTOP          ;LOOKED AT ALL OF CORE?\r
+       AOJA X,DUMPL1           ;NO. COUNT PART OF THIS BLOCK, LOOK ON.\r
+DUMP1: MOVEI W,0(M)            ;END OF BLOCK. IS BLOCK EMPTY?\r
+       SUBI W,0(X)             ;START MINUS END OF BLK\r
+       JUMPE W,DUMP2           ;JUMP IF BLOCK EMPTY\r
+       HRL M,W                 ;MAKE -COUNT,,START-1 FOR COUNTER\r
+       MOVE W,M                ;AND FOR DATA IN FILE\r
+       PUSHJ P,WWORD           ;WRITE IT OUT AS DATA\r
+DUMPL3:        MOVE W,1(M)             ;GET THE WORD FROM CORE\r
+       PUSHJ P,WWORD           ;OUTPUT TO FILE\r
+       AOBJN M,DUMPL3          ;OUTPUT ALL OF BLOCK\r
+DUMP2: CAIGE X,CLRTOP          ;CONSIDERED ALL OF CORE?\r
+       AOJA M,DUMPL2           ;NO. MOVE ON.\r
+       TRO F,R.WEOF            ;FLAG WRITING LAST BLK, SO NO ALLOC\r
+       MOVE W,PROGSA           ;YES. APPEND STARTING ADDRESS\r
+       PUSHJ P,WWORD           ;WRITE OUT THIS WORD\r
+       JUMPL Q,.-1             ;IF MORE TO GO IN BLOCK, WRITE AGAIN\r
+       JRST CLS                ;WRITE OUT THE DIRECTORY\r
+                               ;AND RESTART PROGRAM FOR NEXT COMMAND\r
+\f;SUBROUTINE TO WRITE A WORD INTO THE FILE\r
+\r
+WWORD: SKIPL Q                 ;NEED A NEW POINTER?\r
+       MOVE Q,DBUFP            ;YES.\r
+       MOVEM W,0(Q)            ;PUT WORD INTO BUFFER\r
+       AOBJN Q,CPOPJ           ;COUNT POINTER. DONE?\r
+       MOVE A,FBN              ;GET FIRST BLOCK NUMBER\r
+       LSH A,10                ;PUT IN RIGHT PLACE\r
+       TRO A,177               ;DECLARE 127 WORDS IN BLOCK USED\r
+       HRRZM A,DBUF+0          ;PUT IN LINK WORD\r
+       TRNE F,R.WEOF           ;WRITING LAST BLK?\r
+       JRST WWORD1             ;YES. DONT ALLOCATE ANOTHER\r
+       PUSH P,LBN              ;SAVE BLOCK ABOUT TO WRITE\r
+       PUSHJ P,ALLOC           ;GET NEXT BLOCK OF FILE\r
+        PUSHJ P,ERROR          ;NONE AVAILABLE\r
+       HRLM LBN,DBUF+0         ;PUT IN LINK WORD\r
+       POP P,LBN               ;RESTORE BLOCK FOR WRITING NOW\r
+WWORD1:        PUSHJ P,WRDATA          ;OUTPUT BLOCK, IF POSSIBLE\r
+       HLRZ LBN,DBUF+0         ;GET LINK TO NEXT BLOCK IN LBN\r
+       POPJ P,0                ;OK. RETURN.\r
+\r
+;SUBROUTINE TO LOOK FOR FILE\r
+\r
+LOOK:  MOVE NAME,FNAME         ;GET DESIRED FILENAME\r
+       MOVSI EXT,(SIXBIT /SAV/)        ;DEFAULT EXTENSION\r
+       SKIPE FEXT              ;ANY SUPPLIED?\r
+       HLLZ EXT,FEXT           ;YES. USE IT.\r
+SRCHFD:        MOVSI FN,-NFILES        ;MAKE AOBJN COUNTER\r
+SCHL2: MOVE B,HBUF+D.NAM(FN)   ;GET A FILE NAME\r
+       CAME B,NAME             ;IS NAME RIGHT?\r
+       JRST SCHN2              ;NO. MOVE ON.\r
+       HLLZ B,HBUF+D.EXT(FN)   ;CHECK THE EXTENSION\r
+       CAMN B,EXT              ;IS IT RIGHT TOO?\r
+       AOJA FN,CPOPJ1          ;YES. GOOD RETURN, ANSWER IS FILE NUMBER IN FN\r
+SCHN2: AOBJN FN,SCHL2          ;COUNT FILE, EXT. CHECK NEXT FILE IN FD\r
+       POPJ P,0                ;FAIL RETURN, NOT FOUND.\r
+\f;SUBROUTINE TO READ NEXT BLOCK OF DATA INTO DBUF\r
+\r
+RDDATA:        HLRZ LBN,DBUF+0         ;LINK\r
+       JUMPE LBN,ERROR         ;JUMP IF END OF FILE\r
+RDDAT1:        MOVEI A,DBUF            ;SELECT DATA BUFFER\r
+RDBLK: PUSHJ P,PROCBK          ;PROCESS A BLOCK\r
+        CONO DTC,O.READ        ;ARGS TO PROCBK\r
+        DATAI DTC,0(A)         ; TO CAUSE IT TO READ THE BLOCK\r
+       POPJ P,0                ;SUCCESS. RETURN\r
+\r
+RDDIR: TRNE F,R.DIRI           ;IS THE DIRECTORY IN CORE OK?\r
+       POPJ P,0                ;YES. DONT READ IT AGAIN\r
+       MOVEI A,HBUF            ;MUST READ. WHERE TO PUT IT.\r
+       MOVEI LBN,DIRBLK        ;BLOCK ON TAPE TO READ\r
+       PUSHJ P,RDBLK           ;READ IT\r
+       CONO DTC,C.STOP         ;STOP TAPE IN CASE OF /F COMMAND\r
+       TRO F,R.DIRI            ;HAVE A GOOD DIRECTORY IN CORE NOW\r
+       POPJ P,0                ;RETURN FROM RDDIR\r
+\r
+ZERO:  MOVE A,TAPEID           ;COPY TAPE NAME IF ANY\r
+       MOVEM A,HBUF+177        ; ..\r
+       TLZN F,L.UPA2           ;WAS ONE THERE?\r
+       PUSHJ P,RDDIR           ;NO. GET THE ONE ON TAPE\r
+       SETZM HBUF              ;CLEAR OUT REST OF DIR\r
+       MOVE A,[XWD HBUF,HBUF+1] ; ..\r
+       BLT A,HBUF+176          ; ..\r
+       MOVSI A,(<36B4+36B9>)   ;ALLOCATE BLOCKS 1 AND 2\r
+       MOVEM A,HBUF+D.BYT+0    ; ..\r
+       MOVSI A,(36B9)          ;AND BLOCK 144\r
+       MOVEM A,HBUF+D.BYT+16   ; ..\r
+       HRLOI A,7               ;AND THE NONEXISTENT ONES\r
+       MOVEM A,HBUF+D.BYT+122  ; ..\r
+CLS:   PUSHJ P,WRDIR           ;WRITE OUT THE DIRECTORY\r
+       JRST REGO1              ;STOP TAPE AND RETURN TO COMMAND SCANNER\r
+\r
+WRDIR: MOVEI LBN,DIRBLK        ;BLOCK TO WRITE\r
+       MOVEI A,HBUF            ;DATA TO WRITE\r
+       PJRST WRBLK             ;WRITE IT\r
+\r
+WRDATA:        MOVEI A,DBUF            ;WRITE FROM DATA BUFFER\r
+WRBLK: PUSHJ P,PROCBK          ;PROCESS THE BLOCK\r
+        CONO DTC,O.WRIT        ;ARGS TO PROCBK TO CAUSE IT\r
+        DATAO DTC,0(A)         ;TO WRITE THE BLOCK ONTO TAPE\r
+       POPJ P,0                ;RETURN FROM WRBLK\r
+\fPROCBK:       PUSHJ P,SEARCH          ;ROUTINE TO READ OR WRITE A BLOCK OF TAPE\r
+                               ; FIRST FIND THE BLOCK (EITHER DIRECTION)\r
+       MOVEI N,200             ;NUMBER OF WORDS IN A BLOCK\r
+       TLNE F,L.REV            ;WHICH WAY WE GOING?\r
+       ADDI A,177              ;BACKWARDS. WRITE FROM TOP OF CORE DOWN\r
+       XCT @0(P)               ;CONO WRITE OR READ\r
+       AOS 0(P)                ;COUNT ON TO DATAI OR DATAO\r
+PROCLP:        CONSZ DTS,S.ERR!S.END   ;TROUBLE?\r
+       PUSHJ P,ERROR           ;YES. QUIT\r
+       CONSO DTS,S.DAT         ;WANT DATA MOVED YET?\r
+       JRST PROCLP             ;NO. WAIT SOME MORE.\r
+       XCT @0(P)               ;YES. DATAI OR DATAO TO/FROM BUFFER\r
+       ADDI A,1                ;COUNT BUFFER POINTER\r
+       TLNE F,L.REV            ;GOING BACKWARDS?\r
+       SUBI A,2                ;YES. THEN COUNT POINTER BACKWARDS TOO\r
+       SOJG N,PROCLP           ;TRANSFERRED WHOLE BLOCK?\r
+       CONO DTS,1              ;YES. TELL IT TO DO CHECKSUMMING AND QUIT\r
+       CONSO DTS,S.JOBD        ;DONE?\r
+       JRST .-1                ;NOT YET. WAIT.\r
+       JRST CPOPJ1             ;YES. RETURN AFTER THE DATAI/O ARGUMENT\r
+\r
+SEARCH:        MOVE C,DEVICE           ;GET DRIVE NUMBER\r
+       LSH C,11                ;PUT IN UNIT DIGIT FOR CONO\r
+       CONSZ DTC,C.FWD!C.REV   ;TAPE GOING AT THE MOMENT?\r
+       JRST SRCHC              ;YES.\r
+       TRO C,C.FWD!C.DSEL      ;NO. MAKE IT GO FORWARD\r
+       TLZ F,L.REV             ;AND GET THE FLAG TO SAY THAT\r
+SRCHC: CONO DTC,O.SRCH!C.SEL(C) ;MAKE IT SEARCH\r
+SRCHW: CONSZ DTS,S.END         ;AT END ZONE?\r
+       JRST SRCHTA             ;YES. TURN AROUND.\r
+       CONSZ DTS,S.ERR         ;ANY ERRORS?\r
+        PUSHJ P,ERROR          ;YES. QUIT.\r
+       CONSO DTS,S.DAT         ;BLOCK NUMBER FOUND?\r
+       JRST SRCHW              ;NO. WAIT FOR IT\r
+       DATAI DTC,N             ;YES. SEE WHAT BLOCK WE ARE AT\r
+       ANDI N,7777             ;JUST FOR SAFETY, MASK JUNK OUT\r
+       SUBI N,0(LBN)           ;GET THE DISTANCE TO GO\r
+       JUMPE N,CPOPJ           ;IF FOUND, RETURN WITH TAPE ROLLING INTO DESIRED BLK\r
+       TLNE F,L.REV            ;NOT THERE. WHICH WAY WE GOING?\r
+       MOVNS N                 ;BACKWARDS. NEGATE.\r
+       JUMPL N,SEARCH          ;IF SHOULD KEEP GOING, ITS MINUS.\r
+SRCHTA:        CONO DTC,C.FWD!C.REV    ;MUST TURN AROUND (END ZONE OR PASSED)\r
+       TLC F,L.REV             ;COMPLEMENT DIRECTION FLAG\r
+       JRST SEARCH             ;SEARCH SOME MORE\r
+\fDELETE:       PUSHJ P,LOOK            ;SEE IF FILE EXISTS ALREADY\r
+        POPJ P,0               ;NO. FAIL RETURN\r
+       SETZB B,HBUF+D.NAM-1(FN)        ;FOUND IT. CLEAR NAME\r
+       SETZM HBUF+D.EXT-1(FN)  ;AND EXT IN DIRECTORY\r
+       MOVE BP,BYTPTR          ;INITIAL BYTE POINTER TO DIRECTORY BYTES\r
+       MOVEI N,MAXBLK          ;SEARCH ALL BYTES FOR THIS FILE\r
+       ILDB A,BP               ;GET A DIRECTORY BYTE\r
+       CAIN A,0(FN)            ;BELONG TO THIS FILE?\r
+       DPB B,BP                ;YES. CLEAR IT OUT, ITS FREE NOW\r
+       SOJG N,.-3              ;LOOP FOR WHOLE DIRECTORY\r
+CPOPJ1:        AOS 0(P)                ;SUCCESSFUL RETURN\r
+CPOPJ: POPJ P,0                ;RETURN.\r
+\r
+KILL:  PUSHJ P,DELETE          ;REMOVE FILE FROM DIRECTORY\r
+        PUSHJ P,ERROR          ;NOT THERE, GIVE A BELL\r
+       JRST CLS                ;WRITE DIRECTORY AND RETURN TO CMD SCAN\r
+\r
+ENTR:  PUSHJ P,DELETE          ;FIRST REMOVE OLD FILE BY THIS NAME\r
+        JFCL                   ;MAY NOT HAVE BEEN ONE, THATS OK\r
+       MOVSI FN,-NFILES        ;SEARCH FOR A FREE SLOT\r
+       SKIPN HBUF+D.NAM(FN)    ;SLOT FREE?\r
+       AOJA FN,ENTR1           ;YES. CONVERT RH TO FILE NUMBER, GO USE.\r
+       AOBJN FN,.-2            ;LOOK FOR ANOTHER\r
+       POPJ P,0                ;NONE FREE. WE LOSE.\r
+\fENTR1:        MOVEM NAME,HBUF+D.NAM-1(FN)     ;STORE THE FILE NAME IN FREE SLOT\r
+       HLLZM EXT,HBUF+D.EXT-1(FN)      ;AND THE EXTENSION\r
+ALLOCI:        SETZM PRVLBN            ;INITIALIZE POINTERS FOR ALLOCATOR\r
+       MOVE BP,BYTPTR          ;START HAVING CHECKED BLK 0.\r
+       TLZ F,L.REVA            ;NOT REVERSE ALLOCATING\r
+ALLOC: TLZ F,L.TURN            ;ALLOCATOR HASNT TURNED AROUND\r
+       MOVE LBN,PRVLBN         ;RESTORE PREVIOUS LBN\r
+ALLOCP:        TLNE F,L.REVA           ;WHICH WAY WE LOOKING?\r
+       JRST ALCN2              ;NEXT BACK\r
+       JRST ALCN1              ;NEXT FORWARD\r
+\fALCL1:        ILDB N,BP               ;GET A BLOCK BYTE\r
+       JUMPE N,ALLOC1          ;IF ITS FREE, MAY USE IT\r
+ALCN1: CAIGE LBN,MAXBLK        ;LOOKED ALL THRU FORWARD?\r
+       AOJA LBN,ALCL1          ;NO. TRY ANOTHER\r
+ALLOCT:        TLOE F,L.TURN           ;TURN SEARCH AROUND. BETTER NOT BE SECOND TURN\r
+        POPJ P,0               ;LOOKED THRU AND DIDNT FIND ANYTHING. QUIT.\r
+       TLC F,L.REVA            ;LOOK THE OTHER WAY\r
+       JRST ALLOCP             ;GO SEE WHICH WAY NOW\r
+\r
+ALCL2: ADD BP,[XWD 050000,0]   ;MOVE LEFT A BYTE\r
+       SKIPGE BP               ;OFF THE END OF THE WORD?\r
+       SUB BP,[XWD 430000,1]   ;YES. BACK A WORD, RIGHT 35 BITS\r
+       LDB N,BP                ;GET THIS BYTE\r
+       JUMPE N,ALLOC1          ;IF ITS FREE MAY USE IT.\r
+ALCN2: CAILE LBN,1             ;GONE ALL THE WAY TO THE FRONT?\r
+       SOJA LBN,ALCL2          ;NO, LOOK FURTHER\r
+       JRST ALLOCT             ;YES. MUST TURN ALLOCATOR AROUND\r
+\r
+ALLOC1:        MOVE N,PRVLBN           ;HAVE A FREE ONE. WANT IT?\r
+       SUBI N,0(LBN)           ;FIND DISTANCE FROM LAST ONE\r
+       MOVMS N                 ;WHICHEVER DIRECTION\r
+       CAIGE N,BLKFAC          ;IS IT FAR ENOUGH AWAY?\r
+       TLNE F,L.TURN           ;OR ARE WE TURNING ALLOCATOR AROUND?\r
+       JRST ALLOCY             ;YES. USE THIS ONE.\r
+       JRST ALLOCP             ;NO. PROCEED TO ANOTHER BLOCK\r
+\r
+ALLOCY:        DPB FN,BP               ;PUT THIS FILE NUMBER IN THE BLOCK'S BYTE\r
+       MOVEM LBN,PRVLBN        ;SAVE AS PREVIOUS BLOCK ALLOCATED\r
+       JRST CPOPJ1             ;AND RETURN WITH LBN SET UP\r
+\f;TTY I/O SUBRS\r
+\r
+ERROR: MOVEI C,207             ;MAKE A BELL, EVEN PARITY\r
+       PUSHJ P,TYO             ;TYPE IT OUT\r
+       JRST GO                 ;AND RESTART.\r
+\r
+CRLF:  MOVEI C,215             ;CR, EVEN\r
+       PUSHJ P,TYO             ;TYPE IT.\r
+       MOVEI C,12              ;LF, EVEN\r
+TYO:   DATAO TTY,C             ;SEND OUT CHAR\r
+       CONSZ TTY,20            ;WAIT FOR IDLE\r
+       JRST .-1                ; ..\r
+       POPJ P,0                ;DONE.\r
+\r
+SIXOUT:        MOVEI C,0               ;SO DONT SHIFT IN JUNK\r
+       ROTC B,6                ;GET A SIXBIT CHAR IN C\r
+       ADDI C,40               ;MAKE IT ASCII\r
+       PUSHJ P,TYO             ;TYPE IT\r
+       JUMPN B,SIXOUT          ;IF ANY MORE, TYPE THEM\r
+       POPJ P,0                ;AND RETURN\r
+\f;CONSTANTS AND TEMPS.\r
+\r
+SYSTEM:        SIXBIT /SYSTEM/         ;DEFAULT FILENAME\r
+CRASH: SIXBIT /CRASH/          ;DEFAULT DUMP NAME\r
+DBUFP: XWD -177,DBUF+1         ;POINTER TO DATA BLOCK\r
+BLTXWD:        XWD 40,41               ;FOR CORE-CLEARING\r
+SIXPTR:        XWD 440600,W            ;POINTER FOR SIXBIT NAME\r
+BYTPTR:        POINT 5,HBUF+D.BYT      ;POINTER TO BYTES IN DIRECTORY\r
+SWPTR: POINT 6,SWITCH,5        ;POINTER TO FIRST SWITCH CHARACTER\r
+\r
+LIT\r
+\r
+UU(PDL,PDLL)                   ;STACK\r
+PDP:   XWD -PDLL,PDL-1         ;STACK POINTER\r
+\r
+UU(ZZMAX,0)\r
+\r
+SLOP==576-<.-GO>               ;MUST BE POSITIVE IF WANT\r
+                               ;THIS TO FIT IN BLKS 0,1,2 OF DTA\r
+                               ;THREE BLOCKS INCLUDING HRI BLKI WD AND JRST WD\r
+       END GO\r
+\f
\ No newline at end of file