.MCALL .MODULE .MODULE FILEX,VERSION=09,COMMENT=,AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; 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 Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 25-JAN-91 Remove BPT. Also, with regard to ; RX02, FILEX will workk with RX02 ; drives and media provided the diskette ; has been formatted single-density. ;-- ; Edit History: ; ; 001 13-Feb-80 10:56 Chernoff, Anton (25430) [240,100] ; Change PDT-11/150 device code to 37 ; (001) ; 002 20-Feb-80 11:33 Gentry, Martin (70039) [240,121] ; Fixing VALDEV routine for PDT-11/150's ; (002) ; 003 13-May-80 13:23 Fingerhut, David [240,134] ; Wildcard transfers clobber location zero. ; (003) ; 004 21-Jul-80 10:27 AM Fingerhut, David [240,134] ; Filex null fills Universal records. Should space fill ; (004) ; 005 11-Jun-81 10:49 AM Martin Gentry [240,121] ; Fix of filesize/free area size calculation ; Also cleaned up two crude multiply routines. ; (005) ; ; 006 01-Nov-1990 JFW ; bracket error messages with ;+/;ERROR/.../;- ; ; 007 21-Nov-1990 JFW ; disallow running under VBGEXE ; ; 009 11-Jun-1991 WFG ; ACTION #7479, Add "AUDIT=YES" to .MODULE line ;- .SBTTL RECORD OF CODE CHANGES (BUG FIXES) .ENABL LC ;+ ; ;JM1 - FIXES TRAP TO 4 WHEN NO SYSTEM DATE IS GIVEN (INTERCHANGE). ; ;JM2 - FIXES FILENAME DUPLICATION PROBLEM (INTERCHANGE). ; ;JM3 - FIXES THREE NULL PROBLEMS (INTERCHANGE): ; A) RT-11 BLOCK FILLERS (NUL) ARE TRANSFERRED INSTEAD OF IGNORED. ; B) RECORD LENGTH (U:N) IS INTERPRETED AS THE RECORD SIZE OF THE ; RT-11 FILE. ; C) INTERCHANGE FORMAT DOES NOT FILL SECTOR WITH NULLS WHEN WRITING ; LESS THAN 128. CHARACTERS PER RECORD. ; ;JM4 - INITIALIZE AFTER COPY ROUTINE OCCASIONALLY WILL NOT WORK (INTERCHANGE). ; ;JM5 - LINE CONSISTING OF ONLY ARE IGNORED IN IMAGE COPIES (INTER.). ; ;JM6 - DIRECTORY CORRUPTION WHEN COPYING CERTAIN LENGTH FILES IN PACKED IMAGE ; MODE (INTERCHANGE). ; ;JM7 - ADD RX02 (SINGLE DENSITY SUPPORT) AND PDT11/150 SUPPORT (INTERCHANGE). ; ;JM8 - FATAL ERRORS DO NOT ABORT INDIRECT COMMAND FILE EXECUTIONS (ALL). ; ; X05.00 08-AUG-79 MODIFIED 'ERR' MACRO AND ADDED CODE TO SUPPRORT ; -MBG- THE SETTING OF THE USER PROGRAM ERROR STATUS ; BYTE (53). ALSO ADDED CODE TO RECOGNIZE ERROR ; #3 (PROTECTED FILE) RETURNED FROM '.ENTER' AND ; '.CLOSE' ;MG01 ; ; X05.00 16-NOV-79 Copyright statement update ; -MBG- ; ; X05.01 25-Jul-82 Added /VOL[:ONL] for initialize on interchange ; -MBG- sloppies. ; ; X05.02 17-Aug-82 Addition of /WAIT for Directory, Initialize, ; -MBG- Delete and Copy operations. ; ; X05.03 22-Sep-82 Added VTOCLR routine for correctly clearing ; -MBG- VTOC sectors (UCLRBF routine was not setting ; final 24. words to nulls) ; ; Y05.05 23-MAY-89 Fixed INTERCHANGE mode so that it produces an ; -GTS- error when attempting operation on RX02 disks. ;- .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 ;********************************************************************* ;PATCHING INSTRUCTIONS- ; IF AN IN-LINE PATCH CANNOT BE MADE, APPLY PATCH TO END OF SOURCES. ; AT THE SAME TIME, CHANGE ALL REFERENCES TO "FREE" SO THAT IT WILL ; BE LOCATED AT THE END OF THE NEW PATCH. ; ;- .SBTTL LAYOUT OF IBM FLOPPY DISK ;+ ; ;HERE IS A LAYOUT OF TRACK 0 OF AN IBM FLOPPY DISK. ;EACH TRACK OF A FLOPPY DISK CONSISTS OF 26.SECTORS, NUMBERED ;FROM 1 TO 26. . TRACK 0 OF AN IBM FLOPPY IS USED FOR DATASET ;LABELS (AN OBSCURE FORM OF DIRECTORY). EACH SECTOR HAS A PARTICULAR ;MEANING OR USE, AND THESE ARE DESCRIBED BELOW. SOME OF THEM ONLY ;THE WIZARDS OF WHITE PLAINS KNOW ABOUT; PRESUMABLY THEY ARE NOT ;NEEDED FOR NORMAL OPERATION. IN FACT, ONE GETS THE IDEA THAT ;MOST OF THIS STUFF ISN'T NEEDED FOR NORMAL OPERATION. BUT IT'S ;HERE, ANYWAY. ; ;SECTOR 1 - 4: ;RESERVED BY IBM FOR SYSTEM USE (80 BLANKS PER SECTOR) ; ;SECTOR 5: ;POSITIONS 1-13 OF THIS SECTOR ARE USED TO RECORD THE IDENTITY OF ERROR ;TRACK. POSITIONS 1-5 EQUALS "ERMAP" WHICH IDENTIFIES THE SECTOR AS AN ERROR ;MAP. THIS SECTOR IS NOT SUPPORTED BY RT-11. ; ;SECTOR 6: ;RESERVED BY IBM FOR SYSTEM USE (80 BLANKS) ; ;SECTOR 7: ;IS THE VOLUME LABEL. POSITIONS 1-4 (WHAT WE WOULD CALL BYTES 0-3) ;ARE EBCDIC "VOL1". THIS IDENTIFIES THE DISK, TO US, AS AN IBM DISK. ;IN HOUSE, WE USE THESE 4 BYTES TO IDENTIFY THE SYTEM THAT WROTE THE ;DISK. RT-11 FILLS IN THESE BYTES WITH "RT11". VARIOUS FIELDS IN THIS ;SECTOR IDENTIFY THE DISKETTE, THE DISKETTE FORMAT, DISKETTE OWNER ;IDENTIFICATION, AND WHETHER OR NOT THE DISKETTE USES STANDARD LABELS. ;THIS SECTOR IS DISCRIBED BELOW: ; ;OFFSET ;BYTE ; CONTENTS ;-------------------------------------------------------------------- ; 0 ; 1 ; V ; 1 ; 2 ; O ; 2 ; 3 ; L ; 3 ; 4 ; 1 ; 4 ; 5 ; 5-10 VOLUME ID FIELD. THE ID CONSISTS OF 1 TO 6 ; ; ; NUMERIC DIGITS OR LETTERS (LEFT JUSTIFIED). ; ; ; UNUSED POSITIONS MUST BE A SPACE (BLANK). ; . ; . ; 12 ; 11 ; ACCESS CODE. BLANK (SPACE) PERMITS ACCESS TO DISK ; 13 ; 12 ; 12-37 RESERVED BY IBM ; . ; . ; 45 ; 38 ; 38-51 THE OWNER ID FIELD. NOT USED BY ALL SYSTEMS. ; . ; . ; 63 ; 52 ; 52-76 RESERVED BY IBM ; . ; . ; 114 ; 77 ; 77-78 RECORD SEQUENCE FIELD, THE "INTERLEAVE FACTOR." ; 115 ; 78 ; "BLANK-BLANK" IS 1:1 INTERLEAVE; OTHERS UNKNOWN ; 116 ; 79 ; RESERVED BY IBM ; 117 ; 80 ; LABEL VERSION FIELD. "W" IS STANDARD LABELS (THIS STUFF) ; ;SECTORS 8-26 ARE THE DATASET LABELS. WE WOULD CALL THEM DIRECTORY ENTRIES ;AND THEY WOULD BE ABOUT 8 WORDS LONG. IBM CALLS THEM DATASET LABELS ;AND THEY'RE 40 WORDS LONG. HERE IT IS: ; ; 0 ; 1 ; H 1-4 LABEL IDENTIFIER, "HDR1" IN EBCDIC ; 1 ; 2 ; D ; 2 ; 3 ; R ; 3 ; 4 ; 1 ; 4 ; 5 ; RESERVED ; 5 ; 6 ; 6-13 USER NAME FOR DATASET (THE FILE LABEL) ; . ; . ; 15 ; 14 ; 14-22 RESERVED ; . ; . ; 26 ; 23 ; 23-27 BLOCK/RECORD LENGTH (NORMALLY 80, COULD BE 128) ; . ; . ; 33 ; 28 ; RESERVED ; 34 ; 29 ; 29-30 TRACK NUMBER OF BEGINNING OF DATA ; 35 ; 30 ; AS TWO EBCDIC CHARACTERS ; 36 ; 31 ; 0 MUST BE EBCDIC 0 (OCTAL 360) ; 37 ; 32 ; 32-33 SECTOR # OF BEGINNING OF DATA ; 40 ; 33 ; AS TWO EBCDIC CHARACTERS ; 41 ; 34 ; RESERVED ; 42 ; 35 ; 35-36 TRACK # OF LAST TRACK RESERVED FOR THIS DATASET ; 43 ; 36 ; AS TWO EBCDIC CHARACTERS ; 44 ; 37 ; MUST BE EBCDIC 0 ; 45 ; 38 ; 38-39 SECTOR # OF LAST SECTOR RESERVED FOR THIS DATASET ; 46 ; 39 ; AS TWO EBCDIC CHARACTERS ; 47 ; 40 ; RESERVED ; 50 ; 41 ; BYPASS INDICATOR ; 51 ; 42 ; DATASET SECURITY ; 52 ; 43 ; WRITE PROTECT ; 53 ; 44 ; BLANK FOR DATA INTERCHANGE (OCTAL 100) ; 54 ; 45 ; MULTIVOLUME INDICATOR C-CONTINUED, L-LAST, BLANK-NOT CONTINUED ; 55 ; 46 ; 46-47 VOLUME SEQUENCE # ; 56 ; 47 ; 57 ; 48 ; 48-49 CREATION YEAR (E.G., "75") ; 60 ; 49 ; 61 ; 50 ; 50-51 CREATION MONTH ; 62 ; 51 ; 63 ; 52 ; 52-53 CREATION DAY ; 64 ; 53 ; 65 ; 54 ; 54-66 RESERVED ; . ; . ; 102 ; 67 ; 67-72 EXPIRATION DATE (SAME FORMAT AS CREATION DATE) ; . ; . ; 110 ; 73 ; VERIFY MARK. MUST CONTAIN V OR BLANK.V=DATA SET VERIFIED ; 111 ; 74 ; RESERVED ; 112 ; 75 ; 75-79 NEXT UNUSED TRACK/SECTOR WITHIN THIS DATASET ; 113 ; 76 ; 75-76 TRACK ; 114 ; 77 ; MUST BE EBCDIC 0 ; 115 ; 78 ; 78-79 SECTOR (N.B. NEXT UNUSED, NOT LAST USED) ; 116 ; 79 ; 117 ; 80 ; RESERVED ; ;- .SBTTL MACRO DEFINITIONS ; CSECTS FOR ERROR TABLES (OCCUR FIRST) .CSECT ERRMSG ;THIS CSECT CONTAINS THE MESSAGE TEXT .CSECT ERRTBL ;THIS CSECT CONTAINS MESSAGE POINTERS ERRTBL: ;DEFINE BASE OF ERROR TABLE .CSECT MAIN$ ;THE MAIN BODY ; SYSTEM MACROS .MCALL ..V2.. ..V2.. .MCALL .CLOSE, .CSISP, .DATE .MCALL .DSTAT, .FETCH, .LOCK .MCALL .LOOKU, .PRINT, .RCTRL .MCALL .READW, .REOPE, .SAVES .MCALL .SETTO, .SRESE, .UNLOC .MCALL .WAIT, .WRITW, .SPFUN .MCALL .GTLIN, .SCCA, .TTINR .MCALL .MTPS, .GTIM .LIBRARY "SRC:SYSTEM" .MCALL .JSXDF .SYCDF .JSXDF .SYCDF ; 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 PRE,MSG,CODE .NLIST .IF NB .CSECT ERRMSG LAB = . .IF NB .BYTE ERR$$'CODE .IFF .BYTE ERR$$I .ENDC .ASCIZ \MSG\ .CSECT ERRTBL PRE = .-ERRTBL .WORD LAB .CSECT MAIN$ .ENDC .LIST TRAP PRE .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 ; 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 ; VECTOR DEFINITIONS TRAP.V = 34 ;TRAP VECTOR ; RT-11 SYSCOM LOCATIONS USERPC = 40 ;PROGRAM START ADDRESS USERSP = 42 ;INITIAL VALUE FOR STACK POINTER JSW = 44 ;JOB STATUS WORD GTLIN$ = 000010 ;NON-TERMINATING .GTLIN BIT TCBIT$ = 000100 ;INHIBIT TERMINAL WAIT TTSPC$ = 010000 ;TERMINAL SPECIAL MODE RSTRT$ = 020000 ;PROGRAM IS RE-ENTERABLE UFLOAT = 46 ;USR LOAD ADDRESS ERRBYT = 52 ;ERROR CODE LOCATION USERRB = 53 ;USER PROGRAM ERROR STATUS BYTE ERR$$I = 0 ; INFORMATIONAL ERR$$W = 1 ; WARNING ERR$$E = 2 ; ERROR ERR$$F = 3 ; FATAL/SEVERE ERR$$U = 4 ; UNCONDITIONAL ABORT SYSPTR = 54 ;POINTER TO START OF RMON ; RT-11 FIXED OFFSETS BLKEY = 256 ;DIRECTORY SEGMENT # IN MEMORY CHKEY = 260 ;DEVICE INDEX/UNIT NUMBER OF SEGMENT $USRLC = 266 ;ADDRESS OF NORMAL USR AREA SYUNIT = 274 ;UNIT NUMBER OF SYSTEM DEVICE CONFIG = 300 ;CONFIGURATION WORD FJOB$ = 000200 ;THIS BIT IN CONFIG MEANS F JOB IS IN KT11$ = 010000 ;MAPPED SYSTEM UNDER XM MONITOR SYINDX = 364 ;$PNAME INDEX FOR SYSTEM DEVICE PNPTR = 404 ;OFFSET TO $PNAME TABLE PS = 177776 ; .DSTAT OFFSETS DS.VSZ = 6 ; 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 .ASECT .=$JSX .WORD NOVBG$ .CSECT MAIN$ ;BACK TO SHADOWS .SBTTL FIXED STORAGE AREAS - VOLATILE ;+ ; ; * NOTE * THAT THE .CSISPC CALL USES FROM OUFDB TO SOMEPLACE ;IN INGOTO AS ITS 39.-WORD BUFFER, SO DON'T MESS THIS SECTION UP. ; ;- 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 ; *** START OF CRITICAL ORDERING *** R.DEVS: .WORD 0 ;RT-11 DEVICE STATUS R.CHAN: .WORD 0 ;CURRENT RT-11 CHANNEL R.NCHA: .WORD 0 ;NUMBER OF OPEN CHANNELS ; *** END OF CRITICAL ORDERING *** OUBUFF: .WORD 0 ;LOCATION OF OUTPUT BUFFER OUSIZE: .WORD 0 ;ITS 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 VOLID: .BLKB 82. ;VOLUME ID CMDBUF: .BLKB 82. ;INPUT COMMAND STRING .BLKB 14. ;BRACKETED STUFF BRKBF1=. OUASCI: .WORD 0 ;POINTER TO OUTPUT FILE NAME DATE: .WORD 0 ;POINTER TO SYSTEM DATE XTRABY: .WORD 0 ;EXTRA BYTES/DIR ENTRY OUTPHY: .BLKW ;PHYSICAL DEVICE FOR OUTPUT INPHY: .BLKW ;PHYSICAL DEVICE FOR INPUT ; FOLLOWING ARE FOR SUPPORT OF TRANSLATION OF ; LOGICAL DEVICE NAMES TO PHYSICAL $UNAM1: .BLKW ;ADDRESS OF $UNAM1 TABLE $UNAM2: .BLKW ; " $UNAM2 TABLE $PNAME: .BLKW ; " $PNAME TABLE $SLOT: .BLKW ;SIZE OF MONITOR DEVICE TABLES CCSTAT: .BLKW ;^C STATUS WORD ; 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 EMTBLK: .BLKW 6 ;FOR EMT BLOCK AREA SPFUN1: .WORD 32*400 ;STRICTLY FOR UNIVERSAL FLOPPY UISECT: .WORD 0 UIBUFR: .WORD 0 UITRAC: .WORD 0 ;TRACK GOES HERE .BYTE 377 ;RIGHT BYTE OF COMMAND MUST BE ALL 1'S UICMD: .BYTE 0 ;.SPFUN COMMAND .WORD 0 SPFUN2: .WORD 32*400 ;OUTPUT .SPFUN BLOCK UOSECT: .WORD 0 ;SECTOR UOBUFR: .WORD 0 ;BUFFR ADDRESS UOTRAC: .WORD 0 ;TRACK .BYTE 377 UOCMD: .BYTE 0 .WORD 0 ;+ ; STORAGE WORDS FOR INTERCHANGE INPUT. ;- U.IBCT: .WORD 0 ;INPUT SECTOR BUFFER COUNT U.IBPT: .WORD 0 ;INPUT SECTOR BUFFER POINTER U.ISEC: .WORD 0 ;INPUT TOTALSECTOR # ; (TRACK * 26.) + (SECTOR ON TRACK) ;+ ; STORAGE WORDS FOR INTERCHANGE OUTPUT. ;- U.OBCT: .WORD 0 ;OUTPUT SECTOR BUFFER COUNT U.OBPT: .WORD 0 ;OUTPUT SECTOR BUFFER POINTER U.OSEC: .WORD 0 ;OUTPUT RUNNING TOTALSECTOR # LD1: .BYTE 0 ;KEEP LD1, LD2 TOGETHER AS 1 WORD LD2: .BYTE 0 U.DEVS: .WORD 0 ;FLOPPY DEVICE STATUS ; (DO WE EVEN NEED IT?) U.RSIZ: .BLKB 19. ;DECLARED RECORD SIZE OF EACH ; IBM FLOPPY FILE U.EOL: .BYTE 0 ;FLAG FOR END OF LINE ON IBM READS U.FLG: .BYTE 0 ;FLAG FOR END OF LINE ON IBM WRITES U.OVFG: .BYTE 0 ;IF SET, RECORD BEYOND SPECIFIED ; SIZE (RECORD IS MORE THAN ONE ; SECTOR LONG) ;JM5 .EVEN U.HOLE: .WORD 0. ;PTR TO TABLE OF FREE ENTRY SIZES U.HPTR: .WORD 0 ;PTR TO HOLE IN USE (VIA ENTER) SUPRES: .WORD 0 ;WHEN EQ NO SUPPRESS, WHEN NE SUPPRESS BUFR1: .WORD 0 ;TOP OF CORE UDVSIZ: .WORD 0 ;DEVICE SIZE FOR UNIVERSAL OPERATIONS ; OPERATION INVALID IF NOT 494. .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 U.GOTO: LIST DISPATCH U ;UNIVERSAL FLOPPY DISK ; SPECIAL CHARACTERS IN INPUT SPCL: SPC '[,BRACK ;START OF BRACKETED AREA 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 SPC '%,CMDERR ;EMBEDDED % ARE ILLEGAL SPC '*,EMBAST ;EMBEDDED *'S ARE ILLEGAL .WORD 0 ;END OF TABLE ; SWITCHES SWTBL: SWT A,MOD,ASCII ;ASCII MODE TRANSFER SWT C,ACT,COPY ;ACTION = COPY SWT D,ACT,DELETE ;ACTION = DELETE SWT F,ACT,FASTDI ;ACTION = FAST DIRECTORY SWT G,IGN ;IGNORE INPUT ERRORS SWT I,MOD,IMAGE ;IMAGE MODE TRANSFER SWT L,ACT,LIST ;ACTION = DIRECTORY SWT N,NUM ;(UNUSED) 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 U,FIL,U.GOTO ;UNIVERSAL FLOPPY FILE STRUCTURE SWT V,VOL ;VOLUME ID FOR INTERCHANGE FLOPPIES SWT W,NXT ;/WAIT SWT Y,SUP ;SUPPRESS PROMPTS SWT Z,ACT,ZERO ;ACTION = ZERO .WORD 0 ;END OF TABLE ;THE FOLLOWING CHARACTERS ARE THE ONLY LEGAL TERMINATING CHARACTERS ;THAT ONE NEEDS TO BE CONCERNED ABOUT WHEN TESTING EMBEDDED *'S CHRTBL: .BYTE ', .BYTE '. .BYTE '/ .BYTE ': .BYTE '< .BYTE '= .BYTE '[ .BYTE 0 .EVEN .NLIST BIN VERMSG: .NLCSI PATLVL == .-2 PREFIX: .NLCSI TYPE=I,PART=PREFIX ERRLVL: .ASCII /x-/<200> ;ERROR LEVEL (x=I,W,E,F OR U) MSKLST: .BYTE 0,2,4,10,20 CHRLST: .ASCII /IWEFU/ RUSURE: .ASCII ":/Initialize; Are you sure? "<200> M.VIDC: .ASCII ":/Volume ID change; Are you sure? "<200> M.FJOB: .ASCII /Foreground Loaded; Are you sure? /<200> M.VIDP: .ASCII /Volume ID? /<200> M.VOLI: .ASCII / Volume ID: /<200> M.MIV: .ASCII /Mount input volume in /<200> M.MOV: .ASCII /Mount output volume in /<200> M.MSV: .ASCII /Mount system volume in /<200> M.MIOV: .ASCII /:; Continue? /<200> ASTER: .ASCII /*/<200> EXISTS: .ASCII /File already exists /<200> W.TRUN: .ASCIZ /Volume ID truncated at six characters/ PROTCT: .ASCII /Protected file already exists / PROFIL: .BLKB 15 .EVEN .LIST BIN .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,-(SP) BR 1$ ; ERROR MESSAGE HANDLER ERRPRT: MOV (SP),R0 ;R0->PAST TRAP MOV -(R0),R0 ;GET TRAP INSTRUCTION MOV ERRTBL-TRAP(R0),R0 ;R0->ERROR MESSAGE ENTRY CLR R1 BISB (R0)+,R1 ;GET SEVERITY INDICATOR BISB MSKLST(R1),@#USERRB ;REPORT LEVEL TO MONITOR MOVB CHRLST(R1),ERRLVL ;COMPLETE THE PREFIX MOV R0,-(SP) ;SAVE POINTER TO CONTINUATION .PRINT #PREFIX ;PRINT THE PREFIX 1$: .PRINT (SP)+ ;AND PRINT THE CONTINUATION JMP COPCON ;SEE IF WE HAVE TO MOUNT SYSTEM DISK .DSABL LSB .SBTTL INITIALIZATION NOP ;REENTRY NO-OP START: MOV @#USERSP,SP ;INITIALIZE STACK POINTER .RCTRL ;RESET ^O .UNLOC ;RELEASE USR IF WE HAVE IT CLR R0 CLR OUASCI ;MARK NO OUTPUT FILE GIVEN .SRESE ;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 BUFR1,CORTOP ;SET UP TOP OF CORE .SBTTL COMMAND STRING READER ; READ AND INTERPRET COMMAND STRING, SEPARATING OUT ; THINGS IN BRACKETS MOV #BRKBF1-1,R4 ;BRACKET INFO FOR 1ST FILE CLRB (R4)+ ;ZERO IT INITIALLY CLR SUPRES ;CLEAR SUPRES SWITCH .SCCA #EMTBLK,#0 ;ENSURE ^C TRAPPING IS OFF .GTLIN #CMDBUF,#ASTER ;GET COMMAND LINE MOV #CMDBUF,R1 ;R1->COMMAND BUFFER TSTB @R1 ;ANY COMMAND? BEQ VERSION ;NOPE, RESPOND WITH THE VERSION MOV R1,R0 ;SECOND POINTER TO BUFFER MOV R1,R2 ;R2 = START OF ASCII FILE NAME CMREAD: MOV #SPCL,R5 ;TABLE OF SPECIAL CHARACTERS 1$: CMPB @R1,(R5)+ ;IS THIS A SPECIAL CHARACTER? BNE 2$ ;NO, LOOK AGAIN MOVB @R5,@PC ;SET UP DISPATCH BR .+2 ;REL BRANCH GETS PLUGGED SPBASE =. 2$: TSTB (R5)+ ;PUSH SPECIAL CHARACTER POINTER BNE 1$ ;GO BACK IF THERE'S MORE TO SEE PTRINC: MOVB (R1)+,(R0)+ ;PUT CHAR. BACK IN BUFFER FOR CSI TSTB (R1) ;ARE WE AT THE END OF THE COMMAND? BEQ CMEND ;YES BR CMREAD ;RESET SPCL TABLE AND TEST NEXT CHAR. LESSGN: INC R1 ;CHANGE < TO = EQLS: MOV R2,OUASCI ;SAVE POINTER TO OUTPUT FILE NAME COLON: CMPB -2(R1),#57 ;IS THIS ':' PART OF THE /U OPTION? BEQ PTRINC ;YES,SKIP IT MOV R1,-(SP) ;SAVE THE CURRENT POINTER BR DCLSZ ;TEST STRING FOR /Z FROM DCLS DCLRET: MOV (SP)+,R1 ;RESTORE POINTER AND CONTIN PARSING MOV R1,R2 ;NEW ASCII NAME PTR INC R2 ;IS AFTER THIS BR PTRINC ;KEEP ON READING BRACK: TSTB R4 ;ALREADY HAD A [] ? BEQ CMDERR ;YES, ERROR MOV #14.,R5 ;ALLOW ROOM FOR PPPPPP,PPPPPP0 1$: TSTB (R1)+ ;CARRIAGE RTN INSIDE ? BEQ CMDERR ; ILLEGAL IF SO CMPB (R1),#'] ;HAVE WE REACHED THE END ? BEQ MRKEND ;JA, WUNDERBAR MOVB (R1),-(R4) ;PUT IN BRACKET BUFFER DEC R5 ;OVERFLOWED BUFFER? BGT 1$ ;NO, KEEP LOOKING ;+ ;ERROR CMDERR: ERR ILCM,,F ;ILLEGAL COMMAND ;- MRKEND: CLRB -(R4) ;MARK END OF BUFFER CLR R4 ;INDICATE THAT WE FOUND [] TSTB (R1)+ ;MAKE R1 POINT TO THE CHAR AFTER ] BR CMREAD ;GO TEST FOR SPECIAL CHAR. EMBAST: MOVB -1(R1),R3 ;PUT PREVIOUS CHAR. INTO R3 BEQ 3$ ;0 DETECTS BEGINNING OF CMD LINE JSR PC,EMBTST ;TEST FOR LEGAL * CONSTRUCTION 3$: MOVB 1(R1),R3 ;PUT PRECEEDING CHAR IN R3 FOR TEST BEQ 4$ ;0 DETECTS END OF COMMAND LINE JSR PC,EMBTST ;TEST FOR LEGAL * CONSTRUCTION 4$: BR PTRINC ;PUT CHAR. BACK IN BUFFER DCLSZ: TSTB (R1)+ ;TEST FOR END AND ADV POINTER BEQ DCLRET ;IF 0,END IS DETECTED--RETURN CMPB (R1),#'Z ;TEST FOR Z BNE DCLSZ ;NO,GET NEXT CHAR. CMPB -1(R1),#'/ ;WAS THE PRECEEDING CHAR /? BNE DCLSZ ;NO,CHECK FOR END TST (SP)+ ;CLEAN SAVED POINTER FROM STACK MOV #CMDBUF,R1 ;POINT TO THE BEGIN. OF COMMAND STRING MOV R1,R0 ;ESTABLISH SECOND POINTER TO BUFFER 5$: MOVB (R1)+,(R0) ;RESTORE CHAR.IN CMDBUF CMPB (R0),#'* ;IS CHAR A *? BEQ 5$ ;YES, GET NEXT CHAR. ; DON'T RET. * TO BUF CMPB (R0),#'= ;NO, IS IT A =? BEQ 5$ ;YES, GET NEXT CHAR ; DON'T RET. = TO BUF TSTB (R0)+ ;NO, POINT R0 TO NEXT BYTE IN CMDBUF BNE 5$ ;AND RTN TO MOVE NEXT BYTE IN (R1) ; TO (R0) .SBTTL SWITCH HANDLER CMEND: CLRB @R0 ;MARK END OF INPUT STRING MOV #CMDBUF,R1 ;REPOINT TO STRING .CSISP #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 #100000,-(SP) ;PSEUDO SWITCH 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=. ;+ ;ERROR SWTILL: ERR ILSW,,F ;ILLEGAL SWITCH ;- SWEND: TST INGOTO ;ANY FILE STRUCTURE GIVEN? BNE GODOIT ;YES, DO FOREIGN STUFF ;+ ;ERROR ERR ILCM ;- ; FILE STRUCTURE SWITCHES: /S /T /U SWTTEN: MOV @#SYSPTR,R1 ;/T CAN'T BE DONE IF FG ACTIVE BIT #FJOB$,CONFIG(R1) ;IS IT? BEQ SWTFIL ;NO ;+ ;ERROR ERR FRUN,,F ;- SWTFIL: MOV @R4,R1 ;/S /U R1 -> DISPATCH TABLE 3$: SWAB R3 ;WHICH FILE? ANY 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 ;+ ;ERROR SWTERR: ERR SWER,,F ;SWITCH ERROR ;- SWTSUP: INC SUPRES ;INDICATE SUPPRESS PROMPT MESSAGE BR SWTNXT ; ACTION SWITCHES SWTACT: MOV #ACTION,R0 ;/C /D /F /L /Z BR SWTCOM ; NUMBER OF BLOCKS SWTNUM: TST R3 ;VALUE IS MANDATORY BPL SWTERR BR SWTNXT ; VOLUME ID OPTION: /V[:ONL] SWTVOL: CMP SWT.V,#100000 ;DEFAULT VALUE? BEQ SWTNXT ;YES, IT'S OKAY CMP SWT.V,#<^RONL> ;NOT DEFAULT, SPECIFIED /V:ONLY? BEQ SWTNXT ;YES... ;+ ;ERROR ERR INVV,,F ;- ; GO TO ACTION ROUTINE GODOIT: MOV #FREE,R5 ;POINT TO FREE CORE .FETCH R5,#INFDB ;FETCH INPUT DEVICE DRIVER BCC 10$ ;GOT IT... ;+ ;ERROR 5$: ERR ILDE ;'INVALID DEVICE' ;- 10$: MOV R0,R5 ;SAVE NEW FREE ADDRESS TST OUFDB ;ANY OUTPUT DEVICE? BEQ 20$ .FETCH R5,#OUFDB ;FETCH OUTPUT DEVICE DRIVER BCS 5$ ;DIDN'T GET IT... MOV R0,R5 ;SAVE NEW FREE ADDRESS 20$: CLR INPHY CLR OUTPHY ADD ACTION,PC ;DO THE THING (COPY = 0) ACBASE: NOP ;/C => ACTION = 2 .SBTTL COPY DRIVER ROUTINE .ENABL LSB COPY: MOV #OUFDB,R0 ;POINT TO OUTPUT FILE NAME TST @R0 ;SEE IF THERE! BEQ ERRNOU ;ERROR - NO OUTPUT FILE JSR PC,ILCMCK ;CHECK IF CONSTRUCTION IS CORRECT .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 .IRPC X,012345 MOV R'X,-(SP) .ENDR TST SWT.W ;;;/WAIT SPECIFIED? BEQ 80$ 60$: .PRINT #M.MOV ;'MOUNT OUTPUT VOLUME IN' MOV OUFDB,R0 ;R0 = OUTPUT DEVICE NAME JSR PC,TRNLOG ;TRANSLATE LOGICAL TO PHYSICAL DEVICE MOV R0,OUTPHY ;SAVE OUTPUT PHYSICAL NAME MOV #VOLID,R4 ;TEMP SPACE FOR STRING JSR PC,R50OUT ;CONVERT THE RAD50 DEVICE NAME MOVB #200,(R4) ;TERMINATE STRING .PRINT #VOLID ;'DDN' JSR PC,CLRBFI ;DISCARD THE INPUT BUFFER BIS #GTLIN$,@#JSW .GTLIN #VOLID,#M.MIOV,TERM ;':;CONTINUE?' BIC #GTLIN$,@#JSW MOV #VOLID,R1 ;R1->RESPONSE JSR PC,CCSCAN ;ANY ^C'S? BCS 70$ ;YES... MOVB VOLID,R0 ;ANY RESPONSE? BEQ 60$ ;NOPE... CMPB R0,#'Y ;'YES'? BEQ 80$ ;YEP... CMPB R0,#'N ;NOPE, 'NO'? BNE 60$ ;NOPE... ;+ ;ERROR 70$: ERR OPNC,,E ;- 80$: .IRPC X,543210 MOV (SP)+,R'X .ENDR 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 COPCON ;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 ;+ ;ERROR ERRNOU: ERR ILCM ;ILLEGAL IF NO OUTPUT FILE ERRDEV: ERR ILDE,,F ;ILLEGAL DEVICE FNFERR: ERR FINOFN,,F ;FILE NOT FOUND ;- 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 COPCON: MOV #<^RSY >,R0 ;R0=RAD50(SY) JSR PC,TRNLOG ;TRANSLATE IT TO PHYSICAL CMP R0,INPHY ;SYSTEM DISK USED AS INPUT DEVICE? BEQ SYSMNT ;YES, SYSTEM NEEDS REMOUNTING... CMP R0,OUTPHY ;NOPE, USED AS OUTPUT DEVICE? BEQ SYSMNT ;YES, IT NEEDS REMOUNTING JMP START SYSMNT: MOV R0,-(SP) ;SAVE SYSTEM DEVICE NAME 10$: .PRINT #M.MSV ;'MOUNT SYSTEM VOLUME IN' MOV (SP),R0 MOV #VOLID,R4 JSR PC,R50OUT MOVB #200,(R4) .PRINT #VOLID ;'DDN' JSR PC,CLRBFI ;DISCARD INPUT BUFFER BIS #GTLIN$,@#JSW .GTLIN #VOLID,#M.MIOV,TERM ;':;CONTINUE?' BIC #GTLIN$,@#JSW MOV #VOLID,R1 ;R1->RESPONSE STRING JSR PC,CCSCAN ;WAS THERE A ^C? BCS 10$ ;YES... CMPB VOLID,#'Y BNE 10$ MOV (SP)+,R0 MOV @#SYSPTR,R0 ;R0->$RMON CLR CHKEY(R0) ;FORCE RE-READ OF DIRECTORY CLR BLKEY(R0) JMP START REENTR: BR COPCON .DSABL LSB .SBTTL DIRECTORY LIST DRIVER FASTDI: MOV SP,SWT.L LIST: TST OUFDB ;ANY OUTPUT DEVICE SPECIFIED? BEQ 1$ ;NOPE, ASSUME TT: CMP OUFDB,#<^RTT > ;YES, WAS IT TT:? BEQ 1$ ;YES, OKAY THEN ;+ ;ERROR ERR ILDE ;ANY OTHERS ARE ILLEGAL ;- 1$: CALL XPANDI ;GO EXPAND INPUT SPEC. MOV #CMDBUF,R5 ;POINT TO BUFFER FOR OUTPUT MOV R5,R4 MOVB #40,(R4)+ ;SPACE BEFORE DATE (LIKE DIR) .DATE ;GET THE CURRENT DATE BEQ 2$ ;NOT SET... ADD #1972.-1964.,R0 ;DATOUT WANTS DATE RELATIVE 1964 ; BUT RT RETURNS IT RELATIVE 1972 JSR PC,DATOUT ;CONVERT TO ASCII STRING 2$: CLRB (R4) ;TERMINATE THE STRING .PRINT R5 ; AND PRINT IT TST SWT.U ;INTERCHANGE MODE? BEQ LISTLP ;NOPE... TST SWT.V ;YES, REQUESTING VOLUME ID? BEQ LISTLP ;NOPE...DO REST OF DIRECTORY .PRINT #M.VOLI ;PREFIX VOL ID .PRINT #VOLID ;AND THEN PRINT IT CMP SWT.V,#<^RONL> ;ASKING FOR VOLUME ID ONLY? BEQ REENTR ;YES, SO DON'T DO DIRECTORY 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 .ENABL LSB ZERO: TST SWT.U ;ARE WE IN INTERCHANGE MODE? BNE 10$ ;YES... TST SWT.V ;NOPE, WAS /VOL[:ONL] SPECIFIED? BEQ 10$ ;NOPE... ;+ ;ERROR ERR UNOP,,F ;SUPPORTED ON INTERCHANGE ONLY ;- 10$: MOV #COPCON,-(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 JSR PC,TRNLOG ;TRANSLATE LOGICAL TO PHYSICAL CALL R50OUT ;CONVERT DEVICE NAME TST SUPRES ;SHOULD MESSAGE BE SUPPRESSED? BNE 50$ ;YES, SKIP THE MESSAGE MOVB #200,(R4)+ ;NO CR .PRINT #OUFDB MOV #RUSURE,R1 CMP SWT.V,#<^RONL> ;VOLUME ID CHANGE? BNE 20$ ;NOPE... MOV #M.VIDC,R1 ;YES, USE A DIFFERENT PROMPT 20$: BIS #GTLIN$,@#JSW .GTLIN #VOLID,R1,TERM ;ASK IF HE IS SURE BIC #GTLIN$,@#JSW CMPB VOLID,#'Y ;WELL, IS HE? BEQ 50$ ;YES... JMP START 50$: RETURN ;RETURN TO SAVREG, THEN TO DRIVER .DSABL LSB .SBTTL RAD50 OUTPUT ROUTINES ;+ ; ; OUTFNM ; Converts the three RAD50 words pointed to by R3 to an ; ascii filename (of the form filnam.typ) and places the ; string in the buffer pointed to by R4. ; R3 is advanced. ; ; FNOUT ; Converts the RAD50 word pointed to by R3 to ascii characters ; and places them in the buffer pointed to by R4. ; ; R50OUT ; Converts the RAD50 word in R0 to ascii characters and ; places them in the buffer pointed to by R4. ; ;- 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$ EMBTST: MOV #CHRTBL,R5 ;R5 POINTS TO BEG. OF LEGAL CHAR TABL 7$: CMPB R3,@R5 ;IS THIS A LEGAL CHAR.? BEQ 9$ ;YES, RETURN FROM TEST TSTB (R5)+ ;BUMP THE POINTER AND TEST FOR END BNE 7$ ;NOT THE END, KEEP TESTING ;+ ;ERROR ERR ILCM ;END OF LIST--NO LEGAL CHAR. ;- 9$: RTS PC ;RETURN .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$ ;ILCMCK ROUTINE CHECKS FOR TWO ILLEGALLY STRUCTURED ;COMMAND LINES. THESE COMMAND LINES ARE: ; *.EXT=FILNAM.* ; FILNAM.*=*.EXT ;IF EITHER ARE FOUND,AN ILLEGAL COMMAND ERROR MESSAGE ;WILL BE PRINTED. ILCMCK: MOV #OUFDB+2,R0 ;BRING IN THE OUTPUT STRING CLR R3 ;SET UP R3 AS COMBINATION FLAG CMP (R0)+,#R50STAR ;IS OUTPUT FILENAME WILD BNE 2$ ;NO,KEEP TESTING MOV #1000,R3 ;FLAG OUTPUT NAME WILDCARD 2$: TST (R0)+ ;GET THE EXTENSION CMP @R0,#R50STAR ;IS THE EXTENSION A WILD CARD? BNE 3$ ;NO, LOOK AT THE INPUT STRING ADD #100,R3 ;RECORD THAT THERE WAS A WILDCARD 3$: MOV #INFDB+2,R0 ;BRING IN INPUT STRING CMP (R0)+,#R50STAR ;IS INPUT FILENAME WILD? BNE 4$ ;NO,CHECK THE EXTENSION ADD #10,R3 ;SPECIFY A WILD FILENAME 4$: TST (R0)+ ;POINT TO THE EXTENSION CMP @R0,#R50STAR ;EXTENSION WILD? BNE 5$ ;SKIP FLAG SETTING ADD #1,R3 ;SPECIFY WILD EXTENSION 5$: CMP #1001,R3 ;*.EXT=FILNAM.*? BEQ 6$ ;YES ERROR CMP #110,R3 ;FILNAM.*=*.EXT? BEQ 6$ ;YES, ERROR MOV #OUFDB,R0 ;R0->OUTPUT STRING RTS PC ;RETURN ;+ ;ERROR 6$: ERR ILCM ;ILLEGAL COMMAND ;- .SBTTL EXPAND INPUT LIST .ENABL LSB XPANDI: .DSTAT R5,#INFDB ;GET A DSTATUS BCS 90$ ;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 10$ BIS #100000,R4 ;SET FLAG IF SO 10$: BIS -(R3),R0 CMP -(R3),#R50STAR ;IS FILE NAME A * BNE 20$ COMB R4 ;SET FLAG IF SO 20$: BIS @R3,R0 ;FINISH TEST FOR NULL NAME BNE 30$ ;TREAT NULL NAME AS *.* TST @R5 ;UNLESS NON-FILE STRUCTURED BPL 30$ ; IN WHICH CASE LEAVE NAME DEC R4 ;SET FLAGS FOR *.* 30$: TST @R5 ;IF IT IS NON-FILE-STR BMI 40$ TST R4 ; AND IT HAS WILD CARDS BNE 100$ ; BOOT HIM 40$: TST -(R3) ;DID HE GIVE US A NAME? BEQ 100$ MOV #BRKBF1,R1 50$: .IRPC X,012345 MOV R'X,-(SP) .ENDR TST SWT.W ;/WAIT SPECIFIED? BEQ 80$ .SCCA #EMTBLK,#CCSTAT ;YES, ENABLE ^C TRAPPING MOV @#SYSPTR,R0 ;R0->$RMON BIT #FJOB$,CONFIG(R0) ;IS THERE A FOREGROUND JOB? BEQ 52$ ;NOPE... TST SUPRES ;SUPPRESS WARNING QUERIES? BNE 52$ ;YES... 51$: JSR PC,CLRBFI BIS #GTLIN$,@#JSW .GTLIN #VOLID,#M.FJOB,TERM ;FOREGROUND LOADED, DOES HE CARE? BIC #GTLIN$,@#JSW CMPB VOLID,#'Y ;IS THE RESPONSE A 'YES'? BEQ 52$ ;YES... JMP START ;ANYTHING ELSE, QUIT NOW ; FOLLOWING TWO LOCALS ARE PLACED HERE SO CONDITIONAL BRANCHES ; CAN STILL REACH THEM ;+ ;ERROR 90$: ERR ILDE ;BAD DEVICE ;NOTE THAT R2 STILL POINTS TO ; ASCII NAME 100$: ERR ILCM ;- 52$: MOV OUFDB,R0 ;GET INPUT DEVICE SPEC JSR PC,TRNLOG ;TRANSLATE TO PHYSICAL MOV R0,-(SP) ;SAVE IT MOV INFDB,R0 ;GET OUTPUT DEVICE SPEC JSR PC,TRNLOG ;TRANSLATE TO PHYSICAL CMP R0,(SP)+ ;OUTPUT=INPUT? BNE 60$ ;NOPE... ;+ ;ERROR ERR UNOP ;'UNSUPPORTED OPERATION' ;- 60$: .PRINT #M.MIV ;'MOUNT INPUT VOLUME IN' MOV INFDB,R0 ;R0 = DEVICE NAME JSR PC,TRNLOG MOV R0,INPHY ;SAVE INPUT PHYSICAL NAME MOV #VOLID,R4 ;TEMP SPACE FOR STRING JSR PC,R50OUT ;CONVERT THE RAD50 DEVICE NAME MOVB #200,(R4) ;TERMINATE STRING .PRINT #VOLID ;'DDN' JSR PC,CLRBFI BIS #GTLIN$,@#JSW .GTLIN #VOLID,#M.MIOV,TERM ;':;CONTINUE?' BIC #GTLIN$,@#JSW MOV #VOLID,R1 ;R1->RESPONSE JSR PC,CCSCAN ;ANY ^C'S? BCS 70$ ;YES... MOVB VOLID,R0 ;ANY RESPONSE? BEQ 60$ ;NOPE... CMPB R0,#'Y ;'YES'? BEQ 80$ ;YEP... CMPB R0,#'N ;NOPE, 'NO'? BNE 60$ ;NOPE... ;+ ;ERROR 70$: ERR OPNC,,E ;- 80$: .IRPC X,543210 MOV (SP)+,R'X .ENDR JMP @INGOTO+$EXPA ;GO TO EXPANSION, RETURN TO CALLER .DSABL LSB .SBTTL TRNLOG - TRANSLATE LOGICAL TO PHYSICAL ;+ ; ; TRNLOG ; Translates the {logical} device name in R0 to a physical ; device name (returned in R0) based on the monitor device ; tables. ; ;- TRNLOG: MOV R1,-(SP) ;FIRST SAVE SOME REGISTERS MOV R2,-(SP) MOV R3,-(SP) ; FIRST WE HAVE TO DETERMINE THE POSITION AND SIZE OF THE ; MONITOR DEVICE TABLES MOV @#SYSPTR,R1 ;R1->$RMON ADD PNPTR(R1),R1 ;R1->$PNAME DEVICE TABLE MOV R1,$PNAME ;SAVE IT MOV R1,R2 ;MAKE US A COPY 10$: CMP (R1)+,#-1 ;END OF $ENTRY TABLE? BNE 10$ ;NOPE... TST -(R1) SUB R2,R1 ;R1=COMBINED LENGTH OF $PNAME/$ENTRY ASR R1 ;R1=LENGTH OF A DEVICE TABLE (BYTES) ADD #4,R1 ;FUDGE FACTOR FOR LARGER $UNAMX TABLES SUB R1,R2 ;R2->$UNAM2 MOV R2,$UNAM2 ;SAVE IT SUB R1,R2 ;R2->$UNAM1 MOV R2,$UNAM1 ;SAVE IT SUB #4,R1 ;DETERMINE SIZE OF TABLES (WORDS) ASR R1 MOV R1,$SLOT ;AND SAVE IT ; NOW WE START SCANNING THE TABLES MOV $UNAM2,R1 ;R1->$UNAM2 TABLE (LOGICALS) MOV $SLOT,R2 ;R2=TABLE LENGTH ADD #2,R2 ;$UNAMX TABLES ARE 2 WORDS LONGER 20$: DEC R2 ;MORE TABLE TO SCAN? BLT 30$ ;NOPE... CMP R0,(R1)+ ;YES, DEVICE NAME MATCH THIS ENTRY? BNE 20$ ;NOPE... SUB $SLOT,R1 ;YES, GET THE ASSOCIATED PHYSICAL SUB $SLOT,R1 ; FROM THE SAME POSITION IN THE SUB #6,R1 ; $UNAM1 TABLE (PHYSICALS) MOV (R1),R0 30$: MOV $PNAME,R2 ;R2->$PNAME TABLE (PERMANENTS) SUB #4,R2 ;USE LAST TWO ENTRIES IN $UNAM2 MOV #-2,R3 ; AND START COUNT AT -2 40$: MOV R0,R1 ;MAKE A COPY OF THE DEVICE NAME SUB (R2)+,R1 ;IS IT THIS PERMANENT? BEQ 60$ ;YES, USE IT AS IS... BLO 50$ ;NOPE... SUB #<^R 0>,R1 ;MAYBE, LAST CHARACTER A UNIT NUM? BLO 50$ ;NOPE... CMP R1,#7 ;YES, IS IT A VALID UNIT NUMBER? BLOS 60$ ;YES... 50$: INC R3 ;BUMP SCAN COUNT CMP R3,$SLOT ;SCANNED THE PERMANENT TABLE? BLT 40$ ;NOT YET... BR 70$ ;YES, DEVICE NOT IN PERMANENT EITHER ; (USE AS IS, CSI SHOULD HAVE ; COMPLAINED ABOUT IT ALREADY) 60$: ASL R3 ;SHIFT SCAN COUNT BMI 65$ ;SY OR DK IF STILL NEGATIVE... MOV R0,R1 ;COPY OF DEVICE NAME AGAIN SUB -(R2),R1 ;STRIP PERMANENT PART BNE 70$ ;ALREADY HAS A UNIT NUMBER ADD #<^R 0>,R0 ;NOPE, MAKE IT 'DDN' BR 70$ 65$: MOV @#SYSPTR,R0 ;R0->$RMON MOV SYINDX(R0),-(SP) ;SAVE SYSTEM DEVICE INDEX ADD PNPTR(R0),R0 ;R0->$PNAME TABLE ADD (SP)+,R0 ;ADD INDEX FOR SYSTEM DEVICE MOV (R0),R0 ;GET IT'S ENTRY ADD #<^R 0>,R1 ;CORRECT UNIT NUMBER ADD R1,R0 ;AND ADD IT TO DEVICE 70$: MOV (SP)+,R3 ;RESTORE THE SAVED REGISTERS MOV (SP)+,R2 MOV (SP)+,R1 RTS PC .SBTTL CLRBFI - CLEAR INPUT BUFFER ;+ ; ; CLRBFI ; Discards the current contents of the input buffer. ; ;- CLRBFI: BIS #TTSPC$!TCBIT$,@#JSW ;SET SPECIAL MODE AND INHIBIT WAIT 10$: .TTINR BCC 10$ BIC #TTSPC$!TCBIT$,@#JSW ;RESTORE TERMINAL TO NORMAL RTS PC .SBTTL CCSCAN - SCAN FOR ^C IN INPUT BUFFER ;+ ; ; CCSCAN ; Scans the buffer pointed to by R1 for a ^C character. If ; one is encountered, return is made with CARRY=1. ; ;- CCSCAN: MOV R1,-(SP) ;SAVE R1 10$: TSTB (R1) ;END OF CHARACTER STRING? BEQ 20$ ;YES, ^C NOT FOUND... CMPB (R1)+,#3 ;NOPE, IS CHARACTER A ^C? BEQ 30$ ;YES... BR 10$ ;NOPE, TRY ANOTHER CHARACTER 20$: TST (PC)+ 30$: SEC MOV (SP)+,R1 ;RESTORE R1 RTS PC .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)+ ;FIX A BUG 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 .UNLOC ;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 #EMTBLK,#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 #EMTBLK,#0,R1 ;AND SAVE STATUS BCC 100$ ;+ ;ERROR ERR ILDE ;ILLEGAL DEVICE FOR .SAVESTATUS ;- ; (E.G. MAGTAPE) 100$: 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$ ;+ ;ERROR 30$: ERR FINOFN ;- .SBTTL RT-11 LOOKUP, READ, AND DIR R.LKUP: .CLOSE #17 ;CLOSE CHANNEL IN CASE IN USE .REOPE #EMTBLK,#17,R3 ;REOPEN SAVED FILE CLR R.IBLK ;CLEAR BLOCK NUMBER RETURN ;DONE R.READ: MOV R.IBLK,R1 ;GET BLOCK NUMBER MOV BUFSIZ,R2 ;SIZE OF BUFFER ADD R2,R.IBLK ;UPDATE BLOCK NUMBER SWAB R2 ;WORD COUNT AGAIN .READW #EMTBLK,#17,R4,R2,R1 ;READ A LOAD BCS 2$ ;ERROR ? ASL R0 ;BYTES ACTUALLY READ IS IN R0 ADD R0,R4 ;POINT TO TOP OF GOOD STUFF 1$: RETURN 2$: TSTB @#ERRBYT ;EOF TYPE ERROR ? BEQ 1$ ;YES ;+ ;ERROR ERR INER,,F ;NO, BADDIE ;- U.DIR: ;U.EXPA PUTS IBM DATE IN RT11 FORMAT 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 ;+ ;ERROR 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 ;SEE IF NON-FILE DEVICE LIKE MT OR CS BEQ 11$ ;NOPE OK ;+ ;ERROR ERR ILDE ;ILLEGAL DEVICE FOR THE ;- ; TRICK WE'RE PULLING 11$: .LOOKU #EMTBLK,#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 ;+ ;ERROR OUTER: ERR OUER,,F ;- .SBTTL RT-11 ENTER ;+ ; ; ENTER AS MANY FILES AS POSSIBLE ; ENTRY: R5 -> 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$: .WORD 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: CMPB @#ERRBYT,#3 ;PROTECTED FILE ERROR? BEQ R.PROT ;YEP...LET USER KNOW ABOUT IT ;+ ;ERROR ERR DEFU,,F ;'?DEVICE FULL...' ;- R.PROT: BISB MSKLST+ERR$$F,@#USERRB ;SET SEVERITY LEVEL MOVB CHRLST+ERR$$F,ERRLVL ;COMPLETE PREFIX .PRINT #PREFIX ;AND PRINT IT MOV OUBUFF,R3 ;R3->FILE NAME (RAD50) MOV #PROFIL,R4 ;R4->FILE NAME DESTINATION (ASCII) JSR PC,FNOUT ;DO THE DEVICE NAME MOVB #':,(R4)+ ;DELIMIT IT JSR PC,OUTFNM ;DO THE REST OF THE FILE NAME CLRB (R4) ;END IT IN A NULL BYTE MOV #PROFIL,R3 ;GET SET TO REMOVE SPACES MOV R3,R4 1$: MOVB (R3),(R4) ;MOVE A CHARACTER BEQ 3$ ;END OF STRING...PRINT IT CMPB (R4),#40 ;DID WE MOVE A SPACE? BEQ 2$ ;YES...THEN WRITE OVER IT INC R4 2$: INC R3 BR 1$ ;DO THE NEXT CHARACTER 3$: .PRINT #PROTCT ;PRINT THE CONTINUATION JMP START ;AND RESET EVERYTHING .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)+,R2 ;GET CURRENT CHANNEL CMP R2,@R1 ;WE UP TO THE TOP YET ? BLO 3$ ;NO, AOK 1$: .CLOSE R2 BCS 5$ ;ERROR?!...PROTECTED FILE DEC R2 ;ANY MORE TO DO ? BGT 1$ ;YES CLR @R1 ;NEXT ENTER WILL DO THINGS! 3$: INC R2 ;RESET STARTING CHANNEL MOV R2,-(R1) ;SAVE IT 4$: RETURN ;+ ;ERROR 5$: ERR PROT,,F ;- .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 #EMTBLK,#17,R5 ; ON CHANNEL 1 BCS BADDIR ;BADDIE .SAVES #EMTBLK,#17,R5 ;NEED UNIT NUMBER .REOPE #EMTBLK,#17,R5 ;AND NEED DIRECTORY OPEN MOV 10(R5),-(SP) ;COMPUTE CHKEY FOR IT MOVB @R5,@SP BIC #301,@SP CMP @SP,@SCHKEY ;IS THE DIRECTORY THERE ? BEQ GETDI2 ;IT MIGHT BE CLR @(PC)+ ;IT CAN'T BE, FORCE READ SBLKEY: .WORD 0 GETDI2: MOV (SP)+,@(PC)+ ;SET CHKEY SCHKEY: .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,@SBLKEY ;IS IT ALREADY IN ? BEQ 1$ ;YEP ASL R0 ;NO, CONVERT SEGMENTS TO BLOX ADD #DIRBLK-2,R0 ;POINT TO ABSOLUTE BLOCK MOV R0,-(SP) .READW #EMTBLK,#17,R1,#512.,(SP) ;READ 2 BLOCKS MOV (SP)+,R0 BCS BADDIR ;OUCH ! CMP 4(R1),#37 ;SLIGHT LEGALITY TEST BHI BADDIR ;NO GO MOV DBLOCK,@SBLKEY ;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 ;+ ;ERROR 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 ;+ ;ERROR COROVR: ERR COOV,,F ;MG01 ;- .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 ;+ ;ERROR 9$: ERR FINA,,F ;FIL NAM NULL ;MG01 ;- 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 ;+ ;ERROR ERR NOUF,,F ;MG01 ;- 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 ;+ ;ERROR 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 USRSWP: ;THE USR WILL BE SWAPPED HERE 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 MOV R0,-(SP) .READW #EMTBLK,#0,R4,R5,(SP) ;READ BLOCK MOV (SP)+,R0 BCS 3$ ASL R5 ;COMPUTE TOP OF AREA ADD R5,R4 2$: RETURN ;RETURN (NOTE CLEAR CARRY) ;+ ;ERROR 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 TST (R2)+ ;GET RID OF THE DEVICE NAME MOV R3,R4 ;SAVE INPUT LIST POINTER MOV R5,-(SP) ;SAVE TOP OF CORE JSR PC,XPAND ;GO EXPAND THE LIST 1$: TST @R1 ;EMPTY DIRECTORY SLOT? BEQ 6$ ;YES,GET NEXT SLOT MOV R5,R2 ;POINT TO OUTPUT LIST JSR PC,DUP ;CHECK FOR DUPLICATES 6$: ADD #22,R1 ;ADVANCE TO NEXT FILENAME IN DIRECTORY DECB R0 ;28 DONE YET? BNE 1$ ;NO SWAB R0 ;COUNT AGAIN BEQ 10$ ;DONE, NO ERROR, CLEAN UP ADD #8.,R1 ;SKIP JUNK BETWEEN BLOCKS BR 1$ ;GO BACK TO CHECK FOR MATCH 10$: MOV (SP)+,R5 ;GET TOP OF CORE MOV R4,R3 ;RESTORE INPUT LIST POINTER RTS PC S.DGET: MOV S.DBUF,R1 ;POINT TO DIR BUFFER .READW #EMTBLK,#0,R1,#256.*3,#102 ;READ DOS DIRECTORY BCS 90$ ;ERROR RETURN ;+ ;ERROR 90$: ERR INER ;- FEXIST: MOV #CMDBUF,R4 ;POINT TO BUFFER FOR FILE NAME MOV R2,R3 ;GET POINTER TO FILE NAME CMP -(R3),-(R3) ;FIX IT CALL OUTFNM ;CONVERT FILE NAME CLRB (R4) BISB MSKLST+ERR$$F,@#USERRB ;SET SEVERITY LEVEL MOVB CHRLST+ERR$$F,ERRLVL ;COMPLETE PREFIX .PRINT #PREFIX ; PRINT IT (FACILITY,SEVERITY) .PRINT #EXISTS ; MESSAGE (TEXT) .PRINT #CMDBUF ; ON WHICH FILE JMP START S.INIT: .FETCH R5,R2 ;INITIALIZE DOS...GET HANDLER ; INTO FREE CORE BCS 91$ ;NO GOOD TST (R0)+ MOV R0,R5 ;UPDATE TOP OF CORE MOV R0,S.BUFF ;ALLOCATE DOS BUFFER ADD #512.,R5 ;UPDATE FREE CORE MOV @R2,@R0 ;COPY DEV CLR 2(R0) ;OPEN NON-FILE-STRUCTURED MOV R0,-(SP) .LOOKU #EMTBLK,#0,(SP) ;OPEN ON CHANNEL 0 MOV (SP)+,R0 BCS 91$ ;RETURN IF NO ERROR RTS PC ;+ ;ERROR 91$: ERR ILDE ;- .DSABL LSB DUP: MOV R1,R3 ;DIRECTORY LIST CMP (R2)+,(R3)+ ;THIS EXPANDED NAME MATCH? BNE 4$ ;NO CMP (R2)+,(R3)+ ;SECOND HALF OF FILE NAME? BNE 5$ ;NO CMP @R2,@R3 ;THE EXTENSION? BNE 5$ ;NO BR FEXIST ;ERROR 4$: TST (R2)+ ;FIX POINTER TO INPUT LIST 5$: TST (R2)+ ;ADVANCE TO NEXT INPUT NAME TST @R2 ;END OF LIST? BNE DUP ;NO RTS PC ;YES,RETURN XPAND: CMP @R2,#R50STAR ;IS IT A * FILENAME? BNE 1$ ;NO MOV (R3)+,(R5)+ ;GET THE FILENAME FROM THE MOV (R3)+,(R5)+ ;INPUT LIST CMP (R2)+,(R2)+ ;GO CHECK THE EXTENSION CMP @R2,#R50STAR ;DO WE HAVE A *.* SITUATION BEQ 3$ ;YES MOV @R2,(R5)+ ;(*.EXT) PUT OUTPUT EXT INTO LIST BR 2$ ;WILL IT BE THE END OF LIST? 1$: MOV (R2)+,(R5)+ ;PUT FIRST HALF OF OUTPUT NAME ; INTO OUTPUT LIST MOV (R2)+,(R5)+ ;DO THE SAME FOR THE SECOND HALF CMP @R2,#R50STAR ;FILNAM.EXT? BEQ 8$ ;YES MOV @R2,(R5)+ ;GET EXTENSION 8$: CMP (R3)+,(R3)+ ;ONLY ONE IS LEGAL 3$: MOV (R3)+,(R5)+ ;POINT TO INPUT EXTENSION 2$: TST @R3 ;END YET???? BEQ 7$ ;YUP!!!! ADD #12,R3 ;GET RID OF JUNK CMP -(R2),-(R2) ;GET BACK TO BEG. OF INPUT STRING BR XPAND ;CIRCLE GAME 7$: CLR @R5 ;ZERO THE LAST WORD FOR THE END MOV 2(SP),R5 ;RESTORE THE START OF THE LIST RTS PC ;OUTPUT LIST IS BUILT SO RETURN .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 ;+ ;ERROR 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 ;+ ;ERROR 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$: MOV R0,-(SP) .WRITW #EMTBLK,#0,R2,#256.,(SP) ;WRITE 1 BLOCK MOV (SP)+,R0 ;DON'T CLEAR CARRY BIT 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 #EMTBLK,#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 ;+ ;ERROR 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 ; TWENTY-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 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$: .WRITW #EMTBLK,#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 .WRITW #EMTBLK,#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 #EMTBLK,#0,S.DBUF,#256.*3,#102 ;OUTPUT THE UFD AND MASTER MAP BCC S.RTS2 ;EVERYTHING OK JMP S.OUE1 ;OUTPUT ERROR ; 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 S.RTS2: RETURN S.RD1: MOV R0,-(SP) .READW #EMTBLK,#0,S.BUFF,#256.,(SP) ;READ ONE BLOCK WHOSE ; # IS IN (SP) MOV (SP)+,R0 BCC S.RTS2 ;RETURN IF SUCCESSFUL ;+ ;ERROR 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 ;+ ;ERROR 90$: ERR BAPP,,F ;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 ;+ ;ERROR 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 #<^RDT >,R1 ;IS IT MERELY 'DT'? BEQ 10$ ;GOT NUMBER IF SO SUB #<^R 0>,R1 ;GET DEVICE NUMBER 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 ;+ ;ERROR ILLDEV: ERR ILDE ;ILLEGAL DEVICE TYPE ERRDIR: ERR DIER,,F ;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 ;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 PAK ;SPACE LEFT, SO GO *50 CLR (R5)+ ;CLEAR THE NEXT WORD MOV #3,R50CTR ;RESET COUNT PAK: 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 ;+ ;ERROR ERR INER ;YUP, HOW TERRIBLE ;- 1$: .MTPS #340 ;UP TO 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 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: .WORD 0 CLR DTERR ;REMIND USER JOB THAT WE GOT ERROR RETURN ;BACK TO THE SHADOWS AGAIN .SBTTL UNIVERSAL FLOPPY DISK ROUTINES ;+ ; THE FOLLOWING ROUTINES ARE SPECIFIC TO UNIVERSAL DISKETTES ;- .SBTTL DIRECTORY ZERO FOR UNIVERSAL FLOPPY ;+ ; ; THE FOLLOWING ROUTINE INITIALIZES THE DISKETTE SO THAT IT WILL BE COMPATABLE ; WITH IBM FORMAT. ; FIRST, A DSTATUS IS DONE TO DETERMINE IF THE SPECIFIED DEVICE IS RX01 OR ; RX02 (SINGLE DENSITY). THEN THE WHOLE DISKETTE IS SET TO BLANKS AND ; THE INDEX TRACK IS WRITTEN (TRACK 00). ; ;- .ENABL LSB U.ZERO::CLR UITRAC ;INITIALIZE TRACK 0 ;JM4 CALL XPANDI ;OPEN OUTPUT FLOPPY ; (LOAD HANDLER, ETC) TST SWT.V ;INIT/VOL? BEQ 99$ ;NOPE... CMP SWT.V,#<^RONL> ;YES, INIT/VOL:ONL? BNE 98$ ;NOPE... MOVB #377,UICMD ;SET TO 'READ' MOVB #7,UISECT ; OF SECTOR 7 JSR PC,U.SPF1 ;READ IT MOV UIBUFR,R1 ;R1->BUFFER ADD #6,R1 ;R1->SPOT FOR VOLUME ID MOV U.VOLU,(R1) ;SET THE DEFAULT MOV U.VOLU+2,2(R1) MOV U.VOLU+4,4(R1) JSR PC,GETVID ;GO GET THE VOLUME ID MOVB #376,UICMD ;SET TO 'WRITE' JSR PC,U.SPF1 ;WRITE UPDATED SECTOR RETURN ;ALL DONE 98$: MOV #U.VOLU,R1 JSR PC,GETVID 99$: MOV #U.DATA,R1 ;R1 -->DATA FOR IBM SECTORS MOVB #376,UICMD ;SET UP FOR WRITING REGULAR SECTOR 1$: MOVB (R1)+,UISECT ;GET THE SECTOR NUMBER BMI 5$ ;MINUS - HAVE INSTALLED DATA CALL VTOCLR ;CLEAR THE VTOC 2$: MOVB (R1)+,R2 ;GET OFFSET WITHIN SECTOR FOR DATA BPL 3$ ;IF PLUS - CONTINUE SETTING UP BUFFER JSR PC,U.SPF1 ;END OF DATA - WRITE THE SECTOR BR 1$ ;CREATE NEXT SECTOR 3$: ADD UIBUFR,R2 ;ADD ON BEGINNING OF SECTOR BUFFER 4$: MOVB (R1)+,R0 ;GET DATA CHARACTER TO STORE BEQ 2$ ;IF 0, DONE MOVB R0,(R2)+ ;PUT CHAR IN THE SECTOR BUFFER BR 4$ ;CONTINUE STORING DATA ; THIS SECTION OF THE ROUTINE IS ENTERED AFTER INITIALIZING SECTORS 1 TO 8. ; THE ROUTINE INITIALIZES THE DATASET LABELS (SECTORS 9-26). 5$: MOV #9.,UISECT ;DATASET LABELS BEGIN IN SECTOR 9. MOV #371*400+360,LD1 ;SECTOR NUMBER "09" MOVB #375,UICMD ;SET UP FOR WRITING DELETED DATA MARK 6$: MOV UIBUFR,R2 ;POINT TO START OFINPUT BUFFER TST (R2)+ ;SKIP OVER DEL DATA MARK WORD MOVB #304,@R2 ;DELETE "D" MOV #364*400+367,34(R2) ; "74" OF 74001 IN POSITIONS 29-33 MOV #364*400+367,112(R2) ;AND IN POSITIONS 75-79 ADD #9.,R2 ;POINT TO POSITIONS 10-11 TO MOVB LD1,(R2)+ ;INSERT THE PROPER SECTOR MOVB LD2,(R2)+ ;INTO NAME INCB LD2 ;SET UP WITH NEXT SECTOR NUMBER CMPB #371,LD2 ;EBCDIC 9? BHIS 7$ ;LOWER - WRAP AROUND MOVB #360,LD2 ;MAKE EBCDIC 0 INCB LD1 ;INCREMENT TENS DIGIT 7$: JSR PC,U.SPF1 ;WRITE SECTOR INC UISECT ;INCREAMENT SECTOR CMP #27.,UISECT ;HAVE WE REACHED THE END? BNE 6$ ;WRITE SECTOR 9-26 WITH DELETED ; DATASET LABELS RETURN .DSABL LSB ; THE FOLLOWING DATA IS LOADED INTO SECTORS 5 TO 8 OF THE INDEX TRACK U.DATA: .BYTE 5,2 ;SECTOR 5, OFFSET 0 .BYTE 305,331 ;EBCDIC "ER" .BYTE 324,301 ; "MA" .BYTE 327,100 ; "P " .BYTE 0,-1 ;END GROUP, END SECTOR .BYTE 7,2 ;NEW SECTOR IS 7, OFFSET 0 .BYTE 345,326 ;EBCDIC "VO" .BYTE 323,361 ; "L1" U.VOLU: .BYTE 331,343 ;VOLUME ID "RT" .BYTE 361,361 ; "11" .BYTE 301,100 ; "A " .BYTE 0,80. ;END GROUP, NEW GROUP AT BYTE 78. .BYTE 100,346 ; " W" .BYTE 0,-1 ;END GROUP, END SECTOR .BYTE 8.,2 ;NEW SECTOR IS 8, OFFSET 0 .BYTE 310,304 ;EBCDIC "HD" .BYTE 331,361 ; "R1" .BYTE 100,304 ; " D" .BYTE 301,343 ; "AT" .BYTE 301,100 ; "A " .BYTE 0,26. ;END GROUP, NEW GROUP AT BYTE 24. .BYTE 360,370 ; "08" .BYTE 360,100 ; "0 " .BYTE 360,361 ; "01" .BYTE 360,360 ; "00" .BYTE 361,100 ; "1 " .BYTE 367,363 ; "73" .BYTE 360,362 ; "02" .BYTE 366,100 ; "6 " .BYTE 0,76. ;END GROUP, NEW GROUP AT BYTE 74. .BYTE 360,361 ; "01" .BYTE 360,360 ; "00" .BYTE 361,0 ; "1", END GROUP .BYTE -1,-1 ;END SECTOR, END ALL SECTORS .SBTTL VTOCLR - CLEAR FOR VTOC SECTORS ;+ ; ; VTOCLR ; Unlike UCLRBF, this routine ensures that no matter the ; mode, the first 41. words are set to spaces and the ; final 24. are set to nulls. ; ;- VTOCLR: MOV R1,-(SP) ;SAVE CURRENT R1 MOV UIBUFR,R0 ;R0->BUFFER TO CLEAR MOV #100*400+100,-(SP) ;FILL FOR FIRST 41. WORDS MOV #41.,R1 ;SET THE COUNT 10$: MOV (SP),(R0)+ ;SET TWO BYTES DEC R1 ;MORE TO DO? BGT 10$ ;YES... CLR (SP) ;RESET FILL FOR NULLS MOV #24.,R1 ;R1=FILL COUNT 20$: MOV (SP),(R0)+ ;SET TWO BYTES DEC R1 ;MORE TO DO? BGT 20$ ;YES... TST (SP)+ ;DISCARD FILL MOV (SP)+,R1 ;RESTORE PREVIOUSLY SAVED R1 RTS PC .SBTTL GETVID - GET VOLUME ID FOR INTERCHANGE DISKETTES ;+ ; ; GETVID ; Prompts for and processes 1-6 character volume ID ; ; CALL ; R1 -> 6 byte field to receive volume id ; ; RETURN ; 1-6 character volume id in field ; R1 -> beyond last character of ID ; ; ERRORS ; none ; ;- GETVID: BIS #GTLIN$,@#JSW ;MAKE THE NEXT .GTLIN NON-TERMINATING 10$: JSR PC,CLRBFI ;DISCARD CRUFT IN INPUT BUFFER BIS #GTLIN$,@#JSW .GTLIN #VOLID,#M.VIDP,TERM ;PROMPT FOR VOLUME ID BIC #GTLIN$,@#JSW TSTB VOLID ;ANY RESPONSE? BEQ 50$ ;NOPE, USE DEFAULT JSR PC,CCSCAN ;ANY ^C'S? BCS 10$ ;YES... MOV R2,-(SP) ;SAVE SOME REGISTERS MOV R3,-(SP) MOV #VOLID,R2 ;R2->RESPONSE MOV #6,R3 ;MAXIMUM OF 6 CHARACTERS 20$: MOVB (R2)+,R0 ;GET A CHARACTER BEQ 30$ ;NO MORE... JSR PC,ATOE ;CONVERT FROM ASCII TO EBCDIC MOVB R0,(R1)+ ;PLACE IT IN THE BUFFER DEC R3 ;MORE TO DO? BGT 20$ ;YEP... TSTB (R2) ;ANY EXTRA CHARACTERS? BEQ 40$ ;NOPE... BISB MSKLST+ERR$$W,@#USERRB ;SET ERROR MASK MOVB CHRLST+ERR$$W,ERRLVL ;SET ERROR SEVERITY .PRINT #PREFIX ;PRINT THE PREFIX .PRINT #W.TRUN ; AND THE TEXT BR 40$ 30$: MOVB #100,(R1)+ ;PAD WITH SPACES DEC R3 ;MORE TO DO? BGT 30$ ;YES... 40$: MOV (SP)+,R3 ;RESTORE THE REGISTERS WE SAVED MOV (SP)+,R2 50$: RTS PC .SBTTL UNIVERSAL - INITIALIZE BUFFER ;+ ; ;UCLRBF - THIS ROUTINE INITIALIZES THE INPUT BUFFER. THE FIRST 41 DECIMAL ; WORDS ARE CONVERTED TO EBCDIC SPACES (FIRST WORD OF BUFFER IS FLAG WORD FOR ; .SPFUN PLUS 80. BYTES). THE REMAINDER OF THE BUFFER IS CLEARED (TOTAL ; BUFFER SIZE IS 202 OCTAL BYTES - FLAG WORD PLUS 128. BYTES). IF /A (ASCII) ; OR /I (IMAGE) IS SPECIFIED THE WHOLE BUFFER IS CLEARED (BLANK). ; ;UCLRBX - IF CALLED, R0 ACTUALLY POINTS TO THE OUTPUT BUFFER (UOBUFR). THE ; SAME EXPLANATION (ABOVE) APPLIES. ; ;- .ENABL LSB UCLRBF: MOV UIBUFR,R0 ;R0->START OF THE INPUT BUFFER UCLRBX: MOV #41.,R4 ;R4 = COUNT CLR -(SP) ;SP INITIALLY CONTAINS BLANK FILL TST SWT.A ;ASCII MODE? BNE 10$ ;YES, FILL ALL POSITIONS WITH BLANK TST SWT.I ;IMAGE MODE? BNE 10$ ;YES, FILL ALL POSITIONS WITH BLANK MOV #100*400+100,(SP) ;PACKED MODE - FILL WITH EBCDIC SPACES 10$: MOV (SP),(R0)+ ;FILL POSITIONS WITH EITHER ; BLANK OR SPACE DEC R4 ;DECREAMENT COUNT BNE 10$ ;IF NOT DONE - CONTINUE FILL MOV #24.,R4 ;SET COUNT FOR REST OF BUFFER 20$: MOV (SP),(R0)+ ;FILL REST WITH EBCDIC BLANKS ;004 DEC R4 ;DECREAMENT COUNT BNE 20$ ;IF NOT DONE - CONTINUE FILL TST (SP)+ ;SET STACK POINTER FOR RETURN RETURN .DSABL LSB .SBTTL UNIVERSAL FLOPPY "EXPAND" ;+ ; ; EXPANDS IBM FLOPPY DIRECTORY INTO SOMETHING READABLE. ; SEE GENERAL EXPLANATION OF "EXPAND" AT FRONT OF LISTING. ; EACH FILE ENTRY ON THE DISK GETS AN 8-WORD BLOCK CONSISTING OF: ; ; 1 FIL ; 2 NAM IN RAD 50 ; 3 EX (ONLY 8 CHARS IN NAME SO WE FAKE A 2-CHAR EXT) ; 4 DATE IN RT-11 FORMAT ; 5 # OF DIRECTORY SECTOR (BITS 15-11) & STARTING TOTALSECTOR ; 6 SIZE IN RT-11 BLOCKS (4 SECTORS/BLOCK) ; 7 ENDING TOTALSECTOR OF DATA AREA ; 8 ENDING TOTALSECTOR OF ACTUAL DATA ; ;A "TOTALSECTOR", AS USED ABOVE, IS THE NUMBER OF THE SECTOR ;STARTING FROM TRACK 0 AND JUST ADDING 26. SECTORS PER TRACK. ;E.G. SECTOR 1 OF TRACK 1 IS TOTALSECTOR # 27. ; TOTALSECTOR = TRACK*26.+SECTOR ; ;- U.EXPD:: MOVB #377,UICMD ;SET TO READ CLR UITRAC ; TRACK 0 MOV #7,UISECT ; SECTOR 7 JSR PC,U.SPF1 ;READ IT MOV UIBUFR,R1 ;R1->BUFFER ADD #6,R1 ;BYPASS DELETED DATA MARK AND 'VOL1' MOV #VOLID,R2 ;R2->WHERE TO PUT CONVERTED VOLUME ID MOV #6,R3 ;MAX OF 6 CHARACTERS IN VOLUME ID 100$: CLR R0 BISB (R1)+,R0 ;GET AN EBCDIC CHARACTER JSR PC,ETOA ;CONVERT TO ASCII MOVB R0,(R2)+ ;AND PLACE IN VOLUME ID BUFFER DEC R3 ;MORE TO DO? BGT 100$ ;YEP... CLRB (R2)+ ;TERMINATE THE STRING MOV (SP)+,R3 ;PTR TO START OF EXPANDED FILES LIST CLR (R5)+ ;SIGNAL END OF LIST RETURN .ENABL LSB U.EXPA::CALL VALDEV ;CHECK FOR VALID DEVICE MOV DS.VSZ(R5),UDVSIZ ;SAVE DEVICE SIZE .FETCH R5,R3 ;LOAD FLOPPY HANDLER MOV R0,R5 ;RESET START OF FREE CORE MOV R0,UIBUFR ;DEFINE A FLOPPY I/O BUFFER ADD #65.*2,R5 ;65. WORDS LONG CMP CORTOP,R5 ;MAKE SURE WE DON'T STOMP ON MONITOR BHI 10$ ;NO PROBLEM ;+ ;ERROR ERR COOV ;ERROR ;- 10$: MOV R5,-(SP) ;THIS WILL ALSO BE START OF FILES LIST MOV 2(R3),-(SP) ;SAVE FIRST RAD50 CHARS OF NAME CLR 2(R3) ;CLEAR NAME FOR LOOKUP .LOOKUP #EMTBLK,#0,R3 ;OPEN FLOPPY IN NON-FILE MODE MOV (SP)+,2(R3) ;RESTORE NAME PREVIOUSLY CLEARED BCC 20$ ;C-BIT CLEAR...NO ERROR ;FALL THROUGH FOR ERROR IF C-BIT SET ;+ ;ERROR ERR DIER ;DIRECTORY ERROR ;- 20$: .SPFUN #EMTBLK,#0,#373,#UDVSIZ,#1,#0 ;GET DEVICE SIZE CMP #494.,UDVSIZ ;IS THIS AN RX01 DISK? BEQ 25$ ;BRANCH IF SO ;+ ;ERROR ERR ILDE ;- 25$: TST SWT.Z ;INITIALIZING FLOPPY? BNE U.EXPD ;YES, JUST OPEN AS NON-FILE MODE CALL TSTIBM ;MAKE SURE IBM DISK 30$: INC UISECT ;INCREMENT SECTOR COUNT CMP UISECT,#26. ;END OF THE TRACK? BHI U.EXPD ;END OF THE "DIRECTORY" CALL U.GNAM ;GET NAME FROM SECTOR AND ; CONVERT TO RAD50 BNE 30$ ;IF DELETED DATA MARK OR "DD" SEEN TSTB R4 ;SEE IF WILDCARD NAME BMI 40$ ;IF SO, KEEP NAME JUST EXPANDED CMP 2(R3),-6(R5) ;IF NOT, CHECK FIRST HALF FOR MATCH BNE 50$ ;NO MATCH, CHECK NEXT CMP 4(R3),-4(R5) ;FIRST HALF MATCHED, ; HOW ABOUT SECOND HALF? BNE 50$ ;NO MATCH, CHECK NEXT 40$: TST R4 ;CHECK IF WILD EXTENSION BMI 60$ ;IF SO, WE MAY PROCEED WITH EXPANSION CMP 6(R3),-2(R5) ;EXTENSIONS MATCH? BEQ 60$ ;YES, PROCEED WITH EXPANSION 50$: SUB #6,R5 ;GET NEXT FILE FROM LIST BR 30$ ;AND TEST AGAIN 60$: ADD #34.,R1 ;POINT AT CREATION DATE CALL U.BND ;CONVERT TWO EBCDIC DIGITS TO RAD50 MOV R0,R2 ;IT'S THE "YEAR" PART OF THE DATE BEQ 70$ ;IF NO DATE, LEAVE AS 0 SUB #64.,R2 ;MAKE IT RELATIVE 1964 70$: CALL U.BND ;GET THE MONTH SWAB R0 ;PUT IT WHERE RT WANTS IT ASL R0 ASL R0 ADD R0,R2 CALL U.BND ;WOULD YOU GUESS THIS IS THE DAY? SWAB R0 ASR R0 ASR R0 ASR R0 ADD R0,R2 ;THE DEED IS DID MOV R2,(R5)+ ;PUT IT IN THE 8-WORD FILE BLOCK ADD #-29.,R1 ;BACK UP IN SECTOR BUFFER ; TO RECORD SIZE CALL U.BND ;GET FIRST TWO DIGITS OF ; DECLARED RECORD SIZE MOV R0,R2 ASL R2 ASL R2 ADD R0,R2 ;MULTIPLY BY 10 ASL R2 MOVB (R1)+,R0 ;GET 3RD DIGIT BIC #^C<17>,R0 ADD R0,R2 ;ADD IT IN INC R1 ;SKIP "RESERVED" BYTE MOV UISECT,R0 ADD #U.RSIZ-8.,R0 ;POINT TO SLOT IN TABLE MOVB R2,(R0) ;PLUNK IN THE RECORD SIZE MOV R2,-(SP) ;SAVE RECORD SIZE FOR LATER USE CALL U.TS ;EXTRACT STARTING TRACK/SECTOR ; FOR THIS FILE MOV UISECT,R0 ;GET SECTOR # OF DIRECTORY ENTRY SWAB R0 ASL R0 ASL R0 ASL R0 ;PUT IN BITS 15-11 ADD R0,-2(R5) ;ADD IN STARTING TOTALSECTOR OF FILE CMPB (R5)+,(R5)+ ;SKIP SIZE SLOT FOR NOW CALL U.TS ;GET TRACK/SECTOR OF END OF DATA AREA ADD #34.,R1 ;POINT TO DATA LIMIT TRACK/SECTOR CALL U.TS ;(HOW MUCH OF DATA AREA ACTUALLY USED) SUB #6,R5 ;SET R5 BACK TO SIZE SLOT IN ; EXPANSION BLOCK MOV -2(R5),R2 ;STARTING TOTALSECTOR BIC #^C<3777>,R2 ;CLEAR DIRECTORY SECTOR # BITS MOV 4(R5),R1 ;ENDING TOTALSECTOR OF DATA SUB R2,R1 BHIS 80$ ;ENDING SECTOR .LT. STARTING? CLR R1 80$: CMP (SP)+,#126. ;SEE IF RECORD SIZE IS .GT. 126. BLOS 90$ ;IF NOT, NO SIZE PROBLEMS TST SWT.A ;OTHERWISE, MAY NEED TO MAKE ROOM BNE 90$ ;FOR INSERTING CRLF'S TST SWT.I ;IF THE OUTPUT MODE IS EBCDIC BNE 90$ ;BUT NOT FOR /A OR /I MODE MOV R1,-(SP) ;PUSH THE SECTOR SIZE OF INPUT ADD #377,(SP) ;ROUND UP TO MULTIPLE OF 256. SWAB (SP) ;SINCE # OF SECTORS = # OF RECORDS BIC #^C<377>,(SP) ;AND EACH RECORD GETS CRLF ASL (SP) ASL (SP) ADD (SP)+,R1 ;NEED 4 EXTRA SECTORS PER 256 SECTORS 90$: ADD #4,R1 ;ROUND TO NEXT RT BLOCK, +1 FOR SAFETY ASR R1 ASR R1 ;4 SECTORS/RT11 BLOCK MOV R1,(R5) ;PLUNK THE RESULT IN THE SLOT ADD #6,R5 ;R5->WHERE NEXT 8-WORD BLOCK BEGINS JMP 30$ ;GET NEXT FILE .DSABL LSB ;GET NAME FROM IBM SECTOR, PACK INTO RAD50 .ENABL LSB U.GNAM::CALL U.SPF1 ;GET THE SECTOR MOV UIBUFR,R1 ;R1 POINTS TO START OF INPUT BUFFER TST (R1)+ ;DELETED DATA MARK? BNE 20$ ;IF YES RETURN CMP #304*400+310,(R1)+ ;LOOK FOR "HDR1" BNE 20$ ;IBM DOESN'T ALWAYS USE DELETED ; DATA MARKS! CMP #361*400+331,(R1)+ ;LOOK FOR "DDR1" BNE 20$ ;SO ASSUME "DDR1" IF NOT "HDR1" TSTB (R1)+ ;SKIP "RESERVED" BYTE MOV #8.,-(SP) ;8 CHARACTER COUNT CLR R50CTR ;CTR IN R50PAK 10$: MOVB (R1)+,R0 ;GET THE CHARACTERS OF THE LABEL BIC #^C<377>,R0 ;HORRAY FOR REGISTER SIGN EXTEND! CALL ETOA ;CONVERT EBCDIC TO ASCII CALL R50PAK DEC (SP) BNE 10$ ;KEEP GOING FOR 8 CHARS TST (SP)+ ;CLEAN UP STACK MOV #40,R0 ;FILL 9TH CHARACTER WITH SPACE CALL R50PAK ;PACK RAD50 SEZ 20$: RETURN .DSABL LSB ;TSTIBM - ;TEST FOR IBM FORMAT DISK - READ TRACK 0, SECTOR 7 OF UNIVERSAL FLOPPY INTO ;THE BUFFER. CHECK FOR "VOL1" IN BYTES 1-4. IF NOT PRESENT, ERROR. .ENABL LSB TSTIBM: CLR UITRAC ;SET UP TO READ TRACK 0 MOV #7,UISECT ;SECTOR 7 MOVB #377,UICMD ;.SPFUN TO READ ABSOLUTE SECTOR 7 CALL U.SPF1 ;READ THE SECTOR MOV UIBUFR,R0 ;POINT TO START OF BUFFER TST (R0)+ ;TEST FOR DELETED DATA FLAG BNE 10$ ;DIRECTORY ERROR CMP (R0)+,#326*400+345 ;CHECK FOR EBCDIC "VO" BNE NIBM ;IF NOT EQUAL, NOT IBM FORMAT CMP (R0)+,#361*400+323 ;CHECK FOR EBCDIC "L1" BNE NIBM ;IF NOT EQUAL, NOT IBM FORMAT RETURN ;+ ;ERROR 10$: ERR DIER ;NO DIRECTORY NIBM: ERR NOTIBM,,F ;MG01 ;- .DSABL LSB U.BND:: MOVB (R1)+,R0 BIC #^C<17>,R0 ASL R0 ;CRUDE MULTIPLY BY 10. ;005 MOV R0,-(SP) ASL R0 ;005 ASL R0 ;005 ADD R0,(SP) ;**-2 MOVB (R1)+,R0 ;**-1 BIC #^C<17>,R0 ADD (SP)+,R0 RTS PC U.SPF1: MOV #SPFUN1,R0 BR U.SPFX U.SPF2: MOV #SPFUN2,R0 U.SPFX: MOV 10(R0),FUNT ;SAVE R0 INCASE OF ERROR .SPFUN ;DO YOUR MAGIC, RT! BCS 10$ RTS PC 10$: CMPB @#ERRBYT,#1 ;WAS THE ERROR A HARD ERROR? BLO U21$ ;READ BEYOND EOF? BEQ U31$ ;I/O ERROR? ;+ ;ERROR ERR NOTOPN,,F U21$: ERR EOF,,F ;- U31$: CMP #-1,(PC)+ ;WERE WE READING? FUNT: .WORD 0 BEQ 6$ ;YES ;+ ;ERROR ERR OUER ;NO, A WRITE 6$: ERR INER ;READ ERROR ;- U.TS: JSR PC,U.BND ;CONVERT TWO EBCDIC DIGITS ASL R0 ;CRUDE (BUT FAST) MULTIPLY BY 26;005 MOV R0,(R5) ;**-1 ASL R0 ;005 ASL R0 ;005 ADD R0,(R5) ;**-5 ASL R0 ;005 ADD R0,(R5) ;005 INC R1 ;SKIP "RESERVED" BYTE JSR PC,U.BND ;GET THE SECTOR ADD R0,(R5)+ INC R1 RTS PC .SBTTL UNIVERSAL FLOPPY "U.OPEN" .ENABL LSB U.OPEN::CALL VALDEV ;CHECK FOR VALID DEVICE .FETCH R5,R2 ;LOAD FLOPPY HANDLER 10$: MOV R0,R5 MOV R0,UOBUFR ;ALLOCATE AN OUTPUT FLOPPY BUFFER ADD #65.*2,R5 MOV R5,U.HOLE ;ALLOCATE A HOLE TABLE ADD #19.*2,R5 CMP CORTOP,R5 ;SEE IF CORE OVERFLOW BHIS 20$ ;+ ;ERROR ERR COOV ;- 20$: MOV UIBUFR,-(SP) ;CALL OUTPUT BUFFER THE INPUT ; BUFFER FOR NOW MOV R0,UIBUFR ;SO SUBROUTINES GET WHAT THEY EXPECT MOV R0,R1 ;(N.B. THERE MAY NOT ACTUALLY BE ; AN INP BUFR) CALL UCLRBX ;CLEAR THE OUTPUT BUFFER MOV 2(R2),-(SP) CLR 2(R2) .LOOKUP #EMTBLK,#0,R2 ;OPEN FLOPPY NON-FILE MODE MOV (SP)+,2(R2) BCC 30$ ;+ ;ERROR ERR DIER ;SOME SORT OF LOOKUP ERR ;- 30$: CALL TSTIBM ;CHECK FOR IBM FLOPPY MOV R5,-(SP) ;SAVE FREE CORE PTR MOV U.HOLE,R4 40$: CLR (R4) INC UISECT ;BUMP TO NEXT SECTOR CMP UISECT,#26. ;SEE IF DONE BHI 90$ ;IF SO JSR PC,U.GNAM ;GET THE SECTOR, PACK THE NAME BNE 70$ ;IF DELETED DATA MARK OR "DD" SEEN MOV R3,-(SP) ;SET UP TO SEARCH FOR DUPLICATE NAME MOV R4,-(SP) ;SAVE HOLE LIST PTR 50$: MOV 4(SP),R5 ;RESET FREE CORE PTR ADD #6.,R5 ;POINT TO PUT MAPPED FILNAM.EXT AREA TST (R3) ;END OF INPUT LIST? BEQ 60$ ;YES, GET NEXT SECTOR JSR PC,U.IMAP ;MAP INPUT LIST WITH OUTPUT SPEC MOV 4(SP),R4 ;GET FREE CORE PTR AGAIN SUB #6,R5 ;BACK UP TO START OF NAME.EXT CMP (R4)+,(R5)+ ;COMPARE FLOPPY NAME WITH MAPPED INPUT BNE 50$ ;NO MATCH CMP (R4)+,(R5)+ ;COMPARE SECOND HALF OF FILENAME BNE 50$ ;NO MATCH MOV R1,-(SP) ;SAVE R1 FOR LATER ;JM2- MOV @R5,R0 ;R0 MUST HAVE NUMBER TO DIVIDE MOV R2,-(SP) ;SAVE R2 FROM DIVIDE ROUTINE JSR R5,DIVIDE ;NOW GO DIVIDE ROUTINE .WORD 50 ;BY 50 OCTAL MOV (SP)+,R2 ;RESTORE POINTER TO OUTPUT PROTO NAME MOV R0,(R5)+ ;CONTAINS CHARACTER TO PACK MOV #40,R0 ;PLUS A SPACE CALL PAK ;GO PACK IT TST -(R5) ;RESET FOR COMPARE MOV (SP)+,R1 ;RESTORE R1 ;JM2+ CMP (R4)+,(R5)+ ;COMPARE EXTENSIONS BNE 50$ ;NOT EQUAL, KEEP CHECKING MOV R4,R2 ;GET NAME POINTER IN RIGHT PLACE TST -(R2) ;DO A THINGIE JMP FEXIST ;'FILE ALREADY EXISTS DEV:FILNAM.TYP' 60$: MOV (SP)+,R4 ;GET HOLE LIST PTR AGAIN MOV (SP)+,R3 ;RESTORE INPUT LIST PTR BR 80$ ;GO TO NEXT FLOPPY SECTOR 70$: ADD #28.,R1 ;R1->BYTES OF STARTING TRACK/SECTOR JSR PC,U.TS ;MUNG THEM AROUND MOV -(R5),-(SP) ;SAVE STARTING TOTALSECTOR CALL U.TS ;MUNG THE ENDING TRACK/SECTOR ; OF THE AREA SUB (SP)+,-(R5) ;GET THE SIZE IN TOTALSECTORS INC (R5) ;SIZE=END-START+1 ;005 MOV (R5),(R4) 80$: TST (R4)+ ;AND GO TO NEXT SLOT IN TABLE MOV (SP),R5 ;RESET FREE CORE PTR BR 40$ ;GO TO NEXT ENTRY 90$: MOV (SP)+,R5 ;RESTORE R5 MOV (SP)+,UIBUFR ;RESTORE INPUT BUFR ADDR (IF ANY) RETURN .DSABL LSB ;R2 POINTS TO OUTPUT PROTOTYPE NAME ;R3 POINTS TO INPUT LIST NAME ;R5 POINTS TO FREE CORE .ENABL LSB U.IMAP::MOV R2,-(SP) TST (R2)+ ;SKIP "DEV" CMP #R50STAR,(R2) ;CHECK FOR * IN OUTPUT PROTOTYPE BNE 10$ ;IF NOT, USE NEW OUTPUT NAME MOV (R3)+,(R5)+ ;OTHERWISE USE INPUT NAME BEQ 50$ ;...UNLESS WE'RE AT END OF LIST MOV (R3)+,(R5)+ CMP (R2)+,(R2)+ ;SKIP TO OUTPUT PROTOTYPE EXTENSION BR 20$ 10$: MOV (R2)+,(R5)+ ;IF NO *, USE NEW OUTPUT NAME MOV (R2)+,(R5)+ CMP (R3)+,(R3)+ ;SKIP TO INPUT LIST EXTENSION WORD 20$: CMP #R50STAR,(R2) ;SEE IF * GIVEN AS OUTPUT EXT BNE 30$ ;IF NOT MOV (R3),(R5)+ ;IF SO, PLUNK IN INPUT EXT BR 40$ 30$: MOV (R2),(R5)+ ;USE NEW OUTPUT EXT 40$: ADD #12.,R3 ;BUMP TO NEXT INPUT LIST NAME 50$: MOV (SP)+,R2 ;RESET OUTPUT PROTOTYPE PTR RETURN .DSABL LSB .SBTTL UNIVERSAL FLOPPY "U.LKUP" U.LKUP::CLR U.IBCT ;SHOW BUFR EMPTY MOV 2(R3),U.ISEC ;STARTING TOTALSECTOR FOR FILE BIC #^C<3777>,U.ISEC ;REMOVE DIRECTORY SECTOR # RETURN .SBTTL UNIVERSAL FLOPPY "U.ENTE" ;+ ; ;DOES "BEST FIT" OF FILE IN AVAILABLE SPACES IF /A OR /I ;DOES "WORST FIT" IF STRAIGHT IBM MODE (NECESSARY BECAUSE FILE ;GROWS BY AN INDETERMINANT AMOUNT WHEN GOING FROM RT TO IBM. ;IN IBM MODE, RECORDS MUST START ON SECTOR BOUNDARIES.) ; ;- .ENABL LSB U.ENTE::TST SWT.I BNE 1$ ;IF /I OR /A, DO BEST FIT TST SWT.A BEQ 5$ ;IF NEITHER, DO WORST FIT 1$: MOV 10.(R3),R5 ;GET FILE SIZE NEEDED 2$: CLR R1 MOV U.HOLE,R4 ;PTR TO LIST OF FREE AREA SIZES CLR -(SP) ;FLAG WORD FOR POSSIBLES 3$: MOV (R4)+,R0 ;GET A HOLE SIZE BLE 4$ ;IF NOT A LEGIT POSSIBILITY ASR R0 ASR R0 ;DIVIDE BY 4 FOR RT11 BLOCKS CMP R5,R0 ;SEE IF OUR FILE WILL FIT BEQ 9$ ;IF EXACT, WE TAKE IT BHI 4$ ;IF HOLE TOO SMALL, LOOK FURTHER INC (SP) ;IF GREATER, FLAG FOR FUTURE REF 4$: INC R1 CMP R1,#19. BNE 3$ ;GO FOR 19. SLOTS TST (SP)+ ;SEE IF ANY POSSIBLES BEQ 8$ ;IF NOT, GIVE UP INC R5 ;IF SO, TRY FOR BEST FIT ONE BLOCK BR 2$ ; BIGGER 5$: MOV #8.,R5 CLR -(SP) MOV U.HOLE,R4 CLR R1 6$: MOV (R4)+,R0 BLE 7$ CMP R0,R1 ;COMPARE THIS HOLE WITH CURRENT WORST BLOS 7$ ;IF NO WORSE THAN CURRENT, CONTINUE MOV R0,R1 ;OTHERWISE, MAKE IT NEW WORST MOV R5,(SP) 7$: INC R5 ;GO TO NEXT SECTOR # CMP R5,#27. BNE 6$ MOV (SP)+,R1 ;GET SECTOR # OF WORST BEQ 8$ ;IF 0, MEANS NO HOLES AT ALL SUB #64,R4 ADD R1,R4 ADD R1,R4 ;A MAGIC DIDDLE BR UE35 ;NOW DO LIKE BEST FIT ;+ ;ERROR 8$: ERR DEFU ; "DEVICE FULL" ;- 9$: TST (SP)+ ;POP THE RANDOMNESS ADD #8.,R1 ;COMPUTE DIRECTORY SECTOR # UE35: MOV R1,UOSECT CLR UOTRAC TST -(R4) ;BACK UP PTR MOV R4,U.HPTR ;SAVE PTR TO HOLE TABLE ENTRY WE USED MOVB #377,UOCMD ;"READ" JSR PC,U.SPF2 TST @UOBUFR ;LOOK AT DELETED DATA MARK WORD BNE 10$ ;IT HAD BETTER BE THERE! ;+ ;ERROR ERR DIER ;"DIRECTORY ERROR" ;- 10$: MOV #CMDBUF,R4 ;SCRATCH AREA MOV R4,R5 MOV R3,-(SP) ;SAVE JSR PC,U.IMAP ;CREATE THE OUTPUT NAME MOV R4,R3 ;NOW POINT R3 AT CREATED NAME MOV R5,R4 ;SET R4 TO POINT AFTER NEW NAME JSR PC,FNOUT ;PUT ASCII NAME AT (R4)+ JSR PC,FNOUT ;CONVERT FROM RAD50 TO ASCII JSR PC,FNOUT SUB #9.,R4 ;BACK IT UP MOV (SP)+,R3 ;RESTORE R3 MOV UOBUFR,R1 ADD #7,R1 ;POINT TO ID FIELD MOV #8.,R5 11$: MOVB (R4)+,R0 ;GET A CHAR JSR PC,ATOE ;ASCII TO EBCDIC MOVB R0,(R1)+ ;SALT IT AWAY DEC R5 BNE 11$ ADD #34.,R1 ;POINT TO DATE PLACE MOV DATE,R2 ;GET TODAY'S DATE BNE 13$ ;IF NONE MOV #6,R5 ;IF NO DATE FILL IN JM1- 12$: MOVB #100,(R1)+ ;WITH EBCDIC SPACES DEC R5 ;DECREMENT COUNT BNE 12$ ;IF NOT EQUAL, KEEP FILLIN JM1+ BR 14$ ;IF EQUAL, WE'RE DONE 13$: MOV R2,R0 BIC #^C<37>,R0 ADD #72.,R0 JSR PC,DDIVX ;MUNG THE DATE TO EBCDIC ASR R2 ASR R2 MOV R2,R0 SWAB R0 ;SET UP THE MONTH JSR PC,DDIV MOV R2,R0 ASR R0 ASR R0 ASR R0 JSR PC,DDIV ;NOW THE DAY 14$: SUB #25.,R1 ;POINT TO STARTING TRACK/SECTOR ENTRY MOV #U.OSEC,R5 ;FAKE IT OUT JSR PC,U.TS ;COMPUTE TOTALSECTOR, PUT AT (R5) MOV UOSECT,R0 ;WHICH WE MADE EQUAL TO U.OSEC SWAB R0 ASL R0 ASL R0 ASL R0 ADD R0,U.OSEC ;FILL IN DIRECTORY SECTOR # MOV #128.,R0 TST SWT.A ;IF /A OR /I BNE 16$ ;USE 128-BYTE RECORDS TST SWT.I BNE 16$ MOVB SWT.U,R0 ;GET SWITCH VALUE, IF ANY BIC #^C<377>,R0 ;SIGN EXTEND IS WONDERFUL BNE 15$ ;SUBSTITUTE DEFUALT OF 80. MOV #80.,R0 ;IF NO VALUE 15$: CMP #128.,R0 ;MAKE SURE IT'S REASONABLE BHIS 16$ ;IF OK ;+ ;ERROR ERR SWER ;"SWITCH ERROR" ;- 16$: MOV R0,U.OBCT ;SET UP SIZE COUNTER MOV UOBUFR,U.OBPT ;WHILE WE'RE AT IT, SET UP THIS TOO ADD #2,U.OBPT ;SKIP WORD FOR DEL DATA MARK SUB #10.,R1 ;POINT AT RECORD SIZE PLACE IN SECTOR MOV #360,R2 ;EBCDIC "0" CMP #100.,R0 BHI 17$ INC R2 SUB #100.,R0 17$: MOVB R2,(R1)+ ;EBCDIC "0" OR "1" JSR PC,DDIVX ;THE REST OF THE SIZE ("80" OR "28") MOVB #375,UOCMD ;WRITE DELETED DATA MARK JSR PC,U.SPF2 ;WE'LL REMOVE IT LATER IN "CLOSE" ADD #6,R3 ;NECESSARY FUDGE MOV U.OSEC,R0 JSR PC,U.GCX ;FIX UP RECORD SIZE TABLE PTR MOVB U.OBCT,(R0) ;FILL IN DECLARED SIZE SUB #6,R3 ;UN-FUDGE RETURN .DSABL LSB DDIV: BIC #^C<37>,R0 DDIVX: MOV #360,R5 ;EBCDIC "0" 10$: SUB #10.,R0 BMI 20$ INC R5 BR 10$ 20$: ADD #10.+360,R0 MOVB R5,(R1)+ ;MOVE IN THE 10'S PART MOVB R0,(R1)+ ;AND THE 1'S PART RTS PC .SBTTL UNIVERSAL FLOPPY "U.READ" .ENABL LSB 30$: TSTB U.EOL ;SEE IF WE'RE STICKING IN A CRLF BNE 40$ ;IF SO, PROCEED MOVB #15,U.EOL ;WANT CR FIRST 40$: CMP R4,R5 ;SEE IF SPACE IN BIG I/O BUFR BEQ 50$ CMPB #12,U.EOL ;SEE IF LF BHI 42$ ; .LT. LF, MUST BE 0 BEQ 41$ ;IT IS A LF MOVB U.EOL,R0 ;MUST BE CR MOVB #12,U.EOL ;SET UF FOR LF FOLLOWING BR 44$ 41$: MOVB U.EOL,R0 NEGB U.EOL ;SHOW LF IS DONE BR 44$ 42$: MOVB (R1)+,R0 TST SWT.I ;IMAGE MODE? BNE 44$ ;KEEPA YOU HANDS OFF! TST SWT.A BNE 44$ ;ASSUME ALREADY ASCII IF /A JSR PC,ETOA ;CONVERT EBSILLYDIC TO ASCII 44$: MOVB R0,(R4)+ ;MOVE A BYTE FROM SECTOR TO I/O BUFR 45$: TSTB U.EOL BGT 40$ ;SOMETHING IS IN PROGRESS BEQ 46$ ;NOTHING IS IN PROGRESS CLRB U.EOL ;CLEAR THE FLAG BR 47$ ;PRETEND WE NEVER DID THIS 46$: DEC U.IBCT BNE 40$ TST SWT.A ;IF NEITHER /A NOR /I, MUST PUT CLRF'S BNE U.READ ;AT THE END OF RECORDS TST SWT.I BEQ 30$ U.READ: MOV U.IBPT,R1 TST U.IBCT BNE 40$ TSTB U.EOL BNE 40$ 47$: MOV U.ISEC,R0 CMP R0,10(R3) ;SEE IF WE'VE RUN OUT OF SECTORS BLO 48$ ;IF NOT, KEEP GOING 49$: MOV R5,-(SP) ;IF SO, ROUND UPTO BLOCK BOUNDARY SUB R4,(SP) BIT #777,(SP)+ ;SO RT11 WRITE DOESN'T DIE BEQ 60$ ;IF WE'RE AT A MULTIPLE CLRB (R4)+ ;CLEAR A BYTE BR 49$ ;AND TRY AGAIN 48$: JSR PC,U.MUNG ;CONVERT TOTAL SECTOR TO TRACK/SECTOR MOVB R0,UITRAC SWAB R0 MOVB R0,UISECT JSR PC,U.SPF1 ;READ A SECTOR INC U.ISEC ;FOR NEXT TIME TST @UIBUFR ;SEE IF DELETED DATA MARK BNE U.READ ;IF SO, TRY AGAIN MOV UIBUFR,U.IBPT ADD #2,U.IBPT ;SKIP DELETED DATA MARK WORD JSR PC,U.GSEC ;GET DIRECTORY SECTOR # MOVB (R0),U.IBCT ;GET DECLRED RECORD SIZE FOR THIS FILE BR U.READ 50$: MOV R1,U.IBPT ;SAVE CURRENT STATUS 60$: RTS PC .DSABL LSB U.GSEC: MOV 2(R3),R0 U.GCX: SWAB R0 ;GET DIRECTORY SECTOR # FOR THIS FILE ASR R0 ASR R0 ASR R0 BIC #^C<37>,R0 ADD #U.RSIZ-8.,R0 RTS PC .SBTTL UNIVERSAL FLOPPY "U.WRIT" ;+ ; ;U.WRIT - INTERCHANGE WRITE ROUTINE ; ;NOTE: R4 IS THE INPUT BUFFER POINTER ; R5 IS THE POINTER TO THE END OF THE INPUT BUFFER ; ;- .ENABL LSB U.WRIT::CLRB U.OVFG ;CLEAR RECORD OVERFLOW FLAG ;JM5 10$: MOV U.OBPT,R1 ;R1 = SECTOR POINTER MOVB U.OBCT,R2 ;R2 = BUFFER COUNT BIC #^C<377>,R2 ;MAKE SURE WE HAVE A TRUE COUNT (BYTE) BNE 30$ ;IF STILL SPACE 20$: JSR PC,U.WB ;WRITE THE BUFFER CLRB U.FLG ;CLEAR END OF LINE FLAG BR 10$ ;AND WRITE THE NEXT RECORD 30$: TSTB U.FLG ;END OF RECORD? BNE 60$ ;IF SECTOR FILL IN PROGRESS CMP R4,R5 ;INPUT BUFFER FULL? BEQ 70$ ;YES, RETURN MOVB (R4)+,R0 ;PUT CHARACTER IN R0 TST SWT.I ;IMAGE MODE? BNE 60$ ;IF SO PRINT IT TST SWT.A ;ASCII MODE? BNE 60$ ;IF SO PRINT IT TSTB R0 ;IS THE CHARACTER A NULL? ;JM3 BEQ 30$ ;IF SO IGNORE IT ;JM3 CMPB #15,R0 ;? BEQ 30$ ;IGNORE CR'S IF IBM MODE BLO 50$ ;IF PRINTABLE CHARACTER GO PRINT IT CMPB #12,R0 ;LOOK FOR LF, VT, OR FF BHI 50$ ;MUST BE VT OR FF TSTB U.OVFG ;RECORD OVERFLOW? ;JM5+ BEQ 40$ ;NO, SKIP FILL CLRB U.OVFG ;CLEAR THE OVERFLOW FLAG ;JM5- CMP U.OBCT,R2 ;IS IT A NULL RECORD? ;JM3- BEQ 30$ ;YES, IGNORE IT 40$: MOVB #40,R0 ;NO,FILL REST WITH SPACES ;004 MOV (SP),U.FLG ;AND SET THE END OF LINE FLAG ; BR 60$ ;SKIP CONVERSION ;004 ;004 ; PLACE CHARACTER IN INPUT BUFFER AND UPDATE POINTERS AND COUNT 50$: JSR PC,ATOE ;CONVERT ASCII TO EBCDIC 60$: MOVB R0,(R1)+ ;PUT CHARACTER INTO THE INPUT BUFFER DEC R2 ;DECREAMENT BUFFER COUNT BNE 30$ ;ROOM IN BUFFER - GET NEXT CHARACTER MOVB R0,U.OVFG ;SET IF OVERFLOW ;JM5 BR 20$ ;INPUT BUFFER FULL - WRITE IT OUT 70$: MOV R1,U.OBPT MOV R2,U.OBCT RTS PC .DSABL LSB .ENABL LSB U.MUNG::CLR -(SP) BIC #^C<3777>,R0 ;REMOVE DIRECTORY SECTOR #, IF PRESENT 10$: SUB #26.,R0 BLE 20$ INC (SP) BR 10$ 20$: ADD #26.,R0 SWAB R0 ADD (SP)+,R0 RTS PC ;SECTOR IN LEFT BYTE, TRACK IN RIGHT .DSABL LSB U.WB: DEC @U.HPTR ;SEE IF ALL SPACE USED BLT 10$ ;IF SO MOV U.OSEC,R0 JSR PC,U.MUNG MOVB R0,UOTRAC SWAB R0 MOVB R0,UOSECT MOVB #376,UOCMD ;SET FOR REGULAR WRITE JSR PC,U.SPF2 INC U.OSEC MOV UOBUFR,U.OBPT ADD #2,U.OBPT ;SKIP DEL DATA FLAG WORD MOV U.OSEC,R0 JSR PC,U.GCX ;GET DIRECTORY SECTOR # MOVB (R0),U.OBCT ;GET DECLARED RECORD SIZE RTS PC ;+ ;ERROR 10$: ERR DEFU ;"DEVICE FULL" ;- .SBTTL UNIVERSAL FLOPPY "U.CLOS" .ENABL LSB U.CLOS::MOV U.OBPT,R1 MOV U.OBCT,R2 BIC #^C<37777>,R2 BEQ 20$ CLR R0 TST SWT.I BNE 10$ TST SWT.A BEQ 30$ ;DON'T WRITE LAST RECORD IF NULL;JM3+ 10$: MOVB R0,(R1)+ ;CLEAR REST OF BUFFER DEC R2 BNE 10$ 20$: JSR PC,U.WB ;WRITE THE LAST SECTOR OF DATA 30$: MOV U.OSEC,R0 SWAB R0 ASR R0 ASR R0 ASR R0 BIC #^C<37>,R0 ;GET DIRECTORY SECTOR # MOV UOSECT,-(SP) ;SAVE LAST SECTOR WRITTEN MOV R0,UOSECT MOV UOTRAC,-(SP) ;ALSO SAVE LAST TRACK WRITTEN CLR UOTRAC MOVB #377,UOCMD ;"READ" JSR PC,U.SPF2 ;GET DIRECTORY SECTOR MOV UOBUFR,R1 TST (R1)+ ;SKIP DEL DATA WORD MOV #304*400+310,(R1) ;CHANGE "DD" TO "HD" MOV (SP),R0 ;TRACK ASL R0 MOV R0,-(SP) ;MULTIPLY TRACK BY 26. ASL R0 ASL R0 MOV R0,-(SP) ASL R0 ADD (SP)+,R0 ADD (SP)+,R0 ADD 2(SP),R0 ;ADD IN SECTOR FOR TOTALSECTOR INC R0 ;BUMP TO NEXT UNUSED TOTALSECTOR MOV R0,10(R3) ;PUT IN AS NEXT FREE TOTALSECTOR ADD #42,R1 ;FIX UP END OF DATA AREA TRACK/SECTOR MOV (SP),R0 JSR PC,DDIVX ;PUT IN TRACK MOVB #360,(R1)+ MOV 2(SP),R0 JSR PC,DDIV ;PUT IN SECTOR ADD #43,R1 ;R1->SLOT FOR NEXT FREE TRACK ENTRY INC 2(SP) ;BUMP TO NEXT UNUSED SECTOR CMP #26.,2(SP) BHIS 40$ ;IF STILL WITHIN A TRACK INC (SP) ;IF OVER A TRACK, BUMP TRACK MOV #1,2(SP) ;AND RESET SECTOR 40$: MOV (SP)+,R0 ;GET THE TRACK # JSR PC,DDIVX ;PUT IN TRACK MOV (SP)+,R0 ;GET SECTOR MOVB #360,(R1)+ JSR PC,DDIV ;DO SECTOR MOVB #376,UOCMD ;REGULAR WRITE JSR PC,U.SPF2 ;REWRITE DIRECTORY SECTOR INC UOSECT ;SKIP TO NEXT DIRECTORY SECTOR CMP #26.,UOSECT ;...IF THERE IS ONE BLO 50$ ;NOPE! MOVB #377,UOCMD ;READ JSR PC,U.SPF2 MOV UOBUFR,R1 TST (R1)+ ;LOOK AT DEL DATA MARK BEQ 50$ ;IF LEGIT FILE, CAN'T REASSIGN ; LEFTOVER SPACE MOV 10(R3),R0 SUB 6(R3),R0 DEC R0 ;GET # OF LEFTOVER TOTALSECTORS BLE 50$ ;IF NONE, GO AWAY MOV 10(R3),R0 ADD #34,R1 JSR PC,U.MUNG ;SECTOR LEFT BYTE, TRACK RIGHT MOV R0,-(SP) ;SAVE TRACK BIC #^C<377>,R0 ;GET TRACK NUMBER ;JM6 JSR PC,DDIVX ;RESET STARTING TRACK/SECTOR OF ; NEXT (DELETED) FILE MOV (SP)+,R0 ;RESTORE TRACK NUMBER SWAB R0 MOVB #360,(R1)+ JSR PC,DDIV ;SECTOR MOVB #375,UOCMD ;WRITE DEL DATA JSR PC,U.SPF2 ;WRITE THE DIRECTORY SECTOR 50$: RTS PC .DSABL LSB .SBTTL UNIVERSAL FLOPPY "U.DELE" .ENABL LSB U.DELE::TST (R3) ;SEE IF ANY FILES BEQ 10$ ;ALL DONE MOV 10(R3),R0 ;EXTRACT DIRECTORY SECTOR # SWAB R0 ASR R0 ASR R0 ASR R0 BIC #^C<37>,R0 MOV R0,UISECT ;SECTOR # OF DIRECTORY ENTRY ; FOR THIS FILE CLR UITRAC ;ON TRACK 0, OF COURSE MOVB #377,UICMD ;SET UP FOR SPFUN READ JSR PC,U.SPF1 MOV UIBUFR,R0 CMPB (R0)+,(R0)+ ;SKIP DELETED DATA FLAG WORD MOVB #304,(R0) ;CHANGE FIRST CHAR OF SECTOR TO A "D" MOVB #375,UICMD ;SET UP TO WRITE DELETED DATA JSR PC,U.SPF1 ADD #20,R3 ;SKIP TO NEXT FILE, IF ANY BR U.DELE 10$: RETURN .DSABL LSB .SBTTL EBCDIC CONVERSION TABLE ; BASED ON ANSI STANDARD X3.26-1970 "HOLLERITH PUNCHED CARD CODE" EBCDIC::.BYTE 000 ;000 NUL .BYTE 001 ;001 SOH .BYTE 002 ;002 STX .BYTE 003 ;003 ETX .BYTE 067 ;004 EOT .BYTE 055 ;005 ENQ .BYTE 056 ;006 ACK .BYTE 057 ;007 BEL .BYTE 026 ;010 BACKSPACE .BYTE 005 ;011 TAB .BYTE 045 ;012 LF .BYTE 013 ;013 VT .BYTE 014 ;014 FF .BYTE 015 ;015 CR .BYTE 016 ;016 SO .BYTE 017 ;017 SI .BYTE 020 ;020 DLE .BYTE 021 ;021 DC1 .BYTE 022 ;022 DC2 .BYTE 023 ;023 DC3 .BYTE 074 ;024 DC4 .BYTE 075 ;025 NAK .BYTE 062 ;026 SYN .BYTE 046 ;027 ETB .BYTE 030 ;030 CAN .BYTE 031 ;031 EM .BYTE 077 ;032 SUB .BYTE 047 ;033 ESC .BYTE 034 ;034 FS .BYTE 035 ;035 GS .BYTE 036 ;036 RS .BYTE 037 ;037 US .BYTE 100 ;040 SPACE .BYTE 117 ;041 ! .BYTE 177 ;042 " .BYTE 173 ;043 # .BYTE 133 ;044 $ .BYTE 154 ;045 % .BYTE 120 ;046 & .BYTE 175 ;047 ' .BYTE 115 ;050 ( .BYTE 135 ;051 ) .BYTE 134 ;052 * .BYTE 116 ;053 + .BYTE 153 ;054 , .BYTE 140 ;055 - .BYTE 113 ;056 . .BYTE 141 ;057 / .BYTE 360 ;060 0 .BYTE 361 ;061 1 .BYTE 362 ;062 2 .BYTE 363 ;063 3 .BYTE 364 ;064 4 .BYTE 365 ;065 5 .BYTE 366 ;066 6 .BYTE 367 ;067 7 .BYTE 370 ;070 8 .BYTE 371 ;071 9 .BYTE 172 ;072 : .BYTE 136 ;073 ; .BYTE 114 ;074 < .BYTE 176 ;075 = .BYTE 156 ;076 > .BYTE 157 ;077 ? .BYTE 174 ;100 @ .BYTE 301 ;101 A .BYTE 302 ;102 B .BYTE 303 ;103 C .BYTE 304 ;104 D .BYTE 305 ;105 E .BYTE 306 ;106 F .BYTE 307 ;107 G .BYTE 310 ;110 H .BYTE 311 ;111 I .BYTE 321 ;112 J .BYTE 322 ;113 K .BYTE 323 ;114 L .BYTE 324 ;115 M .BYTE 325 ;116 N .BYTE 326 ;117 O .BYTE 327 ;120 P .BYTE 330 ;121 Q .BYTE 331 ;122 R .BYTE 342 ;123 S .BYTE 343 ;124 T .BYTE 344 ;125 U .BYTE 345 ;126 V .BYTE 346 ;127 W .BYTE 347 ;130 X .BYTE 350 ;131 Y .BYTE 351 ;132 Z .BYTE 112 ;133 [ .BYTE 340 ;134 \ .BYTE 132 ;135 ] .BYTE 137 ;136 ^ .BYTE 155 ;137 _ .BYTE 171 ;140 ACCENT GRAVE .BYTE 201 ;141 LOWER CASE A .BYTE 202 ;142 B .BYTE 203 ;143 C .BYTE 204 ;144 D .BYTE 205 ;145 E .BYTE 206 ;146 F .BYTE 207 ;147 G .BYTE 210 ;150 H .BYTE 211 ;151 I .BYTE 221 ;152 J .BYTE 222 ;153 K .BYTE 223 ;154 L .BYTE 224 ;155 M .BYTE 225 ;156 N .BYTE 226 ;157 O .BYTE 227 ;160 P .BYTE 230 ;161 Q .BYTE 231 ;162 R .BYTE 242 ;163 S .BYTE 243 ;164 T .BYTE 244 ;165 U .BYTE 245 ;166 V .BYTE 246 ;167 W .BYTE 247 ;170 X .BYTE 250 ;171 Y .BYTE 251 ;172 Z .BYTE 300 ;173 LEFT SQUIGGLE BRACKET .BYTE 152 ;174 VERTICAL BAR .BYTE 320 ;175 RIGHT SQUIGGLE BRACKET .BYTE 241 ;176 TILDA .BYTE 007 ;177 RUBOUT .EVEN .SBTTL EBCDIC TO ASCII, ASCII TO EBCDIC ;+ ; ;ENTER WITH CHAR IN R0 ;LEAVE WITH EQUIVALENT IN R0 ; ;- ETOA: MOV R1,-(SP) ;WE NEED A REGISTER CLR R1 ;RESET IT 10$: CMPB R0,EBCDIC(R1) ;HAVE WE FOUND CHARACTER? BEQ 20$ ;YES... INC R1 ;NOPE, BUMP TABLE OFFSET CMP R1,#200 ;HAVE WE FALLEN OFF EDGE OF TABLE? BLO 10$ ;NOT YET, TRY ANOTHER BYTE 20$: MOV R1,R0 ;OFFSET TO CHARACTER IN R1 BIC #^C<377>,R0 ; IS ASCII VALUE MOV (SP)+,R1 ;RESTORE SAVED R1 RTS PC ATOE: ADD #EBCDIC,R0 ;ASCII VALUE USED AS OFFSET TO MOVB (R0),R0 ; EBCDIC EQUIVALENT BIC #^C<377>,R0 RTS PC .SBTTL VALDEV- CHECK FOR VALID DEVICE ;+ ; ;VALDEV - ; THIS ROUTINE CHECKS FOR THE VALID INTERCHANGE DEVICES. THE ONLY VALID ; DEVICES ARE RX01 (DSTATUS 22) AND RX02 (DSTATUS 6) AND PDT-11/150 ;002 ; (DSTATUS 37). ;002 ; ;- VALDEV: CMPB (R5),#22 ;RX01? ;JM7- BEQ 10$ ;YES, NO ERROR CMPB (R5),#6 ;RX02? BEQ 10$ ;YES, NO ERROR CMPB (R5),#37 ;PDT11/150? ;002 BNE 20$ ;NO, ERROR 10$: RETURN ;+ ;ERROR 20$: ERR ILDE ;ILLEGAL DEVICE ;JM7+ ;- .SBTTL PATCH AREA PATCH:: .BLKW 100. .SBTTL INITIALIZATION LIST NOTIMP R LIST NOTIMP T LIST NOTIMP S LIST NOTIMP U ;+ ;ERROR ERR ILCM ;- .GLOBL BEGIN FREE: ;BUFFER OVERLAYS THIS BEGIN: .GTIM #EMTBLK,#EMTBLK+2 ; GET TIME PLEASE... MOV @#SYSPTR,R1 ;POINT TO SYSTEM MOV R1,R0 ;003 ADD #BLKEY,R0 MOV R0,SBLKEY ;SAVE BLKEY PTR ADD #CHKEY-BLKEY,R0 MOV R0,SCHKEY ;AND SAVE THE POINTER MOV $USRLC(R1),R0 ;POINT TO USR BOTTOM MOV R0,USRBUF MOV R0,BUFR1 TST -(R0) ;AND SET UP FOR SETTOP CMP R0,#41024 ;12K OR GREATER? BHIS 10$ ;YES, LET USR SWAP NORMALLY MOV #USRSWP,@#UFLOAT ;SET UP USR SWAP AREA MOV #USRSWP,USRBUF MOV #-2,R0 ;SETTOP TO RMON 10$: .SETTOP ;*** JPH 11-AUG-77 *** MOV #ERRPRT,@#TRAP.V ;*SET UP TRAP VECTOR PC CLR @#TRAP.V+2 ;* PS BIT #KT11$,CONFIG(R1) ;*IS THIS XM MONITOR? BEQ 20$ ;*NO, SO TRAP PS OK AS IS BIS #140000,@#TRAP.V+2 ;*YES. SET USER MODE BITS IN TRAP PS ;********************* 20$: 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 80$ ;DON'T BE FOOLISH BIT #3,R0 ;LEAP YEARISH ? BNE 30$ MOVB #29.,LFEB ;YEP, FIX FEB 30$: MOV R0,-(SP) ;CONVERT DATE TO DOSSISH BIC #177740,@SP ASR R0 ASR R0 ASR R0 ASR R0 ASR R0 BNE 30$ MOV #2000.,R1 ;DOS IS REL 1970, RT REL 72 MOV #LMONTH,R2 ;MONTH LENGTHS MOV (SP)+,R3 ;MONTH TO R3 40$: DEC R3 BEQ 50$ MOVB (R2)+,R4 ADD R4,R1 BR 40$ 50$: ADD (SP)+,R1 ;ADD DAY MOV (SP)+,R3 ;GET YEAR 60$: DEC R3 BMI 70$ ADD #1000.,R1 BR 60$ 70$: MOV R1,S.DATE 80$: MOV #START,@#USERPC BIS #RSTRT$,@#JSW ;MAKE US REENTERABLE JMP START .END BEGIN