--- /dev/null
+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