.TITLE FILEX V02-02 ; RT-11 FILEX ; ; DEC-11-ORFLA-E ; ; ABC ; BC 24-SEP-75 ; ; COPYRIGHT (C) 1974,1975 ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; .SBTTL SOME PREFATORY REMARKS ; FILEX IS A MODULAR CROSS-SYSTEM FILE TRANSFER PROGRAM. ; EACH FUNCTION TO BE PERFORMED IS DONE AT A CENTRALIZED POINT, ; AND SPECIFIC FILE-STRUCTURED ROUTINES ARE CALLED WHENEVER AN ; INTERFACE IS NEEDED TO A PARTICULAR FILE STRUCTURE. ; A FILE-STRUCTURE ROUTINE IS IDENTIFIED BY THE SWITCH LETTER WHICH ; INVOKES IT. ALL SYMBOLS WHICH IT NEEDS FOR ITS EXCLUSIVE USE ; ARE PRECEDED BY THAT LETTER AND A DOT. ; RT-11 CHANNEL IS DEDICATED TO THE FOREIGN FILE STRUCTURE. ; EACH STRUCTURE REQUIRES TEN ROUTINES TO INTERFACE WITH THE SYSTEM- ; INDEPENDENT DRIVER. THESE ARE DESCRIBED IN THE FOLLOWING PARAGRAPHS: ;********************************************************************** ; EXPAND - EXPAND INPUT LIST ; CALLED WITH: ; R1 -> THE STRING WHICH WAS IN [] ON THE INPUT SIDE OF THE ; COMMAND ; R2 -> FILNAM.EXT IN ASCII, TERMINATED BY A 0 BYTE OR A / ; R3 -> DEV:FILNAM.EXT IN RAD50 FOR INPUT SIDE ; R4 = WILD CARD FLAG: BOTTOM BYTE NEGATIVE IF * NAME ; TOP BYTE NEGATIVE IF * EXTENSION ; R5 -> FREE CORE, INITIALLY CONTAINS DSTATUS FOR DEV: ; FUNCTION: ; SCAN OFF DATA IN [], IF RELEVANT ; VERIFY DEVICE TYPE ; FETCH HANDLER @R5 ; EXPAND INPUT FILENAME OR WILD-CARD CONSTRUCTION INTO A LIST ; OF BLOCKS IN THE FREE AREA (AFTER THE HANDLER). ; EACH BLOCK IS 8 WORDS LONG, AND MUST CONTAIN THE ; FILENAME.EXT IN RAD50 IN THE FIRST 3 WORDS. ; WORDS 4-8 ARE KNOWN AS THE 'SAVBLK' FOR THE FILE. ; FOR A TRANSFER OPERATION, WORDS 4-8 MAY CONTAIN ANY ; INFORMATION NECESSARY FOR THE ASSOCIATED I/O ROUTINES ; TO FIND AND READ THE FILE. HOWEVER, WORD 6 IS EXPECTED ; TO CONTAIN THE FILE SIZE (IN RT-11 BLOCKS, I.E. ; 256. WORDS/BLOCK, 2 CHARACTERS/WORD) SO THAT AN ; APPROPRIATE ENTER CAN BE DONE. IF A DIRECTORY LIST IS ; BEING DONE (SWT.L <> 0), THE DATE MUST BE AVAILABLE. ; IF THE I/O ROUTINES NEED A FIXED BUFFER, IT MAY BE ALLOCATED ; FROM FREE CORE AT THIS TIME. ; RETURNS: ; R3 -> BLOCK LIST, ENDING IN A 0 WORD ; R5 -> NEW FREE CORE ; MAY DESTROY: R0,R1,R2,R4 ;********************************************************************** ; OPEN - PREPARE FOR OUTPUT ON A DEVICE ; CALLED WITH: ; R2 -> DEV:FILNAM.EXT IN RAD50 FOR OUTPUT SIDE (MAY HAVE *'S) ; R3 -> EXPANDED INPUT LIST (SEE ABOVE) ; R5 -> FREE CORE, INITIALLY CONTAINS DSTATUS FOR DEV: ; FUNCTION: ; VERIFY DEVICE TYPE ; FETCH HANDLER @R5 ; ALLOCATE ANY FIXED BUFFERS FROM FREE CORE OR BY LOWERING ; CORTOP ; READ DIRECTORY FOR OUTPUT EXPANDER INTO FIXED BUFFER IF NEEDED ; PRE-DELETE FILES OR CHECK FOR EXISTING FILES USING INPUT LIST ; RETURNS: ; R5 -> NEW FREE CORE ; MAY DESTROY: R0,R1,R2,R4 ;********************************************************************** ; LKUP - PREPARE TO READ FILE ; CALLED WITH: ; R3 -> SAVBLK FOR FILE ; FUNCTION: ; SET UP ANY INTERNAL ROUTINES TO READ FROM THE DESIGNATED FILE. ; PRIME FIXED INPUT BUFFER, IF DESIRED, OR JUST CONDITION ; READ TO START AT BEGINNING OF FILE. ; MAY MODIFY SAVBLK IF NEEDED. ; MAY DESTROY: R0,R1,R2,R4,R5 ;********************************************************************** ; ENTER - PREPARE TO WRITE FILE ; CALLED WITH: ; R2 -> DEV:FILNAM.EXT[LEN] IN RAD50 (FROM CSI) ; R3 -> INPUT FILNAM.EXT/SAVBLK ; FUNCTION: ; ENTERS FILE ON OUTPUT DEVICE. ; MUST EXPAND ANY *.* CONSTRUCTION IN OUTPUT NAME WITH OEXPND. ; (NOTE: LKUP ROUTINE HAS NOT YET BEEN CALLED) ; RT-11 VALUE FOR FILE LENGTH IS AVAILABLE AT 8.(R3) ; MAY DESTROY: R0,R1,R4,R5 ;********************************************************************** ; READ - READ BUFFER LOAD OF DATA ; CALLED WITH: ; R3 -> SAVBLK ; R4 -> INPUT BUFFER (INBUFF) ; R5 -> TOP OF INPUT BUFFER (INBUFE) ; FUNCTION: ; READ AS MUCH DATA AS POSSIBLE INTO INPUT BUFFER. ; THE INPUT BUFFER SIZE IN BLOCK IS AVAILABLE AT BUFSIZ. ; IF EOF ENCOUNTERED, MAY RETURN SHORT BUFFER. ; THIS ROUTINE WILL BE RE-CALLED UNTIL IT RETURNS A NULL ; BUFFER TO SIGNAL END OF FILE. ; IT NEED NOT WORRY ABOUT DELETING NULLS & RUBOUTS. ; RETURNS: ; R4 -> TOP OF AREA ACTUALLY READ (UNCHANGED IF EOF) ; MAY DESTROY: R0,R1,R2 ;********************************************************************** ; WRITE - WRITE A BUFFER LOAD ; CALLED WITH: ; R4 -> OUTPUT BUFFER (OUBUFF) ; R5 -> TOP OF DATA TO BE OUTPUT (VARIES ACCORDING TO AMT READ) ; FUNCTION: ; OUTPUT BUFFER LOAD TO OUTPUT FILE ; WRITE WILL NEVER BE CALLED TO OUTPUT A NULL BUFFER, BUT MAY ; BE CALLED WITH A SHORT BUFFER. IT MUST COMPUTE ITS OWN WORD ; COUNT. THE SIZE IS ALWAYS AN EXACT NUMBER OF BLOCKS, EXCEPT ; FOR THE LAST CALL, WHICH MAY BE SHORT. ; MAY DESTROY: R0,R1,R2 ;********************************************************************** ; CLOSE - CLOSE OUTPUT FILE ; NO ARGUMENTS ; FUNCTION: ; CLOSE CURRENT OUTPUT FILE, FLUSHING INTERMEDIATE BUFFERS ; IF NEEDED. UPDATE DIRECTORY, MAKING FILE PERMANENT. ; MAY DESTROY: R0,R1,R2,R4,R5 ;********************************************************************** ; DIR - GET DATE ; CALLED WITH: ; R3 -> SAVBLK ; FUNCTION: ; RETURN DATE OF SELECTED FILE IN RT-11 FORMAT, BUT RELATIVE ; TO 1964. ; RETURNS: ; R0 = DATE ; MAY DESTROY: R1,R2 .SBTTL MACRO DEFINITIONS ; CSECTS FOR ERROR TABLES (OCCUR FIRST) .CSECT ERRMSG ;THIS CSECT CONTAINS THE MESSAGE TEXTS .CSECT ERRTBL ;THIS CSECT CONTAINS MESSAGE POINTERS ERRTBL: ;DEFINE BASE OF ERROR TABLE .CSECT MAIN$ ;THE MAIN BODY ; SYSTEM MACROS .MCALL ..V1.. ..V1.. .MCALL .CLOSE, .CSISPC,.DATE, .DSTATU,.EXIT, .FETCH .MCALL .LOCK, .LOOKUP, .MTPS,.PRINT, .QSET, .RCTRLO,.READW, .REOPEN ;### .MCALL .SAVEST,.SETTOP,.SRESET,.TTYIN, .TTYOUT,.UNLOCK,.WAIT .MCALL .WRITE, .WRITW ; CALL AND RETURN MACROS .MACRO CALL ARG JSR PC,ARG .ENDM CALL .MACRO RETURN RTS PC .ENDM RETURN ; MACRO TO REPEAT ITS ARGUMENT MACRO FOR EACH FUNCTION NAME .MACRO LIST MAC,ARG2 .IRP ARG, .IF NB ARG2 MAC ARG,ARG2 .IFF MAC ARG .ENDC .ENDR .ENDM LIST ; MACRO FOR LIST TO GEN DISPATCH TABLE .MACRO DISPATCH ARG,L .WORD L'.'ARG .ENDM DISPATCH ; MACRO FOR LIST TO GENERATE OFFSETS .MACRO OFFSET ARG $'ARG= 2*GOTOSZ GOTOSZ= GOTOSZ+1 .ENDM OFFSET GOTOSZ=0 ; MACRO FOR LIST TO GENERATE NOT-IMPL DEFINES .MACRO NOTIMP ARG,L .IF NDF L'.'ARG L'.'ARG: .ENDC .ENDM NOTIMP LIST OFFSET ; MACROS TO GENERATE CALLS TO STRUCTURE ROUTINES .MACRO ICALL RTN JSR PC,@INGOTO+$'RTN .ENDM ICALL .MACRO OCALL RTN JSR PC,@OUGOTO+$'RTN .ENDM OCALL ; MACRO TO GENERATE ERROR CALL. ; ALSO GENERATES MESSAGE IN TABLE IF 2ND ARG IS PRESENT .MACRO ERR CODE,MSG .NLIST .IF NB .CSECT ERRMSG LAB=. .ASCIZ /?MSG?/ .CSECT ERRTBL CODE=.-ERRTBL .WORD LAB .CSECT MAIN$ .ENDC .LIST TRAP CODE .ENDM ERR ; MACRO TO GENERATE TABLE OF SPECIAL CHARACTERS ; TO BE FOUND IN INPUT STRING .MACRO SPC C,D .BYTE C,/2 ;RELATIVE OFFSET .ENDM SPC ; MACRO TO GENERATE SWITCH TABLE ; FORMAT: SWITCH NAME (1 BYTE) ; DISPATCH LOC'N (1 BYTE) ; WORD FOR VALUE, LABEL SWT.X ; WORD FOR ASSOCIATED CONSTANT .MACRO SWT L,GO,VAL .ASCII /L/ .BYTE /2 SWT.'L: .WORD 0 .IF B VAL .WORD 0 .IFF .IF IDN GO,ACT .WORD VAL-ACBASE .IFF .WORD VAL .ENDC .ENDC .ENDM SWT .SBTTL SYMBOL DEFINITIONS ; REGISTERS R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 PS = 177776 ; DECTAPE CONTROLLER ADDRESSES TCST = 177340 ;STATUS REGISTER TCCM = 177342 ;COMMAND REGISTER TCWC = 177344 ;WORD COUNT REGISTER TCBA = 177346 ;BUS ADDRESS REGISTER TCDT = 177350 ;DATA REGISTER ; LOW CORE ADDRESSES STRTAD = 40 ;PROGRAM START ADDRESS SPINIT = 42 ;LOCATION CONTAINING INITIAL STACK PTR HICORE = 50 ;LOCATION CONTAINING HIGHEST ADDR OF PROGRAM ERRLOC = 52 ;ERROR CODE LOCATION SYSPTR = 54 ;POINTER TO TOP OF RMON (START OF RESIDENT) JSW = 44 ;JOB STATUS WORD OFFSET = 266 ;OFFSET TO VITAL RMON WORD! CONFIG = 300 ;OFFSET TO CONFIGURATION WORD FJOB$ = 200 ;THIS BIT IN CONFIG MEANS F JOB IS IN ; CODES FOR TRANSFER MODE ASCII = 2 IMAGE = 4 PACKED = 6 ; DIRECTORY BIT CODES DIREOB = 4000 ;END OF BLOCK DIRPRM = 2000 ;PERM ENTRY DIRESZ = 16 ;LENGTH OF ENTRY DIRBLK = 6 ;STARTING BLOCK OF DIR R50STAR = 132500 ;ASTERISK FROM CSI ; SET UP TRAP VECTOR FOR ERRORS .ASECT .=34 ;WHERE TRAP TRAPS ERRPRT ;IT WILL GO TO US 0 ;WITH 0 PRIORITY .CSECT MAIN$ ;BACK TO SHADOWS .SBTTL FIXED STORAGE AREAS - VOLATILE OUFDB: .BLKW 4 ;DEV:FILNAM.EXT FOR OUTPUT ACTION: .WORD 0 ;PUT THINGS TO BE CLEARED HERE CPYMOD: .WORD 0 ;AND LET THE CSI WORK FOR US DEFEXT: .WORD 0,0,0,0 ; *** CAUTION - NEXT 3 WORDS MUST STAY IN ORDER R.DEVS: .WORD 0 ;RT-11 DEVICE STATUS R.CHAN: .WORD 0 ;CURRENT RT-11 CHANNEL R.NCHA: .WORD 0 ;NUMBER OF OPEN CHANNELS OUBUFF: .WORD 0 ;LOCATION OF OUTPUT BUFFER OUSIZE: .WORD 0 ;IT'S SIZE IN WORDS INFDB: .BLKW 4 ;INPUT DEV:FILNAM.EXT R.LENG: .WORD 0 ;LENGTH GIVEN IN BRACKETS S.BLOK: .WORD 0 S.PBLK: .WORD 0 S.BUFF: .WORD 0 INGOTO: .BLKW GOTOSZ ;DISPATCH TABLE OUGOTO: .BLKW GOTOSZ .BYTE 0,0,0,0,0,0,0,377 ;BUFFER FOR CONVERSION DIGITS=.-1 CMDBUF: .BLKB 72. ;INPUT COMMAND STRING .BLKB 14. ;BRACKETED STUFF BRKBF1=. .BLKB 14. BRKBF2=. OUASCI: .WORD 0 ;POINTER TO OUTPUT FILE NAME DATE: .WORD 0 ;POINTER TO SYSTEM DATE XTRABY: .WORD 0 ;EXTRA BYTES/DIR ENTRY ; NEXT 2 IN ORDER R.IBLK: .WORD 0 ;BLOCK # FOR INPUT BUFSIZ: .WORD 0 ;SIZE OF I/O BUFFER (BYTES) USRBUF: .WORD 0 ;POINTER TO BOTTOM OF USR (TOP OF AVAIL CORE) CORTOP: .WORD 0 ;TOP OF AVAIL CORE (LOW IF DOS MFBM IN) INBUFF: .WORD 0 ;POINTER TO INPUT BUFFER S.BCTR: .WORD 0 ;BYTE COUNTER FOR DOS ASCII XFER S.BPTR: .WORD 0 ;BUFFER PTR FOR SAME S.DBUF: .WORD 0 ;POINTS TO USRBUF-3 BLOCKS S.BMAP: .WORD 0 ;POINTS TO USRBUF-1 BLOCK S.ZFMT: .WORD 1,104,36.,1,0 ;ZEROED DT FORMAT FOR DOS. BITMAP BLK .WORD 1,0 ;FILE BITMAPS .WORD 4,101,4,104,104 ;MFD0 .WORD 4,0 ;MFD1 S.PPDF: .WORD 401,102,9. ; (CONT) .WORD 1,103 ;UFD0 .WORD 1,0 ;UFD1 .WORD 0 ;END OF LIST S.FNUM: .WORD 0 ;FILE NUMBER OF DOS OUTPUT FILE S.FPTR: .WORD 0 ;POINTER INTO DIRECTORY S.NAME: .WORD 0,0,0 ;NAME IN RAD50 S.DATE: .WORD 0,0 ;TODAY'S DATE (DOS), FILLER S.FBLK: .WORD 0 ;PTR TO FIRST BLOCK S.NBLK: .WORD 0 ;NUMBER OF BLOX IN FILE S.LBLK: .WORD 0 ;LAST BLOCK .WORD 233 ;PROTECTION .SBTTL FIXED STORAGE AREAS - NON-VOLATILE ; DISPATCHING TABLES FOR FILE STRUCTURES R.GOTO: LIST DISPATCH R ;RT-11 TABLES T.GOTO: LIST DISPATCH T ;TOPS-10 TABLES S.GOTO: LIST DISPATCH S ;DOS TABLES ; SPECIAL CHARACTERS IN INPUT SPCL: SPC '[,BRACK ;START OF BRACKETED AREA SPC 015,CMREAD ;SKIP CR TO GET LINE FEED SPC 012,CMEND ;LINE FEED ENDS LINE SPC 054,CMDERR ;COMMA IMPLIES >1 NAME PER SIDE SPC '=,EQLS ;EQUALS SIGN CHANGES SIDE SPC '<,LESSGN ;DITTO, CHANGE TO = SPC ':,COLON ;FIX START OF ASCII NAME .WORD 0 ;END OF TABLE ; SWITCHES SWTBL: SWT A,MOD,ASCII ;ASCII MODE TRANSFER SWT I,MOD,IMAGE ;IMAGE MODE TRANSFER SWT P,MOD,PACKED ;PACKED MODE TRANFER SWT S,FIL,S.GOTO ;DOS FILE STRUCTURE SWT T,TEN,T.GOTO ;TOPS-10 FILE STRUCTURE SWT C,ACT,COPY ;ACTION = COPY SWT D,ACT,DELETE ;ACTION = DELETE SWT L,ACT,LIST ;ACTION = DIRECTORY SWT Z,ACT,ZERO ;ACTION = ZERO SWT F,ACT,FASTDI ;ACTION = FAST DIRECTORY SWT V,ACT,VERSION ;ACTION = TYPE VERSION # SWT G,IGN ;IGNORE INPUT ERRORS SWT N,NUM ;(UNUSED) .WORD 0 ;END OF TABLE VERMSG: .ASCIZ "FILEX V02-02 " ;### RUSURE: .ASCII ":/Z ARE YOU SURE ?"<200> EXISTS: .ASCIZ " ALREADY EXISTS?" .EVEN .SBTTL ERROR ROUTINE, SAVREG ; REGISTER SAVE ROUTINE SAVREG: MOV R2,-(SP) ;A HANDY UTILITY MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) CALL @R1 MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 RETURN ;RETURN TO HIS CALLER .ENABL LSB ; VERSION COMMAND VERSION:MOV #VERMSG,R0 BR 1$ ; ERROR MESSAGE HANDLER ERRPRT: MOV @SP,R0 ;POINT R0 TO TRAP INSTR + 2 MOV -(R0),R0 ;R0 CONTAINS THE TRAP INSTRUCTION MOV ERRTBL-TRAP(R0),R0 ;R0 NOW POINTS TO MESSAGE 1$: .PRINT ; JMP START ;GO RESTART (RESET STACK) .DSABL LSB .SBTTL INITIALIZATION NOP ;REENTRY NO-OP START: MOV @#SPINIT,SP ;INITIALIZE STACK POINTER .RCTRLO ;RESET ^O .UNLOCK ;RELEASE USR IF WE HAVE IT CLR OUASCI ;MARK NO OUTPUT FILE GIVEN .SRESET ;PURGE HANDLERS, GRONK FILES MOV #SWTBL+2,R0 ;CLEAR SWITCH TABLE 1$: CLR (R0)+ ;CLEAR A WORD TST (R0)+ ;ADVANCE POINTER TST (R0)+ ;END OF TABLE? BNE 1$ ;NOPE MOV USRBUF,CORTOP ;SET UP TOP OF CORE .SBTTL COMMAND STRING READER ; READ AND INTERPRET COMMAND STRING, SEPARATINE OUT ; THINGS IN BRACKETS .TTYOUT #'* ;PROMPT USER WITH STAR MOV #CMDBUF,R1 ;R1 -> CHARACTER BUFFER MOV R1,R2 ;R2 = START OF ASCII FILE NAME MOV #BRKBF1-1,R4 ;R4 -> [] INFO FOR 1ST FILE CLRB (R4)+ ;ZERO IT INITIALLY MOV #72.,R3 ;R3 = CHAR COUNTER CMREAD: .TTYIN ;EAT A CHARACTER MOV #SPCL,R5 ;TABLE OF SPECIAL CHARACTERS 1$: CMPB R0,(R5)+ ;IS THIS A SPECIAL ? BNE 2$ ;NO, LOOK AGAIN MOVB @R5,@PC ;SET UP DISPATCH BR .+2 ;REL. BRANCH GETS PLUGGED SPBASE=. 2$: TSTB (R5)+ ;PUSH SPECIAL POINTER BNE 1$ ;GO IF MORE TO SEE CMDSTF: MOVB R0,(R1)+ ;STUFF THE BYTE DEC R3 ;COUNT DOWN BGT CMREAD ;CONTINUE IF ROOM CMDER2: .TTYIN ;SKIP TO LINE FEED CMP R0,#012 BNE CMDER2 CMDERR: ERR ILCM, ;ILLEGAL COMMAND LESSGN: INC R0 ;CHANGE < TO = EQLS: MOV #BRKBF2-1,R4 ;SET UP FOR SECOND [] STUFF CLRB (R4)+ MOV R2,OUASCI ;SAVE POINTER TO OUTPUT FILE NAME COLON: MOV R1,R2 ;NEW ASCII NAME PTR INC R2 ; IS AFTER THIS BR CMDSTF ;STUFF IT BRACK: TST R4 ;ALREADY HAD A [] ? BEQ CMDER2 ;BOGUS IF TRUE MOV #14.,R5 ;ALLOW ROOM FOR PPPPPP,PPPPPP0 1$: .TTYIN ;GET A THING CMP R0,#015 ;CARRIAGE RTN INSIDE ? BEQ CMDER2 ; ILLEGAL IF SO CMP R0,#'] ;END ? BEQ 2$ ;JA, WUNDERBAR MOVB R0,-(R4) ;STUFF IN BRACK BUFF DEC R5 ;OVERFLOWED BUFFER? BGT 1$ ;NO, KEEP LOOKING BR CMDER2 ;YES, BOOT HIM 2$: CLRB -(R4) ;MARK END OF BUFFER CLR R4 ;INDICATE THAT WE FOUND [] BR CMREAD .SBTTL SWITCH HANDLER CMEND: CLRB @R1 ;MARK END OF INPUT STRING MOV #CMDBUF,R1 ;REPOINT TO STRING TSTB @R1 ;IGNORE NULL LINE BEQ START .CSISPC #OUFDB,#DEFEXT,R1 BCS CMDERR ;PARSE THE 2 NAMES ; PROCESS ALL SWITCHES MOV (SP)+,R5 ;R5 = # OF SWITCHES SWTNXT: DEC R5 ;ANY LEFT? BMI SWEND ;FINISHED IF NOT MOV (SP)+,R3 ;R3 = ACTUAL SWITCH (VAL+FILE) BMI 1$ ;CHECK IF VALUE GIVEN MOV PC,-(SP) ;PSEUDO NON-0 VALUE 1$: MOV #SWTBL-4,R4 ;R4 -> SWITCH TABLE 2$: CMP (R4)+,(R4)+ ;PUSH POINTER MOV (R4)+,R0 ;R0 = TABLE ENTRY BEQ SWTILL ;NOT THERE! CMPB R0,R3 ;IS THIS THE ONE? BNE 2$ ;KEEP TRUCKIN' MOV (SP)+,(R4)+ ;SAVE VALUE IN TABLE SWAB R0 ;SET UP BRANCH AND GO MOVB R0,@PC BR .+2 SWBASE=. SWTILL: ERR ILSW, ;ILLEGAL SWITCH SWEND: TST INGOTO ;ANY FILE STRUCTURE GIVEN? BNE GODOIT ;YES, DO FOREIGN STUFF MOV #R.GOTO,R1 ;NO, ACT LIKE PIP. SET BOTH TO RT11 CLR R3 ;WE'LL RETURN SHORTLY BR RT11FL ;BUT NOW SET BOTH TABLES ; FILE STRUCTURE SWITCHES: /S /T SWTTEN: MOV @#SYSPTR,R1 ;/T CAN'T BE DONE IF FG ACTIVE BIT #FJOB$,CONFIG(R1) ;IS IT? BEQ SWTFIL ;NO ERR FRUN, SWTFIL: MOV @R4,R1 ;R1 -> DISPATCH TABLE SWAB R3 ;WHICH FILE? ANY VALUE? BMI SWTERR ;ILLEGAL IF HAS VALUE BIC #177601,R3 ;REDUCE 0 OR 3 TO 0 OR 2 RT11FL: MOV (PC)+,R4 ;COUNT SIZE OF TABLE .BYTE GOTOSZ,GOTOSZ ;TWO COUNTERS IN ONE 1$: MOV IOFIL(R3),R0 ;POINT TO CORRECT FILE TST @R0 ;ALREADY HAD ONE? BNE SWTERR ;THAT'S A NO-NO 2$: MOV (R1)+,(R0)+ ;COPY A WORD DECB R4 ;FINISHED WITH TABLE? BNE 2$ ;0 ENDS TABLE TST (R3)+ ;SWAP FILE TABLES MOV #R.GOTO,R1 ;SOURCE IS RT-11 DISPATCH SWAB R4 ;SECOND TIME AROUND ? BNE 1$ ;GO FILL RT-11 SIDE BR SWTNXT ;ALL DONE IOFIL: .WORD OUGOTO,INGOTO,OUGOTO ; COPY MODE ETC. SWTMOD: MOV #CPYMOD,R0 ;/A /I /P SWTCOM: TST @R0 ;ALREADY HAD ONE OF THESE? BNE SWTERR MOV @R4,@R0 ;SET MODE SWTIGN: TST R3 ;INSURE NO VALUE /G BPL SWTNXT SWTERR: ERR SWER, ;SWITCH ERROR ; ACTION SWITCHES SWTACT: MOV #ACTION,R0 ;/C /D /L /Z BR SWTCOM ; NUMBER OF BLOCKS SWTNUM: TST R3 ;VALUE IS MANDATORY BPL SWTERR BR SWTNXT ; GO TO ACTION ROUTINE GODOIT: MOV #FREE,R5 ;POINT TO FREE CORE ADD ACTION,PC ;DO THE THING (COPY = 0) ACBASE: NOP ;/C => ACTION = 2 .SBTTL COPY DRIVER ROUTINE COPY: MOV #OUFDB,R0 ;POINT TO OUTPUT FILE NAME TST @R0 ;SEE IF THERE! BEQ ERRNOU ;ERROR - NO OUTPUT FILE .DSTAT R5 ;GET STATUS IN FREE CORE BCS ERRDEV ;NO SUCH DEVICE! MOV @R5,-(SP) ;SAVE FOR CALLING OPEN CALL XPANDI ;GO DO INPUT EXPANSION TST @R3 ;IF NONE, FILE NOT FOUND BEQ FNFERR MOV (SP)+,@R5 ;RESTORE HIS DSTATUS MOV #OUFDB,R2 ;POINT TO OUTPUT PROTO FOR OPEN OCALL OPEN ;CALL OPENER CALL ALCBUF ;ALLOCATE IN/OUT BUFFERS MOV OUBUFF,-(SP) ;WE USE THIS A LOT COPYLP: TST @R3 ;ANY FILES TO COPY? BEQ REENTR ;NO, GET THE ... OUT MOV #OUFDB,R2 ;POINT GUY FOR FIXING OCALL ENTE ;ENTER THE FILE ADD #6,R3 ;ADVANCE POINTER TO GOOD DATA ICALL LKUP ;OPEN THE FILE FOR INPUT TST SWT.A ;WHAT KIND OF XFER? BNE ASCOPY ;GO DO AN ASCII COPY IMCOPY: MOV @SP,R4 ;POINT TO INPUT BUFFER MOV INBUFE,R5 ; AND TOP OF BUFFER ICALL READ ;READ A LOAD MOV R4,R5 ;TOP OF DATA READ IN R5 MOV @SP,R4 ;START OF DATA IN R4 CMP R4,R5 ;ANYTHING ? BEQ CPCLOS ;NO, CLOSE THE OUTPUT OCALL WRIT ;YES, WRITE IT OUT BR IMCOPY ;LOOP ASCOPY: MOV @SP,R5 ;START OUTPUT SCANNER ASLOOP: MOV R5,-(SP) ;SAVE OUTPUT POINTER MOV INBUFF,R4 ;POINT FOR READING MOV INBUFE,R5 ICALL READ MOV R4,R2 ;TOP OF INPUT DATA IN R2 MOV INBUFF,R1 ;BOTTOM OF INPUT IN R1 MOV (SP)+,R5 ;RESTORE OUTPUT POINTER CMP R1,R2 ;GET ANYTHING ? BEQ CPFILL ;NO, FILL AND CLOSE 1$: CMP R1,R2 ;DONE WITH THIS INPUT LOAD ? BHIS ASLOOP ;YES, GET ANOTHER MOVB (R1)+,R0 ;NO, GET A BYTE BIC #177600,R0 ;TRIM IT BEQ 1$ ;IGNORE NULLS CMP #177,R0 ; AND RUBOUTS BEQ 1$ CMP #'Z-100,R0 ;STOP ON ^Z BEQ CPFILL ; AND CLEAN UP MOVB R0,(R5)+ ;PUT INTO OUTPUT BUFFER CMP R5,OUBUFE ;FULL ? BLO 1$ ;NOT YET MOV @SP,R4 ;YES, POINT TO OUTPUT BUFFER MOV R1,-(SP) ;SAVE INPUT POINTERS MOV R2,-(SP) OCALL WRIT ;WRITE FROM R4 TO R5 MOV (SP)+,R2 MOV (SP)+,R1 MOV @SP,R5 ;START ANEW AT OUTPUT BUFFER BR 1$ ;KEEP GOING CPFILL: BIT #1,R5 ;TOP OF OUTPUT ODD ? BEQ 4$ ;NOPE CLRB (R5)+ ;YEP, EVEN IT OUT 4$: MOV @SP,R4 ;POINT TO OUTPUT ONE LAST TIME CMP R4,R5 ;ANYTHING THERE ? BEQ CPCLOS ;NO OCALL WRIT CPCLOS: OCALL CLOS ADD #12,R3 ;PUSH TO NEXT INPUT FILE BR COPYLP ;AND GO REENTR: JMP START ERRNOU: ERR ILCM ;ILLEGAL IF NO OUTPUT FILE ERRDEV: ERR ILDE, ;ILLEGAL DEVICE FNFERR: ERR FINOFN, ;FILE NOT FOUND .SBTTL DIRECTORY LIST DRIVER FASTDI: MOV SP,SWT.L LIST: CALL XPANDI ;GO EXPAND INPUT SPEC. MOV #CMDBUF,R5 ;POINT TO BUFFER FOR OUTPUT LISTLP: TST @R3 ;ANY FILES LEFT? BEQ REENTR MOV R5,R4 ;PREPARE TO COPY MOV #40,CONTIG ;TURN OFF CONTIG FLAG CALL OUTFNM ;PRINT THE FILE NAME ICALL DIR ;GET DATE AND STUFF MOV R0,-(SP) ;SAVE IT CMP (R3)+,(R3)+ ;SKIP 2 WORDS MOV (R3)+,R0 ;GET FILE SIZE TST SWT.F BNE LISTF CALL R10OU6 ;PRINT 6 CHAR FIELD MOVB (PC)+,(R4)+ ;BYTE FLAG FOR CONTIG CONTIG: .WORD 40 MOVB #40,(R4)+ MOV @SP,R0 ;RETRIEVE DATE CALL DATOUT ;AND PRINT IT LISTF: TST (SP)+ ;PRUNE DATE CLRB (R4)+ CMP (R3)+,(R3)+ ;PUSH TO NEXT BLOCK .PRINT R5 ;PRINT THE MESSAGE BR LISTLP .SBTTL ZERO DEVICE DRIVER DELETE: CALL XPANDI ;FIRST EXPAND LIST ICALL DELE ;EASY BR REENTR ZERO: MOV #START,-(SP) ;DRIVER ZERO ROUTINE RETURNS HERE MOV INGOTO+$ZERO,-(SP) ;SAVREG WILL RETURN TO DRIVER ZERO JSR R1,SAVREG ;SAVE ALL REGS MOV #OUFDB,R4 ;GET AREA FOR RAD50 MOV INFDB,R0 ;GET DEVICE NAME CALL R50OUT ;CONVERT DEVICE NAME MOVB #200,(R4)+ ;NO CR .PRINT #OUFDB .PRINT #RUSURE ;ASK IF HE IS SURE .TTYIN R1 ;GET ANSWER 1$: .TTYIN ;SKIP TO LINE FEED CMP #12,R0 BNE 1$ CMP #'Y,R1 ;WAS HE SURE? BNE REENTR ;NO RETURN ;RETURN TO SAVREG, THEN TO DRIVER .SBTTL FILE NAME OUTPUT ; ROUTINE IS CALLED WITH R3 POINTING TO A FILNAM.EXT IN RAD50 ; AND R4 POINTING TO AN OUTPUT AREA ; THE FILE NAME IS CONVERTED TO ASCII AND OUTPUT ; R3 IS ADVANCED OUTFNM: CALL FNOUT ;PRINT FIL CALL FNOUT ;PRINT NAM MOVB #'.,(R4)+ ;PRINT . FNOUT: MOV (R3)+,R0 ;PRINT NEXT 3 CHARACTERS R50OUT: JSR R5,CONV ;CONVERT IT .WORD 3,50 ;3 BYTES OF RADIX 50 1$: MOVB (R2)+,R0 ;GET NEXT CONVERTED BYTE BMI DONE ;FINISHED ON NEGATIVE BEQ 2$ ;ZERO BYTE IS BLANK CMP R0,#32 ;TEST FOR ALFA BLE 3$ ;GO IF A-Z SUB #36,R0 ;TEST FOR NUMBER BCC 4$ 2$: MOV #-40,R0 ;FUDGE OTHERS TO SPACE 3$: ADD #20,R0 4$: ADD #60,R0 MOVB R0,(R4)+ ;PUT IN OUTPUT STREAM BR 1$ .SBTTL OUTPUT CONVERSION (ANY RADIX) ; THIS ROUTINE IS PASSED A NUMBER IN R0 AND A COUNT IN R1 ; IT CONVERTS THE NUMBER TO THE RADIX IN 'RADIX' AND LEAVES ; R2 POINTING TO THE RESULT. IF LESS THAN R1 CHARACTERS ; ARE PRODUCED, BLANKS ARE OUTPUT TO (R4)+ DIVIDE: CLR R1 ;DO THE LOOP ONLY ONCE BR CONV1 ;AND GO DO DIVISION CONV: MOV (R5)+,R1 ;GET THE MAX FIELD SIZE CONV1: MOV #DIGITS,R2 MOV R1,-(SP) ;SAVE THE COUNT CNVLUP: CLR R1 ;CLEAR FOR DIVISION MOV #17,-(SP) ;16. BIT NUMBERS DIVLUP: ASL R0 ;THIS IS AN ORDINARY DIVISION ROL R1 CMP R1,@R5 ;CAN WE DO A SUBTRACT? BLO NOFIT SUB @R5,R1 INC R0 NOFIT: DEC @SP BPL DIVLUP ;NOTE END ON -1 MOVB R1,-(R2) ;SAVE REMAINDER BACKWARDS ADD (SP)+,@SP ;DECREMENT COUNTER AND PRUNE BLE 2$ ;DO NOT EXCEED FIELD SIZE TST R0 ;SHOULD WE CONVERT MORE? BNE CNVLUP ;YES,DO IT 1$: DEC @SP ;NEED WE FILL? BMI 2$ MOVB #40,(R4)+ ;YES, PUT OUT BLAN BR 1$ 2$: CMP (SP)+,(R5)+ ;REMOVE PRUNE FROM STACK RTS R5 .SBTTL DATE OUTPUT UTILITY ; THIS ROUTINE ACCEPTS A DATE IN RT-11 FORMAT IN R0 ; AND PUTS IT OUT AS A 9 CHARACTER FIELD TO (R4)+. ; AN INVALID DATE PUTS A NULL FIELD DATOUT: BIT #36000,R0 ;IS IT A VALID DATE? BEQ DONE ;NO, EXIT 1$: MOV R0,-(SP) ;GET A 5 BIT FIELD BIC #177740,@SP ;TRIM THE STACK ASR R0 ;ADVANCE ASR R0 ASR R0 ASR R0 ASR R0 BNE 1$ ;IF NOT 0, RETURN FOR NEXT FIELD MOV 2(SP),R0 ;PUT OUT THE DAY CALL R10OU2 ; AS A 2 BIT FIELD MOV (SP)+,R0 ;GET MONTH NUMBER ASL R0 ASL R0 ;CONVERT TO TABLE INDEX ADD #MONTHS-4,R0 ;AND POINT TO TABLE MOV #5,@SP ;PUT OUT 5 CHARS 2$: MOVB (R0)+,(R4)+ DEC @SP BNE 2$ TST (SP)+ ;PRUNE STACK MOV (SP)+,R0 ;GET YEAR (REL 1964) ADD #64.,R0 CALL R10OU2 DONE: RETURN .NLIST BEX MONTHS: .ASCII /-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC-/ .EVEN .LIST BEX .SBTTL DECIMAL NUMBER OUTPUT R10OU2: MOV #2,R1 ;ENTER HERE FOR 2 DIGITS BR R10CNV R10OU6: MOV #6,R1 ;ENTER HERE FOR 6 DIGITS R10CNV: JSR R5,CONV1 ;DO THE CONVERSION .WORD 10. ;(BASE 10., OF COURSE) 1$: MOVB (R2)+,R0 ;OUTPUT NEXT DIGIT BMI DONE ADD #60,R0 MOVB R0,(R4)+ BR 1$ .SBTTL EXPAND INPUT LIST .ENABL LSB ;### XPANDI: .DSTAT R5,#INFDB ;GET A DSTATUS BCS 4$ ;BAD DEVICE MOV #INFDB+6,R3 ;PREPARE TO CHECK FOR *.* CLR R4 ;CLEAR FLAG MOV @R3,R0 ;CUMULATIVE TEST FOR NULL NAME CMP R0,#R50STAR ;IS IT A * EXTENSION BNE 1$ BIS #100000,R4 ;SET FLAG IF SO 1$: BIS -(R3),R0 CMP -(R3),#R50STAR ;IS FILE NAME A * BNE 2$ COMB R4 ;SET FLAG IF SO 2$: BIS @R3,R0 ;FINISH TEST FOR NULL NAME BNE 12$ ;TREAT NULL NAME AS *.* TST @R5 ;UNLESS NON-FILE STRUCTURED BPL 12$ ; IN WHICH CASE LEAVE NAME DEC R4 ;SET FLAGS FOR *.* 12$: TST @R5 ;IF IT IS NON-FILE-STR BMI 13$ TST R4 ; AND IT HAS WILD CARDS BNE 10$ ; BOOT HIM 13$: TST -(R3) ;DID HE GIVE US A NAME? BEQ 10$ MOV #BRKBF2,R1 ;POINT HIM TO BRACKETS TST OUASCI ;IS THIS RIGHT BNE 3$ ;YES, BUFFER2 IF OUTPUT EXTANT MOV #BRKBF1,R1 3$: JMP @INGOTO+$EXPA ;GO TO EXPANSION, RETURN TO CALLER ERRIDV: ;### 4$: ERR ILDE ;BAD DEVICE ;NOTE THAT R2 STILL POINTS TO ASCII NAME 10$: ERR ILCM .DSABL LSB ;### .SBTTL RT-11 EXPAND INPUT LIST ; THIS ROUTINE EXPANDS AN INPUT LIST INTO BLOCKS ; WHICH ARE GOOD FOR REOPENS IF /L IS OFF, AND GOOD FOR LISTING ; IF /L IS ON R.EXPA: MOV @R5,-(SP) ;SAVE THE DSTATUS .FETCH R5,R3 ;GET HANDLER IN FREE CORE TST (R0)+ ;MOVE CORE PTR DOWN A WORD ;### MOV R0,R5 ;NEW FREE CORE PTR MOV (SP)+,R0 ;R0 = DSTATUS MOV R3,R2 ;R2 -> INPUT PROTOTYPE MOV R5,R3 ;R3 -> INPUT LIST TST SWT.L ;IF DIRECTORY LIST, BNE 20$ ; THEN ALWAYS EXPAND INPUT MOV R2,R1 ;POINT R1 AT GIVE FILE NAME TST (R1)+ TST R4 ;IS THERE A WILD CARD ? BEQ 5$ ;STRAIGHT FILE NAME IS EASY 20$: .LOCK ;DON'T LET FG USE USR BUFFER CALL GETDIR ;READ FIRST DIRECTORY BLOCK 1$: BIT @R1,#DIREOB ;END OF DIRECTORY BLOCK ? BEQ 3$ ;NO CALL RDDIR ;YES, READ THE NEXT ONE BNE 1$ ;GOT IT 2$: .CLOSE 17 ;CLOSE DIRECTORY CHANNEL .UNLOCK ;OK, DONE WITH USRBUF CMP R3,R5 ;DID WE GET ANY FILES ? BEQ 30$ ;NO, ERROR CLR (R5)+ ;SET END OF LIST CMP ACTION,#2 ;ARE WE COPYING ? BHI 11$ ;NO, DON'T LOOKUP MOV R3,R1 ;YES, COPY NAME LIST POINTER 10$: MOV -(R1),-(SP) ;SAVE A RANDOM WORD MOV @R2,@R1 ;PUT IN DEVICE NAME .LOOKU 0,R1 ;LOOKUP THE FILE BCS 30$ ;IT ISN'T THERE MOV (SP)+,(R1)+ ;RESTORE RANDOM WORD ADD #6,R1 ;POINT TO SAVESTATUS AREA .SAVES 0,R1 ;AND SAVE STATUS BCS ERRIDV ;IF C SET-ILL DEV(MT,CT) ;### ADD #12,R1 ;POINT TO NEXT BLOCK TST @R1 ;DONE ? BNE 10$ ;NOT YET 11$: RETURN 3$: BIT (R1)+,#DIRPRM ;IS THIS A REAL FILE ? BEQ 8$ ;NO, SKIP IT CALL STCHEK ;CHECK FOR MATCH WITH INPUT BNE 8$ 5$: MOV (R1)+,(R5)+ ;MOVE IN FILENAME.EXT MOV (R1)+,(R5)+ MOV (R1)+,(R5)+ MOV (R1)+,4(R5) ;MOVE IN SIZE TST (R1)+ ;SKIP OTHER SIZE MOV (R1)+,@R5 ;PUT IN DATE ADD #8.,(R5)+ ; (MAKE IT REL 1964) ADD #10,R5 ;SKIP ALL THE REST TST R4 ;DO WE CONTINUE ? BEQ 2$ ;NO, GET OUT BR 9$ ;YES 8$: ADD #DIRESZ-2,R1 ;PUSH OVER ENTRY 9$: ADD XTRABY,R1 BR 1$ 30$: ERR FINOFN .SBTTL RT-11 LOOKUP, READ, AND DIR R.LKUP: .CLOSE 17 ;CLOSE CHANNEL IN CASE IN USE .REOPEN 17,R3 ;REOPEN SAVED FILE CLR R.IBLK ;CLEAR BLOCK NUMBER RETURN ;DONE R.READ: MOV R.IBLK,R0 ;GET BLOCK NUMBER MOV BUFSIZ,R2 ;SIZE OF BUFFER ADD R2,R.IBLK ;UPDATE BLOCK NUMBER SWAB R2 ;WORD COUNT AGAIN .READW 17,R4,R2 ;READ A LOAD BCS 2$ ;ERROR ? ASL R0 ;BYTES READ ADD R0,R4 ;POINT TO TOP OF GOOD STUFF 1$: RETURN 2$: TSTB @#ERRLOC ;EOF TYPE ERROR ? BEQ 1$ ;YES ERR INER, ;NO, BADDIE R.DIR: MOV @R3,R0 ;GET DATE WORD RETURN ;EASY SAID, EASY DONE .SBTTL RT-11 OPEN ; THIS ROUTINE PREPARES FOR OUTPUT ON AN RT-11 DEVICE ; IT IS CALLED WITH R5 -> FREE CORE ; AND R2 -> OUTPUT DEV:FILNAM.EXT IN RAD50. ; @R5 IS A DSTATUS FOR DEV: R.OPEN: MOV @R5,R1 ;SAVE THE DSTATUS .FETCH R5,R2 ;GET THE HANDLER BCC 1$ ;SKIP ERROR IF OK 3$: ERR ILDE ;ILLEGAL DEVICE ;### 1$: MOV R0,R5 ;TOP OF HANDLER MOV R1,R.DEVS ;SAVE THE DSTATUS OF OUR DEVICE BMI 2$ ;LEAVE ALONE IF FILE STRUCTURED BIT #10000,R1 ;IS THIS A SPECL DEV?(MT,CT) ;### BNE 3$ ;IF NE-YES-NOT VALID FOR FILEX ;### .LOOKU 1,R2 ;ELSE LET IT BE OPEN ON CHANNEL 1 INC R.NCHAN ;MARK THE CHANNEL OPEN INC R.CHAN ;AND USE CHANNEL 1 2$: RETURN .SBTTL RT-11 WRITE ; THESE ROUTINES HANDLE OUTPUT TO AN RT-11 DEVICE R.WRIT: SUB R4,R5 ;COMPUTE SIZE TO OUTPUT CLR -(SP) ;USE WAIT I/O (& CLC) ROR R5 ;SIZE IS IN WORDS MOV R5,-(SP) ;PUT SIZE ON STACK MOV R4,-(SP) ;PUT OUTPUT POINTER ON STACK MOV (PC)+,R0 ;BLOCK NUMBER IN R0 R.BLOK: .WORD 0 SWAB R5 ;BLOCK COUNT ADD R5,R.BLOK ;UPDATE IT MOV R.CHAN,-(SP) ;BUILD A WRITE EMT ADD (PC)+,@SP EMT 220 MOV (SP)+,@PC .WORD 0 BCS OUTER RETURN OUTER: ERR OUER, .SBTTL RT-11 ENTER ; ENTER AS MANY FILES AS POSSIBLE ; ENTRY: R2 -> OUTPUT PROTOTYPE ; R3 -> INPUT BLOCK R.ENTE: CLR R.BLOK ;WRITE TO BLOCK 0 TST R.NCHAN ;ANYTHING STILL OPEN? BGT 8$ ;YES, JUST VANISH JSR R1,SAVREG ;IT'S REG TIME! CLR R1 ;R1 = CHANNEL COUNTER 1$: MOV OUBUFF,R4 ;USE OUT BUFFER FOR SCRATCH MOV R4,R0 ;SAVE LOCATION FOR ENTER MOV R2,R5 ;R5 -> OUTPUT PROTOTYPE MOV (R5)+,(R4)+ ;COPY DEVICE CALL OEXPND ;EXPAND OUTPUT STARS INC R1 ;BUMP CHANNEL MOV R1,6$ ;SET FOR ENTER MOV R.LENG,-(SP) ;SET UP FILE LENGTH BNE 5$ ;GOOD, HE GAVE ONE MOV 4(R3),@SP ;MOVE IN LENGTH FROM INPUT 5$: ADD (PC)+,(PC) EMT 40+0 ;PROTOTYPE ENTER EMT 6$: 0 BCS R.DEFU ;IS THE DEVICE FULL? CMP R1,#16 ;ENOUGH ALREADY ? BHI 7$ ;YES BLO 10$ ;NO CMP INGOTO,R.GOTO ;RT-11 INPUT ? BEQ 7$ ;YES, LEAVE CH. 17 10$: ADD #12,R3 ;PUSH INPUT POINTER TST @R3 ;IS THERE A FILE? BNE 1$ ;YAH, ENTER IT 7$: MOV R1,R.NCHAN ;SAVE NUMBER OF ENTERS MOV #1,R.CHAN ;SET STARTING CHANNEL 8$: RETURN R.DEFU: ERR DEFU, ;DEVICE FULL .SBTTL RT-11 CLOSE R.CLOS: MOV #R.DEVS,R1 ;POINT TO STATUS 'N STUFF TST (R1)+ ;IS IT FILE STRUCT ? BPL 4$ ;NAH, JUST LEAVE CHANNEL OPEN MOV (R1)+,R0 ;GET CURRENT CHANNEL CMP R0,@R1 ;WE UP TO THE TOP YET ? BLO 3$ ;NO, AOK 1$: MOV R0,2$ ;SET UP CLOSE ADD (PC)+,@PC .CLOSE 0 2$: 0 DEC R0 ;ANY MORE TO DO ? BGT 1$ ;YES CLR @R1 ;NEXT ENTER WILL DO THINGS! 3$: INC R0 ;RESET STARTING CHANNEL MOV R0,-(R1) ;SAVE IT 4$: RETURN .SBTTL RT-11 DIRECTORY READ ; THIS ROUTINE READS THE RT-11 DIRECTORY INTO THE USR'S BUFFER ; IT UPDATES BLKEY AND CHKEY AS NEEDED GETDIR: TST R0 ;CHECK DEVICE STATUS BPL BADDIR ;NO GOOD IF NO FILE STR. MOV @R2,@R5 ;COPY DEVICE NAME CLR 2(R5) ;AND OPEN NON-FILE STR. .LOOKU 17,R5 ; ON CHANNEL 1 BCS BADDIR ;BADDIE .SAVES 17,R5 ;NEED UNIT NUMBER .REOPE 17,R5 ;AND NEED DIRECTORY OPEN MOV 10(R5),-(SP) ;COMPUTE CHKEY FOR IT MOVB @R5,@SP BIC #301,@SP CMP @SP,@CHKEY ;IS THE DIRECTORY THERE ? BEQ GETDI2 ;IT MIGHT BE CLR @(PC)+ ;IT CAN'T BE, FORCE READ BLKEY: .WORD 0 GETDI2: MOV (SP)+,@(PC)+ ;SET CHKEY CHKEY: .WORD 0 MOV #1,DBLOCK ;START AT DIR BLOCK 1 RDDIR: MOV (PC)+,R0 ;GET DIR BLOCK DBLOCK: .WORD 0 BEQ 2$ ;ZERO => END OF DIR MOV USRBUF,R1 ;POINT TO BUFFER CMP R0,@BLKEY ;IS IT ALREADY IN ? BEQ 1$ ;YEP ASL R0 ;NO, COMVERT SEGMENTS TO BLOX ADD #DIRBLK-2,R0 ;POINT TO ABSOLUTE BLOCK .READW 17,R1,#512. ;READ 2 BLOCKS BCS BADDIR ;OUCH ! CMP 4(R1),#37 ;SLIGHT LEGALITY TEST BHI BADDIR ;NO GO MOV DBLOCK,@BLKEY ;SET UP WHAT'S IN 1$: TST (R1)+ ;PUSH OVER HIGH MOV (R1)+,DBLOCK ;SAVE LINK TST (R1)+ MOV (R1)+,XTRABY ;EXTRA BYTES TST (R1)+ ;POINT TO FIRST ENTRY 2$: RETURN BADDIR: ERR DIER .SBTTL BUFFER ALLOCATION ROUTINE ; THIS ROUTINE IS CALLED TO GET BUFFERS FOR INPUT AND OUTPUT. ; IT GIVES ALL OF CORE TO BOTH INBUFF AND OUBUFF IF SWT.A IS OFF ; IT GIVES HALF OF CORE TO EACH IF SWT.A IS ON, BUT SWT.T IS OFF ; (SINCE TOPS-10 USES SELF-GOTTEN BUFFERS) ALCBUF: MOV R5,INBUFF ;INPUT BUFFER IS LOWER MOV R5,(PC)+ INBUFE: .WORD 0 MOV CORTOP,R0 ;TOP OF CORE IN R0 SUB R5,R0 ;COMPUTE AREA REMAINING BLO COROVR ;NONE ALREADY BIC #1777,R0 ;ROUND TO INTEGRAL # BLOX BEQ COROVR ;NOT ENOUGH ROOM FOR US TST SWT.A ;ASCII MODE? BEQ 1$ ; NO, GO DO UNIBUFFER ROR R0 ;HALVE CORE ADD R0,R5 ;BUMP BUFFER BY SIZE 1$: ADD R0,INBUFE ;FIX END POINTER MOV R5,OUBUFF ;SAVE POINTER ADD R0,R5 ;R5 IS NOW A TOP O' CORE PTR MOV R5,(PC)+ ;SAVE TOP OF OUTPUT BUFFER OUBUFE: .WORD 0 SWAB R0 ;MAKE SIZE A BLOCK COUNT ASR R0 MOV R0,BUFSIZ ;SAVE BUFFER SIZE RETURN ;LEAVE WITH BUFFERS SET UP COROVR: ERR COOV, .SBTTL EXPAND OUTPUT FILE NAME ; THIS ROUTINE EXPANDS OUTPUT FILE NAMES, SUBSTITUTING FOR STARS ; WHEN APPROPRIATE OEXPND: CMP @R5,#R50STAR ;IS PROTO FILNAM = * ? BEQ 2$ ;YES, GET INPUT NAME MOV (R5)+,(R4)+ ;NO, COPY FILENAME MOV (R5)+,(R4)+ CMP (R3)+,(R3)+ ;PUSH INPUT BR 3$ 2$: MOV (R3)+,(R4)+ BEQ 9$ ;NULL FILE NAME IS BADDIE MOV (R3)+,(R4)+ CMP (R5)+,(R5)+ 3$: MOV (R3)+,(R4)+ ;COPY INPUT EXTENSION CMP @R5,#R50STAR ;WAS * A GOOD GUESS ? BEQ 4$ ;YES MOV (R5)+,-2(R4) ;NO, COPY PROTO EXT 4$: RETURN 9$: ERR FINA, ;FIL NAM NULL STCHEK: TSTB R4 ;IS FILE NAME = * BNE 1$ CMP @R1,INFDB+2 ;NO, CHECK FOR MATCH BNE 3$ CMP 2(R1),INFDB+4 BNE 3$ 1$: TST R4 ;FILE NAME MATCHES. IS EXT = * ? BMI 2$ CMP 4(R1),INFDB+6 BNE 3$ 2$: SEZ ;RETURN EQUAL ON MATCH 3$: RETURN .SBTTL DOS EXPAND INPUT LIST ; THIS ROUTINE EXPANDS ANY *.* CONSTRUCTION FOR A DOS ; DEVICE. THE FORMAT OF THE 5-WORD SAVESTATUS BLOCK IS: ; ; WORD 1: BIT 15=0 IF LINKED, 1 IF CONTIG ; BITS 11-0 ARE THE DATE AS 1000*(YR-70)+DAY ; WORD 2: STARTING BLOCK NUMBER ON DEVICE ; WORD 3: NUMBER OF BLOCKS IN FILE (# IN USE IF CONTIG) ; WORD 4: LAST BLOCK NUMBER ; WORD 5: PROTECTION ; ; THE CALL IS A STANDARD ?.EXPA CALL: ; R1 -> BUFFER WITH [] STRING (BACKWARDS) ; R2 -> ASCII STRING OF FILNAM.EXT ENDED BY / = OR 0BYTE ; R3 -> 4 WORDS OF DEV:FILNAM.EXT IN RAD50 ; R4 HAS *.* FLAG (LOW BYTE, HIGH BYTE) ; R5 -> FREE CORE .ENABL LSB S.EXPA: CALL PPSCAN ;GET PROJECT/PROG IN R2 MOV @R5,R1 ;GET DSTATUS DECB R1 ;CHECK FOR RK (0) OR DT (1) BEQ 9$ ;DECTAPE IS ALWAYS OK BGT 90$ ;NON-RK IS ILLEGAL MOV SWT.Z,-(SP) ;AND IF WE ARE NOT ZEROING BIS SWT.D,(SP)+ ; NOR DELETING BNE 90$ ; THEN RK IS GOOD 9$: MOV R3,R2 ;PREPARE TO CALL INITIALIZER CALL S.INIT ;INITIALIZE DOS FORMAT CLR R2 ;INITIALIZE FILE NUMBER TO 0 TST SWT.Z ;IF WE WANT TO ZERO IT, JUST OPEN DEVICE BNE 30$ ; AND RETURN MOV R5,R3 ;SAVE POINTER TO STATUS BLOX TSTB R1 ;WAS THAT RIGHT? BMI 1$ ;IF DISK, GO GET MFD AND FIND UFD CALL S.DGET ;READ DIRECTORY, BMAP, R1-> DIR MOV (PC)+,R0 ;SET TO OVERFLOW AFTER 28. ENTRIES .BYTE 28.,28. TST (R1)+ ;ADVANCE TO GOOD DATA BR 6$ ;BEGIN SCAN 1$: MOV #1,S.BLOK ;RK BLOCK 1 LINKS TO MFD CALL S.RDLK ;GET POINTER IN 2$: MOV #63.,R1 ;63 PPN'S PER UFD BLOCK CALL S.RDLK ;GET THE UFD BLOCK BCC 4$ ;GOT IT. ENTER THE LOOP ERR NOUF, 3$: ADD #6,R0 ;GO TO NEXT UFD ENTRY DEC R1 ;ANY MORE ? BEQ 2$ ;NO, NEXT BLOCK 4$: CMP S.PPDF,(R0)+ ;IS THIS THE ONE ? BNE 3$ ;NO, KEEP TRUCKING MOV @R0,S.BLOK ;GOT IT. POINT TO STARTING BLOCK 5$: CALL S.RDLK ;NEXT UFD BLOCK FOR EXPANSION BCS 20$ ;NO MORE. GET OUT OF THIS MESS MOV R0,R1 ;R1 -> FILE ENTRIES MOV #28.,R0 ; (28. OF THEM) 6$: INC R2 ;BUMP FILE NUMBER TST @R1 ;ANY FILE IN THIS SLOT ? BEQ 7$ ;NO. IGNORE IT CALL STCHEK ;YES. DOES IT MATCH IN SPEC ? BEQ 10$ ;YES. WE GOT A HIT 7$: ADD #22,R1 ;NO MATCH. BUMP TO NEXT ENTRY 8$: DECB R0 ;ANY ENTRIES LEFT ? BNE 6$ ;YES SWAB R0 ;NO. DONE FIRST BLOCK OF DT? BEQ 5$ ;NO, LINK TO NEXT UFD BLOCK ADD #4*2,R1 ;YES, POINT TO REST OF DT UFD BR 6$ 10$: TST SWT.D ;ARE WE DELETING? BEQ 12$ ;NO, GO BUILD LIST IF INPUT EXPANSION MOV #9.,-(SP) ;CLEAR 9-WORD ENTRY 11$: CLR (R1)+ DEC @SP BNE 11$ TST (SP)+ ;PRUNE MOV R2,(R5)+ ;AND BUILD A LIST OF FILE NUMBERS BR 14$ 12$: MOV (R1)+,(R5)+ ;COPY FILNAM EXT MOV (R1)+,(R5)+ MOV (R1)+,(R5)+ MOV (R1)+,(R5)+ ;COPY CREATION DATE, TYPE TST (R1)+ ;BUMP OVER FOUL WORD MOV (R1)+,(R5)+ ;COPY START BLOCK # MOV (R1)+,(R5)+ ;COPY LENGTH TST -6(R5) ;MUST WE FIX UP CONTIG LENGTH? BPL 13$ ;NO, GO ON MOV @R1,-(R5) ;COPY END BLOCK NUMBER SUB -2(R5),@R5 ;SUBTRACT START BLOCK NO INC (R5)+ ;AND ADD ONE 13$: MOV (R1)+,(R5)+ ;COPY END BLOCK NUMBER MOV (R1)+,(R5)+ ;COPY PROTECTION 14$: TST R4 ;WERE WE EXPANDING ONLY ONE FILE? BNE 8$ ;STARS IN MY EYES, KEEP TRYING 20$: CLR (R5)+ ;SET END OF LIST 30$: RETURN 90$: ERR ILDE ;ILLEGAL DEVICE .DSABL LSB .SBTTL DOS LOOKUP (REOPEN) FILE S.LKUP: MOV R3,R2 ;COPY INPUT LIST POINTER TST (R2)+ ;LINKED OR CONTIG? BMI 1$ ;GO IF CONTIG MOV (R2)+,S.BLOK ;SET UP START BLOCK CLR @R2 ;FORCE READ ON ENTRY 1$: RETURN .SBTTL DOS READ INPUT FILE S.READ: MOV R3,R2 ;POINT TO FILE DATA TST (R2)+ ;LINKED OR CONTIG? BMI S.RCTG ;GO TO READ CONTIGUOUS MOV (R2)+,R0 ;GET POINTER INTO BUFFER BEQ 6$ ;0 POINTER => EOF TST @R2 ;WHICH DIRECTION WAS IT READ? BPL 5$ ;FORWARD BR 3$ 1$: MOV #-254.,@R2 ;SET FOR BUFFER LOAD 2$: MOV -(R0),(R4)+ ;MOVE A WORD CMP R4,R5 ;END OF BUFFER? BHIS 6$ ;YES, GO BACK TO WRITE 3$: INC @R2 ;ANY MORE HERE? BLE 2$ 4$: CALL S.RDLK ;READ LINKED BLOCK BCS 6$ ;RETURN IF END TST S.PBLK ;WHICH WAS WAS IT DONE? BMI 1$ ;GO IF WRITTEN BACKWARDS MOV #255.,@R2 ;SET UP COUNT 5$: DEC @R2 ;ANY MORE LEFT FORWARD? BMI 4$ MOV (R0)+,(R4)+ CMP R4,R5 BLO 5$ 6$: MOV R0,-(R2) ;SAVE POINTER FOR NEXT TIME RETURN S.RCTG: MOV (R2)+,R0 ;BLOCK NUMBER TO START READ MOV BUFSIZ,R5 ;NUMBER OF BLOCKS IN BUFFER SUB R5,@R2 ;DECREASE BLOCKS LEFT IN FILE BHIS 1$ ;OK, IT FITS ADD @R2,R5 ;RESET R5 TO BLOCK COUNT BEQ 2$ ;RETURN ERROR IF NONE LEFT CLR @R2 1$: ADD R5,-(R2) ;ADJUST NEXT START BLOCK SWAB R5 ;MAKE WORD COUNT .READW 0,R4,R5 ;READ BLOCK BCS 3$ ASL R5 ;COMPUTE TOP OF AREA ADD R5,R4 2$: RETURN ;RETURN (NOTE CLEAR CARRY) 3$: ERR INER ;HARD ERROR .SBTTL DOS OPEN OUTPUT DEVICE .ENABL LSB S.OPEN: DECB @R5 ;MUST BE DECTAPE BNE 91$ ; ELSE ILLEGAL CALL S.INIT ;INITIALIZE STUFF MOV S.BMAP,CORTOP ;ALLOW BIT MAP TO BE RESIDENT CALL S.DGET ;GET DIRECTORY INTO CORE MOV (PC)+,R0 ;CHECK 28 FILENAMES IN EACH BLOCK .BYTE 28.,28. TST (R1)+ ;ADVANCE TO FIRST NAME 1$: TST @R1 ;EMPTY DIR SLOT? BEQ 6$ ;YUP MOV R3,R2 ;R2 -> EXPANDED LIST 3$: MOV R1,R4 ;R4 -> NAME IN DIRECTORY CMP (R2)+,(R4)+ ;THIS EXPANDED NAME MATCH? BNE 5$ ;NO CMP (R2)+,(R4)+ BNE 4$ CMP @R2,@R4 BEQ 92$ ;ENTER ERROR, FILE ALREADY EXISTS 4$: TST -(R2) ;FIX PTR TO INPUT LIST 5$: ADD #16,R2 ;ADVANCE TO NEXT INPUT NAME TST @R2 ;END OF LIST? BNE 3$ ;NO 6$: ADD #22,R1 ;ADVANCE TO NEXT FILENAME IN DIR DECB R0 ;28 DONE YET? BNE 1$ ;NO SWAB R0 ;COUNT AGAIN BEQ 10$ ;DONE, NO ERROR, SO RETURN ADD #8.,R1 ;SKIP JUNK BETWEEN BLOCKS BR 1$ S.DGET: MOV S.DBUF,R1 ;POINT TO DIR BUFFER .READW 0,R1,#256.*3,#102 ;READ DOS DIRECTORY BCS 90$ ;ERROR 10$: RETURN 90$: ERR INER 92$: MOV #CMDBUF,R4 ;POINT TO BUFFER FOR FILE NAME MOVB #'?,(R4)+ ;START WITH QUERULOUS LOOK MOV R2,R3 ;GET POINTER TO FILE NAME CMP -(R3),-(R3) ;FIX IT CALL OUTFNM ;CONVERT FILE NAME MOVB #200,(R4)+ .PRINT #CMDBUF ;TELL HIM WHICH FILE .PRINT #EXISTS ;FINISH THE MESSAGE JMP START S.INIT: .FETCH R5,R2 ;INITIALIZE DOS. GET HANDLER INTO FREE CORE BCS 91$ ;NO GOOD MOV R0,R5 ;UPDATE TOP OF CORE MOV R0,S.BUFF ;ALLOCATE DOS BUFFER ADD #512.,R5 ;UPDATE FREE CORE MOV @R2,@R0 ;COPY DEVICE NAME CLR 2(R0) ;OPEN NON-FILE-STRUCTURED .LOOKU 0 ;OPEN ON CHANNEL 0 BCC 10$ ;RETURN IF NO ERROR 91$: ERR ILDE .DSABL LSB .SBTTL DOS ENTER OUTPUT FILE ; THIS ROUTINE ENTERS A FILE ON THE OUTPUT TAPE ; IT ASSUMES THAT THE DIRECTORY BLOCKS ARE IN CORE S.ENTE: JSR R1,SAVREG ;PRESERVE EVERYTHING CLR S.NBLK ;ZERO LENGTH SO FAR CLR S.BLOK ;TELL ALLOCATE NO TO WRITE MOV #100,R1 ;START LOOKING AT 100 CALL S.BAL2 ;GET INITIAL BLOCK NUMBER MOV (PC)+,R1 ;COUNT TWICE .BYTE 28.,28. MOV S.DBUF,R0 ;POINT TO DIRECTORY TST (R0)+ ;SKIP LINK MOV #S.FNUM,R4 ;COUNT FILE NUMBER CLR @R4 1$: INC @R4 ;NEXT SLOT TST @R0 ;USEFUL ? BEQ 2$ ;YES ADD #22,R0 ;NO, PUSH ON DECB R1 ;DONE HERE ? BNE 1$ ;NO ADD #8.,R0 ;ADVANCE TO NEXT BLOCK SWAB R1 ;GET ANOTHER COUNT BNE 1$ ;GO IF 2ND TIME ERR DEFU ;NO ROOM 2$: TST (R4)+ ;OVER FILE NUMBER MOV R0,(R4)+ ;SAVE SLOT PTR MOV #OUFDB+2,R5 ;POINT TO PROTOTYPE CALL OEXPND ;GET OUTPUT NAME MOV S.BLOK,S.FBLK ;SAVE STARTING BLOCK # RETURN ;DONE .SBTTL DOS ALLOCATE BLOCK IN OUTPUT FILE ; THIS ROUTINE RETURNS THE NEXT AVAILABLE BLOCK ON THE DOS ; OUTPUT TAPE IN R1. IT IS NEGATIVE IF TRANSFER ; SHOULD BE DONE BACKWARD. ; IF THE DEVICE IS FULL, AN ERROR IS ISSUED S.BALC: MOV S.BLOK,R1 ;GET THE MOST RECENT BLOCK NUMBER S.BAL2: CLR -(SP) ;PUT A CLEAN WORD ON THE STACK MOV #1,R0 ;R0 IS THE DIRECTION FLAG TST R1 ;WHICH WAY WERE WE GOING ? BPL 1$ ;FORWARD, BY JOVE NEG R1 ;GET ABSOLUTE BLOCK NUMBER NEG R0 ;AND REVERSE DIRECTION FLAG SUB #8.,R1 ;START AT 4 BELOW THIS 1$: ADD #4,R1 ;START AT 4 ABOVE THIS 12$: BMI 15$ ;BLOCK NUMBER TOO LOW. GO REVERSE CMP R1,#575. ;OFF HIGH END ? BGT 15$ ;YEP, TURN AROUND 11$: MOV R1,R2 ;TAKE BLOCK NUMBER BIC #177770,R2 ; MOD 8 MOVB BITTBL(R2),@SP ; AND GET A SHIFTED BIT MOV R1,R2 ;NOW GET BLOCK NUMBER ASR R2 ; MOD 8 ASR R2 ASR R2 ADD S.BMAP,R2 ;POINT TO THE MAP BYTE BITB @SP,@R2 ;IS IT FREE ? BEQ 20$ ;WE GOT ONE, WE GOT ONE ! ADD R0,R1 ;SHUCKS. MOVE BLOCK NUMBER BR 12$ ;AND KEEP LOOKING 15$: MOV #575.,R1 ;TRY STARTING AT THE TOP NEG R0 ;AND REVERSE DIRECTION BMI 16$ ;AH, BUT IF WE TURN FORWARD MOV R0,R1 ; THEN START AT BLOCK 1 16$: COM @SP ;DID WE ALREADY FLIP TWICE ? BMI 11$ ;NO, IT IS OK ERR DEFU ;DEVICE FULL ! 20$: BISB (SP)+,@R2 ;MARK BLOCK IN USE MOV S.BUFF,R2 ;POINT TO OUTPUT BUFFER TST (R2)+ ;SAVE FIRST DATA WD PTR MOV R2,S.BPTR MOV #256.,S.BCTR ;COUNT OF 256 TST R0 ;WHICH DIRECTION WAS THAT ? BGT 21$ ;GOOD IF POSITIVE NEG S.BCTR ;MARK BACKWARDS IN NEXT LOAD ADD #254.*2,S.BPTR ;START AT TOP NEG R1 ;GIVE HIM A NEGATIVE NUMBER 21$: INC S.NBLK ;BUMP NUMBER OF BLOX IN FILE S.FLSH: MOV S.BUFF,R2 ;POINT TO DATA BUFFER MOV S.BLOK,R0 ;BLOCK # TO WRITE BEQ 33$ ;0 => INITIALIZATION BPL 31$ ;FORWARD MOV R1,255.*2(R2) ;REVERSE. SET LINK WORD AT TOP NEG R0 ;ABSOLUTE BLOCK BR 32$ 31$: MOV R1,@R2 ;FORWARD. SET LINK AT BOTTOM 32$: .WRITW 0,R2,#256. ;WRITE 1 BLOCK BCS S.OUE1 ;OUT ERROR 33$: MOV R1,S.BLOK ;SAVE NEXT BLOCK TO GO MOV #256.,R1 ;COUNT TO CLEAR 34$: CLR (R2)+ DEC R1 BNE 34$ RETURN BITTBL: .BYTE 1,2,4,10,20,40,100,200 .SBTTL DOS WRITE OUTPUT BUFFER .ENABL LSB 1$: CALL S.BALC ;LINK TO NEXT BUFFER, DUMP THIS ONE S.WRIT: MOV S.BPTR,R1 ;POINT TO OUTPUT STUFF MOV S.BCTR,R2 ;NUMBER OF WDS LEFT BMI 20$ ;GO IF BACKWARDS 10$: CMP R4,R5 ;DONE ? BHIS 30$ ;YEP DEC R2 ;ROOM ? BEQ 1$ ;NO, ALLOCATE & TRY AGAIN MOV (R4)+,(R1)+ ;MOVE WORD IN BR 10$ 21$: INC R2 ;ROOM ? BEQ 1$ ;NO MOV (R4)+,-(R1) ;PUT IN A WORD 20$: CMP R4,R5 ;REVERSE. DONE ? BLO 21$ ;NOPE 30$: MOV R1,S.BPTR ;SAVE POINTER MOV R2,S.BCTR ;SAVE COUNT (NEVER 0!) RETURN .DSABL LSB S.CLOS: MOV S.BLOK,-(SP) ;SAVE LAST BLOCK CLR R1 ;DONE. LINK IS 0 (I.E. END) CALL S.FLSH ;FLUSH OUT BUFFER MOV (SP)+,S.LBLK ;SET LAST BLOCK NO. MOV R3,-(SP) ;SAVE R3 MOV #S.FNUM,R3 ;POINT TO DIRECTORY STUFF MOV (R3)+,R0 ;R0 = FILE NUMBER CALL GETMAP ;GET THE FILE MAP MOV R0,-(SP) ;SAVE MAP POINTER MOV S.BMAP,R1 ;POINT TO PERM. MAP MOV (PC)+,R2 ;GET COUNTER(S) .BYTE 36.,36. ;36 WDS/MAP 41$: MOV (R1)+,(R0)+ ;MOVE PBM INTO FBM DECB R2 BNE 41$ CALL S.DGET ;GET OLD DIRECTORY STUFF MOV (SP)+,R0 ;POINT TO FBM AGAIN MOV S.BMAP,R1 ;POINT TO PBM (OLD) SWAB R2 ;COUNT 42$: BIC @R1,@R0 ;MAKE FBM HAVE ONLY NEW BITS BIS (R0)+,(R1)+ ;MAKE PBM HAVE ALL BITS DEC R2 BNE 42$ .WRITW 0,S.BUFF,#256.,S.BLOK ;PUT OUT FBM BCS S.OUE1 ;OUTPUT ERROR MOV (R3)+,R1 ;POINT TO DIR SLOT MOV #9.,R2 ;9 WD ENTRY 43$: MOV (R3)+,(R1)+ DEC R2 BNE 43$ CALL S.DPUT ;REWRITE DIRECTORY MOV (SP)+,R3 ;RESTORE R3 RETURN S.OUE1: ERR OUER .SBTTL DOS DIRECTORY LIST LINE S.DIR: MOV @R3,R0 ;GET DATE WORD, CONTIG FLAG BPL 1$ ;SKIP IF CONTIG MOV #'C,CONTIG ;SET OUTPUT FLAG 1$: BIC #100000,R0 ;ISOLATE DATE JSR R5,DIVIDE ;DIVIDE BY 1000. .WORD 1000. ;GIVING YR-70 IN R0, DAY IN R1 ADD #6,R0 ;CONVERT TO YR-64 MOV #LFEB,R2 ;PREPARE TO FIX FEB MOVB #28.,@R2 ;FEBRUARY HAS 28 DAYS BIT #3,R0 ; EXCEPT ON LEAP YEAR BNE 2$ ; WHEN IT HAS INCB @R2 ; TWNWTY-NINE 2$: DEC R2 ;POINT TO MONTH SIZES CLR -(SP) ;FOR FULLWORD ARITH 3$: ADD #2000,R0 ;INCREMENT MONTH FOR RT-11 MOVB (R2)+,@SP ;PUT ON STACK TO EXTEND TO WORD SUB @SP,R1 ;TAKE OUT MONTH SIZE BGT 3$ ;CONTINUE IF NOT <= 0 ADD (SP)+,R1 4$: ADD #40,R0 ;DO DIDDLE LOOP TO SET DAY DEC R1 BGT 4$ RETURN .NLIST BEX LFEB=.+1 .RADIX 10 LMONTH: .BYTE 31,28,31,30,31,30,31,31,30,31,30,31 .RADIX 8 .EVEN .LIST BEX .SBTTL DOS ZERO DIRECTORY ; THIS ROUTINE ZEROS A DECTAPE DIRECTORY IN DOS FORMAT ; IT CLEARS THE FILE BITMAP BLOCKS IN 70-77, ; AND WRITES A PROTOTYPE MFD CONTAINING ONE ENTRY (CURRENT PPN) ; IT CLEARS THE UFD AND PROPERLY INITILAIZES THE MASTER BIT MAP S.ZERO: CALL XPANDI ;GO THROUGH EXPAND TO OPEN FILE .QSET R5,#2 ;GIVE US SOME QUEUE SPACE MOV R0,R5 ;NEW AVAIL CORE ADD #256.*2,R5 ;TOP OF PROTOTYPE BIT MAP MOV (PC)+,R1 ;NUMBER OF WORDS TO SET TO -1 .BYTE 256.-4.-36.,35. ;COUNT OF -1 SET, 0 SET 1$: MOV #-1,-(R5) DECB R1 BNE 1$ SWAB R1 ;NUMBER OF WORDS TO CLEAR (UNUSED BLOCKS) 2$: CLR -(R5) DEC R1 BNE 2$ MOV #S.ZFMT,R1 ;POINT TO FORMATTED AREA 3$: MOV (R1)+,-(R5) ;PLACE THE START OF THE BIT MAP IN BNE 3$ ;CONVENIENTLY WORD 0 IS 0 COMB 17(R5) ;SAY THE FILE BIT MAPS ARE IN USE MOV #37,20(R5) ;AS ARE MFD0/1, UFD0/1, AND MASTER MAP MOV #70,R3 ;BEGIN WRITING BLOCK 70 MOV #10,R4 ;CLEAR EIGHT FILE MAP BLOCKS MOV (R1)+,R2 ;GET WORD COUNT, POINT TO DATA 4$: .WRITE 0,R1,R2,R3 ;R1->DATA R2=WORD COUNT R3=BLOCK BCS S.OUE1 ;OUTPUT ERROR INC R3 ;NEXT BLOCK DEC R4 ;DO THIS AGAIN? BGT 4$ ;GO IF STILL CLEARING ASL R2 ;DOUBLE WORD COUNT ADD R2,R1 ;BUMP BUFFER POINTER MOV (R1)+,R2 ;GET NEW WORD COUNT BNE 4$ ;GO IF END OF LIST .WRITE 0,R5,#256.,R3 ;WRITE OUT THE BIT MAP BCS S.OUE1 ;OUTPUT ERROR .WAIT 0 ;LET IT RUN TO COMPLETION BCS S.OUE1 ;OUTPUT ERROR RETURN ;EXIT LAUGHING .SBTTL DOS DELETE FILES FROM TAPE ; THIS ROUTINE DELETES FILES FROM A DOS DECTAPE ; R5 HAS AVAIL CORE WHEN CALLED ; IT EXPANDS THE INPUT LIST, DELETING FILES ENTRIES IN THAT ROUTINE ; THE UFD BLOCKS AND THE MASTER BIT MAP ARE KEPT IN CORE AS ; THE INDIVIDUAL FILE MAPS ARE READ AND USED TO CLEAR THE MASTER S.DELE: MOV (R3)+,R0 ;GET FILE NUMBER BEQ S.RTS2 ;NO FILES FOUND, GO HOME CALL GETMAP ;GET MAP IN CORE, POINT R0 TO IT MOV #36.,R2 ;36 WORD ENTRIES MOV S.BMAP,R1 ;POINT TO MASTER MAP 2$: BIC (R0)+,(R1)+ DEC R2 BNE 2$ TST @R3 ;ANY MORE FILES TO DO? BNE S.DELE ;AYE S.DPUT: .WRITW 0,S.DBUF,#256.*3,#102 ;OUTPUT THE UFD AND MASTER MAP BCS S.OUE1 ;OUTPUT ERROR S.RTS2: RETURN ; GETMAP GETS THE BLOCK WITH THE FILE'S MAP INTO S.BUFF AREA AND ; POINTS R0 TO THE PROPER ENTRY GETMAP: MOV R0,-(SP) ;HOLD ONTO NUMBER MOV #67,R0 ;ONE TOO LOW FOR PSEUDO-DIVIDE DEC @SP ;MAKE BLOCK INTO PROPER RANGE 1$: INC R0 ;NEXT BLOCK SUB #7,@SP ; CONTAINS SEVEN MAPS BPL 1$ ; NONE OF WHICH WE WANT ADD #7,@SP ;@SP NOW HAS RELATIVE FILE IN MAP CMP R0,S.BLOK ;IS THE MAP BLOCK ALREADY IN CORE? BEQ 2$ ;YUP MOV R0,S.BLOK ;NOW IT IS CALL S.RD1 ;GO READ ONE BLOCK 2$: MOV S.BUFF,R0 ;POINT TO MAP BLOCK 3$: DEC @SP ;COUNT DOWN ENTRIES BMI 4$ ADD #36.*2,R0 ;AS WE COUNT UP MAPS BR 3$ 4$: TST (SP)+ ;PRUNE RETURN S.RD1: .READW 0,S.BUFF,#256. ;READ ONE BLOCK WHOSE # IS IN R0 BCC S.RTS2 ;RETURN IF SUCCESSFUL ERR INER ;INPUT ERROR .SBTTL DOS READ NEXT LINKED BLOCK, PPSCAN ; ROUTINE TO READ THE NEXT BLOCK OF A LINKED DOS FILE ; IT SETS S.BLOK FOR THE NEXT READ, AND LEAVES R0 ; POINTING CORRECTLY ACCORDING TO THE DIRECTION READ S.RDLK: MOV R1,-(SP) ;SAVE A REG MOV #S.BLOK,R1 ;POINT MOV (R1)+,R0 ;R0 = S.BLOK MOV R0,(R1)+ ;SAVE AS PREVIOUS BLOCK SEC BEQ 3$ ;RETURN CARRY SET IF END BPL 1$ NEG R0 1$: CALL S.RD1 ;READ 1 BLOCK MOV @R1,R0 ;POINT TO BUFFER LOAD TST -(R1) ;CHECK DIRECTION BMI 4$ MOV (R0)+,-(R1) ;SAVE NEXT BLOCK NUMBER BR 5$ 4$: ADD #512.,R0 MOV -(R0),-(R1) 5$: CLC 3$: MOV (SP)+,R1 ;RESTORE R1 RETURN PPSCAN: TSTB -1(R1) ;ANYTHING THERE? BEQ 1$ ;NO, RETURN 0 CALL OCTBIN ;CONVERT SOME CMPB @R1,#054 ;IS IT A COMMA? BNE 90$ SWAB R0 ;PUT IN TOP HALF BNE 90$ MOV R0,-(SP) ;SAVE IT CALL OCTBIN TSTB @R1 ;DID WE END RIGHT? BNE 90$ BIS R0,@SP ;SET THE NUMBER TOGETHER SWAB R0 ;WAS IT IN RANGE ? BNE 90$ ;NO MOV (SP)+,S.PPDF ;SAVE AS NEW DEFAULT 1$: RETURN 90$: ERR BAPP, ;BAD PPN OCTBIN: CLR -(SP) ;CONVERT OCTAL NUMBER TO BINARY 1$: MOVB -(R1),R0 ;GET NEXT BYTE SUB #'8,R0 ;CHECK RANGE ADD #8.,R0 BCC 2$ ;OUT OF RANGE ASL @SP ASL @SP ASL @SP BIS R0,@SP BR 1$ 2$: MOV (SP)+,R0 RETURN .SBTTL TOPS-10 FILE NAME SCAN UTILITY ; THIS ROUTINE SCANS AN ASCII STRING AND CONVERTS IT TO ; A SIXBIT FILE NAME IN FILNM ; ON ENTRY, R2 -> STRING ; USES ALL REGS T.SCAN: JSR R1,SAVREG ;SAVE REGISTERS MOV #6,R4 ;GET A HANDY CONSTANT MOV R4,R0 ;6 WORD BLOCK MOV #FILNM+12.,R1 ;CLEAR BLOCK 1$: CLR -(R1) DEC R0 BNE 1$ 2$: MOV R4,R3 ;6 CHAR. NAME 3$: MOV R4,R0 ;6 BIT SHIFT CALL SHIFT1 SUB R4,R1 ;REPOINT TO LOW BYTE CALL CKDEL ;CHECK FOR DELIMITER BEQ 4$ MOVB (R2)+,R5 ;GET THE BYTE ADD #40,R5 ;CONVERT TO SIXBIT BIC #177700,R5 ;CLEAN IT UP BIS R5,@R1 ;STUFF IT UP 4$: DEC R3 ;6 CHARS YET? BNE 3$ CALL CKDEL ;CHECK FOR DELIM. BNE FNERR ;NONE => NAME ERROR BCS RTSPC ;NO . => DONE! INC R2 ;PUSH PAST . CMP #FILNM,R1 ;JUST FINISHED FILNAM BNE FNERR ADD R4,R1 ;POINT TO EXTENSION BR 2$ RTSPC: RETURN FNERR: ERR FINA ;FILE NAME ILL FORMED FILNM: .BLKW 6 CKDEL: CMPB @R2,#'. ;CHECK DELIMITER BEQ 2$ CMPB @R2,#'/ BEQ 1$ CMPB @R2,#'= BEQ 1$ TSTB @R2 1$: SEC 2$: RETURN .SBTTL TOPS-10 DIRECTORY SEARCH UTILITY ; THIS ROUTINE LOOKS UP THE 6BIT FILE NAME IN FILNM ; IN THE PDP-10 DIRECTORY ; ARGUMENTS - R4 MUST CONTAIN A *.* FLAG WORD ; RETURNS R1 POINTING TO THE FILE NAME DIRECTORY ENTRY ; R2 CONTAINING THE FILE NUMBER ; WHEN CALLED AT T.NXL, LOOK UP NEXT MATCHING ENTRY ; HERE, R1 AND R2 MUST CONTAIN PREVIOUS MATCH VALUES ; NO MATCH RETURNS WITH CARRY SET T.LOOK: MOV (PC)+,R1 ;POINT TO DIRECTORY T.DBUF: .WORD 0 ADD #82.*6,R1 ;MOVE TO FILE NAMES CLR R2 ;CLEAR FILE NUMBER T.LK1: INC R2 ;NEXT FILE ADD #6,R1 MOV R1,-(SP) ;HOLD ON FOR A MINUTE MOV (R1)+,R0 ;CHECK FOR 0 FILE NAME BY OR-ING BITS BIS (R1)+,R0 BIS (R1)+,R0 BEQ T.NXL1 ;0 => FILE SLOT EMPTY MOV #FILNM,R0 ;POINT TO PROTOTYPE TSTB R4 ;IS THE FILE NAME * ? BNE T.LK2 ;YES, ASSUME MATCH CMP -(R1),(R0)+ ;3 WORD MATCH BNE T.NXL1 CMP -(R1),(R0)+ BNE T.NXL1 CMP -(R1),(R0)+ BEQ T.LK3 ;GO IF FILE NAME MATCHES T.NXL1: MOV (SP)+,R1 ;RESTORE FILE POINTER T.NXL: CMP #21.,R2 ;END OF DIRECTORY ? BHIS T.LK1 ;NO, TRY AGAIN MATCH: RETURN ;RETURN, MAYBE WITH CARRY SET T.LK2: ADD #6,R0 ;FILE WAS *, SO BUMP PROTOTYPE PTR T.LK3: MOV (SP)+,R1 ;FILNAM MATCHES, RESTORE PTR TST R4 ;IS THE EXTENSION * ? BMI MATCH ;YEAH, GOT IT MOV 22.*6+2(R1),@R0 ;GET MOST OF THE BITS BIC #3,@R0 ;CLEAR JUNK CMP (R0)+,(R0)+ ;MATCH ? BNE T.NXL ;BAH, NO GOOD CMP 22.*6(R1),@R0 ;4 MORE BITS OK ? BEQ MATCH BR T.NXL ;TRY AGAIN .SBTTL TOPS-10 EXPAND INPUT LIST ; THIS ROUTINE IS CALLED FROM THE MAIN DRIVER TO EXPAND *.* ; CONSTRUCTIONS AND TO LOOK UP IN THE DIRECTORY. ; IT ALLOCATES BUFFERS AND CREATES IN-CORE BLOCKS FOR EACH FILE ; INPUT:R5 -> AVAILABLE CORE (1ST WORD IS DSTATUS) ; R4 = *.* FLAG (LOW BYTE NON-0 IS FILNAM, R4 < 0 IS EXT) ; R3 -> 4 WORDS : RAD50 OF DEV FIL NAM EXT ; R2 -> FILE NAME STRING IN ASCII, TERMINATED BY / OR 0 ;,OUTPUT:R5 -> NEXT AVAILABLE CORE LOCATION ; R3 -> FILE NAME BLOCKS ; SAVBLK= BLOCK # ON TAPE WHERE FILE MIGHT START ; FILE NUMBER (1 TO 21.) ; SIZE ESTIMATE ; DATE (TOP 4 BITS JUNK) ; (UNUSED) T.EXPA: CMP @R5,#100001 ;IS THIS A DECTAPE? BNE ILLDEV ;IF NOT, DEVICE NOT SUPPORTED MOV (R3)+,R1 ;GET DEVICE NAME SUB (PC)+,R1 ;IS IT MERELY DT .RAD50 /DT / BEQ 10$ ;GOT NUMBER IF SO SUB (PC)+,R1 ;GET DEVICE NUMBER .RAD50 / 0/ BMI ILLDEV CMP R1,#7 BHI ILLDEV 10$: MOVB R1,T.UNIT ;ALL THAT FOR A LOUSY BYTE MOV R5,T.DBUF ;WE JUST ALLOCATED A DIR. BUFFER MOV R5,T.BUFF ;WE WANT TO READ INTO IT MOV SP,FULLIO ;FORCE READING OF ALL BITS MOV #100.,R0 ;BLOCK 100 IS THE DIRECTORY CALL T.RDTP ADD #128.*6,R5 ;FREE CORE BUMPED OVER DIR MOV R5,R3 ;SAVE DESCRIPTORS PTR CALL T.SCAN ;CONVERT FILE NAME TO 6BIT CALL T.LOOK ;GO LOOK UP THE FILE NAME BCS T.ENEX ;NONE, GO EXIT 1$: MOV #6,-(SP) ;PUSH A COUNTER JSR R0,BYTSET ;SET BYTE GETTER TO FILE OR EXT .WORD 6 ;6 BIT BYTES 3$: CALL GETBYT ;GET A BYTE ADD #40,R0 ;6BIT CONVERSION CALL R50PAK ;PACK UP IN RADIX 50 DEC @SP ;COUNT DOWN BVS 5$ ;OVERFLOW MEANS DONE EXT BNE 3$ ;NON-0 MEANS MORE FILE NAME MOV #100002,@SP ;SET 3 BYTES FOR EXT ADD #21.*6,BUFPTR ;MAKE BYTE GETTER GET EXTENSION BR 3$ ;GET EXTENSION 5$: MOV R1,@SP ;NOW SAVE R1 FOR NEXT T.LOOK MOV BUFPTR,R0 ;WE NOW GET THE DATE WORD MOV -(R0),-(SP) ;AND SAVE IT ON THE STACK MOV T.DBUF,DPOINT ;INITIALIZE SLOT SCANNER MOV #100.,R0 ;START AT SLOT 100 JSR R5,DEXPLD ;EXPLODE FIRST WORD .WORD 14.*6,6 6$: JSR R5,DSLOT ;GET A SLOT BCS ERRDIR ;NOT FOUND ERROR CMPB R2,@R1 ;IS THIS THE FILE BNE 6$ MOV R0,(R5)+ ;SAVE TAPE BLOCK # MOV R2,(R5)+ ;SAVE FILE NUMBER CLR @R5 ;COUNT # BLOCKS FOR ESTIMATE 7$: CMPB R2,@R1 ;COUNT MATCHES BNE 8$ ;NO HIT INC @R5 ;HIT 8$: JSR R5,DSLOT ;NEXT TRY BCC 7$ ;CONTINUE IF GOT TST SWT.I ;IMAGE XFER? BNE 9$ ;YES.127BY/BLK=> EST BLK+3/4 TST SWT.A ;IS IT ASCII? BEQ 11$ ;MUST BE PACKED MOV @R5,-(SP) ;ESTIMATE #*10+7/8 ASL @R5 ASL @R5 ADD (SP)+,@R5 9$: ADD #3,@R5 ASR @R5 ASR @R5 11$: TST (R5)+ ;MOVE PAST SIZE MOV (SP)+,(R5)+ ;RETRIEVE & STORE DATE TST (R5)+ MOV (SP)+,R1 ;RESTORE POINTER CALL T.NXL ;AND FIND OTHER MATCHES BCC 1$ ;GOT ONE. GO BACK T.ENEX: CLR (R5)+ ;MARK END OF LIST MOV R5,T.BUFF ;MAKE A DATA BUFFER ADD #514.,R5 ;ALLOCATE BUFFER SIZE MOV SWT.A,FULLIO ;SET WHETHER WE WANT ALL BITS BEQ 12$ ;NO ASCII MEANS PARTIAL READ ADD #254.,R5 ;ASCII => 128.*6 BYTES 12$: RETURN ILLDEV: ERR ILDE ;ILLEGAL DEVICE TYPE ERRDIR: ERR DIER, ;DIRECTORY ERROR .SBTTL TOPS-10 READ BUFFER LOAD (IMAGE OR PACKED) ; THIS ROUTINE READS AS MANY 10 BLOCKS AS NEEDED TO FILL ; THE OUTPUT BUFFER T.RNX: CALL T.LINK ;LINK TO NEXT BLOCK BCC T.READ ;PROCESS IF PRESENT BIT #1,R4 ;DON'T LEAVE HIM ODD BEQ 1$ BICB @R4,(R4)+ ;SNEAKY WAY TO LEAVE CARRY ON 1$: RETURN T.READ: MOV BUFPTR,R0 ;GET POINTER INTO BUFFER ADD CPYMOD,PC ;GO TO CORRECT MODE ROUTINE BR 1$ ;NO MODE = PACKED BR T.RDAS ;ASCII = 2 BR T.RDIM ;IMAGE = 4 ; BR 1$ ;PACKED = 6 1$: DEC BYTCTR ;DECREMENT GENERAL COUNTER BMI T.RNX ;NO MORE, TRY TO READ MOV (R0)+,(R4)+ ;MOVE IN A WORD CMP R4,R5 ;TOP OF BUFFER YET? BLO 1$ T.REX: MOV R0,BUFPTR ;SAVE WHERE WE STOPPED RETURN ;NOTE NON-LO IS CLEAR CARRY ; READ IMAGE MODE, ONE BYTE OUT OF EACH FOUR T.RDIM: DEC BYTCTR ;COUNT IT DOWN BMI T.RNX ;CONTINUE IF NONE TST (R0)+ ;SKIP BAD STUFF MOVB (R0)+,(R4)+ INC R0 CMP R4,R5 ;ARE WE DONE? BLO T.RDIM ;NO, CONTINUE BR T.REX ;YES, RETURN ; READ ASCII MODE, 5 7-BIT BYTES PER WORD T.RDAS: DEC BYTCTR ;ANY MORE ? BMI T.RNX ;NO, TRY FOR ANOTHER BLOCK CALL GETBYT ;GET A BYTE MOVB R0,(R4)+ CMP R4,R5 BLO T.RDAS RETURN .SBTTL TOPS-10 DIRECTORY LIST LINE T.DIR: MOV 6(R3),R0 ;GET DATE IN R0 BIC #170000,R0 ;ISOLATE GOOD BITS CLR -(SP) ;CLEAR DATE ASSEMBLY WORD ; NOTE DATE IS IN FORMAT ((Y-64)*12.+M-1)*31.+D-1 JSR R5,DIVIDE .WORD 31. 1$: ADD #40,@SP ;CONVERT REMAINDER TO RT-11 DAY DEC R1 BPL 1$ JSR R5,DIVIDE .WORD 12. 2$: ADD #2000,@SP DEC R1 BPL 2$ ADD (SP)+,R0 RETURN .SBTTL TOPS-10 LOOKUP (REOPEN) FILE ; LOOKS UP FILE, GETS FIRST BLOCK IN CORE ; R3 -> EXPANDED INPUT LIST ; ALSO SETS BYTCTR TO CORRECT NUMBER OF ITEMS IN BLOCK ; ACCORDING TO THE MODE OF THE TRANSFER ; DESTROYS R0,R1 T.LKUP: MOV @R3,R0 ;RETRIEVE BLOCK NUMBER MOV R0,-(SP) ;SAVE THE NUMBER CALL T.RDTP ;GET THE BLOCK IN MOV R0,R1 ;POINTER TO INPUT BUFFER TST (R1)+ ;ASSEMBLE LINK TO 1ST BLOCK MOV (R1)+,R0 ;2 BITS HERE SWAB R0 BIC #176377,R0 BISB 1(R1),R0 ;FIRST BLOCK NO IN R0 CMP R0,(SP)+ ;DID WE HIT? BEQ T.SETU ;YEAH, JUST SET UP READ T.NXRD: CALL T.RDTP ;READ THE BLOCK INTO CORE T.SETU: MOVB (R1)+,R0 ;GET WORDS USED INC R1 ;ADVANCE TO GOOD DATA JSR R0,BYTSET ;SET POINTER .WORD 7 ;7 BIT BYTES TST SWT.I ;THAT'S IT IF IMAGE MODE BNE 2$ MOV R0,-(SP) TST SWT.A ;IF ASCII THEN *5, ELSE *2 BEQ 1$ ASL R0 ASL R0 1$: ADD (SP)+,R0 ;WHICH IS WHAT WE DID 2$: MOV R0,(PC)+ ;SET GENERAL PURPOSE CTR BYTCTR: .WORD 0 RETURN ;EXIT ; CALL T.LINK TO ASSEMBLE FORWARD LINK AND READ NEXT FILE BLOCK ; RETURNS WITH CARRY SET FOR END-OF-FILE T.LINK: MOV T.BUFF,R1 ;POINT TO INPUT BUFFER TST (R1)+ ;ADVANCE TO LINK FIELD MOV (R1)+,R0 ;GET FORWARD LINK ASR R0 ASR R0 BNE T.NXRD ;AND IF NOT 0, GO READ IT SEC ;ELSE SET CARRY FOR FAILURE RETURN ;AND EXIT .SBTTL TOPS-10 DIRECTORY SLOT SCANNER ; THIS ROUTINE WILL SCAN THE SLOTS IN THE DIRECTORY ; FROM 99 TO 1 AND THEN FROM 101 TO 577. ; IT RETURNS THE ASSOCIATED BLOCK # IN R0, AND A POINTER ; TO A BYTE CONTAINING THE FILE ID IN R1 DSLOT: MOV (PC)+,R1 ;SET POINTER TO EXPLODED BYTE DIRPTR: .WORD 0 MOV (PC)+,R0 BLOCKN: .WORD 0 ;LAST BLOCK EXAMINED CMP R0,#100. ;BACKWARDS OR FORWARDS? BLOS 4$ ;BACK TO THE SHADOWS CMP #576.,R0 ;DID WE JUST GIVE HIM 577? BLO 3$ ;IF SO, RETURN WITH CARRY SET INC R0 ;BUMP BLOCK # INC R1 ;NEXT SLOT FORWARD TSTB @R1 ;END OF EXPLODED WORD? BPL DRTS5 ;NO, BUMP AND RETURN JSR R5,DEXPLD ;GO EXPLODE ANOTHER WORD .WORD 6.,7 ;AND RESCAN FROM END-7 = 1ST BYTE 3$: RTS R5 ;RETURN 4$: DEC R0 ;BACKWARDS - DECREMENT BLOCK # BNE 5$ ;DID WE RUN INTO BLOCK 0? MOV #101.,R0 ;START UPWARD AT 101 JSR R5,DEXPLD ;EXPLODE WORD 14 .WORD 14.*6,5 RTS R5 5$: TSTB -(R1) ;ARE THERE BYTES LEFT HERE? BPL DRTS5 ;OK, JUST RETURN JSR R5,DEXPLD ;GO EXPLODE A WORD .WORD -6,1 ;ONE LOWER, START AT END RTS R5 DEXPLD: ADD (R5)+,(PC)+ ;MOV BUFFER POINTER DPOINT: .WORD 0 MOV DPOINT,R1 ;PREPARE FOR BYTER JSR R0,BYTSET ;SET BYTE GETTER .WORD 5 ;5 BIT BYTES MOV R0,-(SP) ;SAVE WORD MOV #DEXBUF+1,R1 ;POINT TO EXPLOSION SITE 1$: CALL GETBYT ;GET A BYTE MOVB R0,(R1)+ ;PLACE IT TSTB @R1 ;BUFFER FULL? BPL 1$ ;GET MORE IF NOT SUB (R5)+,R1 ;REPOINT TO STARTING BYTE (AND CLEAR CARRY) MOV (SP)+,R0 ;RESTORE R0 DRTS5: MOV R0,BLOCKN ;SET CURRENT BLOCK MOV R1,DIRPTR ;REMEMBER WHERE TO CONT. RTS R5 ;GO HOME DEXBUF: .BYTE -1,0,0,0,0,0,0,0,-1 .EVEN .SBTTL GETBYTE AND SHIFT ROUTINES ; BYTSET IS CALLED TO INITIALIZE GETBYT ; R1 MUST POINT TO THE WORD IN WHICH BYTES ARE STORED ; THE WORD AFTER THE JSR R0 MUST CONTAIN THE BYTE SIZE BYTSET: MOV R1,BUFPTR ;SET POINTER TO WORD CLR BITCTR ;FORCE A WORD FETCH CLR R50CTR ;IT'S USEFUL HERE. MOV (R0)+,BYTSIZ RTS R0 ; GETBYT RETURNS BYTES IN R0. (OTHER REGS PRESERVED) ; IF NOT ENOUGH BYTES REMAIN IN THE CURRENT WORD, ; THE BUFFER POINTER IS ADVANCED. ; WARNING - IT NEVER GIVES AN ERROR. THE CALLER ; MUST COUNT. GETBYT: MOV R1,-(SP) ;SAVE REGISTER MOV #BYTSIZ,R1 ;PREPARE TO COUNT DOWN BITS GETBY1: MOV @R1,R0 ;HOLD ON TO BYTE SIZE SUB R0,-(R1) ;SUBTRACT BYTE SIZE FROM BIT CTR BPL GETBY2 ;GO IF THERE ARE BITS LEFT MOV (PC)+,R0 ;R0 POINTS INTO DATA BUFFER BUFPTR: .WORD 0 MOV (R0)+,-(R1) MOV (R0)+,-(R1) MOV (R0)+,-(R1) MOV R0,BUFPTR MOV #4,R0 ;PRENORMALIZE BY 4 BITS CALL SHIFT1 ;GO DO IT (R1 ALREADY POINTS TO BOTTOM) MOV #36.,(R1)+ ;RESET COUNTER BR GETBY1 GETBY2: MOV #RTS1,-(SP) ;SET UP RETURN FUDGE ; SHIFT SHIFTS A THREE WORD ENTITY LEFTWARD ; THE THING IS ASSUMED TO BE BACKWARD IN CORE WORDWISE. ; R0 MUST CONTAIN THE SHIFT COUNT, R1 POINT TO THE WORD ; PAST THE END OF THE ENTITY. ; THE BYTE SHIFTED OUT INTO THE ENDMOST POSITION IS RETURNED ; IN R0. ; R1 IS LEFT POINTING TO THE END OF THE BUFFER SHIFT: SUB #6,R1 ;POINT TO LOW ORDER BITS SHIFT1: ASL (R1)+ ROL (R1)+ ROL (R1)+ DEC R0 ;SHIFTED ENOUGH YET? BNE SHIFT BISB -(R1),R0 ;R0 IS 0. GET THE BYTE CLRB (R1)+ ;CLEAR IT FOR NEXT TIME RETURN BYTBUF: .BLKW 3 BITCTR: .WORD 0 BYTSIZ: .WORD 0 .SBTTL RADIX 50 PACKER ; PACKS CHARACTERS INTO @R5, 3 PER WORD ; CALLED WITH CHARACTER IN R0, WHICH IT DESTROYS R50PAK: DEC (PC)+ ;COUNT DOWN FROM 3 R50CTR: .WORD 0 BGT 1$ ;SPACE LEFT, SO GO *50 CLR (R5)+ ;CLEAR THE NEXT WORD MOV #3,R50CTR ;RESET COUNT 1$: SUB #72,R0 ;CHECK FOR DIGIT ADD #12,R0 BCC 2$ ;NO, GO TRY FOR LETTER ADD #36,R0 ;SCALE DIGIT BR 4$ 2$: SUB #20,R0 ;REDUCE TO LETTER RANGE BLE 3$ ;DELIMITER! CMP R0,#32 ;A TO Z? BLE 4$ ;GOT IT SUB #40,R0 ;MAY AS WELL TRY LOWER CASE BGT 2$ 3$: CLR R0 ;CALL IT A SPACE 4$: ASL -(R5) ;*50+CHAR ASL @R5 ASL @R5 ADD @R5,R0 ASL @R5 ASL @R5 ADD R0,(R5)+ ;KEEP POINTING PAST IT RETURN .SBTTL READ BLOCK FROM PDP-10 TAPE ; ROUTINE TO READ A BLOCK FROM A PDP-10 DECTAPE ; INTO AREA POINTED TO BY T.BUFF ; R0 = BLOCK NUMBER. R0 IS DESTROYED. T.RDTP: CLR -(SP) ;GO INTO SYSTEM STATE CALL 1$ ;SO THAT TIMER TICKS ARE VERY FAST TST DTERR ;GOT DECTAPE ERRORS? BNE RTS0 ;NO ERR INER ;YUP, HOW TERRIBLE 1$: .MTPS #340 ;UP TO PRIORITY 7 ;### JSR R5,@54 ;TO YE SYSTEM .WORD 340 ;AT PRIORITY 0 MOV SP,DTERR ;SAVE CURRENT SP, SAY NO ERROR CALL SEARCH ;POSITION THE DECTAPE MOV R1,-(SP) MOV R2,-(SP) MOV (PC)+,R2 ;POINTER TO EXTRA BIT BUCKET T.BUFF: .WORD 0 MOV R2,-(SP) ;SAVE BUFFER PTR MOV #-256.,R1 ;SET UP WORD COUNT MOV #TCDT,R0 ;POINT FOR FILLER MOV R2,-(R0) ;STUFF BUS ADDRESS MOV R1,-(R0) ;STUFF WORD COUNT TST -(R0) ;POINT RIGHT FOR BYTE .MTPS #340 ;WE MUST NOT BE INTERRUPTED!!! ;### MOVB #5,@R0 ;SET YE COMMANDE GOING 1$: ADD #2,4(R0) ;POINT THE CONTROLLER TO GIVE ME ROOM CLR @R2 ;UNUSED BITS MUST BE 0 CALL TWAIT ;WAIT FOR READY WORD OR ERROR. ASL @R2 ;MAKE ROOM WITH LONG LEFT 2 ROL -(R2) ASL 2(R2) ROL (R2)+ CALL TWAIT ;WAIT FOR A WORD TST (R2)+ ;SKIP OVER THE GOOD WORD TST R1 ;ARE WE DONE (EVEN COUNT) ? BGE 3$ ;YES, CEASE THIS STUFF TST (PC)+ ;DO WE WANT ALL BITS? FULLIO=. .WORD 0 BNE 1$ ;YES, GO EAT .MTPS #0 ;DOWN AGAIN TO PRI. 0 ;### 2$: BIT #100200,@R0 ;NO, JUST WAIT FOR COMPLETION BEQ 2$ BMI HARDER 3$: .MTPS #0 ;DOWN TO 0 IF FULLIO ON ;### MOV T.UNIT,R1 ;A CONVENIENT STOP SEL TRANS SWAB R1 ;FIX IT UP MOV R1,@R0 ;STOP IT!! MOV (SP)+,R0 ;PASS HIM THE BUFFER ADDRESS RTS2: MOV (SP)+,R2 RTS1: MOV (SP)+,R1 RTS0: RETURN TWAIT: TST @R0 ;CHECK FOR ERROR BMI HARDER ;STOP IF SO CMP R1,2(R0) ;IS A WORD READY? BEQ TWAIT ;NO, KEEP LOOPING MOV @#TCST,-(SP) ;GET EXTRA BITS BIC #177774,@SP ;REMOVE JUNK BIS (SP)+,(R2)+ ;ENBUFFER IT INC R1 ;BUMP WORD COUNT RETURN .SBTTL SEARCH DECTAPE ; ROUTINE TO LOCATE A BLOCK ON DECTAPE ; R0 -> BLOCK TO FIND ON DECTAPE SEARCH: MOV R0,-(SP) MOV #TCCM,R0 T.UNIT=.+2 ;ASSEMBLER CAN'T HANDLE THIS MOVB #4400,1(R0) ;SET CORRECT UNIT NUMBER ; NOTE THAT THIS CONSTANT SERVES AS A STOP TRANSPORT ; WHEN IT IS SWAB-ED. CMP @SP,(PC)+ ;WHICH WAY TO TRY? BPREV: .WORD 0 BHI 4$ ;TRY FORWARDS 1$: SUB #3,@SP BIS #4000,@R0 ;SET REVERSE. 15$: MOVB #3,@R0 ;START A SEARCH 2$: BIT #100200,@R0 BEQ 2$ BMI 10$ CMP @SP,@#TCDT BLT 15$ 3$: ADD #3,@SP BIC #4000,@R0 4$: MOVB #3,@R0 5$: BIT #100200,@R0 BEQ 5$ BMI 10$ CMP @SP,@#TCDT BGT 4$ BLT 1$ BIS #10000,@R0 ;GIVE THE GUY A RUNNING START MOV (SP)+,BPREV ;REMEMBER WHERE WE ARE RETURN 10$: TST @#TCST BPL HARDER BIT #4000,@R0 BNE 3$ BR 1$ HARDER: .MTPS #0 ;DOWN TO 0 IF NEED BE ;### CLR @#TCCM MOV (PC)+,SP ;RESET STACK DTERR: 0 CLR DTERR ;REMIND USER JOB THAT WE GOT ERROR RETURN ;BACK TO THE SHADOWS AGAIN .SBTTL INITIALIZATION LIST NOTIMP R LIST NOTIMP T LIST NOTIMP S ERR FENOIM, FREE: ;BUFFER OVERLAYS THIS BEGIN: MOV @#SYSPTR,R2 ;POINT TO SYSTEM ADD #OFFSET-8.,R2 ;POINT TO DEPENDENT STUFF MOV R2,BLKEY ;SAVE BLKEY PTR TST (R2)+ MOV R2,CHKEY ADD #6,R2 MOV @R2,R0 ;POINT TO USR BOTTOM MOV R0,USRBUF TST -(R0) ;FIX FOR SETTOP .SETTO SUB #256.*6-2,R0 ;COMPUTE WHERE THE DOS DIRECTORY COMES IN MOV R0,S.DBUF ADD #256.*4+8.,R0 ;COMPUTE WHERE ITS BIT MAP GOES MOV R0,S.BMAP .DATE MOV R0,DATE ;SAVE TODAY'S DATE BEQ 6$ ;DON'T BE FOOLISH BIT #3,R0 ;LEAP YEARISH ? BNE 1$ MOVB #29.,LFEB ;YEP, FIX FEB 1$: MOV R0,-(SP) ;CONVERT DATE TO DOSSISH BIC #177740,@SP ASR R0 ASR R0 ASR R0 ASR R0 ASR R0 BNE 1$ MOV #2000.,R1 ;DOS IS REL 1970, RT REL 72 MOV #LMONTH,R2 ;MONTH LENGTHS MOV (SP)+,R3 ;MONTH TO R3 2$: DEC R3 BEQ 3$ MOVB (R2)+,R4 ADD R4,R1 BR 2$ 3$: ADD (SP)+,R1 ;ADD DAY MOV (SP)+,R3 ;GET YEAR 4$: DEC R3 BMI 5$ ADD #1000.,R1 BR 4$ 5$: MOV R1,S.DATE 6$: MOV #START,@#STRTAD BIS #20000,@#JSW ;MAKE US REENTERABLE JMP START .END BEGIN