Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
filex.mac
There are 6 other files named filex.mac in the archive. Click here to see a list.
TITLE FILEX - GENERAL FILE TRANSFER ROUTINE - %17(37)
SUBTTL RC CLEMENTS/TCK/PFC 29-JUN-75
;***COPYRIGHT 1969,1970,1971,1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
FLXWHO==0 ;WHO EDITED FILEX LAST
FLXVER==17 ;MAJOR VERSION NUMBER
FLXMIN==0 ;MINOR VERSION NUMBER
FLXEDT==52 ;EDIT NUMBER
SEARCH JOBDAT,C
%%C==%%C
%%JOBD==%%JOBD
.REQUEST REL:HELPER
TWOSEG
SALL
LOC .JBVER
VRSN. FLX
RELOC 400000
;ASSEMBLY PARAMETERS
NDS. LN$PDL,20 ;PDL LENGTH
NDS. LASTOB,1101 ;LAST BLOCK ON -10 DTA
NDS. LN$SFD,5 ;MAX SFD DEPTH
LN$PPN==2+1+LN$SFD+1 ;PATH: PREFIX+UFD+SFD'S+ZERO
NDS. LN$PDS,^D255 ;MAX NUMBER OF PAGE DESCRIPTORS IN .EXE
;PARAMETERS FOR MAKING SAVE FILES
NDS. SAVPMX,^D60 ;MAXIMUM POSIBLE IOWD DATA BLOCK IN COMPRESSED FILES
NDS. SAVPMN,4 ;BUFFER SPACE USED FOR MAKING COMPRESSED FILES
SUBTTL TABLE OF CONTENTS
;
;
; SECTION PAGE
; 1. TABLE OF CONTENTS..................................... 2
; 2. REVISION HISTORY...................................... 3
; 3. DEFINITIONS........................................... 4
; 4. MAIN ROUTINE.......................................... 7
; 5. ROUTINE TO READ AND LIST A DIRECTORY BLOCK............ 11
; 6. ROUTINE TO PROCESS COPY OPERATIONS.................... 12
; 7. END OF MAIN LOOP...................................... 14
; 8. TRANSFER MODE SELECTIONS.............................. 16
; 9. 36-BIT TRANSFER ROUTINES.............................. 19
; 10. TRANSFERS FROM NON-36 TO 36-BIT....................... 30
; 11. TRANSFERS FROM 36-BIT TO NON-36....................... 34
; 12. DIRECTORY LISTER...................................... 40
; 13. ZERO OUTPUT TAPE ROUTINES............................. 47
; 14. SELECT (LOOKUP) FILE.................................. 50
; 15. ROUTINES TO ENTER OUTPUT FILE......................... 57
; 16. CLOSE ROUTINES........................................ 66
; 17. READ BINARY WORD, EXPANDING TO CORE IMAGE............. 69
; 18. READ BINARY WORD ROUTINES............................. 74
; 19. WRITE BINARY WORD ROUTINES............................ 80
; 20. BLOCK INPUT/OUTPUT ROUTINES........................... 85
; 21. FILE SPEC SCANNER INPUT ROUTINE....................... 90
; 22. TYPE OUT ROUTINES..................................... 92
; 23. ERROR ROUTINES........................................ 101
; 24. STORAGE............................................... 107
SUBTTL REVISION HISTORY
;5 STRIP LINE SEQ NUMBERS WHEN GOING TO -15 DTA
;6 DO DATE75 ON -10 DTA
;7 BLT ON -10 TO -10 XFRS; HANDLE CONTIGUOUS -11 DTA FILES;
; HANDLE -11 DTA PROTECTION
;%15(7)
;10 -11 DTA DATE74 FIX
;%16(10) NOV 74
;11 REMOVE SPECIAL SYS: PROTECTION LOGIC SINCE IN MONITOR
;12 REWORK /R TO NOT REQUIRE DTA BE MOUNTED
;13 CLEAN UP I/O LOGIC SLIGHTLY
;14 CONVERT TO USE C
;15 ALLOW /P/R ON OUTPUT DTA-BOTH REUSE SCRATCH UNLESS /Z;
; /R SUPPRESSES TAPE WRITE
;16 /L IS GENERAL SWITCH; IF NO =, JUST /L
;17 DROP OLD USAGE OF _ AND 175, 176
;20 MAKE REENTRANT
;21 REFORMAT WITH PGRFMT; LC MESSAGES
;22 CHANGE DEVPPN TO PATH. FOR ERSATZ DEVICES
;23 IMPLEMENT SFD'S AND DEFAULT PROJ AND PROG AND ACCEPT <>
;24 ALLOW /Z IF NO =
;25 /Z ON OUTPUT ASSUMED IF /Q OR XFO FILE MISSING
;26 IF /R, USE DEVICE AS TEMP FILE NAME WITH .DTA AS EXTENSION
;27 MAKE DEV STICKY, SECOND DEVICE IS TEMP FILE NAME
;30 ADD .HGH, .EXE SUPPORT
; IF .HGH OR .SHR =.EXE, MAY ALSO CREATE .LOW
; IF .EXE=.HGH OR .SHR, MAY ALSO READ .LOW
;31 SUPPORT NUL:
;32 PDP-11 DIRECTORIES WERE LISTED WRONG
;33 DTAX:/Q=A,B DID WRITE A ZERO TAPE BUT FORGOT TO ENTER A ZERO
; DTA STRUCTURE
;34 DTAX:/Q/Z/L=A,B TRIES TO LIST FROM A SCRATCH FILE WHICH NO LONGER
; EXISTS INSTEAD USE THE REAL DECTAPE
;35 DSK:=DTAX:/Q DOES NO LONGER WORK AS READBZ CLOBBERS I/O STATUS
;36 DTAX:/Q/L=FOO WAS BROKEN FOR PDP10 FILES
;37 ALL TEN TO TEN TRANSFERS WITH DEVICES HAVING DIFFERENT
; BUFFERS SIZES DO NOT WORK
;40 CHANGE EXEFLG DEFINITION TO A BLOCK 1 STATEMENT SO
; NO LOW SEGMENT IS CREATED
;41 CONVERSION FROM SHR(HGH) & LOW TO EXE FORMAT DOES NOT
; WORK WHEN THE SAVE FILES IOWDS DO NOT FILL UP THE LAST
; PAGES
;42 =DTA0:/L USED TO LIST ONLY DIRECTORY NOW IT COPIES ALL
; THE FILES ON THE TAPE CAUSING FILES TO DISAPPEAR
;43 DTA0:/L WILL LIST THE DIRECTORY OF THE DECTAPE AND
; AFTER SOME WAITING A FILE DTA0 WILL BE IN THE DISK AREA
; THIS WAS INTRODUCED BY EDIT 42
;44 A.XPN=A.EXE THE EXPANDED FILE CREATED WAS WRONG THE FIRST
; 20 LOCATIONS ARE NON ZERO CAUSING GRIEF TO FILDDT E.G.
;45 A.SAV=A.EXE DID NOT WORK CORRECTLY
;46 A.EXE=A.SHR DID NOT ALAWAYS WORK CORRECTLY
;47 THE EXPLICIT SPECIFICATION OF EXTENSIONS ON CONVERTING SAVE
; FILES IS BOTHERSOME, THEREFORE THE FOLLOWING WAS DONE:
;CONVERSION OF SAVE FILES CAN BE DONE USING THE C SWITCH
;AND A BLANK INPUT EXTENSION.
;OLD SAVE FILES ARE FILES WITH EXTENSION SHR HGH SAV OR LOW (OEX)
;NEW SAVE FILES HAVE AN EXTENSION EXE
;AS LINK PRODUCES OLD SAVE FILES THE DEFAULT CONVERSION MODE
;IS FROM OLD TYPE SAVE FILES TO NEW TYPE SAVE FILES ELSE AN EXPLICIT
;OUTPUT EXTENSION MUST BE USED TO FORCE THE CONVERSION TYPE.
;NOTE NO SCRATCH OUTPUT IS ACCEPTED
;EXAMPLES OF THE VARIOUS CONVERSION COMMANDS ARE:
; 1 A.EXE=A/C ;CONVERT OLD FORMAT SAVE FILE A TO EXE FORMAT
; 2 A=A/C ;SAME AS (1)
; 3 A.OEX=A/C ;CONVERT A.EXE TO OLD SAVE FILE FORMAT
; 4 *=*/C ;CONVERT ALL OLD SAVE FILES TO EXE FORMAT &
;ALL EXE FILES FOR WHICH NO OLD SAVE FILE
;EXISTS
; 5 A:*=B:*/C ;IF A EQL B THEN AS (4) ELSE CONVERT ALL SAVE FILES
; 6 A:*.EXE=B:*/C ;CONVERT ALL OLD SAVE FORMAT FILES
; 7 A:*.OEX=B:*/C ;CONVERT ALL EXE FILES TO OLD SAVE FILE FORMAT
;
;IN CASE 2 A WARNING WILL BE GIVEN IF THE EXTENSION IMPLIED BY THE
;CONTENT OF THE EXE FILE DIFFERS FROM THESPEIFIED ONE
;E.G. A.SHR=A/C WHERE A.HGH WOULD BE GENERATED
;50 CONVERSION OF SHR FILES TO EXE FILES WITHOUT A LOW SEGMENT
; RESULTS IN EXE FILES,WHICH ON A RUN RESULT IN
; " ILLEGAL MEMORY REFERENCE "
;51 CONVERTING EXE FILES TO SAVE FILES CAN RESULT IN FILES,WHICH
; PRODUCE THE ERROR MESSAGE "NOT A SAVE FILE".
; THIS WAS DUE TO LOAD INSTRUCTIONS BEING SPLIT IN SEVERAL
; AEQUIVALENT ONES.THE PARAMETER SAVPMX DEFINES THE SIZE OF
; THE MAXIMUM LOAD INSTRUCTION GENERATED BY FILEX (IN PAGES).
;52 FILEX GENERATES ZERO CREATION TIME FOR FILES
SUBTTL DEFINITIONS
;AC'S
F=0 ;FLAGS
A=1 ;FOUR AC'S FOR LOOKUPS, AND WORK.
B=2
C=3
D=4
T=5 ;3 TEMPS
T1=6
T2=7
CA=10 ;CORE ADDRESS AND COUNTS IN XFR ROUTINES
CKS=11 ;CHECKSUMS IN XFR ROUTINES
N=12 ;NUMBERS FOR DEC & OCT ROUTINES
W=14 ;WORD SIZE DATA
CH=15 ;CHARACTERS FOR TTY IO
P=17 ;STACK
;I/O CHANNELS
INF==1 ;INPUT TAPE
OUTF==2 ;OUTPUT TAPE
SCRF==3 ;DISK SCRATCH FILE
SCOF==4 ;DISK SCRATCH FOR OUTPUT TAPE
UFDF==5 ;DIRECTORY FOR * ON DSK
;LEFT HALF FLAGS
L.DSKI==1 ;INPUT DEV IS A DSK
L.DTI==2 ;INPUT DEV IS A DTA
L.SCRI==4 ;INPUT DTA HAS BEEN PUT ON NNNXFR.TMP
L.6DO==10 ;OUTPUT FILE IS 6 DMP MODE (200 WDS PER BLK, NOT 177)
; ALSO USED FOR PDP15 ABS FILES, PDP10 COMPRESSED+SHR
; FOR TIGHT SPACING.
L.WFI==20 ;INPUT FILE IS *
L.WEI==40 ;INPUT EXT IS *
L.WFO==100 ;OUTPUT FILE IS *
L.WEO==200 ;OUTPUT EXT IS *
L.MFI==400 ;INPUT FILE TERMINATED BY ","
L.STR1==1000 ;FLAG HAVE PROCESSED AT LEAST ONE * INPUT FILE
L.DTO==2000 ;OUTPUT IS TO DTA
L.DSKO==4000 ;OUTPUT IS DISK
L.FRCL==10000 ;FORCE LOOKUP FROM TIFILE/TIEXT;SUPPRESS CLOSE IN XFRCP
L.BEO==20000 ;BLANK EXTENSION ON OUTPUT
L.SCRO==40000 ;SCRATCH FILE FOR OUTPUT TAPE
;SPARE
L.BFO==400000 ;BLANK OUTPUT NAME
;RIGHT HALF FLAGS
R.EXT==1 ;EXPLICIT EXTENSION TYPED
R.DOT==2 ;DOT TYPED
R.TMP==R.DOT ;FOR USE AS A HANDY FLAG
R.SW==4 ;PARENS, NOT SLASHES
R.UPA==10 ;UPARROW (TAPEID)
R.ALL==R.DOT!R.UPA ;SYNTAX FLAG
R.OMT==R.UPA ;OUTPUT ALLOCATOR TURNAROUND. (SHARED BIT)
R.ITD==20 ;INPUT TAPE DIRECTION IF NEEDED
R.SBLK==40 ;OUTPUT IN S-BLK RATHER THAN COMPRESSED (-10)
R.GO==100 ;/G IN EFFECT
R.GOS==200 ;/G AND ERROR MSG ALREADY OUTPUT
R.EOF==400 ;NO MORE DATA IN INPUT FILE
R.OMD==1000 ;1 IF OUTPUT MAC DIRECTION IS REVERSE
R.OMF==2000 ;1 IF FREE BLOCK SKIPPED DURING ALLOCATION ON MACTAPE
R.JSCR==4000 ;1 IF SHOULD JUNK SCRATCH FILE AT END
R.IN==10000 ;1 IF ANY INPUT AT ALL
R.ABC==20000 ;CURRENT INPUT FILE HAS ALWAYS BAD CHECKSUM BIT
R.BDO=40000 ;BLANK OUT DEVICE FILE AND EXTTENSION
R.SAVX=100000 ;CONVERTING SAVE FILES
R.6DI==200000 ;INPUT FILE IS SIX FORMAT DUMP (200W/B)
R.MFI2==400000 ;MULT FILE INPUT SO DON'T REPEAT OUTPUT OPENS
;TABLE OFFSETS
TYPNDT==0 ;NON-DECTAPE
TYPTEN==1 ;PDP10 DECTAPE
TYPSIX==2 ;PDP6 DECTAPE
TYPMAC==3 ;PROJ MAC DTA
TYPFIF==4 ;PDP15 TAPE
TYPVEN==5 ;PDP ELEVEN TAPE
;FLAGS IN RTYP AND PROG (.EXE) DIRECTORY
PF$HGH==1B0 ;HIGH SEG
PF$SHR==1B1 ;SHARABLE
PF$WRT==1B2 ;WRITABLE (LOW SEG)
;MISC PARAMETERS
JOBSV6==73 ;RH OF IOWD FOR PDP6 DMP FILE
DEFINE MSG$ (M) <
XLIST
MOVEI W,[ASCIZ \M\]
PUSHJ P,MSG
LIST
>
DEFINE EMSG$ (M) <
XLIST
CLRBFI
MOVEI W,[ASCIZ \M\]
PUSHJ P,MSG
LIST
>
;MACRO TO COPY [P,PN,SFD...] TO NEW LOCATION
DEFINE MOVPPN (FROM,TO) <
MOVE T,[FROM+1,,TO+1] ;;COPY
BLT T,TO+LN$PPN ;; PATH IF ANY
MOVE T,FROM ;;GET PPN OR POINTER
CAIN T,FROM+1 ;;IF PATH POINTER,
MOVEI T,TO+1 ;; CHANGE TO NEW LOCATION
MOVEM T,TO ;;STORE PPN OR POINTER
>
SUBTTL MAIN ROUTINE
FILEX: JFCL ;JUST IN CASE OF CCL ENTRY
RESET ;CLEAR THE WORLD
HRRZ T,.JBFF ;GET FIRST FREE LOCATION
CORE T, ;AND RETURN CORE (ERROR CODE COMES HERE TOO)
JFCL ;SHOULD NOT OCCUR AND DOES NOT BOTHER
SETZB F,LCOR ;CLEAR FLAGS AND LOW CORE
MOVE A,[LCOR,,LCOR+1]
BLT A,ELCOR
MOVE A,[IOWD 200,DIRECT]
MOVEM A,DIRIOW
HRRI A,ODIREC-1
MOVEM A,ODIIOW
HRRI A,WBUF-1
MOVEM A,WIOL
HRRI A,TBUF-1
MOVEM A,TIOL
MOVE A,[IOWD 400,TBUF]
MOVEM A,TXIOL
MOVE P,[IOWD LN$PDL,PDL] ;SETUP STACK
SETOM LSNFLG ;CLEAR LINE-SEQUENCE-NUMBER-SEEN FLAG
MOVX T,%LDMFD ;GET MFD PPN
GETTAB T,
MOVE T,[1,,1] ;IN CASE OF LEV.C
MOVEM T,MFDPPN
GETPPN T, ;GET OUR
JFCL ; PPN
MOVEM T,MYPPN ;STORE FOR LATER
PJOB T, ;MAKE TEMP FILE NAME
MOVEI N,3
SCRL1: IDIVI T,12 ;TIME-HONORED NAME MAKER
ADDI T1,'0' ;DECIMAL SIXBIT OF JOB NUMBER
LSHC T1,-6 ;TO T2
SOJG N,SCRL1 ;THREE DIGITS
HRRI T2,'XFR' ;NNNXFR.TMP IS NAME
MOVEM T2,SCRNAM ;SAVE IT.
MOVEI W,[ASCIZ /
*/]
PUSHJ P,MSG ;TYPE ASTERISK
;GET OUTPUT SPECIFICATION
PUSHJ P,FILSPC ;GET FILE FOR OUTPUT
JRST FILEX ;TRY AGAIN - ERROR RETURN
SKIPE SWHELP ;IF /H,
DOHELP: JRST [CLRBFI ;CLEAR ANY MORE TYPING
HRROI A,.GTPRG ;YES--GET NAME OF PROGRAM
GETTAB A, ; ..
MOVEI A,0 ; ..
SKIPN A ; ..
MOVE A,['FILEX ']
PUSHJ P,.HELPR##
JRST FILEX] ;AND START OVER
MOVE T,$BRKC ;GET LAST BREAK
CAIE T,"," ;IF COMMA
CAIN T,.CHLFD ; OR END OF LINE,
JRST [MOVE T,$TSW ; THEN CHECK
TRNN T,SW$Z ;UNLESS /Z,
JRST ASKINL ; PROCEED--MUST BE /L
SKIPE SWLIST ;IF /Z,
JRST ERR22 ; /L IS AN ERROR
SETOM SWONLZ ;INDICATE ONLY /Z
JRST .+1] ; AND PROCEED
MOVE T,$TSW ;GET SWITCHES
TRNE T,SW$R ;IF /R,
JRST [SKIPE T,$DEV ; SEE IF DEVICE
MOVEM T,OPDEV ;YES--NAME OF PSEUDO FILE
JRST .+2] ;AND PROCEED
MOVE T,$DEV ;GET DEVICE
IOR T,$FILE ;ADD FILE BITS
IOR T,$EXT ;AND EXTENSION
SKIPN T ;ANYTHING SAID
TRO F,R.BDO ;(NO) REMEMBER BLAK OUT SPEC
SKIPN T,$DEV ;ANY DEVICE SPECIFIED?
MOVSI T,'DSK' ;NO. USE DISK
MOVEM T,ODEV ;SAVE OUTPUT DEVICE
DEVCHR T, ;GET OUT DEV CHARS
JUMPE T,ERR47 ;ANY SUCH THING?
TXNE T,DV.DSK ;IF DISK,
TXZ T,DV.DTA ; NOT DTA (MUST BE NUL)
TXNE T,DV.DTA ;DECTAPE?
TLO F,L.DTO ;YES. REMEMBER IT
MOVE T1,$TSW ;GET SWITCHES
TRNE T1,SW$SCR ;SEE IF SCRATCH FILE
TXZ T,DV.DSK ;YES--KILL DISK INDICATOR
TXNE T,DV.DSK ;DISK?
TLO F,L.DSKO ;YES--REMEMBER THAT
CONT.
TXNN T,DV.M14 ;BINARY SUPPORTED?
JRST ERR44 ;NO. ERROR
MOVS T,$FILE ;GET FILE NAME
CAIN T,'* ' ;WILD?
TLO F,L.WFO ;YES. FLAG WILD FILE OUTPUT
SKIPN T ;ANY NAME?
TLO F,L.BFO ;NO. REMEMBER BLANK OUTPUT
MOVSM T,OFILE ;SAVE NAME
MOVS T,$EXT ;FILE EXTENSION
CAIN T,'* ' ;WILD?
TLO F,L.WEO ;YES. FLAG WILD EXT OUTPUT
SKIPN T ;ANY EXT?
TLO F,L.BEO ;NO. REMEMBER BLANK OUTPUT
MOVSM T,OEXT ;SAVE EXTENSION
MOVPPN $TPPN,OPPN ;MOVE DIRECTORY
MOVE T,$TPRT ;GET PROTECTION FOR OUTPUT
MOVEM T,OPRT ;SAVE IT.
MOVE T,$TID ;OUTPUT TAPE IDENTIFIER
MOVEM T,OTID ; ..
MOVE T,$TSW ;OUTPUT SWITCHES
TRNE T,SW$G ;GO BEYOND ERRORS?
TRO F,R.GO ;YES
MOVEM T,OSW ;SAVE THE SWITCHES
TRNE T,SW$TAP ;A TAPE SWITCH?
TLNE F,L.DTO ;BUT NOT A TAPE ON OUTPUT?
SKIPA ;NO. OK
JRST [TRNN T,SW$R ;YES--SEE IF ON DISK
JRST ERR42 ;NO--ERROR
JRST .+1] ;YES--OK TO PROCEED
BEG1: TLNN F,L.DTO ;SEE IF DECTAPE
TDZA T1,T1 ;NO--CLEAR FLAG
SETOM T1 ;YES--SET FLAG
PUSHJ P,SELDTT ;SELECT TAPE FORMAT
MOVEM T1,OTYPEX ;STORE INDEX FOR OUTPUT
JRST ASKINP ;GET INPUT SPECIFICATION
;FLAG THE END OF JOB FLAG FOR A DIRECTORY LISTING ON THE TTY
ASKINL: SETOM EOJFLG ;THIS IS THE END OF JOB
;NOW GET AN INPUT FILE SPECIFIER
ASKINP: MOVE T,.JBFF ;REMEMBER .JBFF BEFORE ANY FILES
MOVEM T,SJFF ; FOR THE DISK DIRECTORY BUFFER
MOVEM T,SJFF2 ; FOR THE INPUT BUFFERS
MOVEM T,SJFF3 ; FOR THE OUTPUT FILE BUFFERS
MOVEM T,SJFF4 ; FOR THE RPBSCR ROUTINE, AFTER OUT FILE
MOVE T,$BRKC ;SEE IF CORRECT FORMAT COMMAND
CAIE T,"," ;SEE IF COMMA
CAIN T,.CHLFD ; OR IF END
JRST [SKIPN SWLIST ;YES--IF /L,
JRST .+1 ;NO--CONTINUE
SETZM ODEV ;YES--CLEAR OUTPUT
JRST REINP1] ;AND PROCEED
SETZM $PSW ;THESE DONT CARRY OVER THE ARROW
SETZM $PPRT ; ..
SETZM $PPPN ; ..
SETZM $DEV ; ..
SETZM $SDEV ; ..
SETZM IFILE ;CLEAR INPUT FILE NAME
SETZM IEXT ;AND EXT IN CASE NULL INPUT.
CAIE T,"," ;SEE IF COMMA
CAIN T,.CHLFD ;SEE IF END
JRST [SKIPE SWONLZ ;IF PLAIN /Z
JRST OUTASK ; PROCEED
JRST ERR22] ;NO--BAD BREAK
CAIE T,"=" ; ..
JRST ERR22 ;NO GOOD.
REINP: TRZ F,R.IN ;INITIALIZE THIS FLAG
TLZ F,L.MFI ;AND CLEAR COMMA-SEEN FLAG
PUSHJ P,FILSPC ;GET AN INPUT FILE SPECIFIER
JRST FILEX ;BAD SYNTAX.
SKIPE SWHELP ;SEE IF /H
JRST DOHELP ;YES--GO HANDLE THAT
REINP1: SKIPE $TPRT ;CHECK FOR PROTECTION SPECIFIED
PUSHJ P,ERR30 ;YES--WARNING
SKIPE $TID ;CHECK FOR TAPE ID SPECIFIED
PUSHJ P,ERR31 ;YES--WARNING
TLZ F,L.STR1 ;NO STAR FILES PROCESSED YET
MOVE T,$DEV ;ANY INPUT REQUESTED?
IOR T,$FILE ; ..
IOR T,$EXT
IOR T,$TSW
SKIPE T
TRO F,R.IN ;YES. REMEMBER THAT
CONT.
SKIPE $SDEV ;SEE IF PSEUDO DEVICE SET
JRST ASKI01 ;YES--CAN USE DIRECTLY
MOVE T,$TSW ;GET SWITCHES
TRNE T,SW$R ;IF /R,
JRST [SKIPE T,$DEV ; SEE IF DEVICE
MOVEM T,IPDEV ;YES--NAME OF PSEUDO FILE
JRST ASKI0] ;AND PROCEED
ASKI01: SKIPE T,$SDEV ;IF PSEUDO DEVICE,
MOVEM T,IPDEV ;REMEMBER IT AS TEMP FILE NAME
SKIPE T,$DEV ;ANY DEVICE SPECIFIED?
JRST ASKI1 ;YES.
ASKI0: SKIPN T,IDEV ;ANY PREVIOUS DEVICES?
MOVSI T,'DSK' ;NO. FIRST TIME, DEFAULT IS DISK
ASKI1: MOVEM T,IDEV ;STORE INPUT DEVICE
TLZ F,L.DTI!L.DSKI ;FIND DEVICE TYPE. CLEAR OLD ONES.
DEVCHR T, ;GET DEVICE CHAR BITS
JUMPE T,ERR48 ;ANY SUCH THING?
TXNE T,DV.DSK ;IF DISK,
TXZ T,DV.DTA ; CAN'T BE DTA (IN CASE NUL:)
TXNE T,DV.DTA ;DECTAPE?
TLO F,L.DTI ;YES.
MOVE T1,$TSW ;GET SWITCHES
TRNE T1,SW$SCR ;SEE IF SCRATCH FILE
TXZ T,DV.DSK ;YES--KILL DISK INDICATOR
TXNE T,DV.DSK ;DISK?
TLO F,L.DSKI ;YES.
TXNN T,DV.M14 ;BINARY SUPPORTED?
JRST ERR45 ;NO. ERROR
SKIPE SWLIST ;SEE IF /L
TRNN F,R.BDO ; AND NO OUTPUT
SKIPA ;NO
JRST [MOVE T,$TSW ;YES--GET SWITCHES
TRNN T,SW$SCR ;MUST SIMULATE
TLNE F,L.DTI ; OR REAL DTA
JRST .+1 ;OK
JRST ERR50] ;BAD--GIVE ERROR
MOVS T,$FILE ;GET INPUT FILE NAME
SKIPN T ;ANY IN INPUT STRING?
MOVS T,IFILE ;NO. COPY PREVIOUS IF ANY
SKIPN T ;ANY SPECIFIED?
MOVEI T,'* ' ;NO. ASSUME HE MEANS WILD.
CAIN T,'* ' ;IS IT WILD?
TLO F,L.WFI ;YES. REMEMBER THAT.
MOVSM T,IFILE ;AND SAVE IT.
MOVS T,$EXT ;GET INPUT EXT FROM CMD STRING
TRNE F,R.EXT ;ANY SPECIFIED?
JRST ASKI2 ;YES. USE IT EVEN IF BLANK
MOVS T,IEXT ;GET PREVIOUS ONE
SKIPN T ;ANY THERE?
MOVEI T,'* ' ;NO. USE WILD.
CONT.
ASKI2: CAIN T,'* ' ;WILD?
TLO F,L.WEI ;YES. REMEMBER THAT.
MOVSM T,IEXT ;SAVE INPUT EXTENSION
MOVPPN $TPPN,IPPN ;MOVE DIRECTORY
MOVE T,$TSW ;SWITCHES
MOVEM T,ISW ;SAVE THEM
TRNE T,SW$TAP ;A TAPE SWITCH?
TLNE F,L.DTI ;BUT NOT A TAPE INPUT?
SKIPA ;NO. OK
JRST [TRNE T,SW$R ;YES--SEE IF /R
JRST .+1 ;YES--OK
JRST ERR41] ;NO--ERROR
TRNE T,SW$G ;GO SWITCH ON?
TRO F,R.GO ;YES. REMEMBER IF FLAG AC
MOVE T1,$BRKC ;GET BREAK CHARACTER
CAIN T1,"," ;COMMA?
TLO F,L.MFI ;YES. MULTIPLE INPUT FILES.
SKIPN ODEV ;SEE IF OUTPUT
JRST ASKI3 ;NO--SKIP THESE TESTS
SETOM CNVSME ;ASUME IDEV=ODEV
SETOM CNVWEO ;AND A WILD OUTPUT EXTENSION
TRZ F,R.SAVX ;ASSUME NO SAVE CONVERSION
TLNE F,L.WEI ;IF A BLANK OR WILD INPUT EXT
TRNN T,SW$C ;OR NO /C THEN
JRST ASKI23 ;SKIP THE CONVERSION SPECIALS
SETZM SOEXT ;ASSUME BLANK OUTPUT
TLNE F,L.WEO!L.BEO ;IS OUT BLANK OR WILD
JRST ASKI20 ;OKAY NO WISHES
MOVE T1,[-EXTLEN,,EXTLST] ;GET LIST OF EXTENSIONS
MOVE T2,OEXT ;GET OUTPUT EXTENSION
CAME T2,(T1) ;SEE IF IT IS IN THE LIST
AOBJN T1,.-1
JUMPG T1,ASKI23 ;NO THEN NO C STUFF
CAME T2,[ SIXBIT /LOW/] ;IF LOW IS EXTENSION
MOVSI T2,(SIXBIT /HGH/) ;THEN USE HIGH
MOVEM T2,SOEXT ;OEXT MIGHT CHANGE SO VEREXT KNOWS RIGHT ONE
SETZM CNVWEO ;NO WILD EXTENSION
MOVE T1,[-1,,EXEIDX] ;GET POINTER TO EXE
HLRZ T2,OEXT ;GET HIS EXTENSION
CAIN T2,(SIXBIT /EXE/) ;IF EXE THEN
SKIPA T1,[-3,,SAVIDX] ;TAKE OLD SAVE INPUT
ASKI20: MOVE T1,[-4,,SAVIDX] ;START AT THE BEGINNING
TLZ F,L.WEO!L.BEO!L.WEI ;ZAP THE EXTENSION FLAGS
MOVEM T1,EXTPTR ;TO SCAN
MOVE T1,ODEV ;OUTPUT DEVICE
DEVNAM T1, ;GET ITS REAL NAME
SETZM T1 ;ERROR CASE JUST MISMATCH
MOVE T2,IDEV ;INPUT DEVICE
DEVNAM T2, ;GET THE REAL ONE AGAIN
SETOM T2, ;JUST DO ALL
CAME T1,T2 ;IDENTCAL DEVICES
SETZM CNVSME ;NO DIFFERENT
TRO F,R.SAVX ;FLAG CONVERTING
ASKI23: TLNE F,L.MFI!L.WEI!L.WFI ;MORE THAN ONE INPUT?
TLNE F,L.WFO!L.WEO!L.BFO!L.BEO ;YES. MUST BE MULTIPLE OUTPUT TOO.
SKIPA ;OK.
JRST ERR11 ;NO GOOD.
TLNE F,L.WEI ;MAKE SURE *S LINE UP
TLNE F,L.WEO!L.BEO ;INP EXT WILD
SKIPA ; IMPLIES OUT EXT WILD
JRST ERR11 ;NO
TLNE F,L.WFI ;INP NAME WILD
TLNE F,L.WFO!L.BFO ; IMPLIES OUT NAME WILD
SKIPA ;YES
JRST ERR11 ;NO
ASKI3: TRNE T,SW$Z ;ZERO SWITCH ON INPUT?
PUSHJ P,ERR43 ;YES. NON-FATAL ERROR.
;SEE IF WANT TO PUT TAPE ON SCRATCH FILE
EOJLOP: TRNE T,SW$R ;SEE IF /R (REUSE)
JRST ASKI4 ;YES--SKIP OPENS
RELEAS INF, ;CLEAR ANY PREVIOUS USE OF CHANNEL
MOVEI A,IO.NSD!.IODMP ;GET TAPE IN KLUDGE MODE
MOVE B,IDEV ; ..
MOVEI C,IHED2 ; ..
OPEN INF,A ; ..
JRST ERR1 ;NOT THERE.
ASKI4: TLNN F,L.DTI ;SEE IF DECTAPE
TDZA T1,T1 ;NO--CLEAR INDICATOR
SETOM T1 ;YES--SET FLAG
PUSHJ P,SELDTT ;SELECT DECTAPE TYPE
MOVEM T1,ITYPEX ;SAVE TYPE INDEX
TRNN T,SW$R ;UNLESS /R,
TLNE F,L.DTI ; IF INPUT IS A DTA,
TRNN T,SW$SCR ;WANT QUICK MODE?
JRST GETDIR ;NO. FORGET IT THEN.
TRNN T,SW$P!SW$R ;WANT TO KEEP IT?
TRO F,R.JSCR ;NO. REMEMBER TO FLUSH IT
SCRL2: HRRZ T,.JBREL ;COMPUTE NUMBER OF BLOCKS TO FIT IN CORE
HRRZ T1,.JBFF ; ..
SUB T,T1 ;SIZE OF FREE CORE
ASH T,-7 ;IN TAPE BLOCKS
SUBI T,1 ;MINUS FRAGMENT
MOVEM T,BLKS ;SAVE NUMBER OF BLOCKS
CAIL T,40 ;SMALL NUMBER?
JRST SCRB ;NO. USE THIS NUMBER
MOVE T,.JBREL ;TRY FOR MORE CORE
MOVEI T,1(T) ;ASK FOR ANOTHER K
CORE T, ;...
JRST SCRB ;NOT THERE, USE WHAT WE HAVE.
JRST SCRL2 ;GOT IT. RECOMPUTE BLOCKS.
SCRB: MOVE T,ITYPEX ;GET TYPE OF TAPE
MOVE T1,LBLK(T) ;GET LENGTH OF THAT TYPE
CAIN T,TYPSIX ;IF SIX TAPE,
HLRZ T1,DIRECT+0 ;GET LENGTH OF USED TAPE
CAIG T1,LASTOB ;RANGE AHECK SIX TAPE
CAIGE T1,1 ; ..
JRST ERR5 ;NO GOOD 6 DIRECTORY
MOVEM T1,LASTBK ;SAVE FOR LATER
CONT.
SCR1: MOVEI A,.IODMP ;GET DUMP MODE DISK FOR SCRATCH
MOVSI B,'DSK' ; ..
MOVEI C,0 ;NO BUFFERS
OPEN SCRF,A ;ASK FOR DISK
JRST ERR3 ;NOT THERE.
MOVE A,SCRNAM ;GET THE SCRATCH FILE NAME
SKIPE EOJFLG ;IF END PASS,
HRRI A,'XFO' ; THEN USE OUTPUT SCRATCH
MOVE C,IPDEV ;GET INPUT PSEUDO FILE
SKIPE EOJFLG ;IF END PASS,
MOVE C,OPDEV ; GET OUTPUT PSEUDO FILE
SKIPE C ;IF PSEUDO SET
MOVE A,C ; USE AS FILE NAME
MOVSI B,'TMP' ;AND EXT
SKIPE C ;IF PSEUDO SET
MOVSI B,'DTA' ; USE ITS EXTENSION
SETZB C,D ; ..
LOOKUP SCRF,A ;SEE IF FILE ALREADY THERE.
JRST SCRA ;NO. GOOD.
MOVE T,ISW ;YES. SEE IF REALLY WANT NEW ONE
TRNE T,SW$R ; ..
JRST SCRC ;NO. WANT TO REUSE OLD ONE
SETZB A,B ;YES. CLEAR NAME TO DELETE
SETZB C,D ; ..
CLOSE SCRF, ;CLOSE FILE
RENAME SCRF,A ;DELETE FILE
JFCL ;IGNORE FAIL RETURN, ENTER WILL PROB FAIL
SCRA: MOVE T,ISW ;GET INPUT SWITCHES
TRNE T,SW$R ;IF /R
JRST ERR62 ; FILE MUST EXIST
CLOSE SCRF, ;CLOSE FILE FROM LOOKUP
STORE A,ENTBLK,ENTBLK+.RBEST,0 ;CLEAR EXTENDED ENTER BLOCK
MOVEI A,.RBEST
MOVEM A,ENTBLK
MOVE A,SCRNAM ;NOW WRITE SCRATCH FILE
MOVEM A,ENTBLK+.RBNAM
MOVSI A,'TMP'
MOVEM A,ENTBLK+.RBEXT
MOVE A,LASTBK ;ESTIMATE
MOVEM A,ENTBLK+.RBEST ; AS DTA SIZE
ENTER SCRF,ENTBLK ;TRY TO WRITE NEW SCRATCH FILE
JRST ERR4 ;CAN'T. GIVE UP ON TEMP ON DSK
MOVEI T,0 ;BLOCK NUMBER 0
PUSHJ P,READBT ;READ BLOCK TO TBUF
PUSHJ P,ERR39 ;ERROR ON BLK 0
OUT SCRF,TIOL ;WRITE BLOCK 0 ON DISK FILE
SKIPA
PUSHJ P,ERR7
MOVEI B,1 ;CURRENT BLOCK IS NOW BLK 1
CONT.
SCRRL: CAMLE B,LASTBK ;STILL SOME TO READ?
JRST SCREND ;NO. DONE.
MOVE T1,LASTBK ;SEE HOW MANY FOR THIS READ.
ADDI T1,1 ; ..
SUB T1,B ;ALL OF REMAINING TAPE
MOVE T,BLKS ;AMOUNT THAT FITS IN CORE
ADD T,B ;BLK TO READ IF CAN FILL CORE
CAMGE T,LASTBK ;WOULD THAT EXCEED TAPE?
MOVE T1,BLKS ;YES. JUST READ ENOUGH FOR CORE.
MOVEM T1,D ;SAVE THIS NUMBER OF BLOCKS
MOVNS T1 ;MAKE IOWD TO READ THIS
LSH T1,31 ;MINUS WORD COUNT
HRR T1,SJFF ;ADDRESS-1
MOVEM T1,CORIOW ;PUT IN COMMAND LIST
USETI INF,(B) ;SET FOR INPUT BLOCK
IN INF,CORIOW ;READ TAPE
SKIPA
PUSHJ P,ERR6 ;YES. SEE IF /G
OUT SCRF,CORIOW ;NOW WRITE ON DISK
SKIPA
PUSHJ P,ERR7 ;ERR. SEE IF /G
ADD B,D ;UPDATE NEXT BLOCK TO READ
JRST SCRRL ;AND SEE IF DONE YET.
SCREND: MTREW. INF, ;DONE WITH DTA. REWIND IT.
CLOSE SCRF, ;CLOSE SCRATCH FILE
MOVE A,SCRNAM ;NOW SET TO READ SCRATCH FILE
MOVSI B,'TMP' ; ..
SETZB C,D ; ..
LOOKUP SCRF,A ;OPEN FOR READING
JRST ERR8 ;OOPS. CAN'T
SCRC: TLO F,L.SCRI ;FLAG READING SCRATCH FILE ON DSK
SETOM SCRBK1 ;FLAG NOT YET READING SCRF
SUBTTL ROUTINE TO READ AND LIST A DIRECTORY BLOCK
GETDIR: TLNN F,L.DTI!L.SCRI ;SEE IF SIMULATED OR REAL TAPE
JRST OUTASK ;NO--SKIP /L REQUEST IF ANY
MOVE T,ITYPEX ;GET INPUT TAPE TYPE
MOVE T,DBLK(T) ;GET DIRECTORY BLOCK
MOVEM T,DIRBKN ;SAVE NUMBER WHICH IS IN DIRECT BUFFER
PUSHJ P,RBTDIR ;READ INTO DIRECTORY BUFFER
JRST ERR2 ;ERROR READING.
MOVE T1,ITYPEX ;GET INPUT TYPE
CAIE T1,TYPVEN ;PDP-11 TAPE?
JRST TYPDIQ ;NO
HLRZ T,DIRECT+1 ;YES. PRE-PROCESS A BIT. GET PBM BLK #
MOVEM T,PBMBKI
HLRZ T,DIRECT+0 ;GET LINK TO MFD DATA
MOVEM T,DIRBKN ;REMEMBER WHAT'S INDIRECT
PUSHJ P,RBTDIR ;READ DIRECTORY
JRST ERR2
HRRZ T,DIRECT+0 ;GET UIC (PPN)
MOVEM T,VENPPI ;SAVE IT
HRRZ T,DIRECT+1 ;GET LENGTH OF EACH ENTRY IN UFD
MOVEM T,VWPEI ;SAVE IT FOR LATER
HLRZ T,DIRECT+1 ;FIRST BLK OF UFD
MOVEM T,VDIRB1 ;FIRST REAL DATA BLOCK
MOVEM T,DIRBKN ;REMEMBER WHAT BLK THIS IS
PUSHJ P,RBTDIR ;READ IT INTO DIRECT. THIS IS THE REAL STUFF
JRST ERR2
HLRZ T,DIRECT
MOVEM T,VDIRB2 ;AND SECOND ONE
TYPDIQ: SKIPN SWLIST ;SEE IF /L
JRST TYPD.1 ;NO--PROCEED
TLNE F,L.DTI!L.SCRI ;IS THIS A DECTAPE?
PUSHJ P,DIR ;YES--LIST DIRECTORY
TYPD.1: SKIPE EOJFLG ;TEST FOR END-OF-JOB PASS
JRST EOJ1 ;YES--GO BACK TO EOJ PROCESSING
SUBTTL ROUTINE TO PROCESS COPY OPERATIONS
OUTASK: TRNE F,R.BDO ;ANY OUT SPEC?
JRST EPROCS ; ALL DONE
MOVE T,OSW ;GET OUTPUT FILE SWITCHES
TRZE F,R.MFI2 ;REPEATING AFTER COMMA?
JRST SELFIL ;YES. OUTPUT ALREADY SET UP
TLNN F,L.DTO ;IS OUTPUT A DECTAPE?
TRNE T,SW$SCR ; OR SIMULATED ONE
SKIPA ;YES
JRST SELFIL ;NO. SKIP THIS SECTION
TRNE T,SW$R ;REUSING?
JRST OUTASL ;YES--SKIP ONWARD
MOVEI A,IO.NSD!.IODMP ;GET OUTPUT TAPE IN KLUDGE MODE
MOVE B,ODEV ; ..
MOVEI C,0 ;NO BUFFERS
OPEN OUTF,A ;TRY TO GET TAPE
JRST ERR9 ;CAN'T GET IT?
TRNN T,SW$SCR ;QUICK OUTPUT?
JRST OUTZA ;NO.
OUTASL: MOVEI A,.IODMP ;YES. GET DSK FOR SCRATCH FILE
MOVSI B,'DSK' ; ..
MOVEI C,0 ;NO HEADERS
OPEN SCOF,A ;ASK FOR DSK
JRST ERR3 ;NOT THERE?
TRNN T,SW$Z!SW$Q ;IF /Z OR /Q,
JRST OUTZSA ; PROCEED
CONT.
OUTASZ: MOVEI T,SW$Z ;FORCE A ZER FILE SRUCTURE
IORB T,OSW ;REMEMBERIT
STORE A,ENTBLK,ENTBLK+.RBEST,0 ;CLEAR EXTENDED ENTER
MOVEI A,.RBEST
MOVEM A,ENTBLK
MOVE A,SCRNAM ;GET SCRATCH NAME
HRRI A,'XFO' ;OUTPUT SCRATCH NAME
SKIPE OPDEV ;IF PSEUDO FILE,
MOVE A,OPDEV ; GET IT
MOVEM A,ENTBLK+.RBNAM
MOVSI A,'TMP'
SKIPE OPDEV ;IF PSEUDO FILE,
MOVSI A,'DTA' ; USE SPECIAL EXTENSION
MOVEM A,ENTBLK+.RBEXT
MOVEI A,LASTOB
MOVEM A,ENTBLK+.RBEST
ENTER SCOF,ENTBLK ;ENTER IT FOR OUTPUT
JRST ERR4 ;CAN'T?
SETZM TBUF ;USE THIS BLOCK FOR SOME ZEROES
MOVE T,[XWD TBUF,TBUF+1]
BLT T,XBUF+177 ;CLEAR IT
MOVEI T,<LASTOB+1>/2 ;LENGTH OF PSEUDO TAPE
OUT SCOF,TXIOL ;WRITE BLKS 0 THRU 1101
SKIPA
PUSHJ P,ERR35 ;YES
SOJG T,.-3 ;WRITE WHOLE TAPE'S WORTH
CLOSE SCOF, ;CLOSE THE FILE
OUTZSA: MOVE A,SCRNAM ;GET SCRATCH NAME
HRRI A,'XFO' ;CONVERT FOR OUTPUT
SKIPE OPDEV ;IF PSEUDO FILE,
MOVE A,OPDEV ; GET IT
MOVSI B,'TMP' ;INDICATE TEMP FILE
SKIPE OPDEV ;IF PSEUDO FILE,
MOVSI B,'DTA' ; USE SPECIAL EXTENSION
SETZB C,D ; ..
LOOKUP SCOF,A ;OPEN FILE FOR UPDATING
JRST [MOVE T,OSW ;GET OUTPUT SWITCHES
TRNN T,SW$Z!SW$Q ;IF /Z OR /Q,
TRNE B,77 ; OR IF OTHER THAN "NOT FOUND",
JRST ERR35 ; THEN ERROR
PUSHJ P,ERR51 ;ELSE, WARN THAT /Z ASSUMED
MOVEI T,SW$Z ;SET
IORM T,OSW ; /Z ON OUTPUT
JRST OUTASZ] ;AND TRY JUST ONCE MORE
HLLZS B
SETZB C,D
ENTER SCOF,A ; ..
JRST ERR35
TLO F,L.SCRO ;SUCCESSFUL. FLAG FOR LATER ROUTINES.
CONT.
OUTZA: MOVE T,OSW ;GET OUTPUT SWITCHES
TRNN T,SW$Z ;WANT OUTPUT ZEROED?
JRST OUTZA1 ;NO. SKIP THIS
MOVEI T1,SW$Z ;CLEAR BIT IN SWITCH WORD
ANDCAM T1,OSW ;SO ONLY DO THIS ONCE
PUSHJ P,ZER ;ZERO OUTPUT TAPE
OUTZA1: SETOM VODIB1 ;PREPARE THESE BECAUSE DONT KNOW THEM YET
SETOM VODIB2 ; ..
TLNN F,L.DTO!L.SCRO ;NO, IS OUTPUT TO DECTAPE?
JRST SELFIL ;NO. SKIP THIS
MOVE T,OTYPEX ;GET OUTPUT TYPE
MOVE T,DBLK(T) ;GET DIRECTORY BLOCK NUMBER
MOVEM T,ODIBKN ;SAVE FOR MULTI-BLOCK ON ELEVEN
PUSHJ P,INOUTD ;READ OUTPUT DIRECTORY
JRST SELFIL ;PROCEED
DBLK: 0 ;NOT DECTAPE
144 ;TEN
1 ;SIX
100 ;MAC
100 ;FIFTEEN
100 ;ELEVEN
LBLK: 0 ;NOT DECTAPE
LASTOB ;TEN
LASTOB ;SIX
1067 ;MAC
1077 ;FIFTEEN
1077 ;ELEVEN
SELFIL: TRNN F,R.IN ;ANYTHING WANTED?
JRST SCOQ ;NO. QUIT.
SETOM SRCHP ;FLAG NOT YET INTO DIRECTORY
MOVE T,SJFF ;RECLAIM SPACE
MOVEM T,.JBFF ; ..
MOVEM T,SJFF2 ;SET MINIMUM PER-FILE .JBFF
;SELECT FILES AND DISPATCH TO THE TRANSFER ROUTINE
RESELF: PUSHJ P,SELFST ;GO SELECT ANOTHER FILE
JRST [TLZ F,L.WFI!L.WEI ;CLEAR WILD INPUT FLAGS
TLZN F,L.STR1 ;NO MORE STAR. WAS THERE ONE?
JRST ERR23 ;NO. THEN THERE WAS NO SUCH FILE.
JRST EPROCS] ;OK. GO TO END OF PROCESSING.
PROCES: SETZM RCA ;CLEAR READ ADDRESS COUNTER
MOVE T,ITYPEX ;GET INPUT TYPE
PUSHJ P,SELDTP ;SELECT TAPE MACHINE TYPE
MOVE B,T ;SAVE FOR LATER
MOVE T,OTYPEX ;GET OUTPUT TYPE
PUSHJ P,SELDTP ;SELECT TAPE MACHINE TYPE
IMULI B,DT$NUM ;ALLOW FOR N-TYPES
ADDI B,(T) ;COMPUTE MACHINE CONVERSION
JUMPN B,[ADDI B,FT$NUM*FT$NUM+FT$NUM ;OFFSET BEYOND 36-BIT TABLE
JRST PROC.1] ;GO PROCESS TRANSFER
;HERE WHEN TRNASFER IS SOME KIND OF 36 BIT TO 36 BIT
HLRZ A,TIEXT ;GET AN EXTENSION
MOVE C,ISW ;AND SWITCHES
PUSHJ P,SELFTP ;AND SELECT FILE TYPE
MOVE B,RDWRD-1(T) ;GET TYPE OF READ ROUTINE
MOVEM B,RPC ;INTIALIZE ROUTINE
MOVE B,T ;GET ANSWER
MOVE C,OSW ;GET OUTPUT SWITCHES
HLRZ A,TOEXT ;GET OUTPUT EXTENSION
TLNE F,L.WEO ;WILD OUTPUT?
HLRZ A,TIEXT ;YES. COPY INPUT
PUSHJ P,SELFTP ;SELECT FILE TYPE
TLZ F,L.6DO ;ASSUME NOT SIX DUMP
CAIN T,FT$D ;SIX DUMP?
TLO F,L.6DO ;YES. REMEMBER IT
CAIE T,FT$C ;SHOULD FILE BE WRITTEN TIGHT ON TEN?
CAIN T,FT$E ;NAMELY COMPRESSED OR EXPANDED?
TLO F,L.6DO ;YES.
CAIE T,FT$H ;IF HIGH SEG
CAIN T,FT$P ; OR PROGRAM,
TLO F,L.6DO ; SET IT ALSO
IMULI B,FT$NUM ;MAKE MORE SIGNIFICANT
ADDI B,(T) ;GET OFFSET INTO TABLE FOR XFER
PROC.1: PUSH P,B ;SAVE DISPATCH
CAIE B,FT$P*FT$NUM+FT$H ;SEE IF P TO H
CAIN B,FT$P*FT$NUM+FT$C ;OR P TO C
SKIPA ;IN THOSE CASES SKIP THE ENTER
PUSHJ P,ENTRN ;NO--JUST ENTER NORMAL OUTPUT FILE
;(P TO H CHOOSES AUTOMATIC EXTENSIONS)
POP P,B ;RESTORE DISPATCH
PROC.2: PUSHJ P,@XARRAY-1-FT$NUM(B) ;DO THE TRANSFER
; AND CLOSE THE FILE
SUBTTL END OF MAIN LOOP
EPROCS: TRNN F,R.BDO ;IF NO OUTPUT , AND NOT
TLNN F,L.MFI!L.WEI!L.WFI ;MULT INPUTS?
JRST SCOQ ;NO. GO SEE IF TAPE NEEDS WRITING FM SCRATCH
TRO F,R.MFI2 ;FLAG RE-SCANNING, OUTPUT ALREADY OPEN
TLNN F,L.WEI!L.WFI ;WILD?
JRST EPROC0 ;CHECK IF /C NEEDS
TLO F,L.STR1 ;FLAG HAVE READ ONE * FILE
JRST RESELF ;YES. READ ANOTHER OF THE * FILES.
EPROC0: TRZN F,R.SAVX ;CONVERTING WITH /C?
JRST REINP ;GET NEW INPUT
MOVE T,SOEXT ;IF NO OUT EXTENSION
MOVEM T,OEXT ;THEN RESTORE IT
SKIPE CNVWEO ;RESET F FLAG
TLO F,L.BEO!L.WEO ; TO WILD
JRST REINP ;RE DO INPUT
SCOQ: TLNN F,L.SCRO ;SCRATCH OUTPUT?
JRST EOJ ;NO. ALL DONE
CLOSE SCOF, ;HAVE TO CLOSE FILE BEFORE READING
RELEAS INF, ;CLEAR THESE CHANNELS BECAUSE WILL USE
RELEAS UFDF, ; THEIR BUFFER AREAS FOR OUTPUTTING
MOVE T,OSW ;GET OUTPUT SWITCHES
TRNE T,SW$R ;SEE IF TO BE REUSED
JRST SCOENX ;YES--SKIP ON
MOVE A,SCRNAM ;AND RE-OPEN IT FOR INPUT
HRRI A,'XFO'
MOVSI B,'TMP'
SETZB C,D
LOOKUP SCOF,A ;READ THE FILE
JRST ERR34 ;NOT THERE?
USETI SCOF,1 ;READ TAPE'S BLOCK 0
IN SCOF,WIOL ;INTO WBUF
SKIPA
JRST ERR35 ;YES. QUIT
PUSHJ P,WBK0 ;WRITE BLOCK 0 ON TAPE
JRST ERR19 ;ERROR ON TAPE
SCOL2: HRRZ T,.JBREL ;SEE HOW MUCH CORE IS AVAILABLE
HRRZ T1,.JBFF
SUB T,T1
ASH T,-7 ;IN TAPE BLKS
SUBI T,1
MOVEM T,BLKS ;SAVE FOR LOOP
CAIL T,40 ;ENOUGH FOR EFFICIENCY?
JRST SCOB ;YES.
MOVE T,.JBREL ;NO.
MOVEI T,1(T) ;ASK FOR ANOTHER K
CORE T, ; ..
JRST SCOB ;CANT HAVE IT. WELL, USE WHAT YOU HAVE
JRST SCOL2 ;GOT IT. SEE IF ANY MORE NEEDED
CONT.
SCOB: MOVEI B,1 ;START AT BLK 1 (0 DONE ABOVE)
SCOL: CAILE B,LASTOB ;ALL WRITTEN?
JRST SCOEND ;YES.
MOVEI T1,LASTOB ;NO.
ADDI T1,1 ;LAST PLUS ONE
SUB T1,B ;MINUS WHERE WE ARE
MOVE T,BLKS ;SPACE WE HAVE IN CORE
ADD T,B ;WHERE THAT WOULD LEAVE US
CAIGE T,LASTOB ;TOO MUCH?
MOVE T1,BLKS ;NO. GET IT ALL
MOVEM T1,D ;SAVE
MOVNS T1 ;MINUS BLKS
LSH T1,31 ;MINUS WDS,,0
HRR T1,SJFF ;PLACE FOR IT
MOVEM T1,CORIOW ;TO IO LIST
USETI SCOF,1(B) ;GET THE TAPE IMAGE BLK
IN SCOF,CORIOW ; ..
SKIPA
PUSHJ P,ERR32 ;NO.
USETO OUTF,(B) ;WHERE TO WRITE ON TAPE
OUT OUTF,CORIOW ;DO SO.
SKIPA
PUSHJ P,ERR33 ;OOPS
ADD B,D ;ONWARD DOWN THE TAPE
JRST SCOL ;LOOP FOR MORE
SCOEND: CLOSE OUTF, ;CLOSE THE DTA
MTREW. OUTF, ;REWIND IT
RELEAS OUTF, ;SO IT CAN BE USED FOR INPUT
SETZB A,B
SETZB C,D ;RENAME TO 0
MOVE T,OSW ;GET OUTPUT SWITCHES
TRNN T,SW$P!SW$R ;SEE IF PRESERVING
RENAME SCOF,A ; ..
JFCL
SCOENX: RELEAS SCOF, ; ..
;ACTUAL END OF JOB PROCESSING
EOJ: TLNE F,L.DTO!L.SCRO ;REAL OR SIMULATED TAPE?
SKIPN SWLIST ;YES--WAS A DIRECTORY LISTING REQUESTED
JRST EOJ1 ;NO--SKIP THE OUTPUT
MOVE T,ODEV ;COPY OUTPUT DEVICE
MOVEM T,IDEV ; TO INPUT DEVICE
SETZM ODEV ;INDICATE NO COPY
MOVE T,OSW ;COPY OUTPUT SWITCHES
TRZ T,SW$Q ;NO MORE A TEMP FILE
TRZE T,SW$SCR ;IF TEMP FILE,
TRO T,SW$R ; USE /R FOR OUTPUT LISTING
MOVEM T,ISW ; TO INPUT SWITCHES
; AND LEAVE IN T
TLO F,L.DTI ;FLAG AS DECTAPE INPUT
SETOM EOJFLG ;FLAG AS END-OF-JOB PASS
JRST EOJLOP ;GO TO DIRECTORY LISTER
EOJ1: TRNN F,R.JSCR ;WANT TO JUNK SCRATCH?
JRST EOJE ;NO
MOVEI A,.IODMP ;YES. GET DSK
MOVSI B,'DSK'
MOVEI C,0
OPEN SCRF,A
JRST EOJE
MOVE A,SCRNAM
MOVSI B,'TMP'
SETZB C,D
LOOKUP SCRF,A
JRST EOJE
SETZB A,B
SETZB C,D
CLOSE SCRF,
RENAME SCRF,A
JFCL
EOJE: CLOSE SCRF,
JRST FILEX
SUBTTL TRANSFER MODE SELECTIONS
;DUMB ROUTINE TO SELECT THE CURRENT FILE TYPE.
;ARGS - EXTENSION IN RH OF A, SWITCHES IN C. RETURNS TYPE IN T
FT$C==1 ;COMPRESSED SAVE FILE
FT$E==2 ;EXPANDED SAVE FILE
FT$D==3 ;DUMP (SIX) FILE
FT$S==4 ;SBLK (MAC) FILE
FT$B==5 ;RANDOM BINARY
FT$H==6 ;HIGH SEGMENT (.HGH, .SHR)
FT$P==7 ;PROGRAM (.EXE) EXECUTABLE
FT$NUM==7 ;NUMBER OF TYPES
SELFTP: MOVEI T,FT$B ;IN CASE NOTHING ELSE SHOWS UP
CAIE A,'SVE' ;CHECK FOR TEN SAVE EXTENSIONS
CAIN A,'SAV' ; ..
MOVEI T,FT$C ;YES
CAIN A,'LOW' ;ONE MORE
MOVEI T,FT$C
CAIN A,'XPN' ;EXPANDED SAVE FILE?
MOVEI T,FT$E ;YES.
CAIN A,'DMP' ;SIX DUMP FILE?
MOVEI T,FT$D ;YES
CAIE A,'HGH' ;HIGH
CAIN A,'SHR' ; SEGMENT?
MOVEI T,FT$H ;YES
CAIN A,'EXE' ;EXECUTABLE PROGRAM?
MOVEI T,FT$P ;YES
TRNE C,SW$S ;SWITCHES OVERRIDING ABOVE?
MOVEI T,FT$S ; S SWITCH
TRNE C,SW$D
MOVEI T,FT$D
TRNE C,SW$E
MOVEI T,FT$E
TRNE C,SW$B
MOVEI T,FT$B
TRNN C,SW$C ;UNLESS /C,
POPJ P, ; DONE
CAIE T,FT$H ;/C--LOOK IF EXTENSION
CAIN T,FT$P ; HIGH AND PROGRAM
POPJ P, ; OVERRIDE /C
MOVEI T,FT$C ;OTHERWISE, FORCE COMPRESSION
POPJ P, ;RETURN FILE TYPE
CONT.
;DUMB ROUTINE TO SELECT THE CURRENT MACHINE TYPE
;ARG - T/?TYPEX CODE, RETURNS TYPE IN T
DT$TEN==0 ;-10
DT$FIF==1 ;-15
DT$VEN==2 ;-11
DT$NUM==3 ;NUMBER OF TYPES
SELDTP: SUBI T,TYPFIF-1 ;MAKE 15'S 1
SKIPGE T ;IF -10,
MOVEI T,0 ; SET TO 0
POPJ P, ;RETURN
;SWITCH TABLE - INDEX BY LETTER FROM A
;CONTAINS XWD SET BIT(S), CLR BIT(S)
SWTAB: XWD SW$A,SW$I ;A
XWD SW$B,SW$C!SW$D!SW$E!SW$S!SW$A!SW$I ;B
XWD SW$C,SW$B!SW$D!SW$E!SW$S!SW$A!SW$I ;C
XWD SW$D,SW$B!SW$C!SW$E!SW$S!SW$A!SW$I ;D
XWD SW$E,SW$B!SW$C!SW$D!SW$S!SW$A!SW$I ;E
XWD SW$F,SW$M!SW$V!SW$O!SW$T ;F
XWD SW$G,0 ;G
XWD 0,SWHELP ;H
XWD SW$I,SW$A ;I
0 ;J
0 ;K
XWD 0,SWLIST ;L
XWD SW$M,SW$F!SW$V!SW$O!SW$T ;M
0 ;N
XWD SW$O,SW$F!SW$M!SW$V!SW$T ;O
XWD SW$P,SW$Q!SW$R ;P
XWD SW$Q,SW$P!SW$R ;Q
XWD SW$R,SW$P!SW$Q ;R
XWD SW$S,SW$B!SW$C!SW$D!SW$E!SW$A!SW$I ;S
XWD SW$T,SW$M!SW$V!SW$O!SW$F ;T
0 ;U
XWD SW$V,SW$F!SW$M!SW$O!SW$T ;V
0 ;W
0 ;X
0 ;Y
XWD SW$Z,0 ;Z
.ZZ==1 ;BITS
DEFINE M$SW(A)<
IRP<A>,<SW$'A==.ZZ
.ZZ==.ZZ+.ZZ>>
;1 FREE BIT; Z COULD ALSO BE RECLAIMED
M$SW(<A,B,C,D,E,F,G,I,M,O,P,Q,R,S,T,V,Z>)
;THE FOLLOWING SWITCHES CONSTITUTE THE SCRATCH FILE SPECIFIERS
SW$SCR==SW$P!SW$Q!SW$R
;THE FOLLOWING SWITCHES ARE MEANINGFUL ONLY ON THE SIDE OF LEFTARROW
; WHICH HAS A DECTAPE AS THE DEVICE
SW$TAP==SW$F!SW$M!SW$O!SW$SCR!SW$T!SW$V!SW$Z
;DISPATCH TABLE FOR TYPE OF TRANSFER OPERATION
;THE FOLLOWING DEFINES AS ILLEGAL CONVERSIONS BETWEEN LOW
;SEGMENT AND HIGH SEGMENT
DEFINE ERR53$(A),<
IRP (A),<XFR'A==ERR53>
>
ERR53$ <HC,HD,HS,CH,DH,SH>
;THE FOLLOWING IS THE DISPATCH FOR THE GENERAL WORD READER
;EACH IS THE INITIAL POINT TO EXPAND THE APPROPRIATE TYPE OF FILE
DEFINE RDWRD$(A),<
IRP (A),<RDWRD'A>
>
XALL
RDWRD: RDWRD$ (<C,E,D,S,B,H,P>) ;
SALL
DEFINE XFR$(A),< XFR$$(<A>,<A>) >
DEFINE XFR$$(X,Y),<
IRP (X),<
IRP (Y),<
....==1
IFIDN <X><B>, ....==0
IFIDN <Y><B>, ....==0
IFIDN <X><Y>, ....==0
IFE ....,<
XFRBB ;X TO Y (NO CONVERSION)
>
IFN ....,<
XFR'X'Y ;X TO Y
>
>>>
CONT.
XALL
XARRAY: XFR$ (<C,E,D,S,B,H,P>) ;
CONT.
;THESE MUST FOLLOW IMMEDIATELY
XFRTF ;TEN TO FIFTEEN
XFRTV ;TEN TO ELEVEN
XFRFT ;FIFTEEN TO TEN
XFRBB ;FIFTEEN TO FIFTEEN
ERR36 ;FIFTEEN TO ELEVEN
XFRVT ;ELEVEN TO TEN
ERR36 ;ELEVEN TO FIFTEEN
XFRVV ;ELEVEN TO ELEVEN
SUBTTL 36-BIT TRANSFER ROUTINES
;ALL TRANSFERS WHICH CONSIST OF A SIMPLE BINARY COPY FROM INPUT
; TO OUTPUT. THIS IS ALL FOR WHICH INPUT AND OUTPUT ARE THE
; SAME BINARY FORMAT AND ALL THOSE TO AND FROM BINARY MODE.
;THIS IS SO COMMON, THAT SPECIAL CODE TO OPTIMIZE IT IS DESIRABLE.
;IF THE INPUT AND OUTPUT ARE BOTH -10 DEVICES AND NOT
;THE SIMULATED DECTAPES, THEN NO SPECIAL ROUTINES ARE NEEDED
;AND A SIMPLE BLT BETWEEN INPUT AND OUTPUT BUFFERS IS POSSIBLE
XFRBB: TLNE F,L.SCRO!L.SCRI ;IF SCRATCH IN OR OUT,
JRST XBBSLO ; CAN NOT USE FAST MODE
MOVE A,ITYPEX ;GET INPUT DEVICE TYPE
CAILE A,1 ;SEE IF -10 DEVICE
JRST XBBSLO ;NO--DO IT THE SLOW WAY
MOVE A,OTYPEX ;YES--GET OUTPUT TYPE
CAIGE A,1 ;SEE IF -10 DEVICE
JRST XBBFAS ;YES DO IT FAST
;HERE IF MUST DO COPY THE SLOW WAY (ONE WORD AT A TIME)
XBBSLO: PUSHJ P,RPB ;SIMPLE BINARY TRANSFER
JRST CLS ;END OF FILE
PUSHJ P,PPB ;WRITE
JRST CLS
JRST XBBSLO
CONT.
;THE NEXT CODE IS THE CODE DOING A STRAIGHT FORWARD
;TRANSFER FROM PDP-10 FILE TO PDP-10 FILE
;THE ALGORITHM USED IS:
; WHILE NO EOF OR ERROR ON CHANNEL INF DO
; (A:=NUMBER OF WORDS IN INPUT BUFFER
; WHILE THERE ARE ARE NO OUTPUT ERRORS DO
; B:=OUPUT CAPACITY;
; BLOCK TRANSFER INPUT DATA TO OUTPUT BUFFER;)
XBBFAS: SKIPE A,IHED+2 ;NUMBER OF CHARACTERS IN INPUT BUFFER
JRST XBBF.1 ;STILL DATA THERE
IN INF, ;GET A NEW BUFFER
JRST XBBFAS
STATZ INF,IO.ERR ;ANY ERRORS?
PUSHJ P,ERR16 ;YES REPORT THEM
STATZ INF,IO.EOF ;END OF FILE FOUND?
JRST CLS ;YES READY
JRST XBBFAS ;LOOP WITH NEW DATA
XBBF.1: SKIPE B,OHED+2 ;ROOM IN OUTPUT BUFFER
JRST XBBF.2 ;THEN DO THE BLT
OUT OUTF, ;MAKE ROOM
JRST XBBF.1 ;SET UP B FOR BLT
JRST ERR19 ;SORRY
XBBF.2: CAMLE A,B ;MOVE THE SMALLEST NUMBER
MOVE A,B ;WHICH HAPPENS TO BE IN B
HRL B,IHED+1 ;SOURCE ADDRESS
HRR B,OHED+1 ;TARGET ADDRESS -1
ADD B,[1,,1] ;GET REAL ADDRESSES
MOVEI C,(B) ;FIRST TARGET WORD
ADDI C,(A) ;1 TOO FAR!!!!!
BLT B,-1(C) ;COMPENSATE BY OFFSET
ADDM A,IHED+1 ;ACCOUNT IN INPUT HEADER
ADDM A,OHED+1 ;TO GET THE LAST DATA OUT
MOVNS A ;DO ACCOUNTING
ADDM A,IHED+2 ;UPDATE INPUT HEADER
ADDM A,OHED+2 ;UPDATE OUTPUT HEADER
JRST XBBFAS ;GO FOR MORE
;TRANSFER FROM EXPANDED TO HIGH SEGMENT
XFREH: MOVEI CA,.JBDA ;INDICATE LENGTH OF JOB DATA AREA
XEH.1: PUSHJ P,@RPC ;SKIP OVER IT
JRST ERR54 ;ERROR IF THAT IS ALL
SOJG CA,XEH.1 ;LOOP
MOVEI CA,.JBHGH-.JBDA ;INDICATE START OF HIGH SEG
XEH.2: PUSHJ P,@RPC ;GET NEXT WORD OF XPN
JRST ERR54 ;ERROR IF EOF
JUMPN W,ERR54 ;MUST ALL BE 0
SOJG CA,XEH.2 ;LOOP OVER THE 128K OF ZEROS
JRST XFRCE ;THEN WRAP UP WITH SIMPLE COPY
;CONVERT EXE TO XPN FORMAT JUST USE 20 ZEROES INSTEAD OF
;THE SAVE FILE CONTENT
XFRPE: MOVEI CA,20 ;ALL ZEROES
XFRPE0: PUSHJ P,@RPC ;GET A WORD
JRST CLS ;EOF
SETZ W, ;A ZERO
PUSHJ P,PPB ;WITE IT
JRST CLS ;END IF ERROR
SOJG CA,XFRPE0 ;ALL FIRST ZERO
PJRST XFRCE ;REST IS TANDARD
;CONVERT TO -6 (.DMP) SAVE FILE
XFRED:!
XFRSD:!
XFRPD:!
XFRCD: MOVEI CA,JOBSV6 ;INDICATE WHERE -6 STARTS
XCD.1: PUSHJ P,@RPC ;READ AN EXPANDED WORD
JRST CLS ;GIVE UP!
SOJGE CA,XCD.1 ;LOOP UNTIL DONE WITH SKIP
;THEN HANDLE LIKE TO XPN
;CONVERT TO EXPANDED (.XPN) FILE
XFRDE:!
XFRHE:!
XFRSE:!
XFRCE: PUSHJ P,@RPC ;READ EXPANDED WORD FROM INPUT
JRST CLS ;CLOSE WHEN DONE
PUSHJ P,PPB ;WRITE OUTPUT
JRST CLS ;END IF ERROR
JRST XFRCE ;LOOP INDEFINITELY
;TRANSFER TO PROJECT MAC S-BLK FILE
XFRDS:!
XFRPS:!
XFRES: PUSHJ P,OUTMRL ;ISSUE BOOTSTRAP
JRST CLS ;CLOSE IF ERROR
TROA F,R.SBLK ;INDICATE S-BLK OUTPUT
;TRANSFER TO COMPRESSED (.SAV) FILE
XFRDC:!
XFREC: TRZ F,R.SBLK ;INDICATE NOT S-BLK
MOVEI CA,20 ;EXPANDED TO COMPRESSED
MOVEM CA,ICA ;ADDRESS ABOUT TO GET FROM INPUT FILE
XEC.1: PUSHJ P,@RPC ;READ EXPANDED FILE
JRST CLS ;ERROR
SOJG CA,XEC.1 ;DISCARD FIRST 20 LOCS OF EXP FILE
SETZB CA,OCA ;CLEAR OUTPUT POINTERS
SETZM SAVSTA ;NO STARTING ADDRESS KNOWN YET
XEC.2: PUSHJ P,@RPC ;READ INPUT WORD
JRST XEC.5 ;END OF FILE
JUMPE W,XEC.3 ;ZERO WORD FROM INPUT?
MOVEM W,XBUF(CA) ;PUT INTO TRANSFER BUFFER
ADDI CA,1 ;COUNT SIZE OF XFR BUF
CAIGE CA,200 ;FULL?
JRST XEC.2 ;NO.
PUSHJ P,XECOBK ;YES. OUTPUT THIS BLOCK AS ONE AOBJN WD
JRST CLS ;ERROR
JRST XEC.2 ;READ SOME MORE.
XEC.3: JUMPE CA,XEC.4 ;ZERO IN. NEED TO WRITE BLK?
PUSHJ P,XECOBK ;YES. DO SO.
JRST CLS ;ERROR
XEC.4: AOS ICA ;COUNT INPUT ADDRESS
JRST XEC.2 ;AND GO ON.
XEC.5: JUMPE CA,XEC.6 ;NEED TO OUTPUT A BLOCK?
PUSHJ P,XECOBK ;YES. DO.
JRST CLS ;ERROR
XEC.6: SKIPE W,SAVSTA ;HAS A NON-ZERO START ADR BEEN SEEN?
TLOA W,(JRST) ;YES. MAKE A JRST TO IT.
MOVSI W,(HALT) ;OUTPUT JRST WORD (NO SA KNOWN)
PUSHJ P,PPB ; ..
JRST CLS ;ERROR
TRZE F,R.SBLK ;IF S-BLK OUTPUT,
PUSHJ P,PPB ;ISSUE AGAIN (NO SYMBOLS)
JFCL ;IGNORE ERROR
JRST CLS ;END OF FILE
;ROUTINE TO OUTPUT DATA BLOCK FOR COMPRESSOR ABOVE
;IT HANDLES EITHER -10 COMPRESSED OR MAC S-BLK
;CALLED WITH COUNT IN CA AND START ADDRESS IN ICA
;DATA IS IN XBUF
XECOBK: MOVE T,[T,,XBUF] ;GET POINTER TO DATA BLOCK
MOVEM T,GETPTR ;AND SET UP THE GET POINTER
;ENTER AT XECOB0 WITH GET PTR INITIALIZED TO A DATA BLOCK
XECOB0: MOVN W,CA ;OUTPUT DATA BLOCK
HRLZS W ;MAKE COUNT OF BUFFER
HRR W,ICA ;ADDRESS OF BUFFER STARTING IN CORE
SETZB T,OCA ;CLEAR COUNT
TRNE F,R.SBLK ;IF S-BLK,
JRST XECO.2 ; GO DO THAT
;HERE TO OUTPUT -10 COMPRESSED IOWD DATA BLOCK
HRRI W,-1(W) ;MINUS ONE FOR BLKI PTR
PUSHJ P,PPB ;OUTPUT THE POINTER
POPJ P, ;ERROR
XECO.1: MOVE W,@GETPTR ;GET A DATA ITEM
PUSHJ P,PPB ;OUTPUT IT
POPJ P, ;ERROR
AOS T,ICA ;COUNT INPUT ADDRESS
CAIN T,.JBSA+1 ;IS IT WHERE START ADDR LIVES?
HRRZM W,SAVSTA ;YES. SAVE IT.
AOS T,OCA ;COUNT AMT OF XBUF WRITTEN
CAIGE T,(CA) ;ALL OF IT?
JRST XECO.1 ;NO.
JRST XECO.4 ;FINISH UP
;HERE TO OUTPUT PROJECT MAC S-BLK AOBJN BLOCK
XECO.2: MOVE CKS,W ;INITIAL CHECKSUM
PUSHJ P,PPB ;OUTPUT AOBJN PTR
POPJ P, ;ERROR
XECO.3: MOVE W,@GETPTR ;GET DATA
ROT CKS,1 ;PUT IT IN CKSUM
ADD CKS,W ; ..
PUSHJ P,PPB ;OUTPUT THE DATUM
POPJ P, ;ERROR
AOS ICA ;COUNT TRANSFERRED INPUT WORD
AOS T,OCA ;HOW MUCH OF BLOCK XFRD
CAIGE T,(CA) ;ALL OF IT?
JRST XECO.3 ;NOT YET
MOVE W,CKS ;OUTPUT THE CHECKSUM
PUSHJ P,PPB ; ..
POPJ P, ;ERROR
XECO.4: MOVEI CA,0 ;YES. CLEAR COUNT OF FILLED BFR
JRST CPOPJ1 ;OK RETURN.
;ROUTINE TO OUTPUT THE PROJECT MAC S-BLK
;BOOTSTRAP LOADER
OUTMRL: MOVE CA,[XWD -MRLL,MRL] ;POINTER TO LOADER
OUTM.1: MOVE W,(CA) ;GET A WORD OF IT
PUSHJ P,PPB ;OUTPUT IT
POPJ P, ;ERROR
AOBJN CA,OUTM.1 ;LOOP FOR ALL
JRST CPOPJ1 ;SUCCESS RETURN
MRL: DATAI PTR,4
JUMPGE 16,16
DATAI PTR,5
JSP 14,30
DATAI PTR,6
DATAI PTR,0(16)
DATAI PTR,7
ROT 15,1
DATAI PTR,10
ADD 15,0(16)
DATAI PTR,11
AOBJN 16,5
DATAI PTR,12
MOVEI 14,33
DATAI PTR,13
JRST 30
DATAI PTR,30
CONSO PTR,10
DATAI PTR,31
JRST 30
DATAI PTR,32
JRST 0(14)
DATAI PTR,33
DATAI PTR,16
DATAI PTR,34
CAMN 15,16
DATAI PTR,35
JUMPA 1
DATAI PTR,36
HALT
JRST 1
MRLL==.-MRL
;CONVERT COMPRESSED FILE TO S-BLK
XFRCS: PUSHJ P,OUTMRL ;OUTPUT MAC RIM LOADER
JRST CLS ;ERROR
XCS.1: PUSHJ P,RPB ;GET A POINTER OR JRST WORD
JRST CLS ;EOF
JUMPGE W,SCS.3 ;JRST WORD
MOVE CA,W ;POINTER
ADDI W,1 ;MAKE AOBJN NOT BLKI
MOVE CKS,W ;START CHECKSUM OF THIS BLOCK
PUSHJ P,PPB ;OUTPUT POINTER
JRST CLS ;ERROR
XCS.2: ROT CKS,1 ;CHECKSUM
PUSHJ P,RPB ;READ A DATUM FROM TEN FILE
JRST CLS ;BAD END
ADD CKS,W ;CHECKSUM
PUSHJ P,PPB ;OUTPUT THE WORD TO MAC FILE
JRST CLS ;ERROR
AOBJN CA,XCS.2 ;LOOP THROUGH AOBJN BLOCK
MOVE W,CKS ;END OF BLOCK. OUTPUT CKSUM
PUSHJ P,PPB ; ..
JRST CLS
JRST XCS.1 ;READ NEXT POINTER OR JRST
SCS.3: PUSHJ P,PPB ;OUTPUT THE FINAL JRST WORD
JRST CLS
PUSHJ P,PPB ;TWICE (NO SYMS)
JRST CLS
JRST CLS ;END OF FILE
;CONVERT S-BLK TO COMPRESSED
XFRSC: SETOM OCA ;SBLK TO COMPRESSED
PUSHJ P,RPB ;SKIP TO CUE WORD
JRST CLS ;ERROR
CAME W,[JRST 1] ;CUE?
JRST XFRSC ;NOT YET.
XSC.1: PUSHJ P,RPB ;GET POINTER OR JRST WORD
JRST CLS ;EOF OR ERROR
JUMPGE W,XSC.3 ;JRST WORD
MOVE CKS,W ;AOBJN BLK. SET UP CKS
HLL CA,W ;GET COUNT
SKIPGE OCA ;OR IF DATA,
MOVE CA,W ;GET COUNT AND ADDR
SKIPL OCA ;SYMS OR DATA?
HRRI W,(CA) ;SYMS. PUT AFTER DATA.
HRRI W,-1(W) ;MAKE BLKI PTR
PUSHJ P,PPB ;OUTPUT POINTER
JRST CLS ;ERROR
XSC.2: PUSHJ P,RPB ;READ A DATUM
JRST CLS ;ERROR
ROT CKS,1 ;CHECKSUM IT
ADD CKS,W ; ..
PUSHJ P,PPB ;OUTPUT IT
JRST CLS ;ERROR
AOBJN CA,XSC.2 ;COUNT THRU BLK
PUSHJ P,RPB ;READ CHECKSUM
JRST CLS ;ERROR
CAME W,CKS ;CHECK IT
PUSHJ P,CKSERR ;NO GOOD
JRST XSC.1 ;READ ANOTHER BLK
XSC.3: AOSG OCA ;COUNT OUTPUT ADDRESS AS FLAG
JRST XSC.1 ;JUST FIRST ONE. GO ON
PUSHJ P,PPB ;OUTPUT THE JRST WORD AT END
JRST CLS ;ERROR
JRST CLS ;END OF FILE
;TRANSFER FROM PROGRAM (.EXE) TO HIGH (.HGH/.SHR & .LOW)
;NOTE THAT THIS ROUTINE IS ENTERRED WITHOUT AN OUTPUT FILE OPEN
;IT WILL SELECT .HGH/.SHR AND .LOW/.SAV AS NEEDED
XFRPC:!
XFRPH: TLNN F,L.DSKO!L.DTO!L.SCRO ;MAKE SURE RE-OPENABLE
JRST ERR59 ;NO--GIVE UP
MOVSI CA,-.JBDA ;SKIP JOB DATA
XPH.1: PUSHJ P,@RPC ;READ A WORD
POPJ P, ;GIVE UP IF THIS SHORT
MOVEM W,XBUF(CA) ;SAVE IN BUFFER
AOBJN CA,XPH.1 ;LOOP
XPH.2: PUSHJ P,@RPC ;READ FIRST USER WORD
POPJ P, ;!
MOVE T,RTYP ;GET TYPE
TXNE T,PF$HGH ;SEE IF HIGH SEG
JRST [MOVEM W,RW ;YES--SAVE WORD
JRST XPH.9] ; AND NO LOW NEEDED
SKIPN W ;IF NON-ZERO, THEN NEED LOW
JRST XPH.2 ;ELSE LOOP UNTIL WE KNOW
;HERE IF .LOW NEEDED
MOVEM W,XBUF+.JBDA ;SAVE START OF LOW
MOVE T1,PDSCNT ;LOOK AT .EXE DIRECTORY
LSH T1,1 ;COMPUTE
ADD T1,PDSPTR ; LENGTH-1
XPH.3: MOVE T,PDS(T1) ;LOOK AT FLAGS
TXNE T,PF$HGH ;SEE IF HIGH SEGMENT
JRST XPH.3A ;YES--GO ENTER .LOW FIRST
SOS T1 ;BACK UP TWO WORDS
SOJGE T1,XPH.3 ; AND LOOP OVER DIRECTORY
MOVSI T,'SAV' ;NO HIGH SEG--ENTER .SAV
PUSHJ P,VEREXT ;SEE IF THAT WAS WANTED
JRST XPH.3B ; AND DO JUST THAT
XPH.3A: MOVSI T,'LOW' ;FORCE EXTENSION
XPH.3B: PUSHJ P,ENTR ;GO ENTER LOW
PUSHJ P,SAVINI ;INITIALIZE COMPRESSED SEGMENT STORAGE
MOVEI CA,0 ;CLEAR OUTPUT COUNTER
TRZ F,R.SBLK ;INDICATE NOT S-BLK
MOVEI T,XPHR ;SET SPECIAL ROUTINE
EXCH T,RPC ;GET OLD ONE
MOVEM T,RPOP ;SAVE FOR LATER
MOVE T,RCA ;SAVE READ COUNT
MOVEM T,RPOC ; POINT FOR LATER
MOVE T,.JB41+XBUF ;MOVE .JB41
MOVEM T,.SG41+XBUF ; TO SAVE FILE LOCATION
MOVE T,.JBDDT+XBUF ;MOVE .JBDDT
MOVEM T,.SGDDT+XBUF ; TO SAVE FILE LOCATION
SETZM SAVSTA ;INDICATE START ADDRESS UNKNOWN
MOVEI T,104 ;START WITH REAL CORE
MOVEM T,ICA ; ..
MOVEM T,RCA ; ..
CONT.
;LOOP OVER LOW SEGMENT CREATING COMPRESSED FILE
XPH.4: PUSHJ P,@RPC ;READ NEXT WORD
JRST [SETZM RPC ;INDICATE NO HIGH FILE
JRST XPH.7] ; AND FINISH UP LOW
MOVE T,RTYP ;GET TYPE
TXNE T,PF$HGH ;SEE IF HI SEG YET
JRST XPH.7 ;YES--GO FINISH LOW
JUMPE W,XPH.5 ;A ZERO--GO COMPRESS IT
PUSHJ P,SAVWRD ;SAVE THE WORD
PJRST SAVCLS ;GIVE UP ERROR
AOJA CA,XPH.4 ;LOOP
XPH.5: JUMPE CA,XPH.6 ;JUMP IF STRING OF ZEROS
PUSHJ P,SAVOUT ;WITE THE BLOCK
PJRST SAVCLS ;AND CLEAN UP ERROR
XPH.6: AOS ICA ;ADVANCE CORE LOC
JRST XPH.4 ;LOOP
;HERE WHEN HIGH SEG SEEN
XPH.7: MOVEM W,RW ;SAVE HI SEG WORD
JUMPE CA,XPH.8 ;JUMP IF BUFFER EMPTY
PUSHJ P,SAVOUT ;WRITE THE LAST BLOCK
PJRST SAVCLS ;OUT LOST
XPH.8: SKIPE W,SAVSTA ;GET START ADDRESS
TLOA W,(JRST) ;SET--MAKE INTO JRST XXX
MOVSI W,(HALT) ;NOT SET--STOP READER
PUSHJ P,PPB ;STORE END OF LOW
PJRST SAVCLS ;GIVE UP ERROR
PUSHJ P,SAVCLS ;CLOSE COMPRESS STUFF
SKIPN RPC ;SEE IF HIGH WANTED
POPJ P, ;NO ALL SET
CONT.
;HERE TO DO HIGH FILE
XPH.9: MOVE T1,RTYP ;GET TYPE
MOVSI T,'HGH' ;SET NON-SHARABLE
TXNE T1,PF$SHR ;IF SHARABLE,
MOVSI T,'SHR' ; SET SHARABLE
PUSHJ P,VEREXT ;AND VERIFY THE EXTENSION
PUSHJ P,ENTR ;FORCE ENTER
MOVE W,RW ;RESTORE WORD
PUSHJ P,PPB ;OUTPUT IT
JFCL
JRST XFRCE ;AND DO A STRAIGHT COPY
;LOCAL ROUTINE TO READ BACK JOBDATA AREA
XPHR: AOS W,RCA ;COUNT NEXT LOCATION
CAMN W,RPOC ;SEE IF DONE YET
JRST XPHR.1 ;YES--GO RETURN LAST WORD
CAILE W,.JBDA ;NO--SEE IF STILL IN SAVED AREA
TDZA W,W ;NO--CLEAR RESULT
MOVE W,XBUF-1(W) ;YES--GET IT
JRST CPOPJ1 ;RETURN VALUE
XPHR.1: MOVE W,RPOP ;GET ORIGINAL PC
MOVEM W,RPC ;RESTORE IT
MOVE W,XBUF+.JBDA ;RESTORE LAST WORD
JRST CPOPJ1 ;RETURN IT
;VEREXT VERIFY IF THE EXTENSION CHOSEN ON CONVERTING AN EXE FILE
;IS IDENTICAL TO THE ONE EXPLICITLY CHOSEN BY THE USER
;THE EXTENSION CHOSEN IS IN T
VEREXT: TRNN F,R.SAVX ;CONVERTING SAVE FILES
JRST VEREX0 ;NOT WITH /C SWITCH
SKIPN CNVWEO ;IF WILD OUT PUT
CAMN T,SOEXT ;OR WHAT HE WISHED
POPJ P, ;THEN RETURN
TLNE F,L.WFO ;IF 2WILD FILE OUTPUT
POPJ P, ;THEN IGNORE IT
MOVE T1,SOEXT ;EXTENSION TYPED IN
PJRST ERR64 ;WARN THE USER
VEREX0: CAME T,OEXT ;IF DESIRED NAME OR
TLNE F,L.WEO ;IF WILD OUTPUT THEN
POPJ P, ; JUST RETURN
MOVE T1,OEXT ;OUTPUT EXTENSION TYPED
PJRST ERR64 ;WARN PRESERVES T
;AUXILLARY ROUTINES TO MAKE A COMPRESSED FILE.
;A CORE AREA WILL BE USED TO BUILD COMPRESSED FILES STARTING
;AT SAVFPG AND ENDING AT SAVLPG. THE MAXIMUM LENGTH OF THIS AREA
;CAN BE SAVPMX PAGES.
;SAVINI INTIALIZE COMPRESSED SPACE. CALLED AFTER ALL BUFFERS ARE ALLOCATED
SAVINI: HRRZ T,.JBFF ;START OF FREE CORE
HRLI T,CA ;GET STORE POINTER
MOVEM T,SAVPTR ;FOR BUILDING THE DATA BLOCK
HRLI T,T ;GET A GET POINTER
MOVEM T,GETPTR ;FOR MAKING THE OUT BLOCK
ADDI T,1000*SAVPMN ;MINIMUM AMOUNT
HRRZM T,SAVFPG ;END OF FIRST CHUNK
HRRZM T,SAVLPG ;IS LAST ONE TOO
ADDI T,<SAVPMX-SAVPMN+1>*1000 ;LAST ADDRESS +1001
HRRZM T,SAVMAX ;SAVE THE BORDER
HRRZ T,SAVFPG ;GET THE CORE NECXT
CORE T, ;TRY TO GET IT
PJRST ERR65 ;YOU LOST
MOVEI T,1000*SAVPMN ;AMOUNT OF USABLE WORDS
MOVEM T,SAVCNT ;AVAILABLE CAPACITY
ADDM T,.JBFF ;UPDATE THE ACCOUNTING
POPJ P,
;SAVWRD SAVE A WORD IN THE COMPRESSED FILE
SAVWRD: SOSLE SAVCNT ;ANY SPACE
JRST SAVWR1 ;YES USE IT
HRRZ T,.JBFF ;START OF FREE CORE
CAME T,SAVLPG ;CONSISTENT
PJRST ERR67 ;ERROR FOR MAINTAINER
ADDI T,1000 ;NEXT CHUNK
CAME T,SAVMAX ;PASSING THE BORDER
CORE T,
JRST SAVBLK ;GET THIS PIECE OUT
MOVEI T,1000 ;FREE AMOUNT
MOVEM T,SAVCNT ;SORE THAT
ADDB T,.JBFF ;REMEMBR IT
HRRM T,SAVLPG ;LAST ONE+1
JRST SAVWRD ;TRY TO SAVE IT AGAIN
SAVWR1: MOVEM W,@SAVPTR ;STORE DATA
JRST CPOPJ1 ;AND FLAG THE RESULT
SAVBLK: PUSH P,W ;SAVE THE DATA
PUSH P,CA ;AND OUT ADDRESS
PUSHJ P,ERR66 ;WARN FOR THE SURPRISE
POP P,CA ;GET INDEX BACK
PUSHJ P,SAVOUT ;GET THE DATA OUT
JRST SAVBL0 ;AN ERROR OCCURRED
POP P,W ;GET DATA BACK
JRST SAVWRD ;AND RETRY
SAVBL0: POP P,W ;GET ACC BACK
POPJ P, ;AND GIVE ERROR RETURN
SAVCLS: HRRZ T,.JBFF ;GET LAST LOCATION
CAME T,SAVLPG ;DO WE AGREE
PJRST ERR67 ;NO COMPLAIN
HRRZ T,SAVPTR ;GET FIRST ADDRESS WE HAD
HRRM T,.JBFF ;UPDATE THE WORLD
CORE T,
JFCL ;DON'T BOTHER
JRST CLS
;SAVOUT
SAVOUT: PUSHJ P,XECOB0 ;WRIT A BLOCK
POPJ P, ;AN ERROR
HRRZ T,SAVFPG ;START OF DATA
HRRM T,SAVLPG ;UPDATE LAST
HRRZ T,SAVPTR ;FIRST LOC
SUB T,SAVFPG ;LAST ONE+1
MOVMM T,SAVCNT ;# OF FREE WORDS
HRRZ T,SAVFPG ;START OF AREA
CORE T, ;GIVE CORE BACK
JFCL
JRST CPOPJ1 ;OKAY
;TRANSFER FROM HIGH (.HGH/.SHR &.LOW) TO PROGRAM (.EXE)
XFRHP: TLNN F,L.DSKI!L.DTI!L.SCRI ;SEE IF CAPABLE OF RANDOM ACCESS
JRST ERR60 ;NO--NEED RANDOM FILE INPUT
TLNN F,L.DSKO ;MUST BE DISK OUTPUT
JRST ERR56 ;ERROR IF NOT
MOVSI CA,-.JBHDA ;LENGTH OF VESTIGIAL JOB DATA AREA
XHP.1: PUSHJ P,RPB ;READ VEST. JDA
JRST CLS ;GIVE UP IF INCOMPLETE
MOVEM W,RW(CA) ;STORE IN TEMP AREA
AOBJN CA,XHP.1 ;LOOP
TLO F,L.FRCL ;FORCE LOOKUP
PUSH P,SRCHP ;SAVE SEARCH POINT
HLRZ T,RW+.JBHCR ;GET LENGTH OF NON-ZERO LOW
CAIGE T,.JBDA ;IF ONLY IN JOBDAT,
JRST XHP.2 ; THEN JUST DO HIGH FILE
;HERE IF NEED TO GET LOW FILE
SETOM SRCHP ;INITIALIZE FOR LOOP
PUSH P,TIEXT ;SAVE TEMP EXT
MOVSI T,'LOW' ;INDICATE .LOW
MOVEM T,TIEXT ; FOR LOOKUP
PUSHJ P,SEL ;SELECT INPUT FILE
JRST ERR61 ;ERROR IF MISSING
PUSH P,RPC ;SAVE READ ROUTINE
MOVEI T,RDWRDC ;SET FOR
MOVEM T,RPC ; COMPRESSED FILE READER
PUSH P,RCA ;SAVE READ ADDRESS
SETZM RCA ;CLEAR FOR LOW FILE
PUSHJ P,XFRCP ;CONVERT TO PROG
; NOTE THAT L.FRCL IS STILL SET
POP P,RCA ;RESTORE READ ADDRESS
POP P,RPC ;RESTORE HIGH FILE READ ROUTINE
POP P,TIEXT ;RESTORE HIGH EXTENSION
JRST XHP.4 ;GO APPEND HIGH FILE
CONT.
;HERE WHEN JUST A HIGH SEG--MAKE DUMMY JOB DATA AREA
XHP.2: SETZM OCA ;CLEAR OUTPUT ADDRESS
MOVEI T,^D512 ;SKIP DIRECTORY
PUSHJ P,PPBPOS ; PAGE--IT IS FILLED IN LATER
SETZM PDSCNT ;CLEAR DIRECTORY COUNTER
MOVE T,[PF$WRT!1] ;SET LOW AS PAGE ONE
MOVEI T1,0 ; AND JUST ONE PAGE
PUSHJ P,XEPD ;SET INTO DIRECTORY
HLRZ T1,.JBHSA+RW ;GET .JBFF
LSH T1,-^D9 ;REMOVE OFFSET
SOJL T1,XHP.20 ;GET REPEAT COUNT -1
ROT T1,-9 ;MOVE # IN PLACE
HRRI T1,1 ;START AT PPN 1
MOVE T,[PF$WRT] ;UNALLOCATED PAGE
PUSHJ P,XEPD ;STORE IN DIRECTORY
XHP.20: MOVSI CA,-LXHPT ;POINT FOR JOBDAT SETUP
XHP.3: HLRZ T,XHPT(CA) ;GET NEXT JOBDATA LOC
ADDI T,^D512 ;ALLOW FOR DIRECTORY
PUSHJ P,PPBPOS ;SKIP AHEAD TO IT
HRRE W,XHPT(CA) ;GET SOURCE
SKIPL W ;IF NOT A SPECIAL THEN
SKIPA W,RW(W) ;THEN JUST LOAD W
XCT XHPT(W) ;ELSE CALL THE SPECIAL CASE
PUSHJ P,PPBP ;SET INTO OUTPUT
AOBJN CA,XHP.3 ;LOOP
MOVEI T,^D512*2 ;SKIP REST OF PAGE
PUSHJ P,PPBPOS ; ..
JRST XHP.4 ;AND FINISH HIGH SEG
HRRZ W,.JBHRN+RW ;-3 GET .JBREN
HLRZ W,.JBHSA+RW ;-2 GET .JBFF
PUSHJ P,GETHRL ;-1 BUILD .JBHRL
XHPT: .JB41,,.JBH41
.JBHRL,,-1 ;USE AN EXECUTE
.JBSA,,.JBHSA
.JBFF,,-2 ;USE AN EXECUTE
.JBREN,,-3 ;USE AN EXECUTE
.JBCOR,,.JBHCR
.JBVER,,.JBHVR
LXHPT==.-XHPT
GETHRL: HLLZ W,.JBHRN+RW ;GET HIGHSET LOC RELATIVE
HLRS W ;COPY IT
IORI W,400777 ;ADD THE ESSENTIAL BITS
POPJ P,
CONT.
;HERE AFTER DONE WITH LOW--DO HIGH SEG
XHP.4: SETOM SRCHP ;INITIALIZE SEARCH AGAIN
PUSHJ P,SEL ;RESELECT IT
JRST ERR58 ;ERROR IF DISAPPEARED
POP P,SRCHP ;RESTORE POINTER FOR WILD-CARDS
TLZ F,L.FRCL ;CLEAR SPECIAL INDICATOR
MOVE T,OCA ;GET START
LSH T,-^D9 ;CONVERT TO PAGE
TXO T,PF$HGH ;INDICATE HIGH SEG
HLRZ T1,TIEXT ;GET HIGH EXT
CAIN T1,'SHR' ;IF .SHR
TXO T,PF$SHR ; INDICATE SHARABLE
LDB T1,[POINT 9,.JBHGA+RW,17]
SKIPN T1 ;IF START IS NOT SET,
MOVEI T1,400 ; USE 400K
PUSH P,T1 ;SAVE
PUSHJ P,XEPD ;SET INTO DIRECTORY
POP P,CA ;GET BACK HI-SEG PAGE
LSH CA,^D9 ;CONVERT TO WORDS
XHP.5: PUSHJ P,@RPC ;READ WORD
JFCL ;(IGNORE EOF)
SOJG CA,XHP.5 ;SKIP OVER LOW SEG DUMMY
MOVEI CA,0 ;SET HIGH LENGTH COUNTER
XHP.6: PUSHJ P,@RPC ;GET NEXT WORD
JRST XHP.7 ;FINISH UP
PUSHJ P,PPBP ;WRITE TO OUTPUT
AOJA CA,XHP.6 ;LOOP
XHP.7: SOS CA ;TRUNCATE ONE LESS
LSH CA,-^D9 ;TRUNCATE TO PAGES REPEATED
MOVE T,PDSCNT ;GET DIRECTORY INDEX
ADDI T,-2(T) ;COMPUTE LAST ENTRY
DPB CA,[POINT 9,PDS+1(T),8]
JRST XEPX ;FINISH AND WRITE DIRECTORY
;TRANSFER .DMP TO .EXE
XFRDP: MOVEI T,JOBSV6+1 ;INDICATE AN EXTRA
ADDM T,LENFIL ; LENGTH
JRST XFREP ;AND GO HANDLE
;TRANSFER S-BLK TO .EXE
;TRANSFER .SAV TO .EXE
;TRANSFER .XPN TO .EXE
XFRSP:!
XFRCP: SETZM LENFIL ;CAN'T PREDICT LENGTH
XFREP: SETZM OCA ;CLEAR OUTPUT ADDRESS
TLNE F,L.DSKO ;SEE IF DISK OUTPUT
JRST XEP.1 ;YES--CAN DO IT THE CLEAN WAY
SKIPE LENFIL ;IF NO ESTIMATE,
TLNN F,L.DSKI ;NO--SEE IF DISK INPUT
JRST ERR56 ;NO--CAN NOT DO IT!
MOVE W,[1776,,3] ;DISK TO NON-DISK, DIRTY ANSWER
PUSHJ P,PPBP ;OUTPUT SINGLE POINTER
MOVE W,[PF$WRT!1] ;INDICATE ALL IS "LOW"
PUSHJ P,PPBP ; STARTING AT NEXT PAGE
MOVE W,LENFIL ;GET LENGTH OF INPUT (XPN) FILE
SUBI W,^D512-^D511 ;ROUND UP AND SUBTRACT 1 PAGE
LSH W,-^D9 ;MAKE INTO PAGE REPEAT COUNT
PUSHJ P,PPBP ; INDICATE STARTS AT PROG PAGE 0
MOVE W,[1777,,1] ;INDICATE END OF DIRECTORY
PUSHJ P,PPBP ; OF PAGES IN PROGRAM
MOVEI T,^D512 ;SKIP REST OF THIS PAGE
PUSHJ P,PPBPOS ; (DATA IS PAGE ALIGNED)
JRST XFRCE ;AND DO A STRAIGHT BINARY COPY
CONT.
;HERE IF OUTPUT IS DISK, CAN DO AN ELEGANT JOB
XEP.1: MOVEI T,^D512 ;SKIP ONE PAGE FOR DIRECTORY
PUSHJ P,PPBPOS ; (WILL FILL IN CONTENTS AT END)
SETZM PDSCNT ;CLEAR DIRECTORY INDEX
SETZM EXEFLG ;CLEAR EXE FLAG
MOVSI CA,-.JBCOR-1 ;SET UP TO READ PART OF JOB DATA AREA
OVER0: PUSHJ P,@RPC ;GET A WORD
JRST CLS ;EXIT IF EOF
MOVEM W,TBUF(CA) ;STORE IN TBUF
AOBJN CA,OVER0 ;LOOP
MOVE T,.JBCOR+TBUF ;SAVE JOBCOR
MOVEM T,SJBCOR ;FOR LATER
MOVE T,.SGDDT+TBUF ;RESTORE JOBDDT
MOVEM T,.JBDDT+TBUF
MOVE T,.SG41+TBUF ;AND JOB41
MOVEM T,.JB41+TBUF
SETZM CA ;CLEAR INPUT ADDRESS
XEP.2: MOVEI CKS,0 ;CLEAR "STRING OF ZEROS" COUNTER
XEP.3: PUSHJ P,EXREAD ;GET NEXT INPUT WORD
JRST XEP.6 ;EOF FINISH IT
AOS CA ;COUNT INPUT POSITION
REPEAT 0,< ;NON-VM REQUIRES NO ZERO-COMPRESSOR
SKIPN W ;IF ZERO CONTENTS,
AOJA CKS,XEP.3 ; LOOP COUNTING
CAIGE CKS,^D512 ;SEE IF AT LEAST A PAGE
JRST XEP.4 ;NO--CAN'T COMPRESS
MOVX T,PF$WRT ;INDICATE LOW SEG
MOVEI T1,-^D512(CKS) ;GET REPEAT COUNT (ROUNDED DOWN)
LSH T1,-^D9 ;ELSE CONVERT TO PAGE REPEAT COUNT
LSH T1,^D27 ;POSITION RESULT
MOVE T2,CA ;GET CURRENT POSITION OF PROGRAM
SUB T2,CKS ;COMPUTE START OF ZEROS
LSH T2,-^D9 ;CONVERT TO PAGES
IOR T1,T2 ;SET INTO DIRECTORY
PUSHJ P,XEPD ;STORE IN DIRECTORY
>;END REPEAT 0
CONT.
;HERE WHEN A NON-ZERO INPUT
XEP.4: PUSHJ P,CHKXPD ;SET INTO DIRECTORY
REPEAT 0,< ;CONTINUATION OF REPEAT 0 ABOVE
PUSH P,W ;SAVE THIS WORD
ANDI CKS,777 ;GET NUMBER OF WORDS 0 IN THIS PAGE
MOVE T,OCA ;GET CURRENT OUTPUT ADDRESS
ADD T,CKS ;ADVANCE BY RESIDUAL ZEROS
PUSHJ P,PPBPOS ;ADVANCE OUTPUT POSITION
POP P,W ;RESTORE WORD
>;END OF REPEAT 0
XEP.5: PUSHJ P,PPBP ;STORE CURRENT WORD
MOVE T,OCA ;GET OUTPUT ADDRESS
TRNN T,777 ;IF END OF PAGE,
JRST XEP.2 ; GO LOOK FOR ZEROS AGAIN
PUSHJ P,EXREAD ;GET ANOTHER WORD
JRST XEP.6 ;CLEAN IT UP
AOS CA ;COUNT INPUT WORD
JRST XEP.5 ;LOOP OVER DATA PAGE
;END OF FILE FOUND FINISH THE LOW SEG
XEP.6: HRRZ T1,SJBCOR ;GET SAVED JOBCOR
ADDI T1,777 ;ROUND UP TO NEXT PAGE
TRZ T1,777
CAMN T1,CA ;IS THERE MORE TO GO?
JRST XEPX ;ALL IS DONE
SUB T1,CA ;GET THE DIFFERENCE
XEP.7: PUSH P,T1 ;SAVE THE COUNTER
PUSHJ P,CHKXPD ;CHECK FOR DIRECTORY UPDATE
SETZ W, ;GET A ZERO WORD
PUSHJ P,PPBP ;AND OUTPUT IT
AOS CA ;UPDATE THE ADDESS
POP P,T1 ;GET COUNT BACK
SOJG T1,XEP.7 ;AND REDO THE WORK
REPEAT 0,< ;NO VM ALLOWS NO ZERO COMPRESSION
JUMPE CKS,XEPX ;IF NO ZEROS, THAT'S ALL
MOVEI T1,-1(CKS) ;ROUND UP AND SUB 1 FOR REPEAT COUNT
LSH T1,-^D9 ;POSITION AS PAGE REPEATER
LSH T1,^D27 ;POSITION FOR RESULT
MOVE T2,CA ;GET CURRENT POSITION OF PROGRAM
SUB T2,CKS ;COMPUTE START OF ZEROS
LSH T2,-^D9 ;CONVERT TO PAGES
IOR T1,T2 ;SET INTO DIRECTORY
PUSHJ P,XEPD ;SET IN PAGE DIRECTORY
>;END REPEAT 0
;HERE WHEN DONE--NEED TO WRITE DIRECTORY PAGE OUT
XEPX: MOVE T,OCA ;GET CURRENT OUTPUT POSITION
ADDI T,777 ;ROUND UP
TRZ T,777 ;TO AN EVEN PAGE
PUSHJ P,PPBPOS ;POSITION OUTPUT
TLNE F,L.FRCL ;IF CONTROLLING OUTPUT,
POPJ P, ;WAIT TILL LATER TO FINISH
OUT OUTF, ;FLUSH CURRENT OUTPUT
SKIPA ;PROCEED IF NO ERROR
JRST ERR19 ;GIVE UP IF ERROR
WAIT OUTF, ;WAIT FOR OUTPUT TO COMPLETE
USETO OUTF,1 ;GO TO BEGINING OF FILE
MOVE W,PDSCNT ;GET COUNT OF DIRECTORY
LSH W,1 ;CONVERT TO WORD COUNT
ADDI W,1 ;ALLOW FOR HEADER WORD
HRLI W,1776 ;INDICATE PAGE DIRECTORY
PUSHJ P,PPBP ;OUTPUT TO FILE
MOVN CA,PDSCNT ;GET NEGATIVE COUNT AGAIN
IMULI CA,2 ;CONVERT TO NEGATIVE WORDS
HRLZS CA ;MAKE INTO AOBJN POINTER
XEPX.1: MOVE W,PDS(CA) ;GET NEXT WORD
PUSHJ P,PPBP ;OUTPUT IT
AOBJN CA,XEPX.1 ;LOOP OVER PAGE DIRECTORY
MOVE W,[1777,,1] ;INDICATE END OF DIRECTORY
PUSHJ P,PPBP ;OUTPUT THAT
JRST CLS ;AND FINISH FILE
;SUBROUTINE TO READ A WORD FROM AN EXE FILE. IF
; CA IS .LT. .JBCOR, THEN THE WORD IS FETCHED FROM TBUF. OTHERWISE,
; IT IS GOTTEN FROM THE EXE FILE.
EXREAD: CAILE CA,.JBCOR ;WITHIN THIS PART OF JOB DATA AREA?
JRST @RPC ;NO, DO NORMAL STUFF
MOVE W,TBUF(CA) ;GET WORD FROM TBUF
JRST CPOPJ1 ;SKIP RETURN
;CHKXPD CHECK IF DIRECTORY NEEDS UPDATING
CHKXPD: MOVE T,OCA ;GET OUTPUT ADDRESS
TRNE T,777 ;IF NOT END OF PAGE THEN
POPJ P, ;JUST RETURN
LSH T,-^D9 ;MAKE IT PAGE COUNT
TXO T,PF$WRT ;INDICATE LOW SEG
MOVE T1,CA ;GET CURRENT ADDRESS
LSH T1,-^D9 ;CONVERT TO PAGES
PJRST XEPD ;UPDATE DIRECTORY
;ROUTINE TO ADD ENTRY TO THE PROGRAM PAGE DIRECTORY
; IT WILL HANDLE REPEATS AND COALESCE POINTERS
;ENTRY IS IN T/T1
;PDSCNT INDEXES THE PDS BLOCK
;USES T2, A, B
XEPD: SKIPN T2,PDSCNT ;GET CURRENT COUNT
JRST XEPD.1 ;NONE--JUST ADD THIS ONE
ADDI T2,-2(T2) ;CONVERT TO WORDS
MOVE A,T ;GET NEW ENTRY'S FLAGS
XOR A,PDS(T2) ;COMPARE WITH LAST ENTRY
TLNE A,(777B8) ;SEE IF FLAGS MATCH
JRST XEPD.1 ;NO--JUST MAKE NEW ENTRY
LDB A,[POINT 9,PDS+1(T2),8] ;YES--GET OLD REPEAT
HRRZ B,PDS(T2) ;GET OLD FILE PAGE
JUMPE B,XEPD.1 ;JUMP IF NOT DATA
ADD B,A ;INCREMENT TO WHERE IT LEFT OFF
CAIE B,-1(T) ;SEE IF WHERE WE ARE STARTING
JRST XEPD.1 ;NO--ADD NEW ENTRY
HRRZ B,PDS+1(T2) ;GET OLD PROGRAM PAGE
ADD B,A ;INCREMENT TO WHERE IT LEFT OFF
CAIE B,-1(T1) ;SEE IF WHERE WE ARE STARTING
JRST XEPD.1 ;NO--ADD NEW ENTRY
LSH T1,-^D27 ;YES--CAN EXPAND IT
ADDI A,1(T1) ;REPEAT NEW REPEAT PLUS ONE PAGE
DPB A,[POINT 9,PDS+1(T2),8] ;STORE EXPANDED REPEAT
POPJ P, ;AND RETURN
XEPD.1: AOS T2,PDSCNT ;ADD NEW ENTRY
CAILE T2,LN$PDS ;MAKE SURE NO OVERFLOW
JRST ERR57 ;BAD IF TOO LONG
ADDI T2,-2(T2) ;CONVERT TO WORD POINTER
MOVEM T,PDS(T2) ;STORE FLAG AND FILE LOC
MOVEM T1,PDS+1(T2) ;STORE
POPJ P, ;RETURN
SUBTTL TRANSFERS FROM NON-36 TO 36-BIT
;FROM 18-BIT (PDP-15) TO 36-BIT
XFRFT: HLRZ T,TIEXT ;INPUT EXTENSION OF 15 FILE
CAIN T,'ABS' ;DUMP OF CORE?
JRST XFRFAB ;YES.
PUSHJ P,RPB ;NO. ASSUME IOPS FORMAT
JRST CLS ;EOF?
LDB T,[POINT 4,W,17] ;IOPS MODE BYTE
CAIN T,2 ;IOPS ASCII?
JRST XFRFTB ;YES. TEXT HANDLING
JUMPE T,XFRFB ;MODE 0 IS IOPS BIN
XFBB.1: PUSH P,W ;SAVE 36 BIT WORD
HLRZS W ;GET 18 BIT WORD
PUSHJ P,PPB ;OUTPUT IT
JRST CLS
POP P,W ;GET BACK INPUT WORDS
HRRZS W ;SECOND WORD (18 BITS)
PUSHJ P,PPB ;SEND IT TOO
JRST CLS
PUSHJ P,RPB ;GET SOME MORE
JRST CLS ;EOF
JRST XFBB.1 ;LOOP
XFRFAB: PUSHJ P,RPB ;FOR CORE DUMP, TRANSFER WHOLE THING.
JRST CLS ;END OF FILE
JRST XFBB.1 ;LOOP
XFRFTB: SETZM FITXW1 ;FIFTEEN INPUT TEXT WORD
MOVE T,[XWD 440700,FITXW1]
MOVEM T,FITXP1
XFAB.1: MOVEM W,FTEMP ;SAVE INPUT DATA FOR CKSM
LDB T,[POINT 8,FTEMP,8] ;GET WORD-PAIR COUNT
MOVEM T,FCOUNT ;SAVE IT FOR LOOP CONTROL
JRST XFAB.3 ;COUNT DOWN THIS HEADER PAIR
XFAB.2: PUSHJ P,RPB ;READ A PAIR
JRST XFICLS ;END OF FILE
MOVEM W,FITXW2
MOVE T,[XWD 440700,FITXW2]
MOVEM T,FITXP2
ILDB CH,FITXP2
PUSH P,CH
CAIN CH,12
SETZM XFILFQ
MOVEI CH,12
AOSN XFILFQ
PUSHJ P,FIPPA0
POP P,CH
PUSHJ P,FIPPA0
CONT.
REPEAT 4,<
ILDB CH,FITXP2
PUSHJ P,FIPPA0
>
XFAB.3: SOSLE FCOUNT ;DONE?
JRST XFAB.2 ;NO
SETOM XFILFQ ;FLAG PROB WANT LINEFEED NEXT
PUSHJ P,RPB ;INPUT PLEASE
JRST XFICLS ;EOF
TLNN W,-1 ;NON-BLANK?
JRST .-3 ;BLANK
SETZM FIFFLG ;END OF LINE FLAG
JRST XFAB.1 ;NON-BLANK HEADER. PROCESS IT
FIPPA0: SKIPE FIFFLG ;HAS A CR BEEN SEEN
POPJ P, ;IN THIS CASE FORGET CHARACTER
CAIN CH,15 ;SEVEN BITS AND NO PARITY
SETOM FIFFLG ;FLAG THE CR CHARACTER
FIPPA: MOVE T,FITXP1
TLNN T,760000
PUSHJ P,FIPPA1
IDPB CH,FITXP1
POPJ P,
FIPPA1: MOVE W,FITXW1
PUSHJ P,PPB
JRST CLS
MOVE T,[XWD 440700,FITXW1]
MOVEM T,FITXP1
SETZM FITXW1
POPJ P,
XFICLS: MOVEI CH,12
SKIPGE XFILFQ
PUSHJ P,FIPPA
PUSHJ P,FIPPA1
JRST CLS
XFRFB: MOVEM W,FTEMP
LDB T,[POINT 8,FTEMP,8]
MOVEM T,FCOUNT
JRST XFIB.2
XFIB.1: PUSHJ P,RPB
JRST CLS
PUSH P,W
HLRZS W
PUSHJ P,PPB
JRST CLS
POP P,W
ANDI W,-1
PUSHJ P,PPB
JRST CLS
XFIB.2: SOSLE FCOUNT
JRST XFIB.1
PUSHJ P,RPB
JRST CLS
TLNN W,-1
JRST .-3
JRST XFRFB
;FROM 16-BIT (PDP-11) TO 36-BIT
XFRVT: MOVE T,OSW
IOR T,ISW ;SEE IF ANY SWITCHES OF INTEREST
TRNE T,SW$I
JRST PIVIMG ;TRANSFER 8 BITS PER 36 BIT WORD
TRNE T,SW$A ;ASCII?
JRST PIVASC ;YES. CONVERT TO PDP10 PACKING ASCII
TRNE T,SW$B ;BINARY?
JRST PIVBIN ;YES. 32 BITS IN 36 BIT WD
HLLZ T,TOEXT ;NO. SEE IF EXT DECLARES BINARY.
MOVSI T1,-VBINXL
CAMN T,VBINXT(T1) ;CHECK AN EXT
JRST PIVBIN ;MATCHES. PROCESS BINARY
AOBJN T1,.-2 ;LOOP THRU ALL LISTED EXTS
JRST PIVASC ;NO. ASSUME IT IS ASCII
VBINXT: SIXBIT /BIN/
SIXBIT /OBJ/
SIXBIT /SYS/
SIXBIT /LDA/
SIXBIT /LDR/
SIXBIT /LOD/
SIXBIT /LBO/
SIXBIT /MFD/
SIXBIT /UFD/
SIXBIT /SYM/
VBINXL==.-VBINXT
PIVASC: SETZM FITXW1 ;ASCII. BORROW PDP FIFTEEN ROUTINE
MOVE T,[XWD 440700,FITXW1]
MOVEM T,FITXP1
XVAA.1: PUSHJ P,RPAVEN ;GET AN EIGHT BIT BYTE
JRST PIVAS1 ;EOF
JUMPE CH,XVAA.1 ;SKIP NULLS
PUSHJ P,FIPPA ;STASH SEVEN OF THEM
JRST XVAA.1
PIVAS1: PUSHJ P,FIPPA1 ;OUTPUT PARTIAL WD
JRST CLS
PIVIMG: PUSHJ P,RPAVEN ;GET 8 BITS
JRST CLS
MOVE W,CH
PUSHJ P,PPB ;WRITE IN 36 BIT WD
JRST CLS
JRST PIVIMG
PIVBIN: PUSHJ P,RPBVEN
JRST CLS
MOVEM W,FITXW1 ;SAVE FIRST 16 BITS
PUSHJ P,RPBVEN ;GET SECOND
JRST PIVBIX ;NO SECOND. FILL WITH 0
HRL W,FITXW1 ;MAKE 32 BIT WORD
PUSHJ P,PPB ;COPY 32 OF 36 BITS STRAIGHT FROM TAPE
JRST CLS
JRST PIVBIN ;LOOP
PIVBIX: HRLZ W,FITXW1 ;GET FIRST 16 BITS IN LH
PUSHJ P,PPB
JRST CLS
JRST CLS ;END OF FILE
SUBTTL TRANSFERS FROM 36-BIT TO NON-36
;HERE WHEN OUTPUT IS 18-BIT (PDP-15)
XFRTF: HLRZ T,TOEXT ;NO. WHAT KIND OF FILE?
MOVE T1,ISW
IOR T1,OSW ;GET SWITCHES
TRNE T1,SW$A ;A SWITCH OVERRIDES EXT DEFAULT
JRST XFRAFA ;YES.
TRNN T1,SW$I ;I SWITCH FORCES BINARY TRANSFER
CAIN T,'ABS'
JRST XFRBFA
CAIN T,'BIN'
JRST XFRBFB
;HERE TO TRANSFER ASCII TO FIFTEEN ASCII
XFRAFA: SETZM FOTXP1 ;ASSUME TEXT. CLEAR FOR RPA
XAFA.1: MOVEI T,<5*176> ;SET MAX NUMBER CHARACTERS
MOVEM T,IOPSOC
MOVE T,[POINT 7,IOPSOB+1]
MOVEM T,IOPSOP
SETZM IOPSOB
MOVE T,[XWD IOPSOB,IOPSOB+1]
BLT T,IOPSOB+177
XAFA.2: PUSHJ P,FORPA
JRST XAFAX
SOSL IOPSOC
IDPB CH,IOPSOP
CAIN CH,15
JRST XAFA.3 ;TEXT END OF LINE
JRST XAFA.2
XAFA.3: HRRZ T,IOPSOP
SUBI T,IOPSOB-1 ;WORDS ACTUALL WRITTEN PLUS HDR
ANDI T,377
LSH T,11
MOVEI T1,2(T)
HRLZM T1,IOPSOB
XAFA.4: LDB T,[POINT 8,IOPSOB,8]
MOVEM T,IOPSOC
SKIPE OHED+2 ;NEW BLK BEING STARTED?
CAMG T,OHED+2 ;WILL IT FIT IN CURRENT OUTPUT BLK?
JRST XAFA.5 ;YES.
MOVEI W,0
PUSHJ P,PPB
JRST CLS
JRST XAFA.4
XAFA.5: MOVEI CKS,0
HLRZ T1,IOPSOB-1(T)
HRRZ T2,IOPSOB-1(T)
ADD CKS,T1
ADD CKS,T2
SOJG T,.-4
MOVNS CKS
HRRM CKS,IOPSOB
MOVEI CKS,0
POFTLL: MOVE W,IOPSOB(CKS)
PUSHJ P,PPB
JRST CLS
ADDI CKS,1
CAMGE CKS,IOPSOC
JRST POFTLL
JRST XAFA.1
FORPA: MOVE T,FOTXP1
TLNN T,760000
JRST FORP.1
ILDB CH,FOTXP1
JUMPE CH,FORPA
JRST CPOPJ1
FORP.1: MOVE T,[XWD 440700,FOTXW1]
MOVEM T,FOTXP1
PUSHJ P,RPB
POPJ P,
MOVEM W,FOTXW1
TRNE W,1 ;LINE-SEQUENCE NUMBER IN ASCII FILE (PDP-10)
AOSLE LSNFLG ;YES, WARNED YET?
JRST FORPA ;NO LINE-SEQUENCE NUMBER OR ALREADY WARNED
JRST ERR49 ;NOT WARNED YET, SO DO SO (CLOBBERS AC W)
XAFAX: MOVE W,[XWD 001005,776773]
PUSHJ P,PPB
JRST CLS
JRST CLS
;HERE TO TRANSFER BINARY TO FIFTEEN ABSOLUTE
XFRBFA: TLZ F,L.6DO
XBFA.1: PUSHJ P,RPB
JRST CLS
TLCE F,L.6DO
JRST XBFA.3
HRLZM W,FOTXW1
MOVE T,OHED+2
CAILE T,1
JRST XBFA.1
TLZ F,L.6DO
XBFA.2: PUSHJ P,PPB
JRST CLS
JRST XBFA.1
XBFA.3: HLL W,FOTXW1
JRST XBFA.2
;HERE TO TRANSFER BINARY TO FIFTEEN BINARY
XFRBFB: MOVEI T,30
MOVEM T,IOPSOC
MOVE T,[POINT 18,IOPSOB+1]
MOVEM T,IOPSOP
SETZM IOPSOB
MOVE T,[XWD IOPSOB,IOPSOB+1]
BLT T,IOPSOB+177
XBFB.1: PUSHJ P,RPB
JRST POFBCL
IDPB W,IOPSOP
SOSLE IOPSOC
JRST XBFB.1
PUSHJ P,POFEBB
JRST XFRBFB
POFBCL: PUSHJ P,POFEBB
MOVE W,[XWD 001005,776773]
PUSHJ P,PPB
JRST CLS
JRST CLS
POFEBB: HRRZ T,IOPSOP
SUBI T,IOPSOB-1
ANDI T,377
LSH T,11
HRLZM T,IOPSOB
MOVEI CKS,0
POFE.1: LDB T,[POINT 8,IOPSOB,8]
MOVEM T,IOPSOC
SKIPE OHED+2
CAMG T,OHED+2
JRST POFE.2
MOVEI W,0
PUSHJ P,PPB
JRST CLS
JRST POFE.1
POFE.2: MOVEI CKS,0
HLRZ T1,IOPSOB-1(T)
HRRZ T2,IOPSOB-1(T)
ADD CKS,T1
ADD CKS,T2
SOJG T,.-4
MOVNS CKS
HRRM CKS,IOPSOB
MOVEI CKS,0
POFE.3: MOVE W,IOPSOB(CKS)
PUSHJ P,PPB
JRST CLS
ADDI CKS,1
CAMGE CKS,IOPSOC
JRST POFE.3
POPJ P,
;HERE WHEN OUTPUT TAPE IS PDP ELEVEN STYLE. INPUT MAY BE TOO?
XFRTV: HLLZ T,TOEXT ;NO. INPUT IS 36 BIT. WHAT KIND OF FILE?
MOVE T1,ISW ;GET SWITCHES FOR INPUT
IOR T1,OSW ;AND OUTPUT
TRNE T1,SW$A ;ASCII SPECIFIED?
JRST XFRAVA ;YES.
TRNE T1,SW$I ;IMAGE (8 BIT) SPECIFIED?
JRST XFRBVI ;YES.
TRNE T1,SW$B ;BINARY?
JRST XFRBVB ;YES.
MOVSI T1,-VBINXL ;SEE IF EXT FORCES BINARY TRANSFER
CAMN T,VBINXT(T1)
JRST XFRBVB ;YES
AOBJN T1,.-2 ;LOOP
;NO. ASSUME ASCII IF NO SWITCH OR SPECIAL EXT
XFRAVA: SETZM FOTXP1 ;CLEAR POINTER FOR FIRST BYTE
XAVA.1: PUSHJ P,FORPA ;READ FROM 36 BIT WORD INTO CH
JRST CLS ;END OF FILE
PUSHJ P,PPBVEN ;OUTPUT TO ELEVEN, FROM CH
JRST CLS ;ERROR ON OUTPUT. CLOSE FILE.
JRST XAVA.1 ;LOOP TILL EOF
XFRVV: PUSHJ P,RPBVEN ;GET 16 BITS
JRST CLS ;EOF
MOVEM W,FITXW1 ;SAVE IT
PUSHJ P,RPBVEN ;GET 16 MORE BITS
JRST XVV.1 ;END OF FILE
HRL W,FITXW1 ;MAKE 32 BITS
PUSHJ P,PROVBR ;OUTPUT 32 BITS
JRST XFRVV ;LOOP
XVV.1: MOVE W,FITXW1 ;GET THE 16 BITS
MOVEM W,FOTXW1 ;STORE IT
PUSHJ P,PROVBZ ;OUTPUT WITH 16 ZEROES AFTER THEM
JRST CLS ;AND CLOSE THE FILE
XFRBVI: PUSHJ P,RPB ;GET 36 BITS
JRST CLS ;END OF FILE
MOVE CH,W ;OUTPUT THEM
ANDI CH,377 ;JUST EIGHT BITS OF THE WORD
PUSHJ P,PPBVEN ;OUTPUT THEM
JRST CLS ;ERROR
JRST XFRBVI ;LOOP UNTIL EOF
XFRBVB: PUSHJ P,RPB ;READ 36 BITS
JRST CLS ;END OF FILE
PUSHJ P,PROVBR ;OUTPUT 32 BITS
JRST XFRBVB ;LOOP
PROVBR: MOVEM W,FOTXW1 ;STORE 32 BITS
LDB CH,[POINT 8,FOTXW1,17]
PUSHJ P,PPBVEN ;OUTPUT FIRST 8
JRST CLS ;ERROR ON OUTPUT. CLOSE FILE.
LDB CH,[POINT 8,FOTXW1,9]
PUSHJ P,PPBVEN ;OUTPUT SECOND 8
JRST CLS ;ERROR ON OUTPUT. CLOSE FILE.
PROVBZ: LDB CH,[POINT 8,FOTXW1,35]
PUSHJ P,PPBVEN ;THIRD EIGHT
JRST CLS ;ERROR ON OUTPUT. CLOSE FILE.
LDB CH,[POINT 8,FOTXW1,27]
PUSHJ P,PPBVEN ;FOURTH EIGHT
JRST CLS ;ERROR ON OUTPUT. CLOSE FILE.
POPJ P, ;RETURN FROM 32 BIT HANDLING SUBR
SUBTTL DIRECTORY LISTER
;ROUTINE TO SELECT DEVICE (DECTAPE) TYPE
;CALL WITH T CONTAINING SWITCHES AND T1 NE 0 IF DECTAPE
;RETURNS T1 WITH TYPE INDEX AND T UNCHANGED
SELDTT: TRNN T,SW$SCR ;UNLESS SCRATCH FILE
JUMPE T1,CPOPJ ; IF NOT DEC-TAPE, RETURN NDT (=0)
MOVEI T1,TYPTEN ;DEFAULT IS -10
TRNE T,SW$M ;IF PROJECT MAC,
MOVEI T1,TYPMAC ; INDICATE THAT
TRNE T,SW$O ;IFOLD -6 FORMAT,
MOVEI T1,TYPSIX ; INDICATE THAT
TRNE T,SW$F ;IF FIFTEEN,
MOVEI T1,TYPFIF ; INDICATE THAT
TRNE T,SW$V ;IF ELEVEN,
MOVEI T1,TYPVEN ; INDICATE THAT
POPJ P, ;RETURN TYPE OF DECTAPE
;ROUTINE TO HANDLE DIRECTORY LISTING
DIR: PUSHJ P,CRLF
PUSHJ P,CRLF ;SPACE TO DIRECTORY ON PAPER
MOVE T,ITYPEX ;GET INPUT TYPE
JRST @DIRRT(T) ;GO TO LISTER
DIRRT: DIRTEN ;NON-DECTAPE (MUST BE NON-SCRATCH -10)
DIRTEN ;TEN
DIRSIX ;SIX
DIRMAC ;MAC
DIRFIF ;FIFTEEN
DIRVEN ;ELEVEN
;PDP-10 FORMAT DTA DIRECTORY LISTER
DIRTEN: SKIPE T,DIRECT+177 ;ANY TAPE ID?
CAMN T,[-1] ;YES--IS IT MEANINGFUL?
JRST DIRTN1 ;NO
MOVEI W,[ASCIZ /Tape Id: /]
PUSHJ P,MSG
PUSHJ P,SIXCR ;OUTPUT IT, WITH CRLF
DIRTN1: MOVEI W,[ASCIZ /free: /]
PUSHJ P,MSG
MOVEI C,0 ;LOOK FOR BLOCKS IN FILE 0
PUSHJ P,BLKC10 ;COUNT, 10 FORMAT, ANS IN T
PUSHJ P,DECPRT ;OUTPUT BLOCKS
MOVEI W,[ASCIZ / blks, /]
PUSHJ P,MSG
MOVEI T,0 ;COUNT FILES FREE. CLEAR ANSWER
MOVEI T1,26 ;LENGTH OF DIRECTORY FILE SPACE
SKIPN DIRECT+122(T1) ;THIS ONE BUSY?
ADDI T,1 ;NO. COUNT FREE FILE
SOJG T1,.-2 ;LOOP FOR ALL FILE SLOTS
PUSHJ P,DECPRT ;NOW OUTPUT ANSWER
MOVEI W,[ASCIZ / files
/]
PUSHJ P,MSG ;FINISH LINE.
MOVEI C,1 ;NOW TYPE ALL FILENAMES ETC
DIRTNL: SKIPN T,DIRECT+122(C) ;THIS FILE EXIST?
JRST DIRTNN ;NO. SKIP IT
PUSHJ P,SIXTAB ;YES. TYPE NAME.
HLLZ T,DIRECT+150(C) ;GET EXTENSION
PUSHJ P,SIXTAB ;OUTPUT DIRECTORY EXTENSION
PUSHJ P,BLKC10 ;COUNT BLOCKS IN THIS FILE
PUSHJ P,DECPR2 ;OUTPUT ANSWER
PUSHJ P,TAB ;TAB TO DATE COLUMN
PUSHJ P,SLTDAT ;GET DATE IN REG T (CLOBBERS T1)
MOVEI A,(T)
PUSHJ P,DATOUT ;OUTPUT DATE
PUSHJ P,CRLF ;AND RETURN
DIRTNN: CAIGE C,26 ;DONE ALL FILES?
AOJA C,DIRTNL ;NO. DO ANOTHER.
PJRST CRLF ;EXTRA LINE AT END
;OLD PDP6 FORMAT TAPE DIRECTORY LISTER
DIRSIX: HLRZ T,DIRECT ;GET LAST BLOCK USED
MOVNS T
ADDI T,LASTOB ;COMPUTE FREE
PUSHJ P,DECPRT ;OUTPUT FREE BLKS
MOVEI W,[ASCIZ /. Free blocks
/]
PUSHJ P,MSG ;OUTPUT HEADER LINE
HRRZ C,DIRECT ;START OF FOUR WORD BLOCKS
DIRSXL: JUMPE C,DIRSXE ;CHECK RANGE ON INDEX
CAIL C,175 ; ..
JRST DIRSXE ; ..
SKIPN T,DIRECT(C) ;GET FILE NAME, IF ANY
JRST DIRSXX ;NONE. END OF DIRECTORY
PUSHJ P,SIXTAB ;OUTPUTNAME
HLLZ T,DIRECT+1(C) ;GET EXTENSION
PUSHJ P,SIXTAB ;OUTPUT EXTENSION
LDB A,[POINT 15,DIRECT+2(C),35] ;GET PDP-6 DATE
PUSHJ P,DATOUT ;OUTPUT DATE
PUSHJ P,CRLF ;END OF LINE
ADDI C,4 ;STEP TO NEXT NAME
CAIGE C,200 ;END OF DIRECTORY?
JRST DIRSXL ;NO. ONWARD.
DIRSXX: PUSHJ P,CRLF ;END OF DIRECTORY
PJRST CRLF ;SPACE UP AND RETURN
DIRSXE: MOVEI W,[ASCIZ /? Bad format in PDP6 directory
/]
PJRST MSG ;OUTPUT AND RETURN
;PROJECT MAC DIRECTORY LISTER
DIRMAC: HRRZ T,DIRECT+177 ;GET TAPE ID IF ANY
JUMPE T,DIRMC1 ;SKIP THIS IF NONE
MOVEI W,[ASCIZ /Tape Id: /]
PUSHJ P,MSG
HRLZ T,DIRECT+177 ;GET THE ID
PUSHJ P,SIXCR ;OUTPUT IT WITH CRLF
DIRMC1: MOVEI W,[ASCIZ /free: /]
PUSHJ P,MSG
MOVEI C,0 ;COUNT BLOCKS IN FILE 0
PUSHJ P,BLKCMC ;IN MAC FILE DIR
PUSHJ P,DECPRT ;PRINT ANSWER
MOVEI W,[ASCIZ / blks, /]
PUSHJ P,MSG ;MORE HEADER
MOVEI T,0 ;CLEAR COUNT OF FREE FILES
MOVEI T1,27*2 ;LENGTH OF DIR NAME AREA
DIRM1L: SKIPN DIRECT-2(T1) ;THIS FILE IN USE?
SKIPE DIRECT-1(T1) ; ..
SKIPA ;YES
ADDI T,1 ;NO. COUNT IT.
SUBI T1,2 ;CHECK NEXT ONE
JUMPG T1,DIRM1L ;LOOP IF MORE
PUSHJ P,DECPRT ;OUTPUT TOTAL
MOVEI W,[ASCIZ / files
/]
PUSHJ P,MSG
MOVEI C,1 ;SET TO LIST FILE NAMES
DIRMCL: LSH C,1 ;CHANGE INDEX TO OFFSET
MOVE T,DIRECT-2(C) ;GET NAME
TLNN T,-1 ;NAME IN USE?
JRST DIRMCN ;NO. SKIP IT.
PUSHJ P,SIXTAB ;OUTPUT IT AND A TAB
MOVE T,DIRECT-1(C) ;AND THE EXTENSION
PUSHJ P,SIXTAB ;OUTPUT IT.
LSH C,-1 ;CONVERT BACK TO FILE NUMBER FOR BLK CT
CONT.
PUSHJ P,BLKCMC ;COUNT BLOCKS IN THIS FILE
PUSH P,C ;SAVE CURRENT FILE NUMBER OVER EXTS
PUSH P,T ;SAVE CURRENT COUNT
DIRMCC: MOVEI T1,27*2 ;PREPARE TO COUNT THROUGH FILENAMES
DIRML2: CAMN C,DIRECT-1(T1) ;IS THIS THE EXTENSION OF PREV FILE?
SKIPE DIRECT-2(T1) ; ..
SKIPA ;NO
JRST DIRMCA ;YES. GO COUNT ITS BLOCKS
SUBI T1,2 ;COUNT TO NEXT FILENAME
JUMPG T1,DIRML2 ;LOOP IF MORE
JRST DIRMCB ;NO MORE CONTINUATIONS
DIRMCA: MOVE C,T1 ;CONTINUE FILE OFFSET
LSH C,-1 ;CONTINUE FILE NUMBER
PUSHJ P,BLKCMC ;HOW MANY BLKS IN CONTINUATION FILE?
ADDM T,(P) ;ADD TO COUNT
JRST DIRMCC ;AND SEE IF IT TURNS AROUND AGAIN
DIRMCB: POP P,T ;RESTORE TOTAL FOR FILE AND CONTS
POP P,C ;AND FILE NUMBER
PUSHJ P,DECPR2 ;OUTPUT NUMBER OF BLOCKS
PUSHJ P,CRLF ;OUTPUT END OF LINE
DIRMN1: CAIGE C,27 ;COMPLETED ALL FILES?
AOJA C,DIRMCL ;NO. BACK FOR NEXT
PUSHJ P,CRLF ;YES. EOL.
PJRST CRLF ; ..
DIRMCN: LSH C,-1
JRST DIRMN1 ;CONTINUE WITH FILE NUMBER
BLKCMC: MOVE B,[POINT 5,DIRECT+56] ;BYTES IN MAC FILE DIR
MOVEI T1,1067 ;HOW FAR TO COUNT
JRST BLKCNT ;GO COUNT THEM
BLKC10: MOVE B,[POINT 5,DIRECT] ;BYTES IN DEC FILE DIR
MOVEI T1,LASTOB ;HOW MANY TO COUNT
BLKCNT: MOVEI T,0 ;INITIALIZE COUNT
BLKCL: ILDB A,B ;GET A BYTE
CAIN A,(C) ;IS THIS BYTE IN THE DESIRED FILE?
ADDI T,1 ;YES. COUNT IT.
SOJG T1,BLKCL ;LOOP TO NEXT BYTE
POPJ P, ;RETURN ANSWER IN T
;PDP15 DIRECTORY LISTER
DIRFIF: MOVEI W,[ASCIZ /Directory listing
/]
PUSHJ P,MSG
MOVE A,[POINT 1,DIRECT]
MOVEI T,0
MOVEI B,1100
ILDB C,A
SKIPN C
ADDI T,1
SOJG B,.-3
PUSHJ P,OCTP4S ;FREE BLOCKS
MOVEI W,[ASCIZ / free blks
/]
PUSHJ P,MSG
SETZB C,T
DIRFL2: MOVE T1,DIRECT+21(C) ;GET A FILE USE BIT
TRNE T1,400000 ;BIT ON?
ADDI T,1 ;YES. COUNT FILE IN USE
ADDI C,2 ;LOOK AT NEXT FILE
CAIGE C,160
JRST DIRFL2
PUSHJ P,OCTP4S ;OUTPUT NUMBER OF FILES
MOVEI W,[ASCIZ / user files
/]
PUSHJ P,MSG
SETZB C,TBBLK
CONT.
DIRFL: SKIPN T,DIRECT+20(C)
JRST DIRFX
PUSHJ P,TRMSIX ;CONVERT TO SIXBIT
PUSHJ P,SIXTAB
HLLZ T,DIRECT+21(C)
PUSHJ P,TRMSIX ;CONVERT TO SIXBIT
PUSHJ P,SIXTAB
LDB T,[POINT 10,DIRECT+21(C),35]
PUSHJ P,OCTP4S ;FIRST BLOCK OF FILE
PUSHJ P,SPACE ;MOVE OVER
MOVE T,C
LSH T,-4 ;FIND BIT MAP
ADDI T,71
CAMN T,TBBLK ;READ IT ALREADY?
JRST DIRFL4 ;YES
MOVEM T,TBBLK ;NO. UPDATE TO THIS BLK
PUSHJ P,READBT ;GET TAPE BLOCK
DIRFL4: MOVE T1,C
ANDI T1,16
LSH T1,3 ;WORDS WITHIN BLK FOR MAP
ADDI T1,TBUF ;IN THE BUFFER
HRLI T1,440100
MOVEI N,1100
MOVEI T,0
DIRFL3: ILDB T2,T1
SKIPE T2
ADDI T,1 ;COUNT BLOCK IN USE
SOJG N,DIRFL3
PUSHJ P,OCTP4S ;OUTPUT TOTAL THIS FILE
PUSHJ P,CRLF
DIRFX: ADDI C,2
CAIGE C,160
JRST DIRFL
PJRST CRLF
;PDP-11 DIRECTORY LISTER
DIRVEN: MOVEI W,[ASCIZ /
directory [/]
PUSHJ P,MSG
LDB T,[POINT 8,VENPPI,27]
PUSHJ P,OCTPRT
PUSHJ P,COMMA
LDB T,[POINT 8,VENPPI,35]
PUSHJ P,OCTPRT
MOVEI W,[ASCIZ /]
/]
PUSHJ P,MSG
SETZM VENFBN ;BORROW CELL AS COUNTER OF FREE FILES
DIRVL2: MOVEI C,0 ;START OF DIRECTORY BLOCK
DIRVL1: MOVEI T,0 ;GET FIRST HALF OF NAME
PUSHJ P,GTVDWD ;GET THE WORD
SKIPN T ;BLANK?
AOS VENFBN ;YES. COUNT AS A FREE FILE
JUMPE T,DIRVNN ;IF BLANKS, SKIP FILE
PUSHJ P,R5VOUT ;PRINT IT
MOVEI T,1 ;SECOND HALF OF NAME
PUSHJ P,GTVDWD ;GET THE WORD
PUSHJ P,R5VOUT ;PRINT IT
PUSHJ P,DOT ;SEPARATOR
MOVEI T,2 ;EXTENSION
PUSHJ P,GTVDWD ;GET THE WORD
PUSHJ P,R5VOUT ;PRINT IT
MOVEI T,0 ;CODE FOR THREE SPACES
PUSHJ P,R5VOUT
MOVEI T,6 ;GET SIZE OF FILE
PUSHJ P,GTVDWD ; ..
PUSHJ P,DECP3S ;PRINT IT RIGHT ADJ IN 3 SPACES
MOVEI T,3
PUSHJ P,GTVDWD ;GET THE DATE
MOVEI CH," " ;ASSUME LINKED FILE
TRZE T,100000 ;IS IT A CONTIGUOUS ONE
MOVEI CH,"C" ;YES
PUSHJ P,TYO ;INDICATE CONTIGUOUS OR LINKED
PUSHJ P,SPACE2 ;GIVE TWO SPACES
PUSHJ P,VENDAT ;PRINT IT
PUSHJ P,SPACE2
MOVEI T,10 ;GET THE PRIV WORD
PUSHJ P,GTVDWD
ANDI T,777
PUSHJ P,PROOUT ;PRINT IN ANGLES
PUSHJ P,CRLF
CONT.
DIRVNN: MOVE T,VWPEI ;SEE IF NEXT FILE EXISTS
ADDI C,(T)
MOVE T1,C
ADDI T1,(T)
CAIGE T1,377 ;OFF END OF BLK?
JRST DIRVL1 ;NO. PRINT SOME MORE
HLRZ T,DIRECT ;YES. SEE IF A LINK
JUMPE T,DIRVNY ;IF NONE, PRINT SUMMARY
MOVEM T,DIRBKN ;SAVE AS DIRECTORY BLOCK NUMBER
PUSHJ P,RBTDIR ;READ THE BLK
JRST ERR2 ;OOPS - ERROR ON DIRECTORY
JRST DIRVL2
DIRVNY: MSG$ <
free blks: >
MOVE T,PBMBKI
PUSHJ P,READBT
JRST ERR2
MOVEI T1,TBUF+2
MOVEI T,0
MOVEI N,1100
MOVSI T2,400000
DIRVL3: JUMPN T2,DIRVY2
MOVSI T2,400000
ADDI T1,1
DIRVY2: TDNN T2,[XWD 600000,600000]
JRST DIRVY1
LSH T2,-1
JRST DIRVL3
DIRVY1: TDNN T2,(T1)
ADDI T,1
LSH T2,-1
SOJG N,DIRVL3
PUSHJ P,DECP4S
MSG$ <
free files: >
MOVE T,VENFBN
PUSHJ P,DECP4S
PJRST CRLF2
;TWO SUBRS TO GET WORD FROM PDP11 DIRECTORY.
;CALL WITH INDECES IN T AND C SUCH THAT ADDING THEM GIVES NUMBER OF
;PDP11 WORDS INTO DESIRED DIRECTORY.
GTVODW: MOVEI T1,1(T)
ADDI T1,(C)
ROT T1,-1
MOVE T,ODIREC(T1)
SKIPL T1
MOVS T,ODIREC(T1)
ANDI T,177777
POPJ P,
GTVDWD: MOVEI T1,1(T)
ADDI T1,(C)
ROT T1,-1
MOVE T,DIRECT(T1)
SKIPL T1
MOVS T,DIRECT(T1)
ANDI T,177777
POPJ P,
SUBTTL ZERO OUTPUT TAPE ROUTINES
ZER: MOVE T,OTYPEX ;GET OUTPUT TYPE
JRST @ZERRT(T) ;GO TO CORRECT ROUTINE
ZERRT: ZERTEN ;NOT DECTAPE (MUST BE NON-SCRATCH -10)
ZERTEN ;TEN
ZERSIX ;SIX
ZERMAC ;MAC
ZERFIF ;FIFTEEN
ZERVEN ;ELEVEN
;ROUTINE TO ZERO TEN DECTAPE
ZERTEN: HRROI T,144 ;READ BLOCK ^O144--IGNORE ERRORS
PUSHJ P,INOUTD ; INTO DIRECTORY AREA
SETZM ODIREC ;CLEAR THE DIRECTORY
MOVE T,[XWD ODIREC,ODIREC+1]
BLT T,ODIREC+176 ;EXCEPT LAST WORD
SKIPE T,OTID ;ANY REQUESTED ID?
MOVEM T,ODIREC+177 ;YES. STORE IT.
MOVSI T,(<36B4!36B9>)
MOVEM T,ODIREC ;ALLOCATE BLKS 1 AND 2
MOVSI T,(36B9)
MOVEM T,ODIREC+16 ;AND 144
HRLOI T,7 ;AND 1102 ON
MOVEM T,ODIREC+122 ; ..
MOVEI T,144 ;PDP10 DIRECTORY BLOCK
OUTZX: TLNE F,L.SCRO ;SCRATCH FILE?
JRST OUTZY ;YES.
USETO OUTF,(T) ;SELECT DIRECTORY BLOCK
OUT OUTF,ODIIOW ;WRITE DIRECTORY OUT
POPJ P,
JRST ERR10 ;YES.
OUTZY: USETO SCOF,1(T) ;SET TO WRITE DIR BLK
OUT SCOF,ODIIOW ;WRITE IT
POPJ P,
JRST ERR29 ;YES.
;ROUTINE TO ZERO SIX DECTAPE
ZERSIX: MOVE T,[XWD 1,5] ;SIX DIRECTORY. CLEAR IT IN CORE
MOVEM T,ODIREC ;INITIAL WORD OF 6 DIRECTORY
SETZM ODIREC+1 ;CLEAR REST OF DIRECTORY AREA
MOVE T,[XWD ODIREC+1,ODIREC+2]
BLT T,ODIREC+177 ; ..
MOVEI T,1 ;PDP6 DIRECTORY BLOCK NUMBER
JRST OUTZX ;CHECK FOR ERRORS
;ROUTINE TO ZERO ELEVEN DECTAPE
ZERVEN: SKIPN OPPN ;OUTPUT PPN SPECIFIED?
JRST ZERV.1 ;NO.
HRRZ T1,OPPN ;CHECK IT FOR RANGE
CAIE T1,0
CAILE T1,377
JRST ERR37 ;NO GOOD
HLRZ T,OPPN
CAIE T,0
CAILE T,377
JRST ERR37
ZERV.1: PUSHJ P,CLRWBF ;HAVE TO CLEAR FILE BIT MAPS
MOVEI T,70
MOVEM T,OBLK ;THEY START HERE
ZERV.2: PUSHJ P,PPBBLK ;CLEAR ONE
AOS T,OBLK
CAIGE T,100 ;UP TO DATA?
JRST ZERV.2 ;NO. CLEAR SOME MORE
MOVE T,[XWD 101,4] ;LINK,INTERLEAVE FACTOR
MOVEM T,WBUF ; TO OUTPUT BUFFER
MOVE T,[XWD 104,104] ;FIRST PBM,LAST PBM
MOVEM T,WBUF+1
PUSHJ P,PPBBLK
AOS OBLK ;BLK 101
SKIPN OPPN ;OUTPUT PPN SPECIFIED?
JRST ZERV.3 ;NO. DEFAULT TO 1,1
HLRZ T,OPPN
LSH T,10 ;OK PUT IN LEFT BYTE
TROA T,(T1) ;AND RIGHT BYTE
ZERV.3: MOVEI T,401 ;XWD MFD LINK,USER IDENT CODE (PPN) 1,1
MOVEM T,WBUF
MOVE T,[XWD 102,11] ;FIRST BLK OF UFD, WDS PER ENTRY IN UFD
MOVEM T,WBUF+1
PUSHJ P,PPBBLK ;WRITE BLK 101
MOVEI T,104 ;NEXT BLK TO WRITE
MOVEM T,OBLK
MOVE T,[XWD DAT104,WBUF]
BLT T,WBUF+4 ;COPY IN THE PBM'S INITIAL STATE
MOVE T,[XWD 177777,177777]
MOVEM T,WBUF+24 ;THIS SEEMS TO BE IN REST OF BLK
MOVE T,[XWD WBUF+24,WBUF+25]
BLT T,WBUF+177 ; ...
PUSHJ P,PPBBLK ;WRITE PBM
PUSHJ P,CLRWBF ;ZEROS IN WBUF
SOS OBLK ;BLK 103
PUSHJ P,PPBBLK ;CLEAR BLK 103 (2ND BLK OF UFD)
MOVSI T,103 ;UFD LINK FOR BLK 102 TO 103
MOVEM T,ODIREC ;INTO OUTPUT DIRECTORY IMAGE
SETZM ODIREC+1 ;CLEAR THE REST OF IT
MOVE T,[XWD ODIREC+1,ODIREC+2]
BLT T,ODIREC+177
MOVEI T,102 ;WHERE OUTPUT DIRECTORY GOES
JRST OUTZX ;GO WRITE IT.
DAT104: XWD 0,1 ;LINK,NUMBER OF PBM
XWD 44,104 ;WDS/MAP,1ST MAP BLK
XWD 1,0 ;BLKS 17-0,37-20
XWD 0,177400 ;BLKS 57-40,77-60
XWD 37,0 ;BLKS 117-100,137-120
;ROUTINE TO ZERO PROJECT MAC DECTAPE
ZERMAC: HRROI T,100 ;READ BLOCK ^O100--IGNORE ERRORS
PUSHJ P,INOUTD ; INTO DIRECTORY AREA
SETZM ODIREC ;FIRST CLEAR EVERYTHING
MOVE T,[XWD ODIREC,ODIREC+1]
BLT T,ODIREC+176 ;CLEAR ALL BUT TAPE ID
HRROS ODIREC+177 ;ALLOCATE BLK 1070 ON
SKIPE T,OTID ;REQUESTED TAPE ID?
HLROM T,ODIREC+177 ;YES. STORE IT.
MOVSI T,(<36B4!36B9>) ;ALLOCATE BLOCKS 1 AND 2 AS BOOTSTRAP
MOVEM T,ODIREC+56 ; ..
MOVSI T,(<33B4>) ;ALLOCATE BLOCK 100 AS DIRECTORY
MOVEM T,ODIREC+67 ; ..
MOVEI T,100 ;BLOCK TO WRITE IT BACK OUT ON
JRST OUTZX
;ROUTINE TO ZERO FIFTEEN DECTAPE
ZERFIF: PUSHJ P,CLRWBF ;CLEAR WBUF FOR BIT MAP BLOCKS
MOVEI T,71 ;FIRST MAP BLK
MOVEM T,OBLK ; WHERE PPBBLK WANTS IT
ZERF.1: PUSHJ P,PPBBLK ;CLEAR A BIT MAP BLOCK
AOS T,OBLK ;NEXT BLOCK
CAIGE T,100 ;TO DIRECTORY?
JRST ZERF.1 ;NO. CLEAR ANOTHER
SETZM ODIREC ;NOW THE DIRECTORY ITSELF
MOVE T,[XWD ODIREC,ODIREC+1] ; ..
BLT T,ODIREC+177 ;CLEAR IT.
MOVEI T,077600 ;ALLOCATE THE DIRECTORY BLKS, 71-100
MOVEM T,ODIREC+1 ; ..
MOVEI T,100 ;BLOCK NUMBER TO WRITE IT IN
JRST OUTZX ;GO WRITE IT OUT
SUBTTL SELECT (LOOKUP) FILE
SELFST: SETZM ODATE ;CLEAR OUTPUT DATE
SETZM VIPRT ;CLEAR OUTPUT PROTECTION
MOVE T,ITYPEX ;GET INPUT TYPE
TRNE F,R.SAVX ;CONVERTING A SAVE FILE
CAIL T,NO10XF ;AND NO A PDP-10 FILE
JRST @SELRT(T) ;THEN GO TO SELECTION ROUTINE
MOVE T1,EXTPTR ;GET OUR EXTENSION POINTER
JRST SEL2 ;AND TRY TO CONVRT
SEL0: MOVE T1,EXTPTR ;GET POINTER
AOBJN T1,SEL1 ;AND UPDATE IT
JRST SELFF ;THEN OBVIOUSLY A FAILLURE
SEL1: MOVEM T1,EXTPTR ;AND STORE THE POINTER
SEL2: MOVE T1,EXTLST(T1) ;GET THE EXTENSION
MOVEM T1,IEXT ;AND TRY THIS ONE
MOVE T,ITYPEX ;GET INPUT TYPE
PUSHJ P,@SELRT(T) ;TRY TO FIND THE FILE
JRST SEL3 ;RESELECT
HRRZ T,EXTPTR ;GET INPUT EXTENSION
MOVSI T1,(SIXBIT /SHR/) ;ONE OF THE MANY
CAIE T,EXEIDX ;IF EXE THEN READY
MOVSI T1,(SIXBIT /EXE/) ;ELSE USE EXE
MOVEM T1,TOEXT ;AS AN OUTPUT EXTENSION
SKIPE CNVWEO ;IF NO WILD OUT EXT
SKIPN CNVSME ;OR ON THE SAME DEVICE THEN
JRST CPOPJ1 ;PROCES THE FILE
HRRZ T1,EXTPTR ;GET THE POINTER
CAIL T1,DEFIDX ;IF DEFAULT INPUT OR
TLNN F,L.WFO ;WILD OUTPUT
JRST CPOPJ1 ;THEN PROCES
MOVEI A,.IOBIN ;THE MODE USED
SKIPN B,ODEV ;GET OUTPUT DEVICE
MOVSI B,(SIXBIT /DSK/) ;ELSE DISK
MOVSI C,OHED ;USE THIS HAEDER
OPEN OUTF,A ;TRY TO OPEN IT
JRST ERR14 ;BAD DEVICE
MOVE A,TIFILE ;GET FILE NAME
MOVE T1,[-3,,SAVIDX] ;LIST OF HIGHER UPS IN LIST
SEL20: SETZB C,D ;LAST 2 ARUGMENT
MOVE B,EXTLST(T1) ;AND EXTENSION
LOOKUP OUTF,A ;SSE IF IT IS THERE
AOBJN T1,SEL20 ;NO TRY NEXT ONE
RELEASE OUTF, ;RELAESE IT
JUMPG T1,CPOPJ1 ;OKAY TO MAKE IT
TLNE F,L.WFO!L.BFO ;WILD OUTPUT
JRST SEL2 ;THEN CONTINUE SCAN
JRST SEL0 ;ELSE NEXT EXTENSION
SEL3: SETOM SRCHP ;THEN RESET DIRECTOTY SCANNER
JRST SEL0 ;NEXT ONES
;TABLES USED TO CONVERT COMMANDS OF THE TYPE:
; ODEV:OFILE.OEXT=IDEV.IFILE/C
;WITH 10 DEVICES AND OEXT A SAVE EXTENSION OF SOME KIND
EXTLST: SIXBIT /LOW/ ;THIS IS CLASS OLD SAVE
SAVIDX=.-EXTLST ;START OF SHR HGH & EXE EXTENSIONS
SIXBIT /SHR/ ;1...SHR NEXT
SIXBIT /HGH/ ;2...HGH
SIXBIT /SAV/ ;3...SAV
DEFIDX=.-EXTLST ;END OF DEFAULT EXTENSIONS
EXEIDX=.-EXTLST ;INDEX OF EXE EXTENSION
SIXBIT /EXE/ ;4 ...EXE
EXTLEN=.-EXTLST
SELRT: SELNDT ;NON-DECTAPE
SELTEN ;TEN
NO10XF=.-SELRT
SELSIX ;SIX
SELMAC ;MAC
SELFIF ;FIFTEEN
SELVEN ;ELEVEN
SEL: SETZM ODATE ;CLEAR OUTPUT DATE
SETZM VIPRT ;CLEAR OUT PRODUCTION
MOVE T,ITYPEX ;GET INPUT TYPE
JRST @SELRT(T) ;SELECT THE FILE
;ROUTINE TO SELECT FROM PROJECT MAC DECTAPE
SELMAC: SKIPGE C,SRCHP ;MAC. GET DIRECTORY INDEX
MOVEI C,0 ;NONE YET
JRST SELM.2 ;ON TO NEXT ONE
SELM.1: MOVE A,DIRECT-2(C) ;GET A FILENAME
MOVE B,DIRECT-1(C) ;AND EXTENSION
TLNN A,-1 ;FILE IN USE?
JRST SELM.2 ;NO. ON TO NEXT ONE
CAME A,IFILE ;THIS THE ONE DESIRED?
TLNE F,L.WFI ;OR IS IT WILD?
SKIPA ;YES. WANT THIS.
JRST SELM.2 ;NO. ON TO NEXT ONE.
CAME B,IEXT ;IF THE EXTENSION IS RIGHT, THAT IS.
TLNE F,L.WEI ;OR IT'S WILD
JRST SELM.3 ;GOOD MATCH.
SELM.2: ADDI C,2 ;ON TO NEXT FILE
CAIGE C,60 ;LOOKED AT THEM ALL?
JRST SELM.1 ;NO. TRY NEXT ONE.
JRST SELFF ;YES. FAILURE ON THIS LOOKUP
SELM.3: MOVEM C,SRCHP ;SAVE SEARCH POINTER IN CASE OF STAR
MOVEM C,SRCHPM ;AND FOR EXTENSIONS
JRST SELFW ;GIVE SUCCESS RETURN.
;ROUTINE TO SELECT FROM SIX DECTAPE
SELSIX: SKIPL C,SRCHP ;GET OFFSET INTO SIX DIRECTORY
JRST SELS.1 ; OK. USE IT.
HRRZ C,DIRECT+0 ;NONE YET. GET STARTER FROM DIRECTORY
JRST SELS.2 ;DONT INCREMENT IT
SELS.1: ADDI C,4 ;NEXT FILE PLEASE
SELS.2: CAILE C,174 ;STILL ON THE TAPE?
JRST SELFF ;NO. FAILURE.
MOVE A,DIRECT(C) ;YES. GET FILENAME
JUMPE A,SELFF ;JUMP IF END OF DIRECTORY
HLLZ B,DIRECT+1(C) ;AND EXTENSION FROM THE DIRECTORY
HLLZ D,IEXT ;JUST HALF INPUT EXT WORD
CAME A,IFILE ;NAME MATCH?
TLNE F,L.WFI ;OR WILD?
SKIPA ;YES. CHECK EXT
JRST SELS.3 ;NO. ON TO NEXT.
CAME B,D ;EXTENSION MATCH?
TLNE F,L.WEI ;OR WILD?
JRST SELS.4 ;YES. USE THIS FILE
SELS.3: JRST SELS.1 ;NO. ON TO NEXT FILE IN DIR
SELS.4: MOVEM C,SRCHP ;SAVE THIS POSITION IN DIR
LDB T,[POINT 15,DIRECT+2(C),35] ;GET DATE FROM DIR
MOVEM T,ODATE ;SAVE FOR OUTPUT DATE
TRZ F,R.6DI ;ASSUME NOT A DUMP FILE
SKIPGE T,DIRECT+3(C) ;IS IT A DUMP FILE?
TRO F,R.6DI ;YES. SET FLAG
HLRES T ;SAVE LENGTH FROM WORD 3
MOVNM T,IHED+0 ; ..
JRST SELFW ; AND GO TO SELECT FILE WIN
SELTEN: SKIPGE C,SRCHP ;POINTER INTO TEN DIRECTORY
MOVEI C,0 ;FIRST TIME IN
JRST SELT.2 ;ON TO NEXT FILE
SELT.1: MOVE A,DIRECT+122(C) ;GET FILE NAME FROM DTA
JUMPE A,SELT.2 ;SKIP EMPTY SLOTS
HLLZ B,DIRECT+150(C) ;AND EXTENSION FROM DTA DIR
TLNE F,L.FRCL ;SEE IF FORCING
JRST [CAMN A,TIFILE ;YES--SEE IF FILE MATCHES
CAME B,TIEXT ; AND IF EXTENSION MATCHES
JRST SELT.2 ;NO--LOOP ONWARDS
JRST SELT.3] ;YES--ACCEPT THIS FILE
HLLZ D,IEXT ;HALFWORD REQUESTED EXT
CAME A,IFILE ;DOES NAME MATCH?
TLNE F,L.WFI ;OR IS IT WILD?
SKIPA ;YES. CHECK EXT
JRST SELT.2 ;NO MATCH.
CAME B,D ;EXTENSIONS MATCH?
TLNE F,L.WEI ;OR WILD CARD?
JRST SELT.3 ;MATCH.
SELT.2: CAIGE C,26 ;CHECKED THE WHOLE DIR?
AOJA C,SELT.1 ;NO. TRY ANOTHER
JRST SELFF ;YES. NOT THERE. GO TO FAIL
SELT.3: MOVEM C,SRCHP ;SAVE CURRENT INDEX
PUSHJ P,SLTDAT ;GET DATE IN REG T (CLOBBERS T1)
MOVEM T,ODATE ;SAVE IT
JRST SELFW ;AND GO TO WIN
;ROUTINE TO GET 15 BIT FILE DATE FROM DECTAPE DIRECTORY
;AT LOCATION DIRECT.
;CLOBBERS REGS T AND T1
;CALLING SEQUENCE
; MOVEI C,FILE SLOT NUMBER (DECIMAL 1 THROUGH 22)
; PUSHJ P,SLTDAT
SLTDAT: LDB T,[POINT 12,DIRECT+150(C),35] ;GET LOW ORDER PART
MOVEI T1,1 ;SET UP TO GET HIGH-ORDER PART
TDNE T1,DIRECT-1(C) ;IS BIT SET?
TRO T,1B23 ;YES, OR BIT INTO DATE
TDNE T1,DIRECT+^D21(C)
TRO T,1B22
TDNE T1,DIRECT+^D43(C)
TRO T,1B21
POPJ P, ;RETURN
SELFIF: SKIPGE C,SRCHP ;FILE INDEX
MOVEI C,16 ;FIRST TIME THRU
JRST SELF.2 ;GO LOOP
SELF.1: MOVE T,DIRECT(C) ;GET FILE ENTRY
JUMPE T,SELF.2 ;IF EMPTY, SKIP IT
PUSHJ P,TRMSIX ;GET CORRECTED SIXBIT
MOVE A,T ;TO RIGHT AC
HLLZ T,DIRECT+1(C)
PUSHJ P,TRMSIX ;TO SIXBIT
HLLZ B,T ;TO COMPARISON AC
HLLZ D,IEXT ;REQUESTED EXTENSION
CAME A,IFILE ;MATCH?
TLNE F,L.WFI ;OR WILD?
SKIPA ;YES. MATCH
JRST SELF.2
CAME B,D ;EXT MATCH TOO?
TLNE F,L.WEI ;OR WILD?
JRST SELF.3 ;YES.
SELF.2: CAIL C,176
JRST SELFF ;FAIL
ADDI C,2
JRST SELF.1 ;TRY ANOTHER
SELF.3: MOVEM C,SRCHP ;FOUND ONE. SAVE INDEX
SETZM ODATE ;NO DATE IN FIFTEEN DTA DIRECTORY
JRST SELFW ;TO WIN EXIT
SELVEN: SKIPGE C,SRCHP ;STARTED?
MOVEI C,0 ;NO
JRST SELV.2 ;NEXT FILE PLEASE
SELV.1: PUSHJ P,SELVR ;READ FILE NAME AND EXT FOR THIS INDEX
MOVE A,VIFFIL ;GET FILE NAME
JUMPE A,SELV.2 ;NONE, SKIP IT
HLLZ B,VIFEXT ;GET EXTENSION
HLLZ D,IEXT ;AND REQUESTED ONE
CAME A,IFILE ;MATCH ON FILE NAME?
TLNE F,L.WFI ;OR WILD?
SKIPA ;OK. CHECK EXT
JRST SELV.2 ;NO GOOD. MOVE ON
CAME B,D
TLNE F,L.WEI ;EXTENSION MATCH OR WILD?
JRST SELV.3 ;YES. FULL MATCH
SELV.2: CAIGE C,^D56 ;END TEST (SHOULD COMPUTE IT)
AOJA C,SELV.1 ;MOVE ON
JRST SELFF ;FAIL RETURN FROM SELFIL
SELV.3: MOVEM C,SRCHP ;STORE INDEX OF DESIRED FILE
SETZM RPAVC1 ;START IN PHASE FOR RPAVEN ROUTINE
MOVE T,IDATE ;GET INPUT DATE
MOVEM T,ODATE ;COPY FOR OUTPUT
JRST SELFW ;SELECT FILE WIN
;ROUTINE TO READ AND CONVERT NEXT FILE NAME AND EXT
SELVR: PUSH P,C ;SAVE INDEX
MOVE T,VWPEI ;CONVERT TO INDEX OFFSET IN ELEVEN WORDS
IMULI T,(C) ;SEE IF OFF END OF BLK 1
CAIL T,377 ; ..
JRST SVR1 ;YES. TRY BLK 2
SUB T,VWPEI ;IN BLK 1. RESET TO INDEX
PUSH P,T ;SAVE OFFSET INTO DIR BLK
MOVE T,VDIRB1 ;ARE WE IN BLK 1 AT THE MOMENT?
SVR3: CAMN T,DIRBKN ;IS THIS BLK IN DIRECT BUFFER
JRST SVR2 ;YES.
MOVEM T,DIRBKN ;NO. MUST READ
PUSHJ P,RBTDIR ;READ THE BLK TO TBUF AND DIRECT
JRST ERR2 ;ERROR ON DIRECTORY READ
CONT.
SVR2: MOVEI C,0 ;PREVENT OFFSET IN GTVDWD ROUTINE
MOVE T,(P) ;GET INDEX IN ELEVEN WORDS
PUSHJ P,GTVDWD ;GET THE WORD
PUSHJ P,R5VSIX ;MAKE SIXBIT
HRLM T,VIFFIL ;HALF THE NAME
AOS T,(P) ;SECOND ELEVEN WORD
PUSHJ P,GTVDWD ; GET IT
PUSHJ P,R5VSIX ;CONVERT TO SIXBIT
HRRM T,VIFFIL ;SAVE IT
AOS T,(P) ;AND THE EXTENSION
PUSHJ P,GTVDWD ;GET WORD
PUSHJ P,R5VSIX ;CONVERT TO SIXBIT
HRLZM T,VIFEXT ;STORE IN EXT WORD
AOS T,(P) ;AND DATE
PUSHJ P,GTVDWD ; ..
SETZM VCONTG ;ASSUME FILE IS NOT CONTIGUOUS
TRZE T,100000 ;BEFORE MAKING THE TEST
SETOM VCONTG ;FLAG THAT FILE IS CONTIGUOUS
PUSHJ P,DATVT ;CONVERT TO TEN FORMAT DATE
MOVEM T,IDATE ;SAVE IT FOR LATER
POP P,T ;REMOVE INDEX FROM STACK
ADDI T,2 ;GET FIRST BLOCK NUMBER
PUSH P,T ;SAVE INDEX IN UFD
PUSHJ P,GTVDWD ;FROM DIR
MOVEM T,VENFBN ;SAVE IN CASE WANT TO READ THIS
AOS T,(P) ;SKIP LENGTH
AOS T,(P) ;SKIP TO LAST BLOCK #
SKIPN VCONTG ;NOW CHECK THE CONTIGUITY FLAG
JRST NOTCON ;NO A LINKED FILE
PUSHJ P,GTVDWD ;GET THE LAST BLOCK #
MOVEM T,VCONTG ;AND REPLACE TEMP FLAG
NOTCON: POP P,T ;GET # BACK
ADDI T,1 ;AND SKIP TO PROTECTION
PUSHJ P,GTVDWD ;AND GET IT
ANDI T,377 ;MASK OUT SPARE BITS
MOVEM T,VIPRT ;AND SAVE IT
POP P,C ;GET THE FILE NUMBER
POPJ P, ;AND RETURN
SVR1: MOVEI T,377
IDIV T,VWPEI ;SEE HOW MANY FILES PER DIR BLK
MOVNS T
ADD T,(P) ;INDEX IN FILES INTO SECOND DIR BLK
IMUL T,VWPEI ;TOO BIG FOR BLK 2?
CAIL T,377 ; ..
JRST ERR38 ;YES
SUB T,VWPEI ;NO. RESTORE WORD OFFSET INTO T
PUSH P,T ;STACK IT
MOVE T,VDIRB2 ;SECOND BLOCK OF UFD DATA
JRST SVR3 ;GO READ IT.
;ROUTINE TO SELECT FILE FROM NON-DECTAPE
SELNDT: TLNE F,L.FRCL ;SEE IF FORCING
JRST [MOVE A,TIFILE ;YES--GET FILE NAME
MOVE B,TIEXT ; AND EXTENSION
JRST SELFW] ;DECLARE A WIN
TLNE F,L.DSKI ;NON TAPE. DISK?
TLNN F,L.WFI!L.WEI ;YES. NEED TO SEARCH DISK DIRECTORY?
JRST SELFNW ;NO. LOOKUP WHAT WE GOT.
AOSE SRCHP ;STARTING DISK DIRECTORY SEARCH THIS PASS?
JRST SELFD1 ;NO. MOVE ON.
MOVEI B,0 ;MAY NEED TO FIDDLE UP SYS PPN
MOVE A,IDEV ;GET INPUT DEVICE
SETZB B,C ;CLEAR ANSWER AREA
MOVE T,[3,,A] ;POINT TO AREA
PATH. T, ;INQUIRE IF ERSATZ
JFCL ; !!
TXNE B,PT.IPP ;IF IGNORE PPN,
MOVEM C,IPPN ; OVERRIDE WHAT USER TYPED
MOVEI A,.IOBIN ;HAVE TO READ DISK DIRECTORY
SKIPN B,IDEV ;LET'S MAKE SURE THERE'S SOMETHING THERE
MOVSI B,'DSK' ;DEFAULT TO DSK IF NOTHING INPUT
MOVEI C,UHED ; ..
OPEN UFDF,A ; ..
JRST ERR12 ; NO DISK??
SKIPN A,IPPN ;IS THE PROJPROG SPECIFIED?
JRST [MOVE A,[LN$PPN,,IPPN+1] ;NO--GET DEFAULT
MOVEM B,IPPN+1 ; FOR THIS DEVICE
PATH. A, ; FROM MONITOR
JRST [MOVE A,B ;NO PATH.--USE
DEVPPN A, ; OLD CHEAP UUO
MOVE A,MYPPN ; OR STANDARD CODE
JRST .+1] ;AND FINISH
TLZ A,-1 ;CLEAR JUNK FROM POINTER
JRST .+1] ;AND FINISH
MOVSI B,'UFD' ;AND UFD EXTENSION
SETZB C,T
MOVE D,MFDPPN ;IN THE MASTER FILE DIR
TLNE A,-1 ;PATH?
JRST SELN.1 ;NO--OK TO PROCEED
SKIPN .PTPPN+1(A) ;YES--SEE IF REALLY NEEDED
JRST [MOVE A,.PTPPN(A) ;NO--GET UFD
JRST SELN.1] ; AND PROCEED ANY WAY
MOVE D,A ;YES--SET DIRECTORY TO PATH
SKIPE .PTPPN(A) ;LOOK AT PATH FOR END
AOJA A,.-1 ;LOOP UNTIL END
MOVE T,A ;SAVE POINTER TO END
MOVE A,.PTPPN-1(A) ;GET BOTTOM DIRECTORY AS FILE
SETZM .PTPPN-1(T) ;CLEAR FROM PATH LIST
SKIPN .PTPPN+1(D) ;IF ONLY UFD LEFT,
MOVE D,.PTPPN(D) ; USE THAT
MOVSI B,'SFD' ;USE .SFD
CONT.
SELN.1: LOOKUP UFDF,A ;TRY TO READ THE DISK DIRECTORY
JRST ERR12 ;CANT READ IT.
SKIPE T ;IF CLEARED IN PATH,
MOVEM A,.PTPPN-1(T) ; RESTORE WHAT WE ZAPPED
INBUF UFDF,1 ;ALLOCATE A BUFFER
MOVE T,.JBFF ;AND UPDATE FREE CORE FOR FILE
MOVEM T,SJFF2 ; ..
SELFD1: PUSHJ P,URPB ;READ A WORD FROM DISK DIRECTORY
JRST SELFF ;END OF FILE. NOT THERE.
MOVE A,W ;GET THE NAME
PUSHJ P,URPB ;READ THE EXTENSION
JRST SELFF ;SHOULDNT QUIT HERE
JUMPE A,SELFD1 ;COULD BE OVER A BLOCK. SKIP 0'S
HLLZ B,W ;GET THE EXTENSION
HLLZ D,IEXT ;GET REQUESTED EXT
CAME A,IFILE ;FILE NAME MATCH?
TLNE F,L.WFI ;OR WILD CARD?
SKIPA ;OK SO FAR
JRST SELFD1 ;NO GOOD. MOVE ON
CAME B,[SIXBIT /TMP/] ;DSK FILE A .TMP?
JRST SELFD2 ;NO.
TLNE F,L.WEI ;YES. ARE WE DOING .* FILES?
JRST SELFD1 ;YES. .TMP'S ARE NOT INCLUDED
;UNLESS STATED EXPLICITLY.
SELFD2: CAME B,D ;EXTENSION MATCH?
TLNE F,L.WEI ;OR WILD CARD?
JRST SELFW ;MATCH ON EXT TOO
JRST SELFD1 ;NO MATCH. LOOP
;SUBSIDIARY ROUTINE TO READ THE DISK DIRECTORY
URPB: SOSLE UHED+2 ;ANY IN THIS BUFFER?
JRST URPB.1 ;YES.
IN UFDF, ;NO. GET ANOTHER BUFFER
JRST URPB.1 ;JUMP IF OK
STATZ UFDF,IO.ERR ;ERRORS?
JRST ERR13 ;YES.
POPJ P, ;YES. QUIT.
URPB.1: ILDB W,UHED+1 ;OK. GET A WORD
JRST CPOPJ1 ;AND RETURN IT
;FINISH UP WITH A WINNER
SELFNW: MOVE A,IFILE ;HERE WHEN NEITHER WILD NOR DTA
HLLZ B,IEXT ;GET FILE AND EXT
SELFW: MOVEM A,TIFILE ;STORE IN TEMPS
MOVEM B,TIEXT ; ..
MOVE T,SJFF2 ;SET UP BUFFER AREA FOR FILE
MOVEM T,.JBFF ; ..
MOVEM T,SJFF3 ;FOR BUFFERED OUTPUTS, AND
MOVEM T,SJFF4 ; FOR RPBSCR RTN IN CASE NO BUF OUT
TLNN F,L.WFO!L.BFO ;SPECIFIED OUTPUT FILE?
MOVE A,OFILE ;YES. GET IT.
SKIPN A ;IF NO FILE AT ALL,
MOVE A,IDEV ;GET INPUT DEVICE NAME FOR FILENAME
MOVEM A,TOFILE ;STORE RESULT AWAY FOR ENTER
TLNN F,L.WEO!L.BEO ;SPECIFIED OUTPUT EXT?
MOVE B,OEXT ;YES. GET IT.
MOVEM B,TOEXT ;STORE IT AWAY FOR ENTER
SETOM IBLK ;CLEAR FLAGS FOR READ AND COPY ROUTINES
SETZM IHED+2 ;SINCE THIS IS A NEW FILE
TRZ F,R.ABC ;FIND OUT ABOUT BAD CKSM
TLNE F,L.SCRI ;ON SCRATCH FILE?
JRST SELW.4 ;NO LOOKUP NEEDED
MOVE T,ITYPEX ;NOT SCRATCH. WHAT TYPE IS IT?
CAIE T,TYPMAC ;MAC AND SIX DONT NEED LOOKUP
CAIN T,TYPSIX ; ..
JRST SELW.4 ; ..
CAIE T,TYPVEN ;ELEVEN TAPE?
CAIN T,TYPFIF
JRST SELW.4 ;ELEVEN OR PDP15 TAPE
CONT.
SELW.1: MOVE D,IPPN ;NEED A LOOKUP. GET DIRECTORY
MOVEI T,.IOBIN ;READ IN BINARY
MOVE T1,IDEV ;DEVICE NAME
MOVEI T2,IHED ;BUFFER HEADER
OPEN INF,T ;GET THE DEVICE
JRST ERR26 ;CAN'T
MOVE A,TIFILE ;SET BACK UP FOR LOOKUP
MOVE B,TIEXT ; ..
TLNN F,L.DSKI ;READING FROM DISK?
JRST SELW.2 ;NO.
MOVEI T,.RBSTS ;YES. DO EXTENDED LOOKUP
MOVEM T,XBUF ;USE TRANSFER BUFFER, ITS FREE
MOVEM A,XBUF+2 ;NAME
HLLZM B,XBUF+3 ;EXTENSION
MOVEM D,XBUF+1 ;AND DIRECTORY
LOOKUP INF,XBUF ;DO THE LOOKUP
JRST [ TRNN F,R.SAVX ;/C CONVERSION
JRST ERR28 ;NO GIVE ERROR MESSAGE
POPJ P, ] ;YES GIVE LOOSE RETURN
LDB T,[POINT 12,XBUF+4,35] ;GET THE FILE CREATION DATE(LOW PART)
MOVEM T,ODATE ;SAVE FOR THE ENTER
LDB T,[POINT 3,XBUF+.RBEXT,20] ;GET HIGH PART OF DATE
DPB T,[POINT 3,ODATE,23] ;AND STORE
MOVE T,XBUF+.RBSIZ ;GET SIZE OF FILE
MOVEM T,LENFIL ;STORE FOR LATER
MOVE T,XBUF+.RBSTS ;GET THE STATUS WORD
TRNE T,RP.ABC ;BAD CKSUM BIT?
TRO F,R.ABC ;YES. REMEMBER IT
JRST SELW.3 ;LOOKUP DONE
SELW.2: LOOKUP INF,A ;LEVEL C LOOKUP
JRST [ TRNN F,R.SAVX ;SAVE CONVERSION WITH /C
JRST ERR29 ;AN ERROR
POPJ P, ] ;(YES) SIGNAL CALLER
LDB T,[POINT 12,C,35] ;GET TWELVE BIT CREATION DATE
MOVEM T,ODATE ;SAVE FOR ENTER
LDB T,[POINT 3,B,20];GET REMAINING 3 BITS(HIGH PART)
DPB T,[POINT 3,ODATE,23];AND STORE
HLRE T,D ;GET LENGTH
SKIPLE T ;IF POSITIVE,
LSH T,7 ; CONVERT BLOCKS TO WORDS
TLNN F,L.DSKI ;IF NOT DISK,
MOVEI T,0 ; CLEAR LENGTH
MOVMM T,LENFIL ;STORE NO WORDS FOR LATER
SELW.3: INBUF INF,3 ;ALLOCATE THE BUFFER SPACE
SELW.4: MOVE T,.JBFF ;UPDATE OUTPUT SPACE DEFINER
MOVEM T,SJFF3 ; FOR BUFFERED OUTPUTS
MOVEM T,SJFF4 ; AND FOR RPBSCR IN CASE NO BUFFERED OUTS
TRZ F,R.EOF ;INDICATE NOT AT EOF YET
JRST CPOPJ1 ;GIVE WIN RETURN
;HERE IF FAIL TO FIND
SELFF: TRO F,R.EOF ;INDICATE NO DATA
POPJ P, ;GIVE FAILURE RETURN
SUBTTL ROUTINES TO ENTER OUTPUT FILE
ENTRN: MOVEI T,0 ;DO NORMAL ENTER
ENTR: MOVEM T,FOEXT ;CLEAR FORCED OUTPUT EXTENSION
JUMPN T,ENTR.2 ;IF ARGUMENT, USE IT
MOVE T,OSW ;GET OUTPUT SWITCHES
TRNE T,SW$S!SW$C!SW$D!SW$E!SW$B ;SPECIFIC SWITCH?
JRST ENTR.2 ;OUTPUT FORMAT SPECIFIED.
TLNN F,L.WEO ;WILD OUTPUT EXTENSION?
TLNN F,L.BEO ;NO. SPECIFIED EXTENSION?
JRST ENTR.2 ;YES. USE SPECIFIED ONE.
MOVE C,ISW ;UNDECLARED EXT. COMPUTE ONE.
HLRZ A,TIEXT ;FROM INPUT AND TAPE FORMAT
PUSHJ P,SELFTP ;WHAT IS INPUT FILE TYPE?
CAIN T,FT$B ;BINARY?
JRST ENTR.2 ;YES.
MOVE T,OTYPEX ;ITS A CORE FILE OF SOME SORT.
HLRZ T,ONMTAB(T) ;SELECT ON BASIS OF OUT DEVICE
CAIE T,'SAV' ;IS THIS ONE SAV?
JRST ENTR.1 ;NO--USE IT
CAIE A,'SVE' ;SEE IF INPUT IS SVE
CAIN A,'LOW' ;OR LOW
MOVE T,A ;YES--PRESERVE THE ORIGINAL
CAIE A,'HGH' ;SEE IF A
CAIN A,'SHR' ; HIGH SEGMENT
MOVE T,A ;YES--USE THAT
CAIE A,'XPN' ;SEE IF EXPANDED CORE
CAIN A,'EXE' ; OR NEW CORE IMAGE
MOVE T,A ;YES--USE THAT
ENTR.1: HRLZM T,FOEXT ;SAVE AS FORCED EXTENSION
ENTR.2: SETZM OFILEL ;CLEAR LENGTH OF OUTPUT FILE
SETOM OBLK ;CLEAR CURRENT OUTPUT BLOCK
SETZM OHED ;IN CASE ANYONE RELIES ON THESE
SETZM OHED+1 ; ..
SETZM OHED+2 ; ..
MOVE T,OTYPEX ;GET TYPE OF OUTPUT FILE
JRST @ENTRT(T) ;GO TO CORRECT ROUTINE FOR ENTER
ENTRT: ENTNDT ;NOT DECTAPE
ENTTEN ;10 STYLE DTA
ENTSIX ;SIX STYLE DTA
ENTMAC ;MAC STYLE DTA
ENTFIF ;FIFTEEN STYLE DTA
ENTVEN ;ELEVEN STYLE DTA
ONMTAB: SIXBIT /SAV/ ;NOT DECTAPE
SIXBIT /SAV/ ;10 STYLE DTA
SIXBIT /DMP/ ;SIX STYLE DTA
SIXBIT /BIN/ ;MAC STYLE DTA
SIXBIT /ABS/ ;FIFTEEN STYLE DTA
SIXBIT /LOD/ ;ELEVEN STYLE DTA
;ROUTINE TO ENTER A FILE ON TEN DECTAPE
ENTTEN: TLNE F,L.SCRO ;SCRATCH OUTPUT FILE?
JRST ENTTS ;YES.
ENTNDT: MOVEI A,.IOBIN ;NO KLUDGERY. JUST ENTER
SKIPN B,ODEV ;OUTPUT DEVICE
MOVSI B,'DSK' ;DEFAULT IS DISK
MOVSI C,OHED ;BUFFER HEADER
OPEN OUTF,A ;GET THE DEVICE
JRST ERR14 ;CANT
HLRZ A,FOEXT ;GET FORCED EXTENSION
SKIPN A ;IF BLANK, THEN
HLRZ A,TOEXT ;DECIDE IF SPACING SHOULD BE TIGHT
MOVE C,OSW ;ON BASIS OF SWITCHES AND FILE EXTENSION
PUSHJ P,SELFTP ;SEE IF ITS A KNOWN EXTENSION
TLNE F,L.DTO ;DECTAPE OUTPUT?
CAIN T,FT$B ;AND NOT A DULL FILE?
SKIPA ;NO. STANDARD SPACING
UGETF OUTF,T ;YES. TIGHT SPACING FORCED BY UGETF
MOVE A,TOFILE ;GET OUTPUT FILE NAME
SKIPN B,FOEXT ;USE FORCED EXTENSION, IF SET
HLLZ B,TOEXT ;GET EXTENSION
MSTIME C, ;GET TIME IN MSECS
IDIVI C,^D60*^D1000 ;MAKE IT MINUTES
LSH C,^D12 ;MOVE IT TO BIT 23
LDB D,[POINT 3,ODATE,23];GET HIGH PART OF DATE
DPB D,[POINT 3,B,20];STORE WITH EXTENSION
LDB D,[POINT 12,ODATE,35];GET LOW PART OF DATE
TLNE F,L.DTO ;IF DECTAPE OUTPUT THEN
SETZ C, ;ZERO TIME
IOR C,D ;COMBINE TIME AND DATE
MOVE D,OPPN ;GET PROJ PROG NUMBER
ENTER OUTF,A ;WRITE THE FILE
JRST ERR46 ;CANT
MOVE T,SJFF3 ;SET .JBFF TO THE RIGHT PLACE
MOVEM T,.JBFF ; ..
OUTBUF OUTF,3 ;ALLOCATE THE BUFFER SPACE
MOVE T,.JBFF ;GET TOP OF BUFFERS NOW
MOVEM T,SJFF4 ;AND SAVE IT FOR RPBSCR ROUTINE'S ALLOCATION
SETOM SCRBK1 ;FLAG HAVE CHANGED AVAIL CORE SO RPBSCR
; WILL RECOMPUTE SPACE
POPJ P, ;RETURN
ENTTS: MOVE A,TOFILE ;GET NAME
SKIPN B,FOEXT ;AND EXT. FORCED?
HLLZ B,TOEXT ;NO. USE SUPPLIED ONE
MOVEI C,1 ;START OF DIRECTORY INDEX
ENTTL1: HLLZ T,ODIREC+150(C) ;GET EXT FOR FILE FROM DIR
CAMN A,ODIREC+122(C)
CAME B,T ;EXACT MATCH?
SKIPA ;NO
JRST ENTTSS ;YES. SUPERSEDE
CAIGE C,26 ;LOOKED AT THEM ALL?
AOJA C,ENTTL1 ;NO. LOOK ON.
MOVEI C,1 ;YES. NOW LOOK FOR A FREE ONE
ENTTL2: SKIPN ODIREC+122(C) ;FILE FREE?
JRST ENTTNW ;NEW FILE.
CAIGE C,26 ;CHECKED ALL OF THEM?
AOJA C,ENTTL2 ;NOT YET
JRST ERR15 ;YES. DIRECTORY FULL.
ENTTSS: MOVE T,[POINT 5,ODIREC+0] ;BYTES IN DIR
MOVEI T1,0 ;SOURCE OF ZEROES
MOVEI N,1102 ;COUNTER
ILDB T2,T ;GET A BYTE
CAIN T2,(C) ;BELONG TO THIS FILE?
DPB T1,T ;YES. FREE IT
SOJG N,.-3 ;LOOP FOR WHOLE TAPE.
ENTTNW: MOVEM C,OFILEX ;SAVE FILE INDEX
MOVEI N,1 ;LOOK FOR A FREE BLOCK FOR FIRST.
MOVE T,[POINT 5,ODIREC]
ILDB T1,T ;GET A BYTE
JUMPE T1,ENTTB ;IF FREE, GO USE IT.
CAIGE N,LASTOB ;LOOKED AT ALL BLOCKS?
AOJA N,.-3 ;NO. LOOK ON.
JRST ERR15 ;YES. THE TAPE'S FULL
ENTTB: MOVEM N,OFIRBK ;SAVE OUTPUT FIRST BLOCK
MOVEM T,OFIRBP ;AND POINTER TO IT.
MOVEM A,ODIREC+122(C) ;STORE NAME
SKIPN T,ODATE ;GET OUTPUT DATE
DATE T, ; USE TODAY IF NOTHING BETTER
DPB T,[POINT 12,B,35];STORE LOW PART
MOVEM B,ODIREC+150(C) ;STORE EXT,DATE
MOVEI T1,1 ;SETUP TO STORE HIGH PART OF DATE
ANDCAM T1,ODIREC-1(C) ;CLEAR EXISTING BITS
ANDCAM T1,ODIREC+^D21(C)
ANDCAM T1,ODIREC+^D43(C)
TRNE T,1B23 ;IS BIT IN DATE SET?
IORM T1,ODIREC-1(C) ;YES, SET CORRESPONDING BIT IN DIRECTORY
TRNE T,1B22
IORM T1,ODIREC+^D21(C)
TRNE T,1B21
IORM T1,ODIREC+^D43(C)
SETZM OHED+2 ;NO WORDS LEFT IN WRT BUF
POPJ P, ;RETURN
;ROUTINE TO ENTER FILE ON SIX DECTAPE
ENTSIX: PUSHJ P,OPOUTF ;OPEN OUTPUT FILE
MOVE A,TOFILE ;GET OUTPUT FILE NAME
SKIPN B,FOEXT ;FORCED OUTPUT EXTENSION?
HLLZ B,TOEXT ;OUTPUT EXTENSION
HRRZ C,ODIREC+0 ;POINTER INTO DIRECTORY
JRST ENTS2A ;RANGE CHECK
ENTSL1: SKIPN ODIREC(C) ;FREE FILE?
JRST ENTS1 ;YES. USE IT.
CAME A,ODIREC(C) ;SUPERSEDE FILE?
JRST ENTS2 ;NO
HLLZ D,ODIREC+1(C) ;MAYBE. CHECK EXT
CAMN B,D ; ..
JRST ENTS3 ;YES. GO SUPERSEDE
ENTS2: ADDI C,4 ;ON TO NEXT ENTRY
ENTS2A: CAIGE C,175 ;TO END OF DIR?
JRST ENTSL1 ;ON TO ANOTHER SLOT
JRST ERR27 ;ERROR. ENTER FAILS
ENTS1: MOVEM A,ODIREC(C) ;PUT IN NEW FILE NAME
HLR B,ODIREC+0 ;GET FILE'S FIRST BLOCK-1
ADDI B,1 ;FIRST BLOCK
MOVEM B,ODIREC+1(C) ;TO DIRECTORY
HRLM B,ODIREC+0 ;COUNT ALLOCATED BLOCK
SKIPN A,ODATE ;GET OUTPUT DATE, IF ANY
DATE A, ;NONE. USE TODAY.
MOVEM A,ODIREC+2(C) ;STORE IN DIRECTORY
SETZM ODIREC+3(C) ;NO IOWD (YET)
MOVEM C,OFILEX ;SAVE DIRECTORY SLOT FOR LATER
POPJ P, ;RETURN
ENTS3: PUSH P,C ;SAVE CURRENT SLOT OF MATCHING FILE
ENTS3L: MOVE T,ODIREC+4(C) ;GET NEXT SLOT
MOVEM T,ODIREC+0(C) ;COPY IT DOWN BY ONE
CAIGE C,177 ;COPIED IT ALL?
AOJA C,ENTS3L ;NO. MORE.
SETZM ODIREC+177 ;YES. CLEAR LAST FEW WORDS
SETZM ODIREC+176
SETZM ODIREC+175
SETZM ODIREC+174
POP P,C ;GET BACK THE SLOT NUMBER
JRST ENTSL1 ;AND LOOK FOR END.
;ROUTINE TO ENTER FILE ON PROJECT MAC DECTAPE
ENTMAC: PUSHJ P,OPOUTF ;OPEN OUTPUT FILE
MOVE A,TOFILE ;GET OUTPUT FILE NAME
SKIPN B,FOEXT ;FORCED OUTPUT EXTENSION?
MOVE B,TOEXT ;AND EXTENSION (FULL WORD)
JUMPN B,ENTM2 ;SHUFFLE WORDS IF BLANK EXT
MOVE B,A ; ..
MOVSI A,'@ ' ; ..
ENTM2: MOVEI C,2 ;FIRST FILE SLOT INDEX
ENTML1: SKIPN ODIREC-2(C) ;THIS SLOT FREE?
SKIPE ODIREC-1(C) ;AND EXT?
SKIPA ;NO
JRST ENTM1 ;YES. GO USE IT.
CAME A,ODIREC-2(C) ;NO. IS IT SAME AS NEW FILE?
JRST ENTM3 ;NO.
CAMN B,ODIREC-1(C) ;MAYBE. CHECK EXT
JRST ENTM4 ;YES. RE-USE THE SLOT
ENTM3: ADDI C,2 ;COUNT ON TO NEXT SLOT
CAIGE C,60 ;CHECKED THEM ALL?
JRST ENTML1 ;NO. GO ON.
JRST ERR27 ;YES. NO MORE ROOM ON TAPE.
ENTM4: ASH C,-1 ;CONVERT TO FILE NUMBER
PUSH P,C ;SAVE CURRENT INDEX
PUSHJ P,DELFM ;DELETE ITS FILE AND EXTS
POP P,C ;RESTORE INDEX
ASH C,1 ;BACK TO INDEX
;AND NOW USE THIS SLOT
ENTM1: MOVEM A,ODIREC-2(C) ;USE THIS SLOT. ENTER NAME
MOVEM B,ODIREC-1(C) ;AND THE EXTENSION
ASH C,-1 ;CONVERT TO FILE NUMBER
MOVEM C,OFILEX ;AND SAVE IT FOR LATER
POPJ P, ;RETURN
DELFMA: MOVE C,T ;EXTENSION FILE
ASH C,-1 ;FILE NUMBER
DELFM: ASH C,1 ;GET INDEX TO CLEAR NAMES
SETZB N,ODIREC-2(C) ;CLEAR THIS FILE NAME, GET A ZERO AC
SETZM ODIREC-1(C) ;CLEAR EXT TOO
ASH C,-1 ;BACK TO FILE NUMBER
MOVEI T,1067 ;LAST BLK TO LOOK AT
MOVE T1,[POINT 5,ODIREC+56]
DELFML: ILDB T2,T1 ;GET A DIR BYTE
CAMN T2,C ;IN THIS FILE?
DPB N,T1 ;YES. FREE IT
SOJG T,DELFML ;RUN THRU WHOLE DIR
MOVEI T,2 ;NOW SEE IF THERES AN EXTENSION
DELFMB: SKIPN ODIREC-2(T) ;SEE IF EXT
CAME C,ODIREC-1(T) ;IS THE EXT = THE CURRENT FILE NO?
SKIPA ;NOT AN EXT.
JRST DELFMA ;AN EXT. GO DELETE IT TOO
ADDI T,2 ;ON TO NEXT ONE
CAIL T,60 ;ALL OF THEM?
POPJ P, ;YES.
JRST DELFMB ;NO. MORE.
;ENTER ROUTINE FOR PDP11 TAPES
ENTVEN: PUSHJ P,OPOUTF ;OPEN OUTPUT FILE
HLRZ T,TOFILE ;GET THREE CHARS OF OUT FILE NAME
PUSHJ P,SIXR5V ;CONVERT TO R50VEN
MOVEM T,OFIL1V ;SAVE FOR LOOKUP COMPARE RTN
HRRZ T,TOFILE ;SECOND THREE CHARS
PUSHJ P,SIXR5V ; ..
MOVEM T,OFIL2V
SKIPN T,FOEXT ;FORCED OUT EXT?
HLLZ T,TOEXT ;NO. STANDARD ONE
HLRZS T ;TO RH
PUSHJ P,SIXR5V ;TO R50VEN
MOVEM T,OEXTV ;TO TEMP STORAGE
MOVEI T,100 ;NOW GET THE PBM FROM MFD
PUSHJ P,ROUTBT ;READ THE MFD PRIMARY BLK
JRST ERR40 ;ERROR ON MFD
HLRZ T,TBUF+1 ;BIT MAP BLK NUMBER (USUALLY 104)
MOVEM T,PBMBKO ;SAVE FOR RESTORING IT LATER
HLRZ T,TBUF+0 ;LINK TO REST OF MFD
PUSHJ P,ROUTBT ;READ IT TO TEM BUF
JRST ERR40 ;LOSS
HRRZ T,TBUF+0 ;GET USER ID CODE
MOVEM T,VOUIC ;SAVE FOR LATER
HRRZ T,TBUF+1 ;LENGTH OF UFD ENTRIES
MOVEM T,VWPEO ;SAVE VEN WDS PER ENTRY OUTPUT TAPE
HLRZ T,TBUF+1 ;FIRST BLK OF UFD
MOVEM T,VODIB1 ;SAVE
PUSHJ P,ROUTBT ;AND READ TO GET LINK
JRST ERR40 ;LOSS
MOVEM T,ODIBKN ;SAVE AS CURRENT CONTENTS OF ODIREC
HLRZ T,TBUF+0 ;GET LINK TO SECOND BLK
MOVEM T,VODIB2 ;SAVE IT
MOVE T,[XWD TBUF,ODIREC]
BLT T,ODIREC+177 ;COPY INTO OUTPUT DIRECTORY BUFFER
MOVE T,PBMBKO ;NOW READ PBM MAP BLOCK
PUSHJ P,ROUTBT ;READ PBM
JRST ERR40 ;NO GOOD
MOVE T,[XWD TBUF,VBMAPO] ;COPY INTO VEN BIT MAP OUTPUT
BLT T,VBMAPO+177 ; ..
MOVEI C,1 ;START COUNTER THRU VEN DIRECTORY
MOVEM C,OFILEX ;OUTPUT FILE INDEX (1-56.)
CONT.
SETZM FBMX ;CLEAR CELL FOR FREE FILE NUMBER DURING COMPARE
EVL1: PUSHJ P,EVCMP ;SUBR TO GET ENTRY AND CHECK IT AND MARK IF FREE
JRST EV1 ;MATCHED. MUST DELETE OLD ENTRY
AOS C,OFILEX ;NO MATCH. LOOK ONWARD
CAIG C,^D56 ;END TEST (SHOULD BE COMPUTED)***
JRST EVL1 ;LOOK ON
SKIPN C,FBMX ;NO MATCH. ANY FREE SLOTS?
JRST ERR27 ;NO. DIRECTORY FULL. LOSES.
MOVEM C,OFILEX ;YES. STORE FREE INDEX
EV1: PUSHJ P,EVGET ;GET THE DIRECTORY ENTRY FOR THIS INDEX
MOVE T,OFIL1V ;COPY THE FILE ENTRY DATA. NAME1
MOVEM T,EVSN1
MOVE T,OFIL2V ;NAME2
MOVEM T,EVSN2
MOVE T,OEXTV ;EXTENSION
MOVEM T,EVSEXT
SKIPN T,ODATE ;DATE
DATE T, ; USE TODAY IF NOTHING BETTER
PUSHJ P,DATTV ;IN ELEVEN FORMAT
MOVEM T,EVSDAT
SKIPN T,OPRT ;PROTECTION
SKIPN T,VIPRT ;GET THE OLD ELEVEN PRIORITY
MOVEI T,233 ;DEFAULT PROTECTION FOR VEN TAPES
HRRZM T,EVSPRT ; ..
MOVE T,OFILEX ;NOW GET THIS FILE'S BIT MAP IN ITS BLK
SUBI T,1 ;FILE 1 TO 0
IDIVI T,7 ;FILES PER PBM BLK
ADDI T,70 ;FIRST FBM BLK. SHOULD BE IN MFD!!!
MOVEM T,FBMBLK ;BLK NUMBER
IMULI T1,22 ;OFFSET INTO BLOCK
MOVEM T1,FBMX ;INDEX INTO FBM
PUSHJ P,ROUTBT ;READ THE FBM BLK TO TBUF
JRST ERR40 ;LOSS
MOVEI T,TBUF ;NOW MAKE A BLT WORD TO COPY BITS OUT
ADD T,FBMX ; ..
MOVSI T,(T) ; ..
HRRI T,FBMBUF ; ..
BLT T,FBMBUF+21 ;COPY THE BITS TO FBMBUF
MOVSI T,-22 ;CLEAR THEM IN MASTER (FILE GOING AWAY)
MOVE T1,FBMBUF(T) ;GET SOME BITS
ANDCAM T1,VBMAPO+2(T) ; CLEAR IN MASTER
SETZM FBMBUF(T) ;AND IN THIS FILE
AOBJN T,.-3 ;LOOP THRU ALL BITS IN THE FBM
POPJ P, ;RETURN
;LEAVE COPYING FROM SLOT TO ODIREC UNTIL CLOSE TIME.
;THEN WILL HAVE NAME, EXT, FIRST AND LAST BLK, NUMBER OF BLKS ALL
; READY TO WRITE OUT TOGETHER.
;AT CLOSE TIME, WRITE THE PBM,FBM,AND ODIREC.
;SUBR TO GET OUT DIR ENTRY NAME1, NAME2, EXT INTO EVSLOT
EVGET: MOVE T,OFILEX ;OUTPUT FILE NUMBER, 1-56.
IMUL T,VWPEO ;TIMES WORDS PER ENTRY
CAILE T,377 ;IN FIRST BLOCK?
JRST EVGET2 ;NO
SUB T,VWPEO ;ENTRY 1 IS OFFSET 0
PUSH P,T
MOVE T,VODIB1 ;IS THIS BLK IN ODIREC ALREADY?
EVGT2A: CAMN T,ODIBKN ;COMPARE ODIREC'S NUMBER
JRST EVGT1A ;ALREADY THERE. DONT READ AGAIN
PUSHJ P,ROBTOD ;READ OUTPUT DIRECTORY
JRST ERR40
EVGT1A: POP P,A
MOVEM A,EVSPOS ;SAVE FOR USE AT CLOSE TIME
MOVE T,A ;GET WORDS INTO BLK
MOVEI C,0 ;ARG TO GET ROUTINE
PUSHJ P,GTVODW ;GET VEN OUT DIR WORD
MOVEM T,EVSN1 ;NAME ONE
MOVEI T,1(A) ;NAME TWO OFFSET
PUSHJ P,GTVODW ;GET FROM ODIREC
MOVEM T,EVSN2 ; ..
MOVEI T,2(A) ;AND EXT WORD
PUSHJ P,GTVODW ; ..
MOVEM T,EVSEXT ;STORE
POPJ P, ;RETURN
EVGET2: MOVEI T,377 ;TRY SECOND BLK
IDIV T,VWPEO ;HOW MANY FIT IN BLK 1?
MOVNS T ;SUBTRACT THAT
ADD T,OFILEX ;FROM INDEX
IMUL T,VWPEO ;BACK TO WORDS
CAILE T,377 ;TOO BIG?
JRST ERR38 ;YES. LOSE.
SUB T,VWPEO ;CONVERT DOWN 1 (FILE 1 IS IDX 0)
PUSH P,T ;STACK ZEROTH WORD
MOVE T,VODIB2 ;GET BLK NUMBER TWO OF VEN DIR
JRST EVGT2A ;AND GO READ IT
EVCMP: PUSHJ P,EVGET ;GET THE ENTRY
MOVE T,EVSN1 ;COMPARE SLOT NAME 1
CAME T,OFIL1V ;TO OUTPUT NAME 1
JRST EVCMP1 ;NOT A MATCH. SEE IF FREE
MOVE T,EVSN2 ;SAME FOR NAME PART 2
CAME T,OFIL2V ; ..
JRST CPOPJ1 ;NO MATCH
MOVE T,EVSEXT ;AND EXTENSION
CAME T,OEXTV ; ..
JRST CPOPJ1 ;NO MATCH
POPJ P, ;MATCH. NON-SKIP RETURN
CONT.
EVCMP1: JUMPN T,CPOPJ1 ;IF IN USE, RETURN
MOVE T,OFILEX ;FREE. GET INDEX
SKIPN FBMX ;FIRST FREE ONE?
MOVEM T,FBMX ;YES. USE IT FOR ENTER.
JRST CPOPJ1 ;AND SKIP (DIFFERENT) RETURN
PTVODW: ANDI T,177777 ;MAKE SURE FITS IN ELEVEN WORD
MOVEI T1,1(C) ;SKIP LINK WORD
ROT T1,-1 ;HALF WORDS ON TEN
SKIPL T1 ;WHICH HALF
HRLM T,ODIREC(T1) ;LEFT
SKIPGE T1
HRRM T,ODIREC(T1) ;RIGHT
POPJ P,
;ROUTINE TO ENTER FILE ON FIFTEEN DECTAPE
ENTFIF: PUSHJ P,OPOUTF ;OPEN OUTPUT FILE
MOVE T,TOFILE ;GET OUTPUT FILE NAME
PUSHJ P,TRMSIX ;CONVERT TO PDP15 FORMAT SIXBIT
MOVE A,T
SKIPN T,FOEXT
MOVE T,TOEXT
PUSHJ P,TRMSIX ;SAME FOR EXTENSION
HLLZ B,T
SETZB C,OBVFLG ;SEARCH FILE DIR FOR THIS FILE
; AND CLEAR WRITE-DIRECTION FLAG FOR LATER
ENTFL1: CAME A,ODIREC+20(C) ;FILE NAME MATCH?
JRST ENTF1 ;NO
HLLZ T,ODIREC+21(C) ;EXT HALFWORD
CAMN B,T ;EXT MATCH TOO?
JRST ENTF2 ;YES. SUPERSEDE THIS FILE
ENTF1: ADDI C,2 ;COUNT ON TO NEXT FILE
CAIGE C,160 ;LOOKED AT ALL?
JRST ENTFL1 ;NO. LOOK ON
MOVEI C,0 ;YES. FILE NOT THERE. FIND A FREE ONE
ENTFL2: MOVE T,ODIREC+21(C) ;DEFINED BY BIT 18 OF EXT WD
TRNN T,400000 ;IN USE?
JRST ENTF3 ;NO. USE IT.
ADDI C,2 ;YES. LOOK ONWARD
CAIGE C,160 ;TO END OF FD?
JRST ENTFL2 ;NO. LOOK ON
JRST ERR27 ;YES. NO FREE FILES. YOU LOSE.
ENTF2:
ENTF3: MOVEM A,ODIREC+20(C) ;STORE FILE NAME TO WRITE
HRRI B,400000 ;SET FILE SLOT IN USE BIT
MOVEM B,ODIREC+21(C) ;STORE EXT AND BIT (NO FIRST BLK YET)
MOVEM C,OFILEX ;STORE FILE INDEX
MOVE T,C ;COPY IT FOR ARITHMETIC
LSH T,-4 ;CONVERT TO BLOCK NUMBER WHERE BIT MAP IS
ADDI T,71 ; ..
MOVEM T,FBMBLK ;REMEMBER FOR ALLOCATION
PUSHJ P,ROUTBT ;READ FROM SCOF OR OUTF TO TBUF
JRST ERR2 ;BAD ON DIRECTORY READ
MOVE T,[XWD TBUF,FBMBUF] ;COPY INTO ITS OWN BUFFER
BLT T,FBMBUF+177 ; ..
MOVE T,OFILEX ;NOW FREE ANY BLOCKS IT HAS NOW
ANDI T,16 ;GET BIT GROUP IN BLK
LSH T,3 ;MAKE IT A WORD OFFSET
MOVEM T,FBMX ;SAVE THIS INDEX
MOVEI T1,0 ;INDEX FOR MASTER BIT MAP
ENTFL3: MOVE T2,FBMBUF(T) ;GET A WORD OF BITS OCCUPIED BY FILE
ANDCAM T2,ODIREC(T1) ;CLEAR THEM IN MASTER
SETZM FBMBUF(T) ;AND IN BIT MAP FOR FILE
ADDI T1,1 ;STEP
AOBJN T,ENTFL3 ;LOOP ALL SIXTEEN WORDS
POPJ P, ;RETURN
SUBTTL CLOSE ROUTINES
CLS: MOVE T1,OTYPEX ;GET TYPE OF OUTPUT FILE
PUSHJ P,@CLST(T1) ;DISPATCH
SETOM OBLK ;CLEAR USE OF THIS POINTER
POPJ P, ;RETURN FROM PROCES
CLST: CLSNDT ;NON DECTAPE
CLSTEN ;TEN DECTAPE
CLSSIX ;SIX DECTAPE
CLSMAC ;MAC DECTAPE
CLSFIF ;PDP15 DECTAPE
CLSVEN ;PDP11 DECTAPE
;ROUTINE TO CLOSE NON-DECTAPE
CLSNDT: CLOSE OUTF, ;CLOSE THE FILE
TLNE F,L.DTO ;IS OUTPUT A DTA?
JRST CLSN2 ;YES. NO PROTECTION
MOVE A,TOFILE ;GET FILE NAME
SKIPN B,FOEXT ;GET FORCED EXTENSION
HLLZ B,TOEXT ;EXTENSION
SKIPN C,OPRT ;PROTECTION
JRST CLSN2 ;NO--USE SYSTEM DEFAULT
LSH C,^D27 ;IN RIGHT FIELD
MOVE D,OPPN ;PROJ PROG NUMBER
RENAME OUTF,A ;PUT PROT ON
PUSHJ P,ERR25 ;CAN'T RENAME
CLOSE OUTF, ;CLOSE AGAIN
CLSN2: STATZ OUTF,IO.ERR ;ERRORS?
JRST ERR21 ;YES
POPJ P, ;NO.
;ROUTINE TO CLOSE PROJECT MAC DECTAPE
CLSMAC: MOVEI A,100 ;DIRECTORY BLOCK NUMBER
CLSS3: MOVEM A,ODIBKN ;SAVE BLK NUMBER (MAC OR SIX)
SKIPG OBLK ;IS THERE AN OUTPUT BLOCK?
JRST CLSM1 ;NO. JUST WRITE DIR
PUSHJ P,PPBBLK ;WRITE THE CURRENT BUFFER
CLSM1: MOVE A,ODIBKN ;GET BLK NUMBER FOR DIRECTORY
CLSXIT: MOVEM A,OBLK ;FOR WRITER
MOVE T,[XWD ODIREC,WBUF]
BLT T,WBUF+177 ;COPY INTO WRITE BUFFER
PJRST PPBBLK ;AND WRITE IT ON DSK OR TAPE
;PDP-15 FORMAT CLOSE ROUTINE
CLSFIF: HLLOS WBUF+177 ;-1 LINK IS EOF
SKIPGE OBLK ;ACTUALLY WRITTEN?
JRST CLSF1 ;NO. JUST DUMP DIRECTORY
SKIPN OBVFLG ;GOING BACKWARDS?
JRST CLSF2 ;NO
MOVE T,[XWD WBUF,TBUF] ;YES. MUST SHUFFLE BITS
BLT T,TBUF+177 ; MOVE OVER
PUSHJ P,OBVCOM ;SHUFFLE
MOVE T,[XWD TBUF,WBUF]
BLT T,WBUF+177 ;MOVE BACK
CLSF2: PUSHJ P,PPBBLK ;OUTPUT THE BLOCK
CLSF1: MOVE T,[XWD FBMBUF,WBUF] ;PUT BIT MAP IN WBUF
BLT T,WBUF+177
MOVE T,FBMBLK ;WHERE IT GOES ON TAPE
MOVEM T,OBLK ;TO OUTPUTTER'S ARG
PUSHJ P,PPBBLK ;WRITE IT
MOVEI A,100 ;POINT TO DIRECTORY
JRST CLSXIT ;GO FINISH OUTPUTTING
;PDP-11 CLOSE ROUTINE
CLSVEN: SKIPN VCONTG ;DO NOT CLEAR DATA FOR A CONT. FILE
HRRZS WBUF+0 ;CLEAR LINK. NO MORE TO WRITE.
SKIPGE OBLK ;WRITE ANY AT ALL?
JRST CLSV1 ;NO. JUST DUMP DIRECTORY AND STUFF
SKIPN OBVFLG ;YES. WHICH WAY WE GOING?
JRST CLSV2 ;FORWARD
MOVE T,[XWD WBUF,TBUF] ;BACKWARD. HAVE TO SWAP DATA AROUND
BLT T,TBUF+177
PUSHJ P,OBCVEN
MOVE T,[XWD TBUF,WBUF]
BLT T,WBUF+177
CLSV2: PUSHJ P,PPBBLK ;WRITE OUT THE BLOCK
CONT.
CLSV1: MOVE T,[XWD VBMAPO,WBUF] ;WRITE THE MASTER BIT MAP BLK
BLT T,WBUF+177 ;COPY TO WRITE BUFFER
MOVE T,PBMBKO ;GET BK NUMBER WHERE IT GOES
MOVEM T,OBLK ;FOR WRITER
PUSHJ P,PPBBLK ;WRITE IT
MOVE T,FBMBLK ;NOW READ THE FILE'S MAP BLK
MOVEM T,OBLK ;(WILL WRITE IT IN A MINUTE)
PUSHJ P,ROUTBT ;READ IT SO CAN UPDATE ONE FILE'S ENTRY
JRST ERR40 ;OOPS
MOVEI T,TBUF ;COMPUTE WHERE THE BITS GO
ADD T,FBMX
HRLI T,FBMBUF ;BLT WORD
MOVEI T1,21(T) ;END CONDITION
BLT T,(T1) ;MOVE THE BITS FOR THIS FILE
MOVE T,[XWD TBUF,WBUF]
BLT T,WBUF+177 ;COPY OVER FOR WRITING
PUSHJ P,PPBBLK ;WRITE IT OUT
MOVE C,EVSPOS ;NOW GET THE POSITION FOR OUTPUT SLOT IN ODIRECT
MOVE T,EVSN1 ;NAME PART 1
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;TO NEXT HALF NAME
MOVE T,EVSN2 ;GET NAME PART 2
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;TO EXT
MOVE T,EVSEXT ;GET THE EXT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;NOW THE DATE
MOVE T,EVSDAT ;ALREADY IN VEN FORMAT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,2 ;FIRST BLK NUMBER
MOVE T,EVSFBN ;GET IT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;LAST BLOCK NUMBER
MOVE T,EVSLEN ;GET IT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;AND LENGTH
MOVE T,EVSLAS ;GET IT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
ADDI C,1 ;AND FINALLY PROTECTION CODE
MOVE T,EVSPRT ;GET IT
PUSHJ P,PTVODW ;PUT IT IN ODIREC
JRST CLSM1 ;GO FINISH UP
;PDP6 FORMAT CLOSE ROUTINE
CLSSIX: TLNE F,L.6DO ;DUMP OUTPUT?
JRST CLSS1 ;YES.
HRRZS WBUF ;NO. CLEAR LINK
HRRZ A,OHED+2 ;GET USED WORDS COUNT THIS BFR
MOVNS A
ADDI A,177
HRRM A,WBUF ;PUT INTO LINK WORD
JRST CLSS2 ;GO WRITE THE BLOCK
CLSS1: HRRZ A,OHED+2 ;GET USED WORDS IN DUMP FILE
MOVNS A
ADDI A,200
ADDB B,OFILEL ;INTO OUTPUT FILE LENGTH
MOVNS A ;MAKE IOWD FOR WHOLE FILE
HRLZS A
HRRI A,JOBSV6 ;FIRST ADR MINUS ONE
MOVE C,OFILEX ;GET DIRECTORY INDEX
MOVEM A,ODIREC+3(C) ;PUT IOWD IN DIRECTORY
CLSS2: MOVEI A,1 ;DIRECTORY BLOCK NUMBER
JRST CLSS3 ;WRITE IT OUT
;PDP10 CLOSE ROUTINE
CLSTEN: TLNN F,L.SCRO ;SCRATCH OUTPUT FILE?
JRST CLSNDT ;NO. USE SYSTEM CLOSE
SKIPG OBLK ;YES. ANY DATA WRITTEN?
JRST CLST1 ;NO
MOVE T,OFIRBK ;OUTPUT FIRST BLK
LSH T,10 ;TO LINK BYTE
MOVN T1,OHED+2 ;USED WORDS IN LAST BK
ADDI T1,177 ; ..
IOR T,T1 ;OR INTO LINK
HRRZM T,WBUF ;TO LINK IN WBUF, NO NEXT BLK
PUSHJ P,PPBBLK ;OUTPUT THE BLOCK
CLST1: MOVEI A,144 ;POINT TO DIR BLK
JRST CLSXIT ; AND GO WRITE IT
SUBTTL READ BINARY WORD, EXPANDING TO CORE IMAGE
;ALL THESE ROUTINES HAVE THE SAME INTERFACE. EACH CALL
;RESULTS IN THE NEXT WORD OF THE LOGICAL ADDRESS SPACE
;BEING RETURNED.
; INTIALIZE:
; RCA/ 0
; RPC/ ROUTINE FOR FILE TYPE:
; RDWRD? WHERE ?= FILE TYPE
; C=.SAV
; E=.XPN
; D=.DMP
; S=MAC S-BLK
; B=BINARY
; H=.HGH
; P=.EXE
;
;CALL: PUSHJ P,@RPC
; RETURN +1 AT END OF ADDRESS SPACE
; RETURN +2 WITH
; W/ CONTENTS OF NEXT LOCATION
; RCA/ ADDRESS OF NEXT LOCATION (INCREASES BY EXACTLY 1)
; RTYP/ BITS: (0 MEANS DUMMY AREA)
; SAME AS .EXE DIRECTORY
;USES ONLY T, T1, T2, A, B, C, D
;ROUTINE TO READ .XPN AND BINARY
RDWRDB:!
RDWRDE: MOVX W,PF$WRT ;ALL OF FILE IS LOW SEGMENT
MOVEM W,RTYP ;SET FOR CALLER
;HERE TO STRAIGHT COPY REST OF INPUT
RDWRX: PUSHJ P,RPB ;READ A WORD
POPJ P, ;RETURN IF EOF
PUSHJ P,RWO ;SKIP RETURN VALUE
JRST RDWRX ;LOOP FOR EVER
;ROUTINE TO READ .SAV
RDWRDC: MOVX W,PF$WRT ;ALL OF FILE IS LOW SEGMENT
MOVEM W,RTYP ;SET FOR CALLER
RWC.1: PUSHJ P,RPB ;GET NEXT IOWD WORD
POPJ P, ;RETURN IF EOF
JUMPGE W,CPOPJ ;END RETURN IF JRST WORD
HLREM W,RWC ;SAVE IOWD COUNT
MOVEI T,1(W) ;GET NEXT ADDRESS (OF FIRST WORD)
PUSHJ P,RPO ;POSITION OUTPUT
RWC.2: PUSHJ P,RPB ;READ NEXT DATA WORD
POPJ P, ;RETURN IF EOF
PUSHJ P,RWO ;SKIP RETURN OUTPUT
AOSGE RWC ;ADVANCE LOOP COUNT
JRST RWC.2 ;LOOP OVER DATA
JRST RWC.1 ;LOOP FOR NEXT IOWD
;ROUTINE TO READ S-BLK
RDWRDS: MOVX T,PF$WRT ;ASSUME JUST LOW SEG
MOVEM T,RTYP ;SET FOR CALLER
RWS.1: PUSHJ P,RPB ;SKIP OVER BOOT
POPJ P, ;RETURN IF NOTHING
CAME W,[JRST 1] ;LOOK FOR PROGRAM CUE
JRST RWS.1 ;LOOP
RWS.2: PUSHJ P,RPB ;GET NEXT AOBJN
POPJ P, ;RETURN IF DONE
JUMPGE W,CPOPJ ;RETURN IF JRST WORD
MOVEM W,RCKS ;AOBJN--SAVE AS START OF CHECKSUM
HLREM W,RWC ;SET AOBJN COUNTER
MOVEI T,(W) ;GET START OF DATA ADDRESS
PUSHJ P,RPO ;POSITION OUTPUT
RWS.3: PUSHJ P,RPB ;GET NEXT DATA WORD
POPJ P, ;RETURN IF EOF
MOVE T,RCKS ;GET PARTIAL CHECKSUM
ROT T,1 ;ADVANCE
ADD T,W ;INCLUDE THIS WORD
MOVEM T,RCKS ;SAVE AGAIN
PUSHJ P,RWO ;SKIP RETURN THIS DATA WORD
AOSGE RW ;COUNT IT
JRST RWS.3 ;LOOP OVER DATA
PUSHJ P,RPB ;READ CHECKSUM
POPJ P, ;RETURN IF DONE
CAME W,RCKS ;SEE IF OK
PUSHJ P,CKSERR ;WARN IF NOT
JRST RWS.2 ;LOOP OVER FILE
;ROUTINE TO READ .DMP
RDWRDD: MOVX W,PF$WRT ;INDICATE LOW SEG
MOVEM W,RTYP ; FOR CALLER
MOVEI T,JOBSV6+1 ;SKIP THIS
PUSHJ P,RPO ; MUCH
JRST RDWRX ;FINISH AS STRAIGHT COPY
;ROUTINE TO READ .HGH
RDWRDH: SETZM RTYP ;INDICATE DUMMY
PUSH P,CA ;SAVE AN AC
MOVSI CA,-.JBHGA-1 ;LENGTH OF VESTIGIAL JOB DATA AREA
RWH.1: PUSHJ P,RPB ;GET WORD
JRST [POP P,CA ;RESTORE AC
POPJ P,] ;EOF RETURN
MOVEM W,RW(CA) ;SAVE FOR LATER
AOBJN CA,RWH.1 ;LOOP OVER DATA
POP P,CA ;RESTORE AC
LSH W,^D9 ;POSITION STARTING ADDRESS
HLRZS W ;POSITION IN RH
SKIPN T,W ;POSITION
MOVEI T,400000 ;IF NULL, THEN 400K
PUSHJ P,RPO ;SKIP TO THAT POINT
MOVX T,PF$HGH ;SET FOR HIGH SEGMENT
HLRZ T1,TIEXT ;GET INPUT EXTENSION
CAIN T1,'SHR' ;IF SHARABLE,
TXO T,PF$SHR ; INDICATE SHARABLE
MOVEM T,RTYP ;SAVE TYPE
MOVSI T,-.JBHGA-1 ;GET LENGTH IN BUFFER
RWH.2: MOVEM T,RWC ;SAVE COUNT
MOVE W,RW(T) ;GET NEXT WORD FROM BUFFER
PUSHJ P,RWO ;SKIP RETURN TO CALLER
MOVE T,RWC ;GET COUNT
AOBJN T,RWH.2 ;LOOP OVER BUFFER
JRST RDWRX ;THEN STRAIGHT COPY THE REST
;ROUTINE TO READ PROGRAM (.EXE) FORMAT
;AFTER THE FIRST WORD READ, THE DIRECTORY IS LEFT IN PDS
; THE LAST ENTRY IS AT PDS+C(PDSPTR)+2*C(PDSCNT)
RDWRDP: SETZM RPBPCT ;CLEAR PROG COUNTER
PUSH P,CA ;SAVE AN AC
RWP.1: PUSHJ P,RPBP ;GET NEXT WORD, COUNTING
HLRZ T,W ;GET CODE
CAIN T,1776 ;SEE IF PROGRAM PAGE DIRECTORY
JRST RWP.3 ;YES--GO READ PROGRAM DIRECTORY
CAIN T,1777 ;NO--IS IT END OF PROGRAM?
JRST [POP P,CA ;YES--NO PROGRAM HERE
POPJ P,] ; SO END
MOVEI CA,-1(W) ;NO--SKIP THIS BLOCK TYPE
RWP.2: PUSHJ P,RPBP ;GET WORD IN BLOCK
SOJG CA,RWP.2 ;LOOP
JRST RWP.1 ;THEN TRY NEXT BLOCK
RWP.3: MOVEI T,-1(W) ;GET WORDS IN PROGRAM PAGE DIRECTORY
LSH T,-1 ;GET NUMBER OF ENTRIES
MOVEM T,PDSCNT ;SAVE FOR LATER
CAILE T,LN$PDS ;SEE IF ROOM
JRST ERR57 ;NO--TELL USER
LSH T,1 ;GET WORD COUNT
MOVNS T ;MAKE NEGATIVE
HRLZ CA,T ;MAKE INTO AOBJN COUNTER
RWP.4: PUSHJ P,RPBP ;GET PAGE DIRECTORY WORD
MOVEM W,PDS(CA) ;SAVE IN TABLE
AOBJN CA,RWP.4 ;LOOP OVER PAGE DIRECTORY
POP P,CA ;RESTORE AC
MOVNI T,2 ;INITIALIZE PAGE DIRECTORY INDEX
MOVEM T,PDSPTR ; TO CONTROL INPUT PROGRESS
CONT.
RWP.5: MOVEI T,2 ;ADVANCE PAGE DIRECTORY
ADDB T,PDSPTR ; POINTER TO NEXT ENTRY
SOSGE PDSCNT ;COUNT DOWN PROGRESS
POPJ P, ;DONE WHEN DIRECTORY EXPIRED
MOVE T,PDS+1(T) ;GET TARGET (PROGRAM) PAGE
ANDI T,777 ;USE JUST PAGE
LSH T,^D9 ;MAKE WORD ADDRESS
SETZM RTYP ;INDICATE DUMMY REGION
PUSHJ P,RPO ;POSITION OUTPUT FILE
MOVE T2,PDSPTR ;GET POINTER
MOVE T,PDS+1(T2) ;GET REPEAT COUNT
LSH T,-^D27 ;POSITION COUNT
ADDI T,1 ;MAKE INTO ITERATION COUNT
LSH T,^D9 ;POSITION AS WORD COUNT
MOVE T2,PDS(T2) ;GET FILE POSITION
HLLZ T1,T2 ;MAKE A COPY OF FLAGS
TLZ T1,777 ;CLEAR TO JUST FLAGS
MOVEM T1,RTYP ;SAVE FOR CALLER
TLZ T2,(777B8) ;CLEAR FLAGS
JUMPE T2,[PUSHJ P,RPN ;POSITION THAT FAR AHEAD
JRST RWP.5] ;AND CONTINUE
MOVEM T,RWC ;SET LENGTH AS COUNT
MOVE T,T2 ;GET FILE PAGE
LSH T,^D9 ;CONVERT TO WORDS
PUSHJ P,RPBPOS ;ELSE, POSITION INPUT
RWP.6: PUSHJ P,RPB ;READ INPUT
JRST [MOVE T,RWC ;EOF--SEE IF IN LAST PAGE
CAIGE T,^D512 ; ..
JRST .+1 ;YES--OK, JUST A CHINCY WRITER
JRST ERR55] ;NO--SOMETHING SEVERLY WRONG
AOS RPBPCT ;COUNT WORD
PUSHJ P,RWO ;STORE IN OUTPUT, COUNTING
SOSLE RWC ;FOR R+1 PAGES,
JRST RWP.6 ; LOOP
JRST RWP.5 ;THEN GO FOR NEXT DIRECTORY ENTRY
;HELPER ROUTINES FOR RDWRD? ROUTINES
;RPO--POSITION OUTPUT TO LOCATION C(T)
;RPN--POSITION OUTPUT C(T) LOCATIONS AHEAD
RPO: SUB T,RCA ;SEE HOW FAR FROM CURRENT OUTPUT
RPN: JUMPL T,ERR24 ;ERROR IF NO DISTANCE TO GO
MOVEM T,RPOC ;SAVE COUNT OF DISTANCE TO GO
POP P,RPOP ;SAVE RETURN POINT FOR LATER
RPO.1: SOSGE RPOC ;DECREMENT COUNT
JRST @RPOP ;RETURN IF ALL DONE
MOVEI W,0 ;RETURN A ZERO
PUSHJ P,RWO ;SKIP RETURN IT TO OUTER ROUTINE
JRST RPO.1 ;LOOP
;RWO--ROUTINE TO EFFECT A CO-ROUTINE EXIT
; IT RETURNS CONTENTS OF W TO CALLER AS DATA
; AND ADVANCES RPC (VIRTUAL ADDRESS COUNTER)
RWO: POP P,RPC ;INDICATE RE-ENTRY ADDRESS
AOS RCA ;ADVANCE COUNT
JRST CPOPJ1 ;SKIP RETURN
SUBTTL READ BINARY WORD ROUTINES
;ROUTINE TO POSITION INPUT UP TO C(T) LOCATION
RPBPOS: PUSH P,T ;SAVE LOC
RPBP.1: MOVE T,(P) ;GET TARGET
CAMG T,RPBPCT ;SEE IF THERE YET
JRST RPBP.2 ;YES--FINISH UP
PUSHJ P,RPBP ;NO--READ A WORD
JRST RPBP.1 ;LOOP
RPBP.2: POP P,T ;RESTORE TARGET
CAME T,RPBPCT ;IF NOT RIGHT ON,
JRST ERR24 ; MUST HAVE STARTED TOO FAR
POPJ P, ;ELSE, OK RETURN
;ROUTINE TO READ KEEPING TRACK OF PROGRESS
RPBP: PUSHJ P,RPB ;READ ONE WORD
JRST ERR55 ;BAD .EXE FILE IF EOF
AOS RPBPCT ;COUNT PROGRESS
POPJ P, ;RETURN
RPB: MOVE T1,ITYPEX ;READ A WORD FROM CORRECT READ ROUTINE
TRNN F,R.EOF ;SEE IF EOF
PUSHJ P,@RPBT(T1) ;NO--READ ONE WORD
TROA F,R.EOF ;EOF--SET FLAG
JRST CPOPJ1 ;OK--GIVE DATA RETURN
MOVEI W,0 ;IF EOF, RETURN 0
POPJ P, ;AND INDICATE EOF
RPBT: RPBNDT
RPBTEN
RPBSIX
RPBMAC
RPBFIF
RPBVEN
RPBNDT: SOSLE IHED+2 ;ANY MORE IN BUFFER?
JRST RPBNOK ;YES. GO GET ONE
IN INF, ;NO. READ A BLOCK
JRST RPBNOK ;ALL OK
STATZ INF,IO.ERR ;ANY ERRORS?
PUSHJ P,ERR16 ;YES, UNLESS ABC OR /G
STATZ INF,IO.EOF ;EOF?
POPJ P, ;YES. NON-SKIP RETURN
RPBNOK: ILDB W,IHED+1 ;GET A WORD
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P, ;RETURN
RPBTEN: TLNN F,L.SCRI ;READING FROM A SCRATCH FILE?
JRST RPBNDT ;NO. TREAT LIKE NON-DECTAPE
SOSLE IHED+2 ;GET ANOTHER WORD, IF ANY
JRST RPBT1 ;OK READ THE WORD
SKIPL IBLK ;NEED A BLOCK. STARTED YET?
JRST RPBT2 ;YES. MOVE ON
MOVE C,SRCHP ;NO. GET FIRST BLOCK THE HARD WAY
MOVEI T,1 ;FIRST BLOCK
MOVE B,[POINT 5,DIRECT]
RPBTL1: ILDB A,B ;GET A BYTE
CAIN A,(C) ;IN THIS FILE?
JRST RPBT3 ;YES.
CAIGE T,LASTOB ;TO EOT YET?
AOJA T,RPBTL1 ;NO. ONWARD
POPJ P, ;YES. ASSUME EOF, SINCE NO DATA BLKS
RPBT3: PUSHJ P,RPBSCR ;READ THE BLOCK FOR LINK WORD
JRST ERR17 ;ERROR ON SCRATCH FILE
LDB T,[POINT 10,TBUF,27] ;GET FIRST WORD BYTE
JRST RPBT4 ;GO READ IT
RPBT2: LDB T,[POINT 10,TBUF,17] ;LINK TO NEXT BLOCK
JUMPE T,CPOPJ ;IF NONE, EOF
RPBT4: MOVEM T,IBLK ;SAVE THIS BLOCK NUMBER
CAILE T,LASTOB ;CHECK FOR BAD BLOCK
JRST ERR18 ;BAD.
PUSHJ P,RBTRBF ;READ BLK(T) INTO RBUF
JRST ERR17 ;ERROR ON SCRATCH FILE
LDB T,[POINT 7,RBUF,35] ;GET COUNT OF WORDS IN BLOCK
MOVEM T,IHED+2 ;SAVE FOR RPB
JUMPE T,RPBT2 ;IF NO DATA WORDS, LOOP
MOVEI T,RBUF+0 ;SKIP LINK
MOVEM T,IHED+1 ;SAVE POINTER
RPBT1: AOS W,IHED+1 ;COUNT TO DESIRED WORD
MOVE W,(W) ;GET THE WORD
JRST CPOPJ1 ;AND SKIP RETURN
RPBSIX: SOSLE IHED+2 ;ANY LEFT IN TEMP BUFFER?
JRST RPBS1 ;YES. GO GET IT
SKIPL IBLK ;NEED A BLOCK. FIRST ONE?
JRST RPBS2 ;NO. ONWARD
MOVE C,SRCHP ;YES. DROP BACK TO DIRECTORY
HRRZ T,DIRECT+1(C) ;GET FIRST BLOCK NUMBER
JRST RPBS3 ;AND GO READ IT
RPBS2: TRNE F,R.6DI ;DUMP FILE?
JRST RPBS4 ;YES.
LDB T,[POINT 10,RBUF,17] ;NO. GET LINK
JRST RPBS3 ;READ THAT ONE
RPBS4: AOS T,IBLK ;ASSUME NEXT BLOCK IF DUMP FILE
RPBS3: JUMPE T,CPOPJ ;NO MORE IF ZERO LINK. EOF.
MOVEM T,IBLK ;STORE CURRENT BLOCK
CAILE T,LASTOB ;END OF TAPE?
JRST ERR18 ;LINK OFF END. QUIT
PUSHJ P,RBTRBF ;READ THE BLOCK
PUSHJ P,ERR16 ;ERROR. SEE IF /G IN EFFECT
LDB T,[POINT 7,RBUF,35] ;GET WORD COUNT
TRNN F,R.6DI ;DUMP FILE?
JRST RPBS7 ;NO. USE COUNT FROM LINK
MOVE T,IHED+0 ;GET THE COUNT LEFT
JUMPLE T,CPOPJ ;ANY LEFT?
CAILE T,200 ;OVER A BLOCK LEFT?
MOVEI T,200 ;200 WORDS THIS BLOCK
MOVNS T ;MAKE MINUS
ADDM T,IHED+0 ;DECREMENT REMAINING QTY
MOVNS T ;MAKE PLUS AGAIN
RPBS7: MOVEM T,IHED+2 ;STORE WORD COUNT
JUMPE T,RPBS2 ;IF NONE IN BLK, LOOP
MOVEI T,RBUF ;ADDRESS OF BUFFER AFTER LINK
TRNE F,R.6DI ;DUMP FILE?
SUBI T,1 ;YES. NO LINK. MORE DATA
MOVEM T,IHED+1 ;TO POINTER TO DATA
RPBS1: AOS W,IHED+1 ;COUNT POINTER
MOVE W,(W) ;GET DATUM
JRST CPOPJ1 ;AND SKIP RETURN
RPBMAC: SOSLE IHED+2 ;ANY LEFT IN TEMP BUFFER?
JRST RPBM1 ;YES. GO GET ONE.
RPBM0: MOVE C,SRCHPM ;NO. GET FILE NUMBER FOR BLOCK SEARCH
ASH C,-1 ; ..
SKIPL A,IBLK ;STARTED YET?
JRST RPBM2 ;YES. CONTINUE
TRZ F,R.ITD ;CLEAR INPUT TAPE DIRECTION FLAG
MOVEI A,1 ;SEARCH FOR BLOCK
MOVE B,[POINT 5,DIRECT+56]
RPBML1: ILDB T,B ;GET A BYTE
CAIN T,(C) ;IN THIS FILE?
JRST RPBM3 ;YES. GO READ IT
CAIGE A,1067 ;TO EOT?
AOJA A,RPBML1 ;LOOK AT ANOTHER
POPJ P, ;ASSUME EOF IF NO BLKS IN FILE AT ALL
RPBM2: MOVE B,IMACP ;CONTINUE SEARCH
TRNE F,R.ITD ;WHICH WAY?
JRST RPBM4N ;BACKWARDS
JRST RPBM2N ;FORWARDS
RPBM2L: CAILE A,1067 ;TO END YET?
JRST RPBMRV ;YES. REVERSE
ILDB T,B ;GET A BYTE
CAIE T,(C) ;IN THIS FILE?
RPBM2N: AOJA A,RPBM2L ;ON TO NEXT BYTE
JRST RPBM3 ;FOUND A BYTE IN THIS FILE.
RPBM4L: CAIGE A,1 ;STILL ON TAPE?
JRST RPBMFW ;NO. GO FORWARD NOW
ADD B,[XWD 050000,0] ;DECREMENT POINTER
SKIPGE B ;OFF TOP OF WORD?
SUB B,[XWD 430000,1] ;TO PREVIOUS WORD
LDB T,B ;GET THE BYTE
CAIE T,(C) ;BELONG TO THIS FILE?
RPBM4N: SOJA A,RPBM4L ;LOOP TO NEXT BYTE BACK
JRST RPBM3 ;FOUND A BLOCK
CONT.
RPBMFW:
RPBMRV: MOVEI A,2 ;SEARCH FOR EXTENSION FILE
RPBMRL: SKIPN DIRECT-2(A) ;NAME BLANK?
CAME C,DIRECT-1(A) ;THIS THE EXTENSION?
SKIPA ;NO
JRST RPBMR1 ;YES.
ADDI A,2 ;NO. TRY NEXT
CAIGE A,60 ;END OF DIR?
JRST RPBMRL ;NO. LOOP FOR NEXT SLOT
POPJ P, ;NO EXTENSION. EOF.
RPBMR1: MOVEM A,SRCHPM ;STORE SEARCH POINTER
MOVEI A,0 ;NOW LOOK FOR BLOCK FOR THIS FILE
MOVE B,[POINT 5,DIRECT+56]
TRCE F,R.ITD ;COMPLEMENT DIRECTION FLAG
JRST RPBMR2 ;NOW GOING FORWARD
MOVEI A,1070 ;NOW GOING REVERSE. SWITCH COUNTERS
MOVE B,[POINT 5,DIRECT+177,4]
RPBMR2: MOVEM A,IBLK ;STORE BLOCK NUMBER
MOVEM B,IMACP ;AND POINTER
JRST RPBM0 ;AND CONTINUE SEARCH
RPBM3: MOVEM A,IBLK ;SAVE FOR NEXT BLOCK
MOVEM B,IMACP ; ..
MOVEI T,200 ;WORDS IN A BLOCK
MOVEM T,IHED+2 ; ..
MOVEI T,RBUF-1 ;POINTER TO DATA
MOVEM T,IHED+1 ; ..
MOVEI T,(A) ;TO BLOCK NUMBER ARG AC
CAILE T,0 ;IS BLOCK NUMBER GOOD?
CAIL T,1070 ; ..
JRST ERR18 ;NO. LOST SOMEWHERE.
PUSHJ P,RBTRBF ;READ TO RBUF
PUSHJ P,ERR16 ;ERROR. SEE IF /G
RPBM1: AOS W,IHED+1 ;GET WORD ADDRESS
MOVE W,(W) ;AND WORD
JRST CPOPJ1 ;AND SKIP RETURN
RPBFIF: SOSLE IHED+2
JRST RPBF1 ;BUFFER HAS SOME
TRZ F,R.TMP ;CLEAR OBVERSE COMP FLAG
SKIPL IBLK ;READ ANY AT ALL YET?
JRST RPBF2 ;YES. GO GET LINK
MOVE C,SRCHP ;NO. GET FIRST BLK NUMBER FROM DIR
HRRZ T,DIRECT+1(C) ; ..
JRST RPBF3 ;USE IT
RPBF2: HRRZ T,RBUF+177 ;GET LINK TO NEXT BLOCK
CAMGE T,IBLK ;GOING FORWARD?
TRO F,R.TMP ;NO. FLAG NEED TO COMP DATA
JRST RPBF3
RPBF3: CAIN T,-1 ;EOF FLAG OF MINUS 1?
POPJ P, ;YES. QUIT
TRZ T,400000 ;ACTIVE FLAG FROM DIRECTORY IS JUNK
CAILE T,1077 ;LEGAL PDP15 TAPE BLOCK?
JRST ERR18 ;NO.
MOVEM T,IBLK ;SAVE IT
PUSHJ P,RBTRBF ;READ TO RBUF
PUSHJ P,ERR16 ;ERROR - SEE IF /G
TRNE F,R.TMP ;NEED TO SHUFFLE THE DATA?
PUSHJ P,OBVCMR ;YES. DO SO.
MOVEI T,200 ;WORD COUNT IS 128 MINUS HALF A WORD
MOVEM T,IHED+2 ;STORE IT
JUMPE T,RPBF2 ;IF ZERO, SKIP BLOCK
MOVEI T,RBUF-1 ;SET FOR PSEUDO ILDB
MOVEM T,IHED+1
RPBF1: AOS W,IHED+1 ;NEXT WORD
MOVE W,(W) ;DATA WORD
JRST CPOPJ1 ;EXIT HAPPY
;ROUTINE TO READ -11 DECTAPE WORD
RPBVEN: SOSLE IHED+2
JRST RPBV1
SKIPL IBLK ;STARTED YET?
JRST RPBV2 ;YES. FOLLOW LINK
MOVE T,VENFBN ;NO. REMEMBER FBN FROM LOOKUP
JRST RPBV3
RPBV2: SKIPN T1,VCONTG ;LAST BLOCK # OF A CONTIGUOUS FILE
JRST LKDFLE ;NO A LINKED FILE
AOS T,IBLK ;UPDATE THE NEXT BLOCK NUMBER
CAILE T,(T1) ;WAS THE LAST ONE READ
SETZB T,IBLK ;YES SHOW EOF
JRST RPBV3 ;SKIP THE LINKED FILE LOGIC
LKDFLE: HLRZ T,RBUF+0 ;LINK TO NEXT BLOCK
TRNE T,100000 ;NEGATIVE?
TRO T,600000 ;YES EXTEND SIGN
HRRES T ; ..
RPBV3: MOVEM T,IBLK ;STORE AWAY
JUMPE T,CPOPJ ;QUIT ON EOF
MOVM T,IBLK ;GET INPUT BLOCK NUMBER BACK
CAILE T,1077 ;MAX BLK IN BIT MAP
JRST ERR18 ;OUT OF BOUNDS
PUSHJ P,RBTRBF ;READ THE BLOCK FROM TAPE OR SCRATCH FILE
PUSHJ P,ERR16 ;ERROR. SEE IF /G
SKIPGE IBLK ;WHICH DIRECTION WAS READ?
PUSHJ P,OBCVR ;BACKWARDS. SWAP DATA AROUND
MOVMS IBLK ;MAKE SURE NOT NEGATIVE FOR NEXT RPB
MOVEI T,377 ;NUMBER OF 16 BIT WORDS TO READ
SKIPE VCONTG ;IF IT IS A CONTIGUOUS FILE
MOVEI T,400 ;THERE IS NO LINK SO ONE MORE
MOVEM T,IHED+2
MOVE T,[XWD 442200,RBUF] ;POINTER TO THEM
SKIPN VCONTG ;A CONTIGUOUS FILE STARTS ONE EARLIER
IBP T ;SO COMPENSATE IT
MOVEM T,IHED+1
RPBV1: ILDB W,IHED+1
JRST CPOPJ1 ;GOOD RETURN
RPAVEN: SKIPE RPAVC1 ;HAVE A BYTE LEFT?
JRST RPAVN1 ;YES
PUSHJ P,RPBVEN ;NO. READ A HALF WORD
POPJ P, ;EOF
MOVEM W,RPAVW1 ;STORE THE REMAINING HALF WORD
LDB CH,[POINT 8,W,35] ;GET THE FIRST (RIGHT) BYTE
SETOM RPAVC1 ;FLAG ONE LEFT
JRST CPOPJ1
CONT.
RPAVN1: LDB CH,[POINT 8,RPAVW1,27] ;SECOND (LEFT) BYTE
SETZM RPAVC1 ;NEED NEW WORD NEXT TIME
JRST CPOPJ1 ;GOOD RETURN.
OBCVEN: MOVSI N,-100
OBCVL1: MOVS T,TBUF(N)
MOVNI T1,(N)
EXCH T,TBUF+177(T1)
MOVSM T,TBUF(N)
AOBJN N,OBCVL1
POPJ P,
OBCVR: PUSHJ P,MOVRT
PUSHJ P,OBCVEN
JRST MOVTR
SUBTTL WRITE BINARY WORD ROUTINES
;ROUTINE TO SKIP OUTPUT UP TO A GIVE POINT IN C(T)
PPBPOS: PUSH P,T ;SAVE TARGET
MOVEI W,0 ;GET A CONSTANT 0
PPBP.1: MOVE T,(P) ;GET TARGET
CAMG T,OCA ;SEE IF THERE YET
JRST PPBP.2 ;YES--GO FINISH
PUSHJ P,PPBP ;NO--WRITE A 0
JRST PPBP.1 ;LOOP
PPBP.2: POP P,T ;RESTORE TARGET
CAME T,OCA ;SEE IF RIGHT ON
JRST ERR24 ;NO--ERROR
POPJ P, ;RETURN OK
;ROUTINE TO WRITE COUNTING PROGRESS IN OCA
PPBP: PUSHJ P,PPB ;WRITE WORD
HALT
AOS OCA ;COUNT PROGRESS
POPJ P, ;RETURN
PPB: MOVE T1,OTYPEX ;GET OUTPUT TYPE INDEX
JRST @PPBT(T1) ;DISPATCH
PPBT: PPBNDT ;NON DECTAPE
PPBTEN
PPBSIX
PPBMAC
PPBFIF
PPBVEN
PPBNDT: SOSLE OHED+2 ;ANY LEFT IN THIS BUFFER?
JRST PPBNOK ;YES
OUT OUTF, ;NO. SEND BUFFER
SKIPA
JRST ERR19 ;YES. QUIT
PPBNOK: IDPB W,OHED+1 ;PLACE WORD IN BFR
JRST CPOPJ1 ;OK RETURN
PPBTEN: TLNN F,L.SCRO ;SCRATCH OUTPUT FILE?
JRST PPBNDT ;NO. USE SYSTEM'S IO
SKIPLE OHED+2 ;HAS BUFFER ANY SPACE?
JRST PPBT1 ;YES. USE IT
SKIPLE OBLK ;NO. HAS I/O BEEN STARTED BEFORE?
JRST PPBTN1 ;YES. GO HANDLE END OF BLOCK
MOVE A,OFIRBK ;NO. GET FIRST BLOCK.
MOVE B,OFIRBP ;AND POINTER TO IT
MOVE C,OFILEX ;FILE INDEX
DPB C,B ;ALLOCATE THE FIRST BLOCK
TRZ F,R.OMF!R.OMD!R.OMT ;CLEAR ALLOCATION CUES
JRST PPBT3 ;DIVE INTO ALLOCATER AT BUFFER CLR
CONT.
PPBTL1: ILDB T,B ;GET A DIR BYTE
JUMPE T,PPBT4 ;JUMP IF ITS FREE
PPBT2: CAIGE A,LASTOB ;TO END OF TAPE?
AOJA A,PPBTL1 ;NO. LOOK FORWARD
JRST PPBTRV ;YES. REVERSE THE SEARCH
PPBT4: HRRZ T,OBLK ;GET THE OUTPUT BLOCK NUMBER LAST USED
SUB T,A ;DISTANCE TO THE FREE BLOCK
MOVMS T ;MAGNITUDE OF DISTANCE
TRZE F,R.OMT ;TURNAROUND IN PROGRESS?
JRST PPBT4A ;YES. FORGET INT FACTOR FOR NOW
TLNN F,L.6DO ;TIGHT FILE?
JRST PPBT4B ;NO
CAIL T,2 ;YES. CLOSE ENOUGH?
JRST PPBT4A ;YES. PUT IT THERE.
PPBT4B: CAIGE T,4 ;FOUR APART?
JRST PPBTN ;NO.
PPBT4A: DPB C,B ;YES. ALLOCATE THE BLK
HRLM A,WBUF ;PUT IT IN THE LINK WORD OF PREV BLK
MOVE T,OFIRBK ;GET THE FIRST BLOCK OF FILE
LSH T,10 ;PUT IN ITS BYTE OF LINK
TRO T,177 ;FULL BLOCK, 177 WORDS OF DATA
HRRM T,WBUF ;PUT IN LINK WD IN BUF
PUSHJ P,PPBBLK ;OUTPUT THE BLK TO TAPE OR SCRATCH FILE
PPBT3: MOVEM A,OBLK ;SAVE AS NEXT BLK TO WRITE
PUSHJ P,CLRWBF ;CLEAR WBUF FOR NEXT BLOCK
MOVEI T,177
MOVEM T,OHED+2 ;SET UP FOR NEXT BLOCK
MOVEI T,WBUF
MOVEM T,OHED+1 ;FIRST DATUM TO WBUF+1
PPBT1: SOS OHED+2 ;ONE LESS FREE DATUM
AOS T,OHED+1 ;WHERE TO PUT IT
MOVEM W,(T) ; DO SO
JRST CPOPJ1 ;SUCCESS RETURN
PPBTN: TRO F,R.OMF ;SKIPPED A BLK
PPBTN1: TRNN F,R.OMD ;WHICH WAY PASSING OVER DIR?
JRST PPBT2 ;FWD
JRST PPBT6 ;BACK
PPBTL2: ADD B,[XWD 050000,0] ;BACK A BYTE
SKIPGE B ;OFF START OF WORD?
SUB B,[XWD 430000,1] ;YES. BACK A WORD
LDB T,B ;GET THE BYTE
JUMPE T,PPBT4 ;JUMP IF BLK IS FREE
PPBT6: CAILE A,1 ;OFF FRONT OF TAPE?
SOJA A,PPBTL2 ;NO. TRY ANOTHER
PPBTRV: TRZN F,R.OMF ;WORTH TURNING AROUND?
JRST ERR20 ;NO. NONE AVAIL ON TAPE
TRC F,R.OMD ;YES. COMPLEMENT DIRECTION
TRO F,R.OMT ;FLAG TURN-AROUND CONDITION
JRST PPBTN1 ;AND GO PICK ANOTHER BLOCK
PPBSIX: SOSLE OHED+2 ;ROOM LEFT IN WBUF?
JRST PPBS1 ;YES.
SKIPLE OBLK ;NO. NEED A BLOCK. STARTED YET?
JRST PPBS2 ;YES. CONTINUE.
MOVE C,OFILEX ;NO. GET FIRST BLOCK, SET UP BEFORE
HRRZ A,ODIREC+1(C) ;FROM THE DIRECTORY SLOT
MOVEM A,OBLK ;STORE THAT
JRST PPBS3 ;AND GO START WRITING IT
PPBS2: HRRZ A,OHED+2 ;GET COUNT
MOVNS A
ADDI A,177 ;WORDS USED
TLNE F,L.6DO ;DUMP OUTPUT?
ADDI A,1 ;YES. ANOTHER WORD (NO LINK)
ADDM A,OFILEL ;ADD TO LENGTH FOR LATER UPDATE OF DIR
HLRZ B,ODIREC+0 ;LAST USED BLOCK
ADDI B,1 ;COUNT IT
HRLM B,ODIREC+0 ;NOW USED ANOTHER
HRLM B,A ;MAKE LINK WORD
TLNN F,L.6DO ;UNLESS DUMP FILE,
MOVEM A,WBUF ;PUT IN LINK WORD OF THIS BLOCK
PUSHJ P,PPBBLK ;OUTPUT BLK ON TAPE OR DSK SCRATCH
CAILE B,LASTOB ;STILL ON THE TAPE?
JRST ERR20 ;NO. EXCEEDED TAPE CAPACITY
MOVEM B,OBLK ;NEW OUTPUT BLOCK
PPBS3: MOVEI A,200 ;SIZE OF BLOCK
TLNN F,L.6DO ;UNLESS NOT DUMP,
MOVEI A,177 ;SIZE OF NON-DUMP BLOCK
MOVEM A,OHED+2 ;STORE FOR COUNTDOWN
MOVEI A,WBUF-1 ;OUTPUT POINTER WORD
TLNN F,L.6DO ;DUMP FILE?
MOVEI A,WBUF+0 ;LEAVE SPACE FOR LINK
MOVEM A,OHED+1 ;STORE AS POINTER
PUSHJ P,CLRWBF ;CLEAR WBUF FOR NEXT BLK
PPBS1: AOS T,OHED+1 ;COUNT OUTPUT POINTER
MOVEM W,(T) ;STORE DATUM
JRST CPOPJ1 ;AND RETURN
PPBMAC: SOSLE OHED+2 ;ROOM IN WBUF?
JRST PPBM1 ;YES.
SKIPLE OBLK ;NEED A BLOCK. STARTED?
JRST PPBM2 ;YES. CONTINUE.
MOVEI A,1 ;NO. SEARCH FOR A FREE BLOCK
MOVE B,[POINT 5,ODIREC+56]
TRZ F,R.OMD!R.OMF!R.OMT ;INITIALIZE OUTPUT FLAGS
MOVE C,OFILEX ;GET FILE INDEX
PPBML1: ILDB T,B ;GET A BLOCK BYTE
JUMPE T,PPBM3 ;IF FREE, GO CONSIDER IT
PPBM5: CAIGE A,1067 ;END OF TAPE?
AOJA A,PPBML1 ;NO. LOOK FURTHER
JRST PPBMRV ;NOW GO REVERSE IF ANY
PPBM3: HRRZ T,OBLK ;CHECK FOR SPACING
SUB T,A ;FROM PRV TO CURRENT BLK
MOVMS T ;MAGNITUDE OF DISTANCE
TRZE F,R.OMT ;TURNAROUND COND?
JRST PPBM3A ;YES. IGNORE SPACING COND
CAIGE T,4 ;FOUR BLOCKS?
JRST PPBMN ;NO. SKIP THIS ONE
PPBM3A: DPB C,B ;ALLOCATE THIS BLOCK
MOVEM A,OBLK ;STORE BLOCK NUMBER
MOVEM B,OMACP ;AND BYTE POINTER
MOVEI T,200 ;SIZE OF BLOCK
MOVEM T,OHED+2 ;FOR SOSLE
MOVEI T,WBUF-1 ;AND DATA ADDRESS
MOVEM T,OHED+1 ; ..
PUSHJ P,CLRWBF ;CLEAR THE BUFFER
PPBM1: AOS T,OHED+1 ;WRITE THE WORD VIA POINTER
MOVEM W,(T) ; INTO BUFFER
JRST CPOPJ1 ;AND SKIP RETURN
PPBM2: PUSHJ P,PPBBLK ;OUTPUT BLK ON TAPE OR DSK SCRATCH
MOVE C,OFILEX ;GET THE CURRENT FILE NUMBER
MOVE A,OBLK ;GET OUTPUT BLOCK
SKIPA B,OMACP ;AND BYTE POINTER TO DIRECTORY
PPBMN: TRO F,R.OMF ;SKIPPING A BLOCK. REMEMBER THAT
PPBMN1: TRNN F,R.OMD ;WHICH WAY WE GOING?
JRST PPBM5 ;FORWARD. GET NEXT FREE BLOCK
JRST PPBM6 ;BACKWARD. GET NEXT FREE BLK
CONT.
PPBML2: ADD B,[XWD 050000,0] ;BACK UP A BYTE
SKIPGE B ;OUT OF WORD?
SUB B,[XWD 430000,1] ;YES RIGHT 35 BITS, BACK A WORD
LDB T,B ;GET THIS BYTE
JUMPE T,PPBM3 ;IF FREE, CONSIDER IT
PPBM6: CAILE A,1 ;NOT FREE. AT FRONT?
SOJA A,PPBML2 ;NO. LOOK ON.
JRST PPBMFW ;YES. TURN AROUND AGAIN
PPBMRV:
PPBMFW: TRZN F,R.OMF ;DID WE PASS ANY BLOCKS?
JRST ERR20 ;NO. TAPE FULL
MOVEI C,2 ;YES. LOOK FOR A FILE FOR EXT.
PPBMRL: SKIPN ODIREC-2(C) ;THIS ONE FREE?
SKIPE ODIREC-1(C) ; ..
SKIPA ;NO.
JRST PPBMR1 ;YES. GO USE IT.
CAIL C,60 ;LOOKED AT ALL?
JRST ERR20 ;YES. GIVE UP.
ADDI C,2 ;NO. ONWARD
JRST PPBMRL ; ..
PPBMR1: MOVE T,C ;COPY OF FILE INDEX
ASH C,-1 ;CONVERT TO FILE NUMBER
EXCH C,OFILEX ;SAVE OUTPUT FILE INDEX, GET OLD ONE
MOVEM C,ODIREC-1(T) ;MARK EXTENSION IN NEW SLOT
TRC F,R.OMD ;TURN AROUND
MOVE C,OFILEX ;GET NEW FILE INDEX
TRO F,R.OMT ;REMEMBER TURNAROUND COND
JRST PPBMN1 ;AND ON TO NEXT BLOCK
PPBFIF: SKIPLE OHED+2 ;ROOM IN CURRENT BUFFER?
JRST PPBF1 ;YES - USE IT
SKIPL OBLK ;NEED A BLK. FIRST TIME IN?
JRST PPBF2 ;NO.
MOVEI A,1 ;YES. SEARCH FOR A BLK
MOVE B,[POINT 1,ODIREC,0]
ILDB T,B ;GET A BIT
JUMPE T,PPBF3 ;IS IT FREE?
CAIGE A,1077 ;NO. TO END OF TAPE?
AOJA A,.-3 ;LOOP
JRST ERR20 ;TAPE FULL.
PPBF3: MOVE C,OFILEX ;GET FILE INDEX
DPB A,[POINT 10,ODIREC+21(C),35]
MOVEI T,1 ;ALLOCATE IN MASTER DIR
DPB T,B
MOVE T1,B ;AND IN OWN BIT MAP
ADDI T1,FBMBUF-ODIREC ;MOVE TO OTHER BLOCK
ADD T1,FBMX ;AND TO SUBGROUP IN BLK
DPB T,T1 ;ALLOCATE IN FILE'S MAP
TRZ F,R.OMD!R.OMF!R.OMT ;INITIALIZE ALLOCATOR FLAGS
PPBF4: MOVEM A,OBLK ;STORE FOR OUTPUTTER
MOVEM B,OMACP ;AND SAVE POINTER TO BYTE
PUSHJ P,CLRWBF ;CLEAR THE WRITE BUFFER
MOVEI T,177 ;NUMBER OF PDP10 WORDS IN BUFFER
MOVEM T,OHED+2 ;STORE FOR SOSLE
MOVEI T,WBUF-1 ;PLACE WHERE WORDS GO
MOVEM T,OHED+1
PPBF1: SOS OHED+2 ;USE A COUNT
AOS T,OHED+1 ;COUNT WORD POSITION
MOVEM W,(T) ;STORE WORD IN WBUF
JRST CPOPJ1 ;OK RETURN.
PPBF2: MOVE A,OBLK ;WHERE WAS LAST OUTPUT
SKIPA B,OMACP ;AND ITS POINTER
PPBFN: TRO F,R.OMF ;MARK SKIPPING A BLK
PPBFN1: TRNN F,R.OMD ;WHICH WAY SCANNING BYTES?
JRST PPBF2A ;FORWARD
JRST PPBF6A ;BACKWARD
CONT.
PPBFL1: ILDB T,B ;GET A MASTER DIRECTORY BIT
JUMPE T,PPBF4A ;JUMP IF FREE
PPBF2A: CAIGE A,1076 ;LOOKED AT ALL LEGAL BLKS?
AOJA A,PPBFL1 ;NO. LOOK ON
JRST PPBFRV ;YES. REVERSE THE SCAN
PPBF4A: HRRZ T,OBLK ;GET PREVIOUS WRITTEN BLK
SUB T,A ;DISTANCE
MOVMS T
TRZE F,R.OMT ;AT THE TURNAROUND?
JRST PPBF4C ;YES. FORGET THE SPACING THIS TIME
CAIGE T,5 ;SPACE FIVE APART
JRST PPBFN ;TOO CLOSE TOGETHER
PPBF4C: MOVEI T,1 ;OK. ALLOCATE IT
DPB T,B ;IN MASTER BYTE TABLE
MOVE T1,B ;AND IN ITS OWN BYTE TABLE
ADDI T1,FBMBUF-ODIREC
ADD T1,FBMX
DPB T,T1
HRRM A,WBUF+177 ;LINK TO NEXT BLK
SKIPN OBVFLG ;NEED TO OBVERSE COMP THIS BLK?
JRST PPBF4B ;NO.
MOVE T,[XWD WBUF,TBUF] ;YES. COPY IT
BLT T,TBUF+177
PUSHJ P,OBVCOM
MOVE T,[XWD TBUF,WBUF]
BLT T,WBUF+177
PPBF4B: SETZM OBVFLG
CAMG A,OBLK
SETOM OBVFLG ;GOING BACKWARDS NEXT BLK.
PUSHJ P,PPBBLK ;FINALLY OUTPUT THE OLD BLK
JRST PPBF4 ;NOW CLEAR AND PUT W IN
PPBFL2: ADD B,[XWD 010000,0]
HLRZ T,B
CAIN T,440100
SUB B,[XWD 440000,1]
LDB T,B ;GET BYTE FROM ODIREC
JUMPE T,PPBF4A ;JUMP IF FREE
PPBF6A: CAILE A,0 ;TO FRONT OF TAPE?
SOJA A,PPBFL2 ;NO. LOOK ONWARD
PPBFRV: TRZN F,R.OMF ;TAPE ENTIRELY FULL?
JRST ERR20 ;YES. LOSE
TRC F,R.OMD ;CHANGE DIRECTION
TRO F,R.OMT ;SUPPRESS SPACING FACTOR ON TURNAROUND
JRST PPBFN1 ;AND LOOK ONWARD
PPBVEN: SKIPLE OHED+2 ;ANY SPACE IN BLK?
JRST PPBV1 ;YES
SKIPL OBLK ;NO. STARTED OUTPUT FILE YET?
JRST PPBV2 ;YES. GET ANOTHER BLK
SETZM EVSLEN ;CLEAR THE LENGTH IN BLKS OF THIS FILE
SETZM EVSLAS ;AND FIRST AND LAST BLKS, IN CASE NONE
SETZM EVSFBN ; ..
MOVEI A,1 ;NO. START AT BLK 1
PUSHJ P,PVFREQ ;IS BLK FREE?
JRST PPBV3 ;YES.
CAIGE A,1100 ;NO. TO EOT?
AOJA A,.-3 ;NO, LOOK ON
JRST ERR20 ;YES. TAPE FULL.
PPBV3: MOVEM A,EVSFBN ;STORE FIRST BLK NUMBER FOR DIRECTORY
PUSHJ P,PVALOC ;ALLOCATE AND LEAVE TRACKS
TRZ F,R.OMF!R.OMD!R.OMT ;INIT FLAGS FOR ALLOCATOR
SETZM OBVFLG ; ..
PPBV4: MOVEM A,OBLK ;STORE THIS BLK NUMBER AS OUTPUT BLK
PUSHJ P,CLRWBF ;CLEAR THE WRITE BUFFER
MOVEI T,1 ;SET UP BYTE POINTER TO SECOND VEN WORD
MOVEM T,OHED+1 ; ..
MOVEI T,776 ;NUMBER OF BYTES WHICH BLK WILL HOLD
MOVEM T,OHED+2 ;AFTER USING UP LINK.
PPBV1: SOS OHED+2 ;COUNT USING A BYTE
AOS T,OHED+1 ;AND GET ITS INDEX
IDIVI T,4 ;CONVERT TO STORE IT
DPB CH,PPAVT1(T1) ;STORE BYTE
JRST CPOPJ1 ;OK RETURN
PPAVT1: POINT 8,WBUF(T),17
POINT 8,WBUF(T),09
POINT 8,WBUF(T),35
POINT 8,WBUF(T),27
PVFREQ: PUSH P,A ;SAVE BLOCK NUMBER
IDIVI A,40 ;BITS IN TWO VEN WORDS
MOVEI T,1 ;CONVERT TO BIT POSITION
LSH T,(B) ; ..
TDNE T,[XWD 037777,600000]
LSH T,2 ;IN LEFT HALF
MOVSS T ;BUT WORDS IN OTHER ORDER
MOVE T1,A ;COPY FOR ALLOCATOR
TDNE T,VBMAPO+2(T1) ;FREE?
AOS -1(P) ;NO. SKIP RETURN
POP P,A
POPJ P,
PVALOC: IORM T,VBMAPO+2(T1) ;ALLOCATE IN MASTER MAP
IORM T,FBMBUF(T1) ;AND INDIVIDUAL MAP
MOVEM A,EVSLAS ;LAST BLOCK (SO FAR)
AOS EVSLEN ;COUNT ANOTHER IN LENGTH
POPJ P, ;RETURN
CONT.
PPBV2: MOVE A,OBLK
PPBVN: TRO F,R.OMF
PPBVN1: TRNN F,R.OMD
JRST PPBV2A
JRST PPBV6A
PPBVL1: PUSHJ P,PVFREQ ;FREE?
JRST PPBV4A ;YES. SEE IF FAR ENOUGH AWAY
PPBV2A: CAIGE A,1077 ;EOT?
AOJA A,PPBVL1 ;NO
JRST PPBVRV ;YES. REVERSE DIRECTION
PPBV4A: HRRZ T,OBLK ;GET LAST WRITTEN BLK
SUB T,A ;DISTANCE
MOVMS T ;MAGNITUDE OF IT
TRZE F,R.OMT ;TURN-AROUND IN PROCESS?
JRST PPBV4D ;YES. IGNORE SPACING
CAIGE T,6 ;FAR ENOUGH? 6 TO SPEED UP PROCESSING
JRST PPBVN ;NO
PPBV4D: PUSHJ P,PVFREQ ;YES. RECOMPUTE T AND T1
SKIPA
JRST ERR38 ;THIS CANT BE BUSY - IT WAS JUST FREE
PUSHJ P,PVALOC ;ALLOCATE THE BLOCK
HRLM A,WBUF+0 ;PUT LINK IN DATA BLK
CAML A,OBLK ;WILL NEXT BLK BE WRITTEN BACKWARDS?
JRST PPBV4C ;NO
MOVN T,A ;YES. NEGATE THE BLK NUMBER AS FLAG
ANDI T,177777 ;ONLY 16 BITS
HRLM T,WBUF+0 ;STORE NEGATIVE
PPBV4C: SKIPN OBVFLG ;WRITING BACKWARDS IN THIS CURRENT BLK?
JRST PPBV4B ;NO
MOVE T,[XWD WBUF,TBUF] ;YES. MUST OBV COM CURRENT DATA
BLT T,TBUF+177 ;COPY FOR OBVCOM RTN
PUSHJ P,OBCVEN
MOVE T,[XWD TBUF,WBUF]
BLT T,WBUF+177
PPBV4B: SETZM OBVFLG ;NOW SET UP FLAG FOR NEXT TIME
CAMG A,OBLK ;WHICH WAY?
SETOM OBVFLG ;BACKWARDS
PUSHJ P,PPBBLK ;WRITE THE DATA
JRST PPBV4 ;SET UP WBUF FOR NEXT BLK IF ANY
PPBVL2: PUSHJ P,PVFREQ ;FREE?
JRST PPBV4A ;YES
PPBV6A: CAILE A,1 ;TO FRONT OF TAPE?
SOJA A,PPBVL2 ;NO
PPBVRV: TRZN F,R.OMF ;REVERSE. PASS ANY FREE ONES?
JRST ERR20 ;NO. ITS FULL
TRC F,R.OMD ;YES. CHANGE DIRECTION FLAG
TRO F,R.OMT ;FLAG IN TURN-AROUND
JRST PPBVN1 ;ON TO NEXT BLK
SUBTTL BLOCK INPUT/OUTPUT ROUTINES
OBVCMR: PUSHJ P,MOVRT
PUSHJ P,OBVCOM
JRST MOVTR
OBVCOM: MOVSI N,-100 ;COUNTER FOR BUFFER LENGTH/2
OBVCL1: MOVE T,TBUF(N) ;GET A DATA WORD
MOVNI T1,(N) ;COUNTER BACK FROM END OF BUFFER
EXCH T,TBUF+177(T1) ;SWAP TWO WORDS
MOVEM T,TBUF(N) ; ..
AOBJN N,OBVCL1 ;LOOP THRU WHOLE BUFFE
SETZM RADIX ;BORROW THIS TEMP TO COUNT TO 200
OBVCL2: MOVE T,RADIX ;INDEX
SETCM T2,TBUF(T) ;GET A WORD, COMPLEMENT IT
MOVEI N,14 ;TWELVE 3BIT BYTES
ROTC T1,-3 ;SHUFFLE THEM
LSHC T,3 ; ..
SOJG N,.-2
MOVE T2,RADIX ;WHERE IT GOES
MOVEM T,TBUF(T2) ;STORE IT BACK
AOS T,RADIX ;COUNT THRU BUFFER
CAIGE T,200 ;DONE YET?
JRST OBVCL2 ;NO. LOOP
POPJ P, ;YES. QUIT
READBT: TLNE F,L.SCRI ;READING FROM SCRATCH FILE?
JRST RPBSCR ;YES. GO TO DISK ROUTINE
JUMPE T,READBZ ;SPECIAL HANDLING FOR BLK ZERO
USETI INF,(T) ;NORMAL BLOCK. SET IT UP
IN INF,TIOL ;TO TBUF
JRST CPOPJ1 ;NO ERROR. SKIP RETURN
POPJ P, ;ERROR RETURN
READBZ: SETSTS INF,IO.NSD!IO.SYN!IO.UWC!.IOBIN ;FOLLOWING MESS READS BLOCK ZERO
MOVEI T,TBUF ;PLACE FOR IT AND RING HDR
EXCH T,.JBFF
INBUF INF,1 ;GET BUFFER
MOVEM T,.JBFF ;RESTORE .JBFF
USETI INF,0 ;SET FOR BLK 0
IN INF, ;READ THE BLOCK
JRST READBX ;OK
SETSTS INF,IO.NSD!.IODMP ;BACK TO REGULAR KLUDGE IO MODE
POPJ P, ;YES. NON-SKIP RETURN
READBX: SETSTS INF,IO.NSD!.IODMP ;BACK TO REGULAR KLUDGE IO MODE
HRLZ T,IHED2+1 ;GET START OF DATA
HRRI T,TBUF ;MOVE IT DOWN WHERE IT BELONGS
BLT T,TBUF+177 ; ..
JRST CPOPJ1 ;SKIP RETURN - SUCCESSFUL
;OUTPUT WBUF TO BLOCK IN OBLK, ON DSK SCRATCH OR DTA AS APPROPRIATE
PPBBLK: TLNE F,L.SCRO ;OUTPUTTING TO TAPE OR DSK?
JRST PPBSCR ;DISK
SKIPN OBLK ;TAPE. IS IT BLK 0?
JRST PPBB0 ;YES.
USETO OUTF,@OBLK ;SET FOR BLK
OUT OUTF,WIOL ;PUT OUT WBUF
SKIPA
JRST ERR19 ;YES
POPJ P, ;NO
PPBB0: PUSHJ P,WBK0 ;GET THE TAPE, WRITE BK 0
JRST ERR19 ;TAPE ERROR
POPJ P,
PPBSCR: MOVE T,OBLK ;GET OUTPUT BLK
USETO SCOF,1(T) ;RIGHT BLK ON DSK
OUT SCOF,WIOL ;SEND THE DATA
SKIPA
JRST ERR3 ;YES.
POPJ P, ;NO. RETURN
CLRWBF: MOVE T,[XWD WBUF,WBUF+1]
SETZM WBUF ;CLEAR BUFFER FOR NEXT BLK
BLT T,WBUF+177 ; ..
POPJ P,
ROBTOD: MOVEM T,ODIBKN ;SAVE BLK NUMBER IN ODIREC
PUSHJ P,ROUTBT ;READ TO TBUF
SOS (P) ;ERROR
MOVE T,[XWD TBUF,ODIREC]
BLT T,ODIREC+177 ;COPY TO ODIREC BUFFER
JRST CPOPJ1 ;OK RETURN
RBTDIR: PUSHJ P,READBT ;READ BLOCK IN T INTO TBUF
SOS (P) ;SET FOR ERROR RETURN
MOVE T,[XWD TBUF,DIRECT] ;OK. COPY IT TO DIRECTORY BLOCK
BLT T,DIRECT+177 ; ..
JRST CPOPJ1 ;SUCCESS RETURN
RBTRBF: PUSHJ P,READBT ;READ THE BLOCK INTO TBUF
SOS (P) ;SET FOR ERROR RETURN
MOVE T,[XWD TBUF,RBUF] ;COPY INTO READ BUFFER
BLT T,RBUF+177 ; ..
JRST CPOPJ1 ;RETURN
MOVRT: MOVE T,[XWD RBUF,TBUF]
BLT T,TBUF+177
POPJ P,
MOVTR: MOVE T,[XWD TBUF,RBUF]
BLT T,RBUF+177
POPJ P,
WBK0: PUSH P,A ;SAVE WORK AC'S
PUSH P,B ; ..
PUSH P,C ; ..
MOVEI A,IO.NSD!IO.SYN!IO.UWC!.IOBIN ;NOW WRITE ON THE TAPE. KLUDGE FOR BK 0
MOVE B,ODEV
MOVSI C,OHED2 ;HEADER FOR BK 0 WRITER
OPEN OUTF,A
JRST ERR14
POP P,C ;RESTORE THEM
POP P,B ; ..
POP P,A ; ..
PUSH P,.JBFF ;GET A BUFFER FOR BLK 0
MOVEI T,TBUF ;IN TBUF
MOVEM T,.JBFF
OUTBUF OUTF,1 ;ONE BUFFER
POP P,.JBFF ;RESTORE
USETO OUTF,0 ;WRITE BLK 0
OUTPUT OUTF, ;GET USE BITS RIGHT
SOS OHED2+1 ;MODIFY LINK WD
MOVE T,WIOL ;COPY WBUF TO TBUF
MOVE T1,1(T) ;GET A WORD
IDPB T1,OHED2+1 ;COPY IT TO TBUF
AOBJN T,.-2 ;COPY 128 WDS
SETZM OHED2+2 ;WROTE ALL WDS
OUT OUTF, ;WRITE IT ON TAPE
SKIPA
POPJ P, ;YES. LOSE
SETSTS OUTF,IO.NSD!.IODMP ;OK. RETURN TO DUMP MODE
JRST CPOPJ1 ;GOOD RETURN
ROUTBT: TLNE F,L.SCRO ;SCRATCH OUTPUT FILE OPEN?
JRST ROBT1 ;YES
USETI OUTF,(T) ;NO. READ FROM TAPE, BLK IN T
IN OUTF,TIOL ;READ THE BLOCK TO TBUF
JRST CPOPJ1 ;OK
POPJ P,
ROBT1: USETI SCOF,1(T) ;SELECT BLOCK VIA T
IN SCOF,TIOL ;READ TO TBUF
JRST CPOPJ1
POPJ P, ; ..
;ROUTINE TO GET A BLK FROM SCRATCH FILE
RPBSCR: SKIPLE T1,SCRBK1 ;STARTED COR BFR YET?
JRST RPBSCC ;YES
HRRZ T2,.JBREL ;NO. COMPUTE BLOCKS TO FIT
SUB T2,SJFF4 ; ..
ASH T2,-7 ; ..
MOVEI T2,-1(T2) ; ..
MOVEM T2,BLKS ;SAVE
RPBSCC: CAIGE T,-1(T1) ;DESIRED BLOCK BEFORE CURRENT?
JRST RPBSCA ;YES. MUST READ
ADD T1,BLKS ;CHECK IF IN CORE
CAIGE T,-1(T1) ;OFF THE TOP?
JRST RPBSCB ;ITS IN CORE. GO GET IT
RPBSCA: MOVE T1,BLKS ;COMPUTE WHERE TO START DSK
ASH T1,-2 ;STATISTICALLY FORWARD MOSTLY
MOVNS T1
ADDI T1,1(T) ;REQ-SIZ/4
SKIPG T1 ;UNLESS TOO LOW
MOVEI T1,1 ;START AT BEGINNING
MOVEM T1,SCRBK1 ;HERE'S BASE OF COR IMAGE
USETI SCRF,(T1) ;SET DSK TO IT
ADD T1,BLKS ;HOW MUCH TO READ
MOVE T2,LASTBK ;CHECK TO MAKE SURE STILL ON TAPE
CAILE T1,1(T2) ;OFFSET BY ONE FOR BLK ZERO BEING BLK 1 OF DSK
MOVEI T1,1(T2) ;TOO MANY. JUST READ THRU LASTBK OF TAPE
ADDI T1,1 ;NUMBER OF BLOCKS
SUB T1,SCRBK1 ; ..
MOVNS T1 ;- BLOCKS
ASH T1,31 ;(-WDS)
HRR T1,SJFF4 ;FREE CORE
MOVEM T1,CORIOW ;IO LIST
IN SCRF,CORIOW ;READ IT
SKIPA
POPJ P, ;ERROR. FAIL RETURN
RPBSCB: MOVEI T1,1(T) ;SEE WHERE DESIRED BLK IS IN CORE
SUB T1,SCRBK1 ;DISTANCE IN BLKS
ASH T1,7 ; IN WORDS
ADD T1,CORIOW ;ADDRESS
ADDI T1,1 ;FOR THE IOWD OFFSET
MOVSS T1 ;FOR BLT
HRRI T1,TBUF ;DESTINATION
BLT T1,TBUF+177 ;END OF BUFFER
JRST CPOPJ1 ;SUCCESS RETURN
OPOUTF: TLNE F,L.SCRO ;SEE IF SCRATCH OUTPUT
POPJ P, ;YES--ALREADY OPEN
MOVEI A,IO.NSD!.IODMP ;NO--SET SPECIAL MODE
MOVE B,ODEV ;GET OUTPUT DEVICE
MOVEI C,0 ;NO BUFFERS
OPEN OUTF,A ;OPEN DEVICE
JRST ERR14 ;ERROR IF NOT AVAILABLE
POPJ P, ;OK--RETURN
INOUTD: TLNE F,L.SCRO ;SEE IF SCRATCH OUTPUT
JRST [USETI SCOF,1(T) ;YES--POSITION TO BLOCK
IN SCOF,ODIIOW ;INPUT BLOCK
POPJ P, ;RETURN IF OK
JRST ERR32] ;ERROR IS FATAL IS SCRATCH
USETI OUTF,(T) ;POSITION TO BLOCK ON TAPE
IN OUTF,ODIIOW ;INPUT BLOCK
POPJ P, ;OK IF OK
JUMPGE T,ERR10 ;UNLESS "ERROR IS OK", GIVE ERROR
SETSTS OUTF,IO.NSD!.IODMP ;OK--JUST CLEAR ERROR STATUS
POPJ P, ;RETURN
SUBTTL FILE SPEC SCANNER INPUT ROUTINE
FILSPC: SETZM $FILE
SETZM $EXT
SETZM $TID
MOVE T,$PSW
MOVEM T,$TSW ;COPY PERM SW'S
MOVPPN $PPPN,$TPPN
MOVE T,$PPRT
MOVEM T,$TPRT
TRZ F,R.DOT!R.SW!R.EXT!R.UPA
FILSL: PUSHJ P,SIXBRD ;READ A WORD
CAIN CH,":" ;BREAK CHAR
JRST FILS1
TRNN F,R.ALL
JRST FILS2
TRZE F,R.UPA ;TAPE ID?
MOVEM W,$TID
TRZN F,R.DOT
JRST FILSRE
MOVEM W,$EXT
TRO F,R.EXT ;EXPLICIT EXTENSION
FILSRE: CAIE CH,"_" ;BREAKS?
CAIG CH,40 ; ..
JRST FILSX
CAIE CH,","
CAIN CH,"="
JRST FILSX
CAIN CH,"["
JRST FILSU
CAIN CH,"<"
JRST FILSP
CAIN CH,"."
JRST FILSD
CAIN CH,"^" ;UPARROW?
JRST FILSUA
CAIN CH,"/"
JRST FILSW
CAIN CH,"("
JRST FILSS
JRST ERR63 ;MUST BE JUNKY CHARACTER
CONT.
FILS1: SKIPE $DEV ;IF DEVICE ALREADY,
JRST [MOVEM W,$SDEV ; SET AS PSEUDO DEVICE
JRST .+2] ; AND CONTINUE
MOVEM W,$DEV ;SAVE DEVICE
SETZM $PPPN ;CLEAR PROJ-PROG
SETZM $TPPN
SETZM $PPRT ;CLEAR PROTECTION
SETZM $TPRT
JRST FILSL
FILS2: SKIPE W ;ANY NAME?
MOVEM W,$FILE ;YES
JRST FILSRE
FILSX: MOVEM CH,$BRKC
SKIPN $SDEV ;SEE IF PSEUDO DEVICE
JRST CPOPJ1 ;NO--GIVE OK RETURN
MOVE T,$DEV ;YES--GET REAL DEVICE
DEVCHR T, ;SEE IF
TXNN T,DV.DTA ; IT IS A DTA
JRST ERR52 ;ERROR IF NOT
MOVE T,$TSW ;GET SWITCHES
TRNN T,SW$SCR ;SEE IF FAST MODE
JRST ERR52 ;NO--ERROR
JRST CPOPJ1
CONT.
FILSU: PUSHJ P,OCTIN
FILSU1: HLRZ N,MYPPN ;NULL--GET USER'S PROJECT
FILSU2: CAIE CH,","
JRST FILSYN ;SYNTAX ERROR
HRLM N,$TPPN
PUSHJ P,OCTIN
HRRZ N,MYPPN ;NULL--GET USER'S PROGRAMMER NO.
HRRM N,$TPPN
CAIE CH,"," ;SEE IF SFD COMING
JRST FILSU8 ;NO--GO VERIFY END OF DIRECTORY
MOVE T,$TPPN ;YES--GET UFD
MOVEM T,$TPPN+1+.PTPPN ; AND PLACE IT IN PATH
SETZM $TPPN+1 ;CLEAR START OF
SETZM $TPPN+2 ; PATH AREA
MOVEI T,$TPPN+1 ;POINT TO PATH AREA
MOVEM T,$TPPN ;FROM DIRECTORY
MOVE T,[-LN$SFD,,$TPPN+1+.PTPPN+1]
FILSU5: PUSHJ P,SIXBRD ;GET SIXBIT WORD
JUMPE W,FILSYN ;ERROR IF NULL
CAIN W,['* '] ;ERROR IF
JRST FILSYN ; WILD
MOVEM W,(T) ;STORE PATH
SETZM 1(T) ;CLEAR NEXT WORD
CAIN CH,"," ;IF MORE PATH
AOBJN T,FILSU5 ; LOOP IF STILL ROOM
FILSU8: CAIN CH,.CHLFD ;END OF LINE OK
JRST FILSU9 ; ..
CAIE CH,"]" ;CLOSE BRACKET
CAIN CH,">" ; OR THIS TOO
SKIPA ;OK
JRST FILSYN ;ELSE, ERROR
FILSU9: SKIPE $FILE
JRST FILSUX
MOVPPN $TPPN,$PPPN
JRST FILSUX
CONT.
FILSP: PUSHJ P,OCTIN
JRST FILSU1 ;NULL--MUST BE DIRECTORY
CAIE CH,">"
CAIN CH,.CHLFD ;EOL IS OK
SKIPA ;OK
JRST FILSU2 ;MUST BE DIRECTORY OR ERROR
HRROM N,$TPRT
SKIPN $FILE
HRROM N,$PPRT
FILSUX: CAIN CH,.CHLFD
JRST FILSX
JRST FILSL
FILSUA: TROA F,R.UPA
FILSD: TRO F,R.DOT
JRST FILSL
FILSS: TRO F,R.SW ;PARENS
FILSW: PUSHJ P,TYI
CAIL CH,"A"
CAILE CH,"Z" ;ONLY LETTERS ARE SWITCHES
JRST FILSWQ
SKIPN A,SWTAB-"A"(CH)
JRST BADSW
TLNN A,-1 ;SEE IF GLOBAL
JRST [SETOM (A) ;YES--SET IT
JRST FILSWL] ;AND LOOP ON
HRRZ A,SWTAB-"A"(CH) ;GET SWS TO CLR
ANDCAM A,$TSW ; ..
SKIPN $FILE ;PERM?
ANDCAM A,$PSW ;YES
HLRZ A,SWTAB-"A"(CH) ;GET SET SWS
IORM A,$TSW
SKIPN $FILE
IORM A,$PSW
FILSWL: TRNE F,R.SW ;PARENS?
JRST FILSS ;YES
JRST FILSL ;NO
FILSWQ: TRZE F,R.SW
CAIE CH,")"
JRST BADSW
JRST FILSL
SIXBRD: MOVE A,[POINT 6,W]
MOVEI W,0
SIXBRL: PUSHJ P,TYI
CAIN CH,"*"
JRST SIXLTR
CAIL CH,"A"
CAILE CH,"Z"
SKIPA
JRST SIXLTR
CAIL CH,"0"
CAILE CH,"9"
POPJ P,
SIXLTR: SUBI CH,40
TLNE A,770000
IDPB CH,A
JRST SIXBRL
OCTIN: MOVEI N,0
PUSHJ P,TYI ;LOOK AT FIRST CHAR
CAIL CH,"0" ;IF
CAILE CH,"7" ; OCTAL,
POPJ P, ;NO--NON-SKIP SINCE NULL FIELD
SKIPA ;YES--OK
OCTINL: PUSHJ P,TYI
CAIL CH,"0"
CAILE CH,"7"
JRST CPOPJ1
ASH N,3
ADDI N,-"0"(CH)
JRST OCTINL
SUBTTL TYPE OUT ROUTINES
SIXDOT: PUSHJ P,SIXOUT ;OUTPUT SIXBIT
DOT: MOVEI CH,"." ;AND A DOT
JRST TYO
SIXTAB: PUSHJ P,SIXOUT
TAB: MOVEI CH,.CHTAB
TYO: OUTCHR CH
POPJ P,
MINUS: MOVEI CH,"-"
JRST TYO
COLON: MOVEI CH,":" ;TYPE A COLON
JRST TYO
COMMA: MOVEI CH,","
JRST TYO
SPACE: MOVEI CH," "
JRST TYO
SIXCR: PUSHJ P,SIXOUT
CRLF: MOVEI W,[ASCIZ /
/]
MSG: HRLI W,(POINT 7,)
MSG.1: ILDB CH,W
JUMPE CH,CPOPJ
PUSHJ P,TYO
JRST MSG.1
R5VOUT: PUSHJ P,R5VSIX ;CONVERT R50 TO SIXBIT IN RH OF T
SIXOU3: HRLZS T ;POSITION TO LH
SIXOUT: MOVE T1,T ;COPY TO SCRATCH
SIXO.1: JUMPE T1,CPOPJ ;EXIT IF DONE
MOVEI T,0 ;CLEAR ACCUMULATOR
LSHC T,6 ;GET NEXT CHARACTER
MOVEI CH,40(T) ;CONVERT TO ASCII
PUSHJ P,TYO ;OUTPUT IT
JRST SIXO.1 ;LOOP
DATOUT: JUMPLE A,NODATE
PUSH P,C
IDIVI A,^D31
MOVEI T,1(B)
PUSHJ P,DECPR2
IDIVI A,^D12
MOVE T,MONTAB(B)
MOVEI T1,0
MOVEI W,T
PUSHJ P,MSG
MOVEI T,^D64(A)
CAIL T,^D100 ;TWO DIGITS ONLY FOR DATE
SUBI T,^D100
PUSHJ P,DECPR2
POP P,C
POPJ P,
OCTP4S: CAIGE T,1000
PUSHJ P,SPACE
CAIGE T,100
PUSHJ P,SPACE
CAIGE T,10
PUSHJ P,SPACE
JRST OCTPRT
;RADIX FIFTY CONVERTER FOR PDP-11 TAPE DIRECTORIES
;NOTE THAT FOR SOME REASON THE CODING OF THIS RADIX 50 IS NOT THE
;SAME AS THAT FOR THE PDP10 (SIGH)
R5VSIX: SETZM W ;CLEAR ANSWER CELL
MOVE T2,[POINT 6,W,17] ;POINTER TO OUTPUT
ANDI T,177777 ;MAKE SURE REASONABLE SIZE
IDIVI T,3100 ;GET FIRST CHAR
PUSH P,T1 ;SAVE OTHER 2
PUSHJ P,R5VOU1 ;OUTPUT FIRST
POP P,T ;RESTORE 2 AND 3
IDIVI T,50 ;SPLIT APART
PUSH P,T1 ;SAVE LAST CHAR
PUSHJ P,R5VOU1 ;OUTPUT SECOND
POP P,T ;RESTORE THIRD
PUSHJ P,R5VOU1 ;LAST CHARACTER CONVERSION
MOVE T,W ;ANSWER TO RIGHT AC
POPJ P,
R5VOU1: IDIVI T,6 ;USUAL CODE CONVERSION BYTE POINTER HACK
LDB CH,R5VOU2(T1) ;GET CHAR IN SIXBIT
IDPB CH,T2 ;PUT IN W
POPJ P, ;AND RETURN IT
R5VOU2: POINT 6,R5VTAB(T),5
POINT 6,R5VTAB(T),11
POINT 6,R5VTAB(T),17
POINT 6,R5VTAB(T),23
POINT 6,R5VTAB(T),29
POINT 6,R5VTAB(T),35
R5VTAB: SIXBIT \ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789?\
;AND THE REVERSE CONVERSION. CALL WITH 3 SIXBIT CHARS IN RH OF T,
; RETURN WITH RADIX 50 (11 STYLE) IN T (AND W) , ALL BAD CHARS CODED
; AS 35'S, THE UNDEFINED CHAR, WHICH FILEX TREATS AS "%".
SIXR5V: MOVEI W,0 ;CLEAR ANSWER
MOVE N,[POINT 6,T,17] ;POINT TO INPUT
SXR5VL: ILDB T1,N ;GET A CHAR
IDIVI T1,6 ;CODE CONVERT
LDB CH,SXR5V2(T2) ;GET THE R50 BYTE
IMULI W,50 ;LEFT SHIFT PREV BYTES
ADDI W,(CH) ;ADD IN THIS ONE
TLNE N,770000 ;DONE?
JRST SXR5VL ;NO
MOVE T,W ;YES. ANSWER TO AC T
POPJ P, ;AND RETURN
SXR5V2: POINT 6,SXR5V3(T1),05
POINT 6,SXR5V3(T1),11
POINT 6,SXR5V3(T1),17
POINT 6,SXR5V3(T1),23
POINT 6,SXR5V3(T1),29
POINT 6,SXR5V3(T1),35
SXR5V3: BYTE (6) 0,35,35,35,33,35,35,35,35,35,35,35
BYTE (6) 35,35,34,35,36,37,40,41,42,43,44,45
BYTE (6) 46,47,35,35,35,35,35,35,35,01,02,03
BYTE (6) 04,05,06,07,10,11,12,13,14,15,16,17
BYTE (6) 20,21,22,23,24,25,26,27,30,31,32,35,35,35,35,35,35,35
DECP4S: CAIGE T,^D1000
PUSHJ P,SPACE
DECP3S: CAIGE T,^D100
PUSHJ P,SPACE
DECP2S: CAIGE T,^D10
PUSHJ P,SPACE
JRST DECPRT
PROOUT: PUSH P,T
MOVEI CH,74
PUSHJ P,TYO
POP P,T
PUSHJ P,OCTPR3
MOVEI CH,76
JRST TYO
OCTPR3: CAIGE T,100
PUSHJ P,ZEROUT
OCTPR2: CAIGE T,10
PUSHJ P,ZEROUT
JRST OCTPRT
SPACE2: PUSHJ P,SPACE
JRST SPACE
CRLF2: PUSHJ P,CRLF
JRST CRLF
DATTV: IDIVI T,^D31*^D12 ;CONVERT DATES FROM TEN TO ELEVEN
IDIVI T1,^D31
MOVE N,T
SUBI T,6 ;1970-1964
MOVEI CH,0
IMULI T,^D1000 ;1000 TIMES YEARS SINCE 70
DATTV2: JUMPE T1,DATTV3 ;IF TO RIGHT MONTH, JUMP
ADD T,MONTB2(CH) ;ADD IN A MONTH OF DAYS
CAIN CH,1 ;FEBRUARY
TRNE N,3 ;AND LEAP YR
SKIPA ;NO
ADDI T,1 ;YES.
SUBI T1,1 ;COUNT DOWN A MONTH
AOJA CH,DATTV2 ;COUNT TABLE INDEX, LOOP
DATTV3: ADDI T,1(T2) ;ADD IN DAY OF MONTH
TDNE T,[^-77777]
MOVEI T,0 ;IF OVERFLOW
POPJ P, ;RETURN
DATVT: JUMPE T,CPOPJ
IDIVI T,^D1000
MOVEI N,2(T)
IMULI T,^D372 ;DAYS IN A PDP10 YEAR
ADDI T,^D2232 ;1 JAN 70
MOVEI CH,0 ;MONTH TABLE INDEX
DATVT2: MOVE T2,MONTB2(CH)
CAIN CH,1 ;FEB?
TRNE N,3 ;LEAP YR?
SKIPA ;NO
ADDI T2,1 ;YES. IT'S 29 DAYS LONG
CAMG T1,T2 ;IN THIS MONTH?
JRST DATVT1 ;YES
SUB T1,T2 ;NO
ADDI T,^D31
AOJA CH,DATVT2 ;LOOP, COUNT MONTH INDEX
DATVT1: ADDI T,-1(T1) ;ADD IN DAY OF MONTH
POPJ P, ;RETURN
OUTLST: MOVE T,ODEV ;OUTPUT DEVICE
PUSHJ P,SIXOUT
PUSHJ P,COLON
MOVE T,TOFILE
PUSHJ P,SIXDOT
HLRZ T,TOEXT
JRST SIXOU3
CONTQ: TRNN F,R.GO
POPJ P,
MOVEI W,[ASCIZ \ (continuing - /G) \]
TRON F,R.GOS
PUSHJ P,MSG
PUSHJ P,CRLF
JRST CPOPJ1
VENDAT: JUMPG T,VDATE1 ;BLANK?
NODATE: MOVEI W,[ASCIZ /(undated)/]
JRST MSG
VDATE1: PUSH P,T ;SAVE DATE
IDIVI T,^D1000 ;GET DAY OF YEAR
ADDI T,2 ;BECAUSE 1970 WASNT A LEAP YEAR
MOVEI N,0 ;COMPUTE REAL DATE
VDATE3: MOVE T2,MONTB2(N) ;GET TABLE ENTRY
CAIN N,1 ;FEBRUARY?
TRNE T,3 ;AND LEAP YEAR?
SKIPA ;NO
ADDI T2,1 ;YES. THE MONTH IS LONGER
CAMG T1,T2 ;IN THIS MONTH?
JRST VDATE2 ;YES
SUB T1,T2 ;MOVE TO NEXT MONTH
ADDI N,1 ;NEXT MONTH
CAIGE N,14 ;PAST DECEMBER?
JRST VDATE3 ;NO. TRY IT.
POP P,T ;YES. BAD DATE.
MOVEI W,[ASCIZ /bad date/]
JRST MSG
VDATE2: PUSH P,N
MOVE T,T1
PUSHJ P,DECPR2
POP P,T
MOVE T,MONTAB(T)
MOVEI T1,0
MOVEI W,T
PUSHJ P,MSG
POP P,T
IDIVI T,^D1000
ADDI T,^D70
VDATE5: CAIG T,^D99
JRST VDATE4
SUBI T,^D100
JRST VDATE5
VDATE4: PUSHJ P,DECPR2
POPJ P,
MONTB2: DEC 31,28,31,30,31,30,31,31,30,31,30,31
MONTAB: ASCII /-Jan--Feb--Mar--Apr--May--Jun-/
ASCII /-Jul--Aug--Sep--Oct--Nov--Dec-/
OCTPRT: MOVEI CH,10
JRST RDXPRT
DECPR2: CAIG T,11
PUSHJ P,ZEROUT
DECPRT: MOVEI CH,12
RDXPRT: MOVEM CH,RADIX
SKIPGE T ;IF NEGATIVE,
PUSHJ P,MINUS ; TELL USER
RDXP.1: IDIV T,RADIX
MOVMS T1
HRLM T1,(P)
SKIPE T
PUSHJ P,RDXP.1
HLRZ CH,(P)
ADDI CH,"0"
JRST TYO
ZEROUT: MOVEI CH,"0"
JRST TYO
TYI: INCHWL CH ;GET A CHARACTER
JUMPE CH,TYI ;DISCARD NULLS
CAIE CH,.CHDEL ;DELETE?
CAIN CH,.CHCRT ;CARRIAGE RETURN?
JRST TYI ;YES. SKIP IT
CAIE CH," " ;SPACE?
CAIN CH,.CHTAB ;OR TAB?
JRST TYI ;YES. SKIP THEM.
CAIL CH,140 ;LOWER CASE?
TRZ CH,40 ;YES. MAKE UPPER CASE.
CAIE CH,.CHVTB ;VERTICAL TAB
CAIN CH,.CHFFD ; AND FORM FEED
MOVEI CH,.CHLFD ;ARE SAME AS NEW LINE
CAIE CH,.CHCNC ;CONTROL C?
CAIN CH,.CHCNZ ;CONTROL Z?
JRST [RESET ;YES--CLEAR IO
MONRT. ;EXIT TO MONITOR
JRST FILEX] ;IF CONTINUE, START OVER
CAIE CH,";"
CAIN CH,"!"
JRST TYI.1
POPJ P, ;AND RETURN CHARACTER
TYI.1: PUSHJ P,TYI ;DISCARD COMMENTS
CAILE CH,37
JRST TYI.1
POPJ P,
TRMSIX: MOVSI T1,770000
MOVSI T2,400000
TRMSXL: TDNE T,T1
XOR T,T2
LSH T1,-6
LSH T2,-6
JUMPN T1,TRMSXL
POPJ P,
SUBTTL ERROR ROUTINES
ERR1: PUSH P,B
EMSG$ <? Can't access input device >
POP P,T
PUSHJ P,SIXOUT
JRST FILEX
ERR2: EMSG$ <? Error reading tape directory>
JRST FILEX
ERR3: MSG$ <% Can't access DSK for scratch file
>
JRST TYPDIQ
ERR4: EMSG$ <? Can't ENTER scratch file on disk
>
JRST FILEX
ERR5: EMSG$ <? Bad free count on PDP6 directory>
JRST FILEX
ERR6: MSG$ <% I/O error reading tape - continuing
>
JRST TYPDIQ
ERR7: MSG$ <% I/O error writing scratch file - continuing
>
JRST TYPDIQ
ERR8=ERR3
ERR9: EMSG$ <? Can't OPEN output device>
JRST FILEX
ERR10: EMSG$ <? Error on output device >
GETSTS OUTF,T
PUSHJ P,OCTPRT
JRST FILEX
ERR11: EMSG$ <? Command error - no * on output with multiple input>
JRST FILEX
ERR12: EMSG$ <? Can't access DSK for directory>
JRST FILEX
ERR13: EMSG$ <? I/O error reading disk directory>
JRST FILEX
ERR14=ERR9
ERR15: EMSG$ <? Can't ENTER file >
MOVE T,A
PUSHJ P,SIXDOT
MOVE T,B
PUSHJ P,SIXCR
JRST FILEX
ERR16: TRNE F,R.ABC ;ALWAYS BAD CKSM?
JRST ERR16C ;YES. CONSIDER WHAT BIT
ERR16B: TROE F,R.GOS ;ERROR. FIRST?
JRST ERR16E ;NO
TRNN F,R.GO ;/G?
JRST ERR16D ;NO. GIVE FATAL MESSAGE
MSG$ <% I/O error reading input file - continuing (/G)
>
ERR16E: GETSTS INF,T
TRZ T,IO.ERR
SETSTS INF,(T)
POPJ P, ;YES
ERR16C: STATZ INF,IO.ERR-IO.IMP ;ERRORS BESIDES CKSM?
JRST ERR16B ;YES. GIVE MESSAGE
POPJ P, ;NO. IGNORE ERROR.
ERR16D: EMSG$ <? I/O error reading input file
>
JRST FILEX
ERR17: EMSG$ <? Error reading disk scratch file
>
POPJ P,
ERR18: EMSG$ <? Bad link block number on tape
>
POPJ P,
ERR19: EMSG$ <? Error on output device>
JRST FILEX
ERR20: EMSG$ <? Output tape full
>
JRST CLS
ERR21=ERR10
ERR22: MOVE A,ODEV ;SEE IF SOMETHING
IOR A,$DEV
IOR A,$FILE
IOR A,$EXT
IOR A,$TPPN
IOR A,$TPRT
IOR A,$TSW
SKIPN A
CAIL T,40 ;NO. END OF LINE?
SKIPA ;BAD
JRST FILEX ;BLANK LINE. IGNORE IT
EMSG$ <? Command error - no = after output file>
JRST FILEX
ERR23: EMSG$ <? No such file as >
MOVE T,IFILE
PUSHJ P,SIXDOT
MOVE T,IEXT
PUSHJ P,SIXCR
JRST EPROCS
ERR24: EMSG$ <? Non-monotonic input data
>
JRST CLS
ERR25: MSG$ <protection RENAME failed
>
POPJ P,
ERR26: EMSG$ <? Can't access input device>
JRST FILEX
ERR27: EMSG$ <? Tape directory full>
JRST FILEX
ERR28: PUSH P,XBUF+3 ;SAVE ERROR CODE
SKIPA
ERR29: PUSH P,B ;SAVE ERROR CODE
HRRZ T,(P) ;GET ERROR CODE
TLNE F,L.FRCL ;IF FORCING,
JUMPE T,SELFF ; AND NOT FOUND, THEN INDICATE NO FILE
EMSG$ <? LOOKUP failure (>
POP P,T
HRRZS T
PUSHJ P,OCTPR2
MSG$ <) file >
MOVE T,A
PUSHJ P,SIXDOT
MOVE T,B
PUSHJ P,SIXCR
JRST EPROCS ;TRY TO CONTINUE IF MULT FILES
ERR30: MSG$ <% Protection ignored on input file
>
POPJ P,
ERR31: MSG$ <% Tape ID ignored on input file
>
POPJ P,
ERR32: EMSG$ <? Error reading output scratch file
>
JRST FILEX
ERR33: EMSG$ <? Error writing scratch file for output tape
>
JRST FILEX
ERR34: EMSG$ <? Can't read output scratch file
>
JRST FILEX
ERR35: EMSG$ <? I/O error on output scratch file
>
JRST FILEX
ERR36: EMSG$ <? Can't process directly between 16 & 18 bit machine tapes.
>
JRST FILEX
ERR37: EMSG$ <? Illegal value for PDP11 UIC
>
JRST FILEX
ERR38: EMSG$ <? Consistency check in PDP11 tape directory
>
JRST FILEX
ERR39: MSG$ <% Error reading block 0 - continuing
>
POPJ P,
ERR40: EMSG$ <? Error on output directory
>
JRST EPROCS
ERR41: EMSG$ <? DECtape switch on non-DECtape input device
>
JRST FILEX
ERR42: EMSG$ <? DECtape switch on non-DECtape output device
>
JRST FILEX
ERR43: MSG$ <% Zero switch on input device ignored
>
POPJ P,
ERR44: EMSG$ <? Output device not a binary device>
JRST FILEX
ERR45: EMSG$ <? Input device not a binary device>
JRST FILEX
ERR46: EMSG$ <? ENTER failure >
HRRZ T,B
PUSHJ P,OCTPRT
MSG$ < on output >
PUSHJ P,OUTLST
PUSHJ P,CONTQ ;/G?
JRST FILEX
JRST EPROCS ;YES
ERR47: EMSG$ <? Device >
MOVE T,ODEV
ERR47A: PUSHJ P,SIXOUT
MSG$ < does not exist>
JRST FILEX
ERR48: EMSG$ <? Device >
MOVE T,IDEV
JRST ERR47A
ERR49: MSG$ <% Converting PDP-10 line-sequence numbers to regular text
>
JRST FORPA
ERR50: EMSG$ <? Can't list disk directory
>
JRST FILEX
ERR51: MSG$ <% No existing output scratch file, /Z assumed
>
POPJ P,
ERR52: EMSG$ <? Can't specify pseudo tape unless /P /Q or /R for a DECtape
>
JRST FILEX
ERR53: EMSG$ <? Can't convert between high and compressed files
>
JRST FILEX
ERR54: EMSG$ <? Non-zero location below 400K writing high file
>
JRST FILEX
ERR55: EMSG$ <? Incorrectly formatted .EXE file
>
JRST FILEX
ERR56: EMSG$ <? Can't create .EXE file unless to or from disk
>
JRST FILEX
ERR57: EMSG$ <? Too many descriptors for .EXE file
>
JRST FILEX
ERR58: EMSG$ <? No high segment
>
JRST FILEX
ERR59: EMSG$ <? Converting .EXE to .HGH requires disk or DECtape output
>
JRST FILEX
ERR60: EMSG$ <? Converting .HGH to .EXE requires disk or DECtape input
a>
JRST FILEX
ERR61: EMSG$ <? .LOW file missing
>
JRST FILEX
ERR62: EMSG$ <? Input scratch tape does not exist
>
JRST FILEX
ERR63: EMSG$ <? Command error--illegal separator
>
JRST FILEX
;ERR64 PRINT THAT EXTENSION IN T DIFFERS FROM EXTENSION IN OEXT
ERR64: PUSH P,T ;SAVE THE EXTENSION
PUSH P,T1 ;EXTENSION TYPED
MSG$ <% EXTENSION >
PUSHJ P,SIXOUT ;PRINT T IN 6 BIT
MSG$ < WAS CHOSEN FOR EXE CONVERSION >
POP P,T ;TYPED ONE
PUSHJ P,SIXOUT
MSG$ < WAS SPECIFIED>
PUSHJ P,CRLF ;A NEW LINE
POP P,T ;GET EXTENSION BACK
POPJ P,
ERR65: EMSG$ <? NO CORE AVAILABLE TO CREATE COMPRESSED FILE
>
JRST FILEX ;RESTART
ERR66: MSG$ <% IOWD WAS TRUNCATED IN A COMPRESSED FILE
>
POPJ P,
;ERR67 SHOULD ONLY BE SEEN BY FILEX MAINTAINERS
ERR67: EMSG$ <? STORAGE FOR A COMPRESSED FILE HAS TO BE CONTIGUOUS
>
JRST FILEX
CKSERR: MSG$ <MAC file checksum error - continuing
>
POPJ P,
FILSYN: EMSG$ <? Eh?
>
POPJ P,
BADSW: PUSHJ P,TYO
MSG$ < is a bad switch
?>
POPJ P,
SUBTTL STORAGE
XLIST ;LITERALS
LIT
LIST
RELOC 0
LCOR:!
SWHELP: BLOCK 1
SWLIST: BLOCK 1
SWONLZ: BLOCK 1
IDEV: BLOCK 1
IPDEV: BLOCK 1
IPPN: BLOCK 1+LN$PPN
IFILE: BLOCK 1
TIFILE: BLOCK 1
IEXT: BLOCK 1
TIEXT: BLOCK 1
SCRNAM: BLOCK 1
LASTBK: BLOCK 1
SJFF: BLOCK 1 ;.JBFF FOR DISK DIRECTORY FOR WILDCARD LOOKUP
SJFF2: BLOCK 1 ;.JBFF FOR INPUT BUFFER BASE
SJFF3: BLOCK 1 ;.JBFF AS SEEN FOR OUTPUT BUFFER BASE
SJFF4: BLOCK 1 ;.JBFF AS SEEN BY RPBSCR RTN
BLKS: BLOCK 1
ODEV: BLOCK 1
OPDEV: BLOCK 1
OFILE: BLOCK 1
TOFILE: BLOCK 1
OEXT: BLOCK 1
FOEXT: BLOCK 1
TOEXT: BLOCK 1
OPPN: BLOCK 1+LN$PPN
OPRT: BLOCK 1
IDATE: BLOCK 1
ODATE: BLOCK 1
LENFIL: BLOCK 1
IBLK: BLOCK 1
OBLK: BLOCK 1
OSW: BLOCK 1
ISW: BLOCK 1
OFILEX: BLOCK 1
CNVSME: BLOCK 1 ;-1 IF SAVE INPUT DEVICE=OUT DEVICE
CNVWEO: BLOCK 1 ;-1 IF OUT EXT IS WILD ON A SAVE CONVERSION
EXEFLG: BLOCK 1 ;FLAG FOR EXE FILES
;STORAGE FOR MAKING COMPRESSED FILES
SAVCNT: BLOCK 1 ;# OF FREE LOCS IN COMPRESSED STORAGE
SAVLPG: BLOCK 1 ;FIRST ADDRESS AFTER COMPRESSED STORAGE
SAVFPG: BLOCK 1 ;FIRST ADDRESS AFTER DEFAULT COMPRESSED STORAGE
SAVMAX: BLOCK 1 ;1 ST NOT AVAIL. ADDR. + 1000 FOR COMPRESSED STORAGE
SAVPTR: BLOCK 1 ;POINTER TO STORE DATA INDIRECTLY IN COMPRESSED STORAGE
GETPTR: BLOCK 1 ;POINTER TO GET DATA FROM COMPRESSED STORAGE
OCA: BLOCK 1
ICA: BLOCK 1
RCA: BLOCK 1
RPC: BLOCK 1
RPOC: BLOCK 1
RPOP: BLOCK 1
RWC: BLOCK 1
RW: BLOCK 10
RTYP: BLOCK 1
RCKS: BLOCK 1
RPBPCT: BLOCK 1
PDSCNT: BLOCK 1
PDSPTR: BLOCK 1
PDS: BLOCK 2*LN$PDS
$DEV: BLOCK 1
$SDEV: BLOCK 1
$FILE: BLOCK 1
$EXT: BLOCK 1
$PPPN: BLOCK 1+LN$PPN
$TPPN: BLOCK 1+LN$PPN
$PPRT: BLOCK 1
$TPRT: BLOCK 1
$PSW: BLOCK 1
$TSW: BLOCK 1
$BRKC: BLOCK 1
OFIRBK: BLOCK 1
OFIRBP: BLOCK 1
OFIL1V: BLOCK 1 ;NAME1 OF VEN OUT FILE IN R50VEN
OFIL2V: BLOCK 1 ;SECOND HALF NAME
OEXTV: BLOCK 1 ;AND EXT
RADIX: BLOCK 1
SJBCOR: BLOCK 1 ;PLACE TO SAVE JOBCOR FOR EXE FILES
OTYPEX: BLOCK 1
ITYPEX: BLOCK 1
SRCHP: BLOCK 1
EXTPTR: BLOCK 1
SOEXT: BLOCK 1 ;SAVE OUT EXTENSION ON /C CONVERT
SRCHPM: BLOCK 1
OFILEL: BLOCK 1
IMACP: BLOCK 1
OMACP: BLOCK 1
$TID: BLOCK 1
OTID: BLOCK 1
SCRBK1: BLOCK 1
EOJFLG: BLOCK 1
FTEMP: BLOCK 1
FCOUNT: BLOCK 1
MFDPPN: BLOCK 1 ;PPN TO FIND UFD'S
MYPPN: BLOCK 1 ;PPN FOR ME ON DSK
FBMX: BLOCK 1
FBMBLK: BLOCK 1 ;BLOCK NUMBER FOR BIT MAP FOR CURRENT OUTPUT FILE
PBMBKI: BLOCK 1 ;BLK NUMBER FOR MASTER BIT MAP ON VEN TAPE
PBMBKO: BLOCK 1 ;SAME FOR OUTPUT VEN TAPE
TBBLK: BLOCK 1 ;BLOCK WHICH IS CURRENTLY IN TBUF
OBVFLG: BLOCK 1 ;FLAG NEED OBVCOM OF PREV BLK
IOPSOC: BLOCK 1
IOPSOP: BLOCK 1
FOTXP1: BLOCK 1
FOTXW1: BLOCK 1
IOPSOB: BLOCK 200
VBMAPO=IOPSOB ;ELEVEN OUTPUT MASTER BIT MAP IN SAME SPACE
FITXP1: BLOCK 1
FITXP2: BLOCK 1
FITXW1: BLOCK 1
FITXW2: BLOCK 1
XFILFQ: BLOCK 1
SAVSTA: BLOCK 1 ;START ADDR WHEN MAKING A SAV FILE
DIRBKN: BLOCK 1 ;BLK NUMBER CURRENTLY IN DIRECT BUFFER
ODIBKN: BLOCK 1 ;BLK NUMBER CURRENTLY IN ODIREC BUFFER
VENPPI: BLOCK 1 ;PPN (UIC) OF INPUT VEN TAPE
VOUIC: BLOCK 1 ;VEN OUTPUT USER ID CODE
VWPEI: BLOCK 1 ;VEN WORDS PER ENTRY IN UFD ON INPUT TAPE
VWPEO: BLOCK 1 ;VEN WDS PER UFD ENTRY OUTPUT TAPE
VIFFIL: BLOCK 1 ;INPUT FILE NAME FOR CURRENT VEN DIRECT SLOT IN SIXBIT
VIFEXT: BLOCK 1 ;INPUT FILE EXT IN SIXBIT ...
VDIRB1: BLOCK 1 ;FIRST REAL DATA BLK OF VEN DIR
VDIRB2: BLOCK 1 ;SECOND .. ..
VODIB1: BLOCK 1 ;FIRST REAL DATA BLK OF OUTPUT VEN DIR
VODIB2: BLOCK 1 ;SECOND ...
VENFBN: BLOCK 1 ;FIRST BLOCK NUMBER (AFTER A LOOKUP)
VIPRT: BLOCK 1 ;OLD PROTECTION OF A PDP-11 FILE
VCONTG: BLOCK 1 ;LAST BLOCK NUMBER OF A 11 CONTIGUOUS FILE
FIFFLG: BLOCK 1 ;FLAG SET TO INDICATE THAT THE LAST CHARACTER
;OF A PDP-15 ASCI FILE WAS SEEN(CR)
RPAVC1: BLOCK 1 ;FLAG FOR WHICH BYTE OF WORD
RPAVW1: BLOCK 1 ;WORD HELD BETWEEN TWO RPA'S
LSNFLG: BLOCK 1 ;LINE-SEQUENCE-NUMBER-SEEN FLAG
DIRIOW: BLOCK 1 ;IOWD 200,DIRECT
BLOCK 1
DIRECT: BLOCK 200
ODIIOW: BLOCK 1 ;IOWD 200,ODIREC
BLOCK 1
ODIREC: BLOCK 200
WIOL: BLOCK 1 ;IOWD 200,WBUF
BLOCK 1
WBUF: BLOCK 200
RBUF: BLOCK 200
IHED2: BLOCK 3
OHED2: BLOCK 3
TIOL: BLOCK 1 ;IOWD 200,TBUF
BLOCK 1
;DO NOT SEPARATE - NEEDED FOR BLOCK ZERO READER
TXIOL: BLOCK 1 ;IOWD 400,TBUF
BLOCK 1
TBUF: BLOCK 200
XBUF: BLOCK 200
;END DO NOT SEPARATE
FBMBUF: BLOCK 200
EVSPOS=FBMBUF+37 ;POSITION IN THE DIRECTORY BLOCK OF THIS SLOT
EVSLOT=FBMBUF+40 ;SLOT FOR OUTPUT VEN ENTRY
EVSN1=EVSLOT+0 ;NAME FIRST THREE CHARS
EVSN2=EVSLOT+1 ;SECOND THREE
EVSEXT=EVSLOT+2 ;EXTENSION
EVSDAT=EVSLOT+3 ;DATE
EVSFBN=EVSLOT+5 ;FIRST BLOCK IN FILE
EVSLEN=EVSLOT+6 ;NUMBER OF BLOCKS
EVSLAS=EVSLOT+7 ;LAST BLOCK
EVSPRT=EVSLOT+10 ;PROTECTION CODE
CORIOW: BLOCK 1
BLOCK 1
ENTBLK: BLOCK .RBEST+1
IHED: BLOCK 3
OHED: BLOCK 3
UHED: BLOCK 3
PDL: BLOCK LN$PDL+1
ELCOR==.-1
END FILEX ;END OF FILEX