Trailing-Edge
-
PDP-10 Archives
-
decuslib10-03
-
43,50316/bakwds.mac
There are no other files named bakwds.mac in the archive.
TITLE BAKWDS V.1 ;FROM PIP V.033A(123)
SUBTTL VJC/PMH/AK-DAG/DMN 18-OCT-72
;PERIPHERAL INTERCHANGE PROGRAM
;"COPYRIGHT 1968,1969,1970,1971,1972, DIGITAL EQUIPMENT CORP.,MAYNARD,MASS.,U.S.A.
REPEAT 0,<
VPIP==33 ;VERSION NUMBER
VUPDATE==1 ;DEC UPDATE LEVEL
VEDIT==123 ;EDIT NUMBER
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
>
VPIP==0 ;BAKWDS VERSION
VUPDATE==0 ;BAKWDS VERSION
VEDIT==1 ;BAKWDS VERSION
VCUSTOM==0 ;BAKWDS VERSION
LOC 124
PIP1 ;SET REENTER ADDRESS
RELOC
LOC 137
<VCUSTOM>B2+<VPIP>B11+<VUPDATE>B17+VEDIT
RELOC
;RIMSW==0 /Y SWITCH OPTION UNAVAILABLE.
;RIMSW==1 /Y SWITCH OPTION AVAILABLE.
;CCLSW==0 PIP WILL NOT PROCESS CCL COMMANDS.
;CCLSW==1 PIP WILL EXECUTE CCL COMMANDS FROM DISK.
;TEMP==1 PIP WILL GET CCL COMMANDS FROM CORE (TMPCOR UUO)
;REENT==1 PIP IS REENTRANT (AK-DAG)
;FTDSK==0 NON-DSK SYSTEM
;FTDSK==1 DSK SYSTEM
;FORSW==1 FOROTS/FORSE BINARY DATA FILE CONVERSION ON /K
;NOTE THIS "FEATURE" WILL VANISH FOREVER ON 1-1-74
;CONDITIONAL ASSEMBLY SWITCH SETUP (DEC CONFIGURATION)
;---------------------------------
IFNDEF FTDSK, <FTDSK==1>
IFE FTDSK, <CCLSW==0>
IFNDEF CCLSW, <CCLSW==1>
IFE CCLSW, <TEMP==0>
IFNDEF TEMP, <TEMP==1>
IFNDEF REENT, <REENT==1>
IFNDEF RIMSW, <RIMSW==0>
IFNDEF FORSW, <FORSW==1>
IFN REENT,< TWOSEGMENTS
RELOC 400000>
MLON
SALL
EXTERN .JBFF,.JBSA,.JBREL
;FLAG ASSIGNMENTS (RIGHT HALF)
LINE==1 ;ASCII LINE MODE PROCESSING
BMOD==2 ;BINARY PROCESSING
TBMOD==4 ;SUPPRESS TRAILING SP, CHANGE MULTIPLE SP TO TABS
DFLG==10 ;DELETE FILES MODE
LFLG==20 ;LIST DIRECTORY
NSMOD==40 ;IGNORE INPUT SEQUENCE NUMBERS
RFLG==100 ;RENAME FILE MODE
SQMOD==200 ;GENERATE SEQUENCE NUMBERS
STS==400 ;END OF LINE SEEN, OUTPUT SEQUENCE NUMBER NEXT
SPMOD==1000 ;SUPPRESS TRAILING SPACES
XFLG==2000 ;COPY DECTAPE MODE
ZFLG==4000 ;CLEAR DECTAPE DIRECTORY
SUS==10000 ;SEQUENCE NUMBER GENERATION IN PROGRESS
SPOK==20000 ;SPACE WAS LAST CHARACTER
ESQ==40000 ;STOP OUTPUTTING SEQ NUM, RESUME OUTPUTTING DATA
SNI==100000 ;DO NOT INCREMENT SEQUENCE NUMBER
MTFLG==200000 ;MTA REQUEST RECEIVED
OSFLG==400000 ;GENERATE SEQ. NOS. INCR. BY ONE
;FLAG ASSIGNMENTS (LEFT HALF)
OFLG==1 ;BLOCK 0 COPY
RIMFLG==2 ;RIM FORMAT INPUT /OUT TO DTA. ILLEG IF RIMSW==0
PFLG==4 ;FORTRAN PROGRAM OUTPUT FORMAT CONVERSION
PCONV==10 ;COLUMN 1 CONVERSION IN PROGRESS
KFLG==20 ;FOROTS/FORSE CONVERSION REQUIRED
CHKFLG==40 ;PARENTHESES CHECK MODE
IFLG==100 ;SELECT IMAGE MODE
GFLG==200 ;KEEP GOING IF THERE ARE I/O ERRORS
IBFLG==400 ;SELECT IMAGE BINARY MODE
JFLG==1000 ;NON-STANDARD MODE
WFLG==2000 ;/W CONVERT TABS TO SPACES
;*** FLAGS TOO BIG FOR SWITCHES ***
TBSN==4000 ;TAB ALREADY SEEN DURING /W
NEWFIL==10000 ;NEW FILE JUST INITIATED
;AUXFLG ASSIGNMENTS (LEFT HALF)
QFLG==1 ;PLEASE PRINT SWITCH SET
NSPROT==2 ;NON-STANDARD DISK OUTPUT PROTECTION
SBIN==4 ;36-BIT PR. ON REL. ETC. FILES
NOMORE==20 ;IGNORE ANY SWITCHES BUT MTA FROM NOW ON
CDRFLG==40 ;CONVERT COLS 73-80 TO SPACES + /C
RSDCFL==200 ;USED FOR MERGING FILES, ==1 IF FILE HAS EXTENSION
;REL,SAV,DMP,CHN OR OTHERWISE == 0
FRSTIN==400 ;THIS IS THE FIRST INPUT FILE (USED IN FILE
;MERGE COMMAND) == 0 FOR FIRST INPUT
;MTAREQ ASSIGNMENTS (RIGHT HALF)
MTAFLG==1 ;MTA ADVANCE ONE FILE
MTBFLG==2 ;MTA BACKSPACE ONE FILE
MTTFLG==4 ;MTA SKIP TP LOGICAL EOT
MTWFLG==10 ;MTA REWIND
MTFFLG==20 ;MTA MARK EOF
MTUFLG==40 ;MTA REWIND AND UNLOAD
MTDFLG==100 ;MTA ADVANCE ONE RECORD
MTPFLG==200 ;MTA BACKSPACE ONE RECORD
MT8FLG==400 ;MTA SET 800 B.P.I.
MT5FLG==1000 ;MTA SET 556 B.P.I.
MT2FLG==2000 ;MTA SET 200 B.P.I.
MTEFLG==4000 ;MTA SELECT EVEN PARITY
MTIFLG==10000 ;MTA INDUSTRIAL COMPATIBLE
MTSFLG==20000 ;MTA DEC STANDARD
;AUXFLG ASSIGNMENTS (RIGHT HALF)
REDFLG==1 ;==1 IF ANY FILES ARE INPUT (OTHER THAN DIRECTORIES)
SYSFLG==2 ;DEVICE IS SYS
SYSLST==4 ;LAST DEVICE WAS SYS
LPTOUT==10 ;LPT OUTPUT
FFLG==20 ;LIST SHORT DISK DIRECTORY
ONEOUT==40 ;ONE OUTPUT FILE INITIALIZED
CDRIN==100 ;CARDS IN
MTAOUT==200 ;OUTPUT TO MTA
MTAIN==400 ;INPUT FROM MTA
TTYIN==1000 ;INPUT FROM TTY
READ1==2000 ;LOOK FOUND NEW INPUT FILE, NO READ YET.
DTAOUT==4000 ;OUTPUT TO DTA
DSKOUT==10000 ;OUTPUT TO DSK
DTAIN==20000 ;INPUT FROM DTA
DSKIN==40000 ;INPUT FROM DSK
TTYOUT==100000 ;OUTPUT TO TTY
PPTIN==200000 ;INPUT FROM PTR
PPTOUT==400000 ;OUTPUT TO PTP
;CALFLG ASSIGNMENTS (RIGHT HALF) FOR DESCRIBING A BLOCK OF INFORMATION
;FOUND BY THE COMMAND SCANNER.
FNEX==1 ;==1 WHEN FN.EX==*.*, *.EXT, FN.* (WHEN MORE
;THAN ONE FN.EX IS IMPLIED).
MATEX==2 ;FILE EXTENSIONS MUST MATCH
MATFN==4 ;FILE NAMES MUST MATCH
NEWDEV==10 ;A NEW INPUT DEVICE WAS GIVEN
NEWPP==20 ;A NEW #P-P WAS GIVEN
ASTFLG==40 ;FLAG SET WHEN FILE NAMED IN CS FOUND
;BY LOOK ROUTINE EVEN IF FN OR EXT =*
DEV==100 ;DEVICE NAME INDICATOR
DVSWTH==200 ;OUTPUT DEVICE SEEN
NSWTCH==400 ;INDICATES NULL NAME
SSWTCH==1000 ;LEFT ARROW SEEN (TEMPORARY SWITCH)
LISTTY==2000 ;LIST TO TTY
TMPI==4000 ;INPUT DEVICE TMPCOR SEEN
TMPO==10000 ;OUTPUT DEVICE TMPCOR
RXFLG==20000 ;(RX) SEEN
RTRNFL==40000 ;RETURN (POPJ ) FROM ERROR PRINTER (PTEXT)
ARWSW==100000 ;LEFT ARROW SEEN IN THIS LINE
SQNSN==200000 ;A SEQUENCE NUMBER HAS BEEN SEEN FOR THIS LINE
COMAFL==400000 ;A COMMA SEEN ON INPUT SIDE OF SPECIFICATIONS
ALLCLF==FNEX!MATEX!MATFN!NEWDEV!NEWPP
;MORE FLAGS IN LEFT HALF
MFLG==1 ;A WILD CHAR MASK HAS BEEN SET UP FOR ??????.???
LDVFLG==2 ;WE HAVE A DEVICE TO OUTPUT (DIR COMMAND)
LPPFLG==4 ;WE HAVE A PPN TO OUTPUT (DIR)
OSPLFL==10 ;OUTPUT DEVICE IS SPOOLED
;DEVICE CHANNEL ASSIGNMENTS
IFN CCLSW,<
COM==0 ;STORED COMMAND INPUT CHANNEL>
CON==1 ;COMMAND INPUT CHANNEL
OUT==2 ;OUTPUT DEVICE
IN==3 ;INPUT DEVICE
TAPE==4 ;MTA POSITIONING
DIR==5 ;DISK DIR. READ
DD==6 ;DUMP MODE CHANNEL FOR DTA DIR (TAPE ID ONLY)
;ACCUMULATOR ASSIGNMENTS
T1=1 ;GENERAL PURPOSE
T2=2 ;G.P.
T3=3 ;G.P.
CHR=4 ;INPUT CHARACTER
FL=5 ;MORE FLAGS
FLAG=6 ;FLAG REGISTER
T4=7 ;G.P.
IOS=10 ;IO STATUS BITS
T5=11 ;G.P.
T6=12 ; G.P.
AUXFLG=13 ;AUXILIARY FLAG REGISTER
T7=14 ;G.P.
DOUT=15 ;DIVIDED NO. FOR OUTPUT
DOUT1=16 ;REMAINDER, DOUT+1
P=17 ;PUSHDOWN POINTER
CALFLG==FL ;OLD NAME - TOO LONG TO TYPE
;MISCELLANEOUS PARAMETERS
WRTLOK==400000 ;WRITE LOCK (DECTAPE) /IMPROPER I/O
BIGBLK==40000 ;BLOCK TOO LARGE
INBIT==2 ;DEVCHR BIT FOR DEV CAN DO INPUT
OUTBIT==1 ;DEVCHR BIT FOR DEV CAN DO OUTPUT
EOFBIT==20000 ;END OF FILE
EOTBIT==2000 ;END OF TAPE
DTABIT==4 ;DEVCHR BIT FOR DECTAPE IDENTIFICATION
INHIB==1 ;OUTPUT RELEASE INHIBIT BIT
TABSP==10 ;SPACES PER TAB
PTRBIT==200 ;DEVCHR BIT FOR PTR
PTPBIT==400 ;DEVCHR BIT FOR PTP
DSKBIT==200000 ;DEVCHR BIT FOR DSK
MTABIT==20 ;DEVCHR BIT FOR MTA
LPTBIT==40000 ;DEVCHR BIT FOR LPT
TTYBIT==10 ;DEVCHR BIT FOR TTY
CDRBIT==100000 ;DEVCHR FOR CDR
DENS2==200 ;MTA 200 BPI
DENS5==400 ;MTA 556 BPI
DENS8==600 ;MTA 800 BPI
PARE==1000 ;MTA EVEN PARITY
LDP==4000 ;MTA LOAD POINT STATUS
HPAGE==20
.TYSPL==(1B13) ;DEVTYP BIT FOR SPOOLING
;MACRO DEFINITIONS
DEFINE SKIP (J)<JRST .+1+'J>
DEFINE LSTLIN (Z),<
MOVEI T1,Z
PUSHJ P,LISTIT>
DEFINE ERRPNT (X),<
JSP T1,PTEXT
XLIST
ASCIZ X
LIST>
DEFINE ERRPN2 (X),<
JSP T1,PTEXT2
XLIST
ASCIZ X
LIST>
;MACRO TO THROW AWAY CURRENT LINE BEFORE PRINTING ERROR MESSAGE
DEFINE ERRPNX (X)<
JSP T1,PRETXT
XLIST
ASCIZ X
LIST>
DEFINE SWSEG <
IFN REENT, <RELOC>>
;ASCII CHARACTERS
CR==15 ;CARRIAGE RETURN
LF==12 ;LINE FEED
FF==14 ;FORM-FEED
ALTMOD==33 ;NEWEST ALTMODE
ALT175==175 ;OLDEST ALTMODE
ALT176==176 ;OLDER ALTMODE
LA==137 ;LEFT ARROW
CZ==32 ;CONTROL Z
XON==21 ;^Q,START TTY PTR
XOFF==23 ;^S,STOP TTY PTR MODE
COMMA==54
PERIOD==56 ;PERIOD
COLON==72
SPACE==40
DEL==177 ;DELETE,RUBOUT,REPEAT MOD.35
TAB==11 ;TAB
;CALLI DEFINITIONS
OPDEF WAIT [MTAPE 0]
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF MSTIME [CALLI 23]
OPDEF GETPPN [CALLI 24]
OPDEF PJOB [CALLI 30]
OPDEF RUN [CALLI 35]
OPDEF GETTAB [CALLI 41]
OPDEF TMPCOR [CALLI 44]
OPDEF DSKCHR [CALLI 45]
OPDEF GOBSTR [CALLI 66]
OPDEF DEVPPN [CALLI 55]
OPDEF PATH. [CALLI 110]
;EXTENDED LOOKUP PARAMETERS
RBSIZ==5 ;WRITTEN FILE LENGTH
RIBSTS==17 ;STATUS BITS
PTHLEN==6 ;NUMBER OF SFD'S ALLOWED (1 MORE THAN 5.04)
PIP1: IFN CCLSW,<
TDZA FLAG,FLAG ;NORMAL ENTRY TO ACCEPT COMMANDS FROM TTY
SETO FLAG, ;CCL ENTRY TO READ COMMANDS FROM DISK FILE>
MOVE 0,[LOW,,LOW+1] ;XWD FOR BLT TO
SETZM LOW ;CLEAR DATA AREA
BLT 0,LOWTOP-1 ;TO ZERO
MOVEI P,PDL-1 ;SETUP PDL INCASE OF ERRORS
MOVSI 'TTY' ;TEST TTY TO SEE IF NOT A REAL TTY
DEVCHR
TLNE TTYBIT ;WELL IS IT
SKIP 2 ;YES
OUTSTR [ASCIZ /?Logical TTY must be physical TTY/]
EXIT 1, ;NO, DO MONRET
IFN FTDSK,<
GETPPN ;SEE WHO WE ARE
JFCL ;INCASE JACCT ON?
MOVEM MYPPN ;STORE
MOVE [PTHLEN+3,,JOBPTH]
SETOM JOBPTH ;FIND JOB'S DEFAULT PATH
PATH. ;GET PATH
SETZM JOBPTH ;FAILED NOT SFD'S
MOVE [XWD 17,11] ;STATES WORD
GETTAB ;GET IT
SETZ ;ERROR RETURN
TLNN (7B9) ;TEST FOR LEVEL D
TDZA ;NOT LEVEL D
HRROI -2 ;THIS IS LEVEL D
MOVEM LEVEL ;SAVE
MOVSI 'SYS'
DEVPPN ;FIND PP OF DEVICE SYS
JRST [MOVE PP11 ;ASSUME 1,,1 IF NOT LEVEL D
SKIPE LEVEL ;DEVPPN FAILED, BUT MIGHT BE SMALL MONITOR
ADDI 3 ;IT WAS, USE LEVEL D AREA
JRST .+1]
MOVEM SYSPP ;SAVE AS SYS PP>
IFE REENT,<
IFE FTDSK,<HLRZ T1,.JBSA ;NO DSK SO USE JOBFF>
IFN FTDSK,<MOVEI T1,DSKDR0 ;ASSUME NO DISK FOR TEST, LOC OF DSK RTNS
MOVSI 0,'DSK'
DEVCHR ;DEVCHR REQUEST: IS THERE A DSK
JUMPE 0,P1 ;0 IF NO DISK: USE DSKDR
MOVE T1,.JBFF ;DISK: PREPARE TO SAVE C(JOBFF)
HRRZ T2,.JBREL ;HIGHEST REL LOC AVAILABLE TO USER
CAIL T2,6000 ;CURRENT SIZE 4K
JRST P1 ;YES
MOVEI T2,7777 ;NO. EXPAND TO 4K
HRRZM T1,SVJBFF ;SAVE JOBFF SO BUFFERS CAN BE CREATED
CORE T2, ;CORE UUO
JRST CERR7 ;CORE UNAVAILABLE>
>
IFN REENT,<
HLRZ T1,.JBSA ;GET JOBFF>
P1: HRRZM T1,SVJBFF ;SAVE JOBFF SO BUFFERS CAN BE CREATED
RESET ;RESET. MOVES JOBSA (LH) TO C (JOBFF)
IFE CCLSW,<JRST PIP>
IFN CCLSW,<JUMPE FLAG,PIP ;ENTER PIP IF NO COMMAND FILE
MOVEI PIP1 ;GET STARTING ADDRESS
HRRM .JBSA ;RESET IT SO ^C START WILL WORK
;THIS IS MODIFICATION FOR USING TMPCOR WITH CCL
IFN TEMP,<MOVE T1,[XWD 1,TMPFIL];SET BLOCK POINTER FOR TMPCOR UUO
;1=READ ONLY, LOC OF FILENAME
MOVSI T2,'PIP'
MOVEM T2,TMPFIL
MOVSI T2,-200
HRR T2,SVJBFF ;CALCULATE TMPFIL ADDRESS FOR BUFFER
HRRZ T5,.JBREL ;GET TOP OF CORE
CAIGE T5,200(T2) ;WILL BUFFER FIT IN AVAILABLE CORE?
JRST [ADDI T5,200 ;NO, TRY FOR ONE MORE K
CORE T5,
JRST OMODER ;FAILED, GIVE UP
JRST .+1] ;WILL BE OK NOW
MOVEM T2,TMPFIL+1 ;STORE IN TMPFIL+1
SOS TMPFIL+1 ;MAKE IT AN IOWD
TMPCOR T1, ;READ AND DELETE PIP FILE
;T1 ON RETURN=NOWDS IN CS
JRST P11 ;NO PIP FILE IN CORE TRY DSK
HRLI T2,440700 ;SET UP BYTE POINTR FOR COMMANDS
MOVEM T2,TMPPNT ;USE LATER IN GETSC
SETOM TMPFLG ;SIGNAL THAT TMPCOR WAS USED
MOVNI 0,(T1) ;GET NUMBER OF WORDS
HRLM 0,TMPFIL+1 ;IN CASE COMMAND FAILS
ADDB T1,SVJBFF ;CALCULATE END OF TMPCOR BUFFER
MOVEM T1,TMPEND ;STORE FOR LATER USE
SETOM COMFLG ;MARK THAT CCL IS IN ACTION
JRST PIP2A ;START PIP
P11:>
PJOB T1, ;GET JOB NBR.
MOVEI 0,3 ;SET TO GENER. 3 DIGIT JOB NO
IDIVI T1,^D10 ;DIVIDE BY 10
ADDI T2,"0"-40 ;REMAINDER MAKE SIXBIT
LSHC T2,-6 ;SHIFT T2 RIGHT INTO T3
SOJG 0,.-3 ;DECREMENT AND LOOP
HRRI T3,'PIP'
MOVEM T3,CFILE ;INSERT JOB NBR IN CCL INIT
MOVSI T3,'DSK'
MOVEM T3,CCLINI+1 ;DEFAULT DEVICE
MOVSI T3,'TMP'
SETZM CFILE+3
P12: MOVEM T3,CFILE+1
SETZM CCLINI ;CLEAR MODE
MOVEI T3,CFI ;COMMAND FILE BUFFER HEADER
MOVEM T3,CCLINI+2
OPEN COM,CCLINI ;INIT DEVICE FOR CCL OR @
JRST CER1 ;CAN'T INIT
LOOKUP COM,CFILE ;LOOKUP COMMAND FILE
JRST [SKIPE CFILE+1 ;IF NUL FILE NOT FOUND
JRST CER2 ;NO, REAL FILE NOT FOUND
MOVSI T3,'CCL'
MOVEM T3,CFILE+1
JRST .-1] ;TRY AGAIN WITH CCL
INBUF COM,1 ;1 BUFFER ONLY
MOVE 0,.JBFF ;SAVE JOBFF NOW
HRRZM 0,SVJBFF ;TO LEAVE COMMANDS INTACT WHEN BUFFERS RECREATED
SETOM COMFLG ;SUCCESS: COMMAND FILE REQUESTED
JRST PIP2A
CER1: ERRPNT </?File />
PUSHJ P,P6BIT
CFILE
ERRPN2 </.TMP init failure!/>
CER2: SETOM COMEOF ;FORCE EXIT AFTER MESSAGE
ERRPNT </?Command file />
MOVEI T3,CFILE ;ADDRESS OF FILE NAME
PUSHJ P,FN.EX ;PUT IT IN MESSAGE
ERRPN2 </ not found!/>
PIP2: SKIPE TAPEID ;NEED TO SET TAPE ID?
PUSHJ P,WRTID ;YES
SKIPE COMFLG ;LAST COMMAND CCL?
SKIPN COMEOF ;ANY MORE CCL COMMAND?
JRST PIP2A ;YES,GET NEXT PIP COMMAND
CLOSE CON, ;FORCE OUTPUT OF ERROR MESSAGE
EXIT 1, ;NO,CAN EXIT
SETZM COMFLG ;CLEAR FLAG NOW
JRST PIP2A ;JUST INCASE MONITOR RETURNS>
IFE REENT,<IFN FTDSK,<
CERR7: ERRPNT </?4K needed/>
EXIT ;EXIT TO MONITOR>>
PIP:
;NEW COMMAND STRING SCAN STARTS HERE
IFE CCLSW,<PIP2: >
PIP2A: JSP T5,INICN1 ;INITIALIZE THE TTY AND PDL
IFN CCLSW,<SKIPE COMFLG ;ACCEPT NEW PIP COMMAND?
JRST PIP2B ;NOT PIP (TTY) COMMD, BUT CCL>
MOVEI 0,"*" ;TYPE ASTERISK******
IDPB 0,TFO+1 ;READY TO ACCEPT
OUTPUT CON, ;COMMAND FROM TTY
PIP2B: SETZM TOTBRK ;CLEAR PAREN COUNTER
MOVEI 0,TABSP ;SPACES PER TAB
MOVEM 0,TABCT ;INITIALIZE TAB COUNT
MOVE 0,ZRO ;ASCII /00000/
MOVEM 0,SQNUM ;INITIALIZE SEQUENCE NUMBERS
RELEAS CON, ;RELEASE TTY FOR USE AS IN-OUT DEVICE
MAINA1: SETZB FLAG,FZERO ;INITIALIZE FOR FIRST/NEXT COMMAND STRING
SETZB AUXFLG,DEVICE
IFN FTDSK,<HRRZI 0,'SYS' ;SYSTEM DIRECT DEV, DSK/DTA
HRLZM 0,ADSK ;PUT IN SYSTEM DEVICE>
MOVE 0,[XWD FZERO,FZERO+1]
BLT 0,LZERO ;CLEAR STORAGE AREA
SETZ CALFLG, ;CLEAR OTHER FLAGS
IFN CCLSW,<SKIPE COMFLG ;CCL COMMAND?
JRST COMPRO ;YES, GET FROM CORE OR DSK>
MOVE T3,.JBFF ;FREE CORE POINTER
HRLI T3,(POINT 7) ;FORM BYTE POINTER
MOVEM T3,COMPTR ; FOR STORING CS IN CORE
;ACCUMULATE CS CHARS IN CORE
COMSTO: PUSHJ P,GETTA ;GET CS CHAR
AOS COMCNT ;COUNT CHARS
MOVEI T4,1(T3) ;GET BYTE POINTER ADDRESS PLUS SOME
CAMGE T4,.JBREL ;SEE IF IT WILL BE IN BOUNDS
JRST .+3 ;YES, ALL IS WELL
CORE T4, ;GET WHAT WE NEED
JRST OMODER ;FAILED, UNLIKELY TO HAPPEN
CAIN 0,CZ ;CHECK FOR ^Z
COMASK: PUSHJ P,GETEN2 ;SET ^Z IN 0
IDPB 0,T3 ;STORE IN COMBUF
SKIPE COMEOF ;END-OF-FILE SET?
AOJA T3,COMSTD ;YES, PROCESS CS IN COMBUF
CAIG 0,CR ;NOT EOF
CAIGE 0,LF ;LF,VT,FF,CR?
CAIN 0,ALTMODE ;NO, $?
JRST COMASK ;YES
JRST COMSTO ;NO, KEEP STORING
COMSTD: HRRM T3,.JBFF ;RESET JOBFF TO RETAIN STORED COMMAND
HRRM T3,DTJBFF ;ALSO JOBFF AFTER 2 TTY BUFFERS (PLUS COMMAND)
; AND FALL INTO COMPRO
;********************************************************************
;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING
COMPRO:
IFN FTDSK,<
MOVSI 0,'DSK' ;MAKE DEFAULT DEVICE
MOVEM 0,DEVICE ;TENTATIVELY DSK>
COMPRP: RELEASE CON, ;RELEASE TTY
PUSHJ P,NAME ;GO SCAN DESTINATION PORTION OF COMMAND STRING
SKIPE XNAME ;NO SCAN OVERSHOOT ALLOWED
JRST ERR6A
SKIPL ESWTCH ;11/25/69 END OF CS ?
JRST MAINC ;NO
IFN CCLSW,<SKIPE COMFLG ;STILL IN CCL
JRST PIP2 ;YES>
TLNE AUXFLG,QFLG ;PERHAPS JUST /Q?
JRST MAINQ ;YES IT WAS
TRNN CALFLG,NSWTCH ;NON-NULL DESTINATION
TRNE CALFLG,SSWTCH ;_ NOT SEEN?
SKIPE FILNAM ;OR ANYTHING IN FILENAME
JRST ERR6A ;YES, ERROR
JRST PIP2 ;NO, ALL OK
MAINQ: MOVSI 0,'DSK' ;SEE IF DEFAULT DEVICE
CAMN 0,DEVICE
TLCA 0,200722;TURN DSK INTO TTY BY WAVE OF WAND
MAINC: MOVE 0,DEVICE ;GET OUTPUT DEVICE NAME
MOVEM 0,ODEV ;SAVE DEVICE NAME FOR LATER USAGE
PUSHJ P,DEVTST ;SAVE DEVICE TYPE, SET XXXOUT.E.G. DTAOUT
PUSHJ P,ABCHK ;CHECK MTA BACKSPACE/ADV VALUES
PUSHJ P,PROTK ;CHECK PROTECTION
MOVE 0,AB ;MTA VALUE SWITCHES
MOVEM 0,ABOUT ;GET MTA CONTROL NUMBERS FO R OUT
MOVE 0,AUX
MOVEM 0,AUXOUT
MOVE 0,[FILNAM,,DTON]
BLT 0,DTON+3 ;SAVE DESTINATION FILE NAME
IFN FTDSK,<TRNN AUXFLG,DSKOUT ;DISK OUTPUT?>
SETZM DTON+3 ;ZERO 4TH WD OF DIRECTORY ENTRY
IFN FTDSK,<SKIPN PTHADD ;FULL PATH SPECIFIED?
JRST M3 ;NO
MOVE 0,[PTHADD,,PTHOUT]
HRRZM 0,DTON+3 ;SET PATH ADDRESS
BLT 0,PTHOUT+PTHLEN+3
>
M3: TRZ CALFLG,SSWTCH ;TERMINATE DESTINATION FILE SCAN
IFE FTDSK,<SETZM DEVICE ;DONT CARRY OVER INPUT DEVICE>
IFN FTDSK,<SETZM PPP ;CLEAR OUTPUT PPN
SETZM PP ;JUST IN CASE
SETZM PTHADD ;AND FULL PATH JUNK
SETZM DEFPTH ;AND ITS DEFAULT
MOVSI 0,'DSK' ;DEFAULT CASE DSK
MOVEM 0,DEVICE ;MUST NOT LET O/DEV. CARRY OVER AS I/DEV.>
M3A: PUSHJ P,DESCRP ;GET A UNIT DESCRIPTOR (INPUT).
TLZN AUXFLG,QFLG ;/Q?
JRST M2 ;NO
HRRZI 0,'SYS' ;YES MAKE INPUT DEVICE SYS
HRLZM 0,DEVICE
HRLZM DEVA ;SAVE COPY OF INPUT DEVICE
MOVE 0,['PIPHLP'] ;NAME.EXT FOR HELP TEXT
HLLZM 0,FILNAM
HRLZM 0,FILEX
TRO AUXFLG,SYSFLG ;DEVICE IS SYS
IFN FTDSK,<MOVE 0,SYSPP ;GET SYS PP
MOVEM 0,PP ;AND SET IT>
SOS ESWTCH ;NO MORE COMMAND STRING
PUSHJ P,CHECK1 ;CHECK INPUT DEVICE
M2: TLO AUXFLG,NOMORE ;NO MORE SWITCHES BUT MTA ALLOWED
TLNE FLAG,OFLG ;BLOCK 0 COPY?
JRST BLOCK0 ;YES
TRNN FLAG,XFLG ;/X ?
JRST M2A ;NO
TRNE FLAG,RFLG ;(RX)?
JRST M5 ;YES, (RX)
MOVE 0,DTON ;GET FILE NAME
JUMPN 0,M5 ;BELIEVE ANYTHING BUT ZERO
HLRZ 0,DTON+1 ;SAME FOR EXT
JUMPN 0,M5
M2A: IFN RIMSW,<
TLNN FLAG,RIMFLG ;RIM OUTPUT?
JRST M1 ;NO
TRNE AUXFLG,PPTOUT ;RIM IS ONLY DTA TO PTP
TRNN AUXFLG,DTAIN!DSKIN!MTAIN
JRST ERR5B>
M1: MOVEI T4,1 ;ASCII LINE MODE ASSUMED
PUSHJ P,OUTLOOK ;SEE IF OUTPUT DEV MTA
PUSHJ P,M4 ;NOT MTA
TLNE FLAG,JFLG ;NON STARDARD MODE ?
TRO T4,100 ;TO PUNCH 029 ON CDP
HRRZM T4,OMOD ;SET MODE OF OUTPUT DEV
MOVEI T4,1
PUSHJ P,INLOOK ;SEE IF INPUT DEV MTA
PUSHJ P,M4 ;NOT MTA
HRRZM T4,ININI1 ;SET MODE OF INPUT DEV
PUSHJ P,FNSET ;NOW DEVICE, DEVA CORRECT FOR START
JRST OMOD1 ;INIT OUTPUT DEVICE
;SET MODE IF /I,/B,/H,
M4: TRNN FLAG,BMOD ;BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,14 ;BIN. MODE
TLNN FLAG,IFLG ;IMAGE BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,10 ;IM. MODE
TLNN FLAG,IBFLG ;IMAGE BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,13 ;YES
TRNE FLAG,XFLG ;COPY MODE?
POPJ P, ;YES, DON'T ALTER DATA MODE
TRNE FLAG,DFLG+RFLG ;DELETE OR RENAME?
TRO T4,20 ;DIRECTORY WILL BE WRITTEN, DON'T
POPJ P, ;COMPUTE WORD COUNT MODE NEEDED.
;FORCE MONITOR TO USE WORD COUNT
;IN FIRST DATA WORD OF BUFFER
M5: TRZ FLAG,RFLG ;CLEAR /R FLAG
TRO CALFLG,RXFLG ;SET (RX) FLAG
MOVE 0,[DTON,,MATCH]
BLT 0,MATCH+1 ;SAVE NAME AND EXT
JRST M2A ;RETURN
;IF OUTPUT DEVICE IS MTA PERFORM ALL PRE-TRANSFER REQUESTS
;SUCH AS REWIND. IF OUTPUT DEVICE IS MTA, AND THERE IS NO
;INPUT DEVICE, EXIT. FOR OTHER MTA OUTPUT, PREPARE INIT
;DENSITY AND PARITY.
OUTLOOK:
MOVE T3,ABOUT ;AB FOR OUTPUT DEV
MOVE T1,AUXOUT ;AUX FOR OUTPUT DEV
MOVEI T6,INOMTA ;SET TO INIT
JRST MT1 ;MTA FOR OUTPUT
;SAME FOR INPUT DEVICE.
INLOOK: SKIPE T3,FILNAM ;IF NO FILENAME
TRNN FLAG,XFLG ;OR NOT /X
JRST INLUK1 ;CONTINUE
SKIPE DTON ;IF OUTPUT NAME SET UP
JRST INLUK1 ;CONTINUE
HLRZ T1,FILEX ;GET EXT
MOVEM T3,DTON ;SET OUT NAME
HRLZM T1,DTON+1 ;AND EXTENSION
INLUK1: MOVE T3,AB ;ADV OR BKSPACE
MOVE T1,AUX ;AUX FOR INPUT DEV
MOVEI T6,INIMTA ;SET TO INIT
JRST MT1 ;MTA FOR INPUT
;ROUTINE TO INITIALIZE OUTPUT DEVICE
OMODE: IFN TEMP,<
TRNE CALFLG,TMPO ;TMPCOR OUTPUT DEVICE?
JRST OMOD2 ;YES, NO OUTBUFS>
MOVE T1,[XWD OBF,IBF]
MOVEM T1,ODEV+1
MOVE T1,DTJBFF ;JOBFF AFTER 2 TTY BUFS
MOVEM T1,.JBFF ;SET UP
MOVEI 0,MTIFLG!MTSFLG ;TEST FOR (MI) OR (MS) NOW
AND 0,OMOD
ANDCAM 0,OMOD ;AND CLEAR FROM MODE WORD
OPEN OUT,OMOD ;INITIALIZE OUTPUT DEVICE
JRST ERR1 ;UNAVAILABLE ERROR
JUMPE 0,OMOD3 ;JUMP IF NOT (MI) OR (MS)
MOVEI T4,100 ;ARG FOR MTAPE UUO
TRNE 0,MTIFLG ;DID WE GUESS CORRECTLY?
IORI T4,101 ;NO
MTAPE OUT,(T4) ;SET MODE
OMOD3: OUTBUF OUT,1 ;TRY ONE OUTBUFFER FOR SIZE
EXCH T1,.JBFF ;JOBFF_DTJBFF+BUFSZ
;NOTE JOBFF RESET TO DTJBFF
SUB T1,DTJBFF ;T1=BUFSZ
HRRZ 0,.JBREL ;HIGHEST CORE AVAILABLE
SUB 0,DTJBFF ;0=TOTAL CORE AVAILABLE
ASH 0,-1 ;COMPUTE HOW MANY OUTPUT BUFFERS
IDIVM 0,T1 ;FIT IN HALF THE AVAILABLE SPACE
MOVEI T4,OMODE ;SET RETURN FROM CORCHK
PUSHJ P,CORCHK ;LOOP BACK OR ERROR IF NOT ENOUGH CORE
OUTBUF OUT,(T1) ;SET UP OUTPUT BUFFERS
MOVE 0,OBF+1
MOVEM 0,SVOBF ;SAVE ORIGINAL MODE SETTING
OMOD2: MOVE 0,.JBFF
HRRZM 0,SVJBF1 ;PREPARE TO RECLAIM INBUFFER SPACE
POPJ P,
OMOD1: PUSHJ P,OMODE ;GO INITIALIZE OUTPUT DEVICE
TRZN FLAG,ZFLG ;Z COMMAND TYPED?
JRST MAINA2 ;NO,
PUSHJ P,DTCLR ;YES, GO CLEAR DIRECTORY
RELEASE OUT,
RELEASE DIR,
TRNN CALFLG,NSWTCH ;SEE IF DEVICE WAS TYPED
JRST OMOD1 ;YES
JRST PIP2 ;GET NEXT COMMAND
;ROUTINE TO CHECK FOR ENOUGH CORE FOR I/O BUFFERS
;ENTER T1: COMPUTED NUMBER OF BUFFERS WE WANT
; T4: WHERE TO GO IF WE EXPAND CORE
CORCHK: CAIL T1,2 ;ROOM NOW FOR AT LEAST 2 BUFFERS?
POPJ P, ;YES, RETURN OK
JUMPLE T1,MORCOR ;HAVE TO GET MORE ROOM IF NONE
HRRZ 0,.JBREL ;WANTED 1, SEE IF WE CAN GET 2
ADDI 0,1000 ;TRY 1/2K MORE
CORE 0,
POPJ P, ;NO, LIVE WITH 1 BUFFER
POP P,0 ;YES, POP OFF PUSHJ CALL
JRST (T4) ;AND RECOMPUTE
MORCOR: HRRZ 0,.JBREL ;TRY TO GET
ADDI 0,2000 ;1K MORE OF CORE
CORE ;ASK MONITOR FOR 1K CORE
JRST OMODER ;NOT AVAILABLE
JRST (T4) ;GOT IT
OMODER: ERRPNT</?Not enough core/>
EXIT
;MAIN LOOP TO PROCESS INPUT SIDE OF CS
MAINA2: TRNE FLAG,RFLG+DFLG ;RENAME OR DELETE FILE MODE?
JRST DTDELE ;YES./D,/X,OR(DX)
IFN RIMSW,<
TLNE FLAG,RIMFLG ;RIM?
JRST RIMTB ;YES./Y
>
TRNE FLAG,XFLG ;TRANSFER EVERYTHING MODE?
JRST PRECOP ;YES./X
;LOOP TO COPY ALL FILES BEGINS HERE FROM MAIN2
MAINA3: TRNN AUXFLG,FFLG ;LIST DSK DIR SHORT?
TRNE FLAG,LFLG ;LIST DIRECTORY?
JRST DTPDIR ;YES./F OR /L
IFN TEMP,<
TRNE CALFLG,TMPI ;TEMCOR:
JRST TMPIN ;YES THIS IS SPECIAL>
PUSHJ P,ININIT ;INITIALIZE INPUT FILE
TRNN CALFLG,FNEX ;SINGLE FILE SPECIFICATION?
JRST [MOVE 0,[FILNAM,,ZRF] ;YES, DON'T READ DIRECTORY
BLT 0,ZRF+3 ;SET UP FILE NAME,EXT, AND PPN
SETZM GENERI ;JUST IN CASE
JRST MAINA4+2]
TRNE AUXFLG,DTAIN ;DEC TAPE INPUT?
PUSHJ P,DTADIR ;INIT DTA DIR
IFN FTDSK,<TRNN AUXFLG,DSKIN ;NO, DISK INPUT?
JRST MAINA4 ;NO
PUSHJ P,INITFS ;INIT SEARCH LIST IF LEVEL D
JRST MAINA4-1 ;NOT GENERIC "DSK"
MAINAD: PUSHJ P,NXTFSU ;GET NEXT F/S
JRST MAINA6 ;END OF F/S LIST
TROA CALFLG,FNEX ;KEEP THE FLAG FLYING
PUSHJ P,DSKDIR ;INIT DSK UFD CHANNEL
JFCL>
MAINA4: PUSHJ P,LOOK ;GET A FILE TO COPY
JRST MAINA5 ;NO MORE
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT>
LOOKUP IN,ZRF
JRST ERR3 ;LOOKUP FAILURE
IFN TEMP,<TRNE CALFLG,TMPO
JRST TMPOUT ;OUTPUT TO TMPCOR>
TLO FLAG,NEWFIL
PUSHJ P,FILTYP
TRNE AUXFLG,ONEOUT
JRST PSCANA ;OUT HAS BEEN INITIALIZED
PUSHJ P,OKBLKS
IFN FTDSK,<SKIPE LEVEL ;IF LEVEL D
TLNN AUXFLG,NSPROT ;AND NON-STANDARD PROTECTION
JRST .+3 ;NOT BOTH TRUE
LDB 0,PRPTL ;GET PROTECTION CODE
DPB 0,PRPTD ;INTO ENTER BLOCK>
GETSTS OUT,T1 ;SAVE CURRENT MODE
LDB T2,[POINT 4,ZRF+2,12] ;GET INPUT MODE
SETSTS OUT,(T2) ;SET OUTPUT SAME
PUSHJ P,CHKDTON ;MAKE SURE WE HAVE A VALID NAME
ENTER OUT,DTON ;CREATE OUTPUT FILE
JRST ERR4 ;DIR. FULL OR 0 FILE NAME
SETSTS OUT,(T1) ;RESET OUTPUT MODE
JRST PSCANA
MAINA5:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT
JRST MAINAD ;YES, GET NEXT F/S>
MAINA7: TRZ AUXFLG,REDFLG
JRST MAIN1
MAINA6: TRNN AUXFLG,REDFLG ;WAS FILE FOUND?
PUSHJ P,ERR3A ;NO
JRST MAINA7 ;YES, BUT NO MORE F/S
;HERE TO CHECK NAME.EXT IN DTON
;AT THIS POINT THERE MUST BE NO ? FROM MASK LEFT
;NOTE ? INTRODUCED BY # ARE OK
CHKDTON:HLLZS DTON+1 ;CLEAR IN CASE ERROR
MOVE 0,OQMASK ;GET OUTPUT MASK
JUMPE 0,CPOPJ ;NO WILD CARDS
AND 0,DTON ;JUST LEAVE MASKED CHARS.
XOR 0,OQMASK ;THEY SHOULD HAVE CHANGED
JUMPE 0,CPOPJ1 ;SKIP RETURN IS FAILURE
MOVE 0,OQMASK+1 ;SAME FOR EXT
JUMPE 0,CPOPJ
AND 0,DTON+1
XOR 0,OQMASK+1
JUMPE 0,CPOPJ1
POPJ P, ;GOOD RETURN
PSCANB: TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN ;ON NON-DIR DEVICE?
TRZ CALFLG,ALLCLF ;END OF THE ONE OR MANY FILES SPECIFIED
TRON AUXFLG,ONEOUT ;HAS OUT JUST BEEN INIT?
OUTPUT OUT, ;YES, AND FIRST FILE IS EOF ONLY, INIT OUT IN
;CASE NO MORE SOURCE FILES
JRST PSCAN5 ;EMPTY FILE, CLOSE INPUT, RETURN FOR MORE
PSCANA: TRO AUXFLG,REDFLG ;SET FLAG FOR INPUT FILE READ
PUSHJ P,INP ;GO READ INPUT FILE
TRZ AUXFLG,READ1
PUSHJ P,TTYZ ;CHECK IF INPUT IS TTY
TRNE IOS,EOFBIT ;EOF FIRST DATA?
JRST PSCANB
SKIPN IBF+2
JRST PSCANA
PSCAN: TRO AUXFLG,ONEOUT ;INDICATE ONE OUTPUT FILE INITED
TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN. OR NO CHAR. PROCESSING
TLNE AUXFLG,SBIN
JRST PSCAN3 ;YES
MOVE 0,OPTRA ;PRESCAN A LINE, INITIALIZE LINE BUFFER PTR
MOVEM 0,OPTR
SETZM CDRCNT
PUSHJ P,CLRBUF ;CLEAR LINE BUFFER
TRO FLAG,STS ;START A FRESH LINE
PSCAN2: PUSHJ P,GET ;GET CHARACTER
JRST PSCAN1 ;END OF FILE RETURN
CAIN CHR,DEL ;VJC 4/16/69
JRST PSCAN2 ;GET NEXT CHAR
HRRZ T1,OPTR ;GET DEPOSIT ADDRESS
CAIL T1,LBUFE
PUSHJ P,PSCLNG ;LINE TOO LONG
IDPB CHR,OPTR ;DEPOSIT CHAR. IN LINE BUFFER
CAIG CHR,24
CAIGE CHR,20 ;LINE PRINTERR CONTROL CHAR
SKIP 1 ;NO
JRST PSCAN4 ;YES, TREAT AS END OF LINE
CAIG CHR,14
CAIGE CHR,12 ;END OF LINE CHARACTER?
SKIP 1 ;NO
JRST PSCAN4 ;YES
CAIGE CHR," " ;TEST FOR CONTROL CHARS.
CAIN CHR,CR ;BUT ALLOW CR
JRST PSCAN2 ;NONE, SO CONTINUE
CAIE CHR,TAB ;TAB IS O.K. THOUGH
TRNN AUXFLG,LPTOUT!TTYOUT
JRST PSCAN2 ;IF LPT OR TTY CONVERT CHARACTER
PUSH P,CHR ;IT WAS, SO SAVE IT
MOVEI CHR,"^" ;STANDARD UP ARROW
DPB CHR,OPTR;WIPE OUT BAD CHAR
POP P,CHR ;GET IT BACK
TRC CHR,100 ;MAKE IT VISIBLE
IDPB CHR,OPTR
JRST PSCAN2 ;AND CONTINUE
PSCAN4: TRNN FLAG,TBMOD!SPMOD;REMOVED TRAILING SPACES?
JRST PSCAN7 ;NO
MOVE T2,LBUF ;GET FIRST 5 CHARS.
CAME T2,[BYTE (7) 15,12,40,40,40]
JRST PSCAN7 ;NOT A BLANK LINE
MOVE T2,[BYTE (7) 40,15,12,40,40]
MOVEM T2,LBUF ;GUARENTEE ONE SPACE
IBP OPTR ;DON'T FORGET TO ACCOUNT FOR IT
PSCAN7: PUSHJ P,OUTLBF ;YES, SO DUMP THE LINE BUFFER
JRST PSCAN ;SCAN THE NEXT LINE
PSCAN1: LDB CHR,OPTR ;PICK UP LAST CHAR.
CAIN CHR,CZ ;IS IT ^Z
TRNN AUXFLG,TTYIN ;FROM TTY?
JRST PSCAN6 ;NO
SETZ CHR, ;YES,CLEAR CHAR.
DPB CHR,OPTR ;AND REMOVE FROM BUFFER
PSCAN6: PUSHJ P,OUTLBF ;DUMP THE REMAINING BUFFER
PSCAN9: TRNE FLAG,XFLG ;COPY MODE?
JRST COPY2A ;YES, GO COPY THE NEXT FILE
PSCAN5: CLOSE IN,
JRST MAINA4
;HERE IF LINE IS TOO LONG FOR LINE BUFFER
PSCLNG: TRNE FLAG,LINE ;FATAL IF /A LINE BLOCKING
JRST ERR10 ;SINCE WE DON'T KNOW HOW TO
PUSHJ P,OUTLBF ;DUMP THE LINE
MOVE 0,OPTRA ;FIX UP LINE BUFFER AGAIN
MOVEM 0,OPTR
JRST CLRBUF ;CLEAR LINE BUFFER AND RETURN
;HERE FOR BINARY TRANSFER
PSCAN3:
IFN FORSW,<TLNE FLAG,KFLG ;/K ?
JRST KCONV0 ;YES>
SETZB T3,T4 ;SAVES TIME LATER
TLNN FLAG,PFLG ;FORTRAN BINARY DATA (BP) ?
JRST PSCAN8 ;NO
ILDB T3,IBF+1 ;GET DATA COUNT
TRZE T3,-1 ;INCASE ONLY ONE BLOCK
SETO T4, ;IT WAS, SO FLAG THAT FACT
SOS IBF+2 ;COUNT ONE LESS
PSCAN8: SKIPG IBF+2 ;BUFER ENPTY?
JRST [PUSHJ P,INP ;YES, INPUT A BUFFER
TRNE IOS,EOFBIT ;END OF FILE?
JRST PSCAN9 ;YES, RETURN
TLNN FLAG,PFLG ;FORTRAN BINARY?
JRST .+1 ;NO
ILDB CHR,IBF+1 ;GET FIRST DATA WORD
TRZE CHR,-1 ;INCASE LAST BLOCK
HRLI T4,-1 ;FLAG IT WAS
ADD T3,CHR ;ADD TO WORD COUNT
SOS IBF+2 ;DECREMENT WORD COUNT
JRST .+1] ;BUFFER FULL NOW
SKIPG OBF+2 ;ANY ROOM IN OUTPUT BUFFER?
JRST [PUSHJ P,OUTP ;OUTPUT FULL BUFFER
TLNN FLAG,PFLG ;FORTRAN BINARY?
JRST .+1 ;NO
SOS CHR,OBF+2 ;GET WORD COUNT-1
HRLZS CHR ;PUT COUNT IN LEFT HALF
SUB T3,CHR ;ACCOUNT FOR LAST BLOCK OUTPUT
IDPB CHR,OBF+1 ;STORE AS FIRST WORD
ADDI T3,1 ;INCREMENT BLOCK COUNT
HRR T4,OBF+1 ;SAVE INITIAL ADDRESS
JRST .+1] ;CONTINUE
MOVE T1,IBF+2 ;NUMBER OF WORDS TO GO
CAMLE T1,OBF+2 ;WILL THEY FIT?
MOVE T1,OBF+2 ;NO, SO FILL BUFFER ONLY
HRLZ T2,IBF+1 ;BLT FROM INPUT
HRR T2,OBF+1 ;TO OUTPUT
AOBJP T2,.+1 ;BUT START ON DATA WORDS
ADDM T1,IBF+1 ;ADJUST BYTE POINTER
ADDM T1,OBF+1
MOVNS T1 ;NEGATE WORDS TO GO
ADDM T1,IBF+2 ;ADJUST WORD COUNT
ADDM T1,OBF+2
BLT T2,@OBF+1 ;MOVE WORDS
JUMPGE T4,PSCAN8 ;NOT FORTRAN BINARY, OR NOT LAST BLOCK
SKIPE IBF+2 ;FINISHED WITH THIS BUFFER?
JRST PSCAN8 ;NO, WILL FIX WORD COUNT NEXT TIME
ADDM T3,(T4) ;SET FINAL WORD COUNT
SETZB T3,T4 ;JUST IN CASE
SETZM OBF+2 ;FORCE OUTPUT
JRST PSCAN8 ;GET MORE
;HERE FOR FOROTS TO FORSE DATA FILE CONVERSION
IFN FORSW,<
KCONV0: SKIPGE OBF ;BUFFER SETUP?
KCONVA: PUSHJ P,OUTP ;NO, DO DUMMY OUTPUT
SETZB T3,T4
SOSLE IBF+2 ;BUFFER EMPTY
JRST .+4 ;NO
PUSHJ P,INP ;YES
TRNE IOS,EOFBIT ;TEST FOR E-O-F
JRST PSCAN9 ;ALL DONE IF SO
ILDB T2,IBF+1 ;GET CONTROL WORD
TLNE T2,DEL*4000 ;BITS 0-6 MUST BE ZERO
JRST KERR ;ERROR
LDB T1,[POINT 2,T2,8] ;GET CONTROL WORD TYPE
SOJN T1,KERR ;ERROR IF NOT TYPE 1
MOVEI T2,-1(T2) ;IGNORE TRAILING CONTROL WORD FOR NOW
KCONVB: ADD T3,[1,,0] ;BUMP BUFFER COUNT
MOVE T4,OBF+1 ;STORE ORIGINAL BYTE PTR
IBP OBF+1 ;ADVANCE PAST CONTROL WORD
SOS OBF+2 ;ACCOUNT FOR IT
KCONVC: CAMLE T2,OBF+2 ;WILL ALL DATA FIT IN THIS BLOCK (USUALLY)
JRST KCONV2 ;NO
ADD T3,T2 ;ADD THIS DATA TO TOTAL
MOVSM T3,1(T4) ;STORE CONTROL WORD
MOVN T3,T2 ;GET COPY OF -COUNT
HRLZ T1,IBF+1 ;FROM
HRR T1,OBF+1 ;TO
ADDM T2,IBF+1 ;ACCOUNT FOR INPUT WORDS
ADDB T2,OBF+1 ;END
ADD T1,[1,,1]
BLT T1,(T2)
ADDM T3,IBF+2
ADDM T3,OBF+2 ;FIXUP WORD COUNT
KCONVD: SOSLE IBF+2 ;BUFFER EMPTY
JRST .+4 ;NO
PUSHJ P,INP ;YES
TRNE IOS,EOFBIT ;TEST FOR E-O-F
JRST KERR ;MUST SEE CONTROL WORD
ILDB T2,IBF+1 ;GET NEXT CONTROL WORD
LDB T1,[POINT 2,T2,8] ;GET CONTROL TYPE
SOJLE T1,KERR ;ERROR IF CODE 0 OR 1
SOJG T1,KCONVA ;CODE 3, GET NEXT LOGICAL RECORD
KCONV1: HRRZI T2,-1(T2) ;GET DATA WORD COUNT
JUMPE T2,KCONVD ;GET NEXT CONTROL WORD IF NO DATA
MOVS T3,1(T4) ;RECOVER PARTIAL CONTROL WORD
JRST KCONVC ;AND CONTINUE
KCONV2: ADD T3,OBF+2 ;ONLY THIS MANY ALLOWED
HRLZM T3,1(T4) ;WORDS PER PHYSICAL BLOCK
HLLZS T3 ;START BACK ON ZERO
PUSHJ P,OUTP ;OUTPUT THIS BLOCK
JRST KCONVB ;AND CONTINUE WITH NEW OUTPUT BUFFER
KERR: ERRPNT </?Incorrect FOROTS data file!/>
>
;COME HERE AFTER /L,/D,/R ON DISK OR THROUGH COPYING
MAIN1: RELEAS DIR, ;RELEASE THE DIRECTORY DEVICE
RELEAS IN,INHIB ;RELEASE THE INPUT DEVICE
SKIPL T4,ESWTCH ;MORE COMMAND STRING TO PROCESS?
JRST MAIN2 ;YES
;COME HERE AFTER /D,/R ON DTA. ALSO FROM ABOVE
MAINB: CLOSE OUT, ;CLOSE THE OUTPUT FILE
PUSHJ P,OUTP1 ;CHECK THE FINAL ERROR BITS
IFN FTDSK,<TLNE AUXFLG,NSPROT ;NON-ST. PROT?
TRNN AUXFLG,DSKOUT ;DISK OUT/
JRST MAINB1 ;NO
LDB 0,PRPTL
SKIPE LEVEL ;IF LEVEL D
JUMPN 0,MAINB1 ;ALREADY SET UNLESS 0
DPB 0,PRPTD
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,DTON+3 ;NON-SKIP RETURN, USE IT
RENAME OUT,DTON ;SET UP RENAME REQUEST
JRST DERR6 ;DISK ERROR
MAINB1:>
RELEAS OUT, ;RELEASE THE OUTPUT DEVICE
JRST PIP2 ;PROCESS THE NEXT COMMAND
MAIN2: PUSHJ P,DESCRP ;GET THE NEXT INPUT FILE TO PROCESS
PUSHJ P,INLOOK
PUSHJ P,M4
HRRZM T4,ININI1
JRST MAINA3
;END OF LOOP BEGINNING AT MAINA3
;SUBROUTINE TO INITIALIZE THE INPUT FILE
ININIT: IFN TEMP,<
TRNE CALFLG,TMPI ;IF DEV IS TMPCOR:
POPJ P, ;RETURN>
MOVE T1,SVJBF1 ;SVJBF1=END OF OUTPUT BUFFERS
MOVEM T1,.JBFF ;COMPARE OMODE CODE
MOVEI 0,IBF
MOVEM 0,DEVICE+1
OPEN IN,ININI1
JRST ERR1A ;NOT AVAILABLE ERROR
INBUF IN,1 ;TRY ONE INPUT BUFFER FOR SIZE
EXCH T1,.JBFF ;HOW MANY INBUFFERS WILL FIT?
SUB T1,SVJBF1
HRRZ 0,.JBREL
SUB 0,.JBFF ;JOBREL-SVJBF1=TOTAL SPACE LEFT
IDIVM 0,T1
MOVEI T4,ININIT ;RETURN FROM CORCHK IS ININIT
PUSHJ P,CORCHK ;LOOP BACK OR ERROR IF NOT ENOUGH CORE
INBUF IN,(T1) ;SET UP AS MANY BUFFS AS FIT
MOVE 0,IBF+1 ;SAVE ORIGINAL MODE
MOVEM 0,SVIBF
POPJ P,
;THIS ROUTINE GETS AN INPUT UNIT DESCRIPTOR AND, FOR
;ADVANCE FILE AND BSPF ON MTA, ENSURES THE VALUE 1 IF NO
;NUMBER WAS GIVEN.
DESCRP: SETZM AUX ;WILL GET ANY MTA REQ. GOING TO AUXFLG.
TRZE AUXFLG,SYSFLG ;IS THIS DEVICE SYS.?
TRO AUXFLG,SYSLST ;YES,SET SYS AS LAST DEVICE
SETZM AB ;MTA VALUE SWITCHES
SETZM PR ;PROTECTION
IFN FTDSK,<SETZM PP ;PROJ-PROG NUMBER>
PUSHJ P,NAME ;GO SCAN INPUT SIDE OF COMMAND STRING
MOVE T1,PR ;PROTECTION
HLLZM T1,PR ;IGNORE PR FLAG IN RHS FOR INPUT
PUSHJ P,CHECK1 ;CHECK UNIT, AND FOR _
IFN FTDSK,<TRNN AUXFLG,DSKIN ;DSK INPUT?
JRST DESCR1 ;NO
TRNE AUXFLG,SYSFLG ;IS THIS DEVICE SYS?
JRST DESCR1 ;YES
TRNN AUXFLG,SYSLST ;WAS LAST DEVICE?
JRST DESCR1 ;NO
MOVE T2,FNPPNS ;YES, SAVE LAST [P,P]
SKIPE PP ;[P,P] ZERO?
JRST DESCR1
MOVEM T2,PP ;YES, MAKE OLD [P,P] CURRENT [P,P]
MOVEM T2,FNPPN ;RESERVE [P,P]>
DESCR1: SKIPE XNAME ;NO OVERSHOOT ALLOWED
JRST ERR6A
ABCHK: HLRZ T2,AB ;NO RECS/FILES TO BACKSPACE
JUMPN T2,.+2 ;IF 0
MOVEI T2,1 ;GUARANTEE ONE
HRLM T2,AB ;SET AB LH
HRRZ T2,AB ;NO RECS/FILES TO ADV
JUMPN T2,FNSET ;IF 0
AOS AB ;GUARANTEE 1
JRST FNSET ;FIND OUT DETAILS OF FILENAME
;IF A NON-STANDARD OUTPUT PROTECTION IS REQUESTED, SAVE FOR RENAME.
PROTK: MOVE T1,PR
TRNN T1,1
JRST PROTK1
HLLZM T1,PROTS
HLLZM T1,PR
TLOA AUXFLG,NSPROT
PROTK1: SETZB T1,PR
POPJ P,
;TEST "DEVICE" TO SEE IF DESTINATION DEVICE IS DTA, DSK, PTP, LPT, TTY, MTA
;IF ANY IS TRUE, SET RELEVANT BIT IN AUXFLG. "0" CONTAINS
;"DEVICE" ON ENTRY.
DEVTST: DEVCHR ;GET DEVICE CHARACTERISTICS
IFN FTDSK,<TLNN 0,DSKBIT ;IS OUTPUT DEV DSK?
JRST DEVTSU ;NO
TRO AUXFLG,DSKOUT ;YES, SET BIT
PUSH P,DEVICE ;SAVE DEVICE NAME
POP P,ADSK ;PUT NAME IN DSK INIT
POPJ P,
DEVTSU:>
JUMPE 0,DEVER2 ;NON-EXISTENT DEVICE
TLNN 0,OUTBIT ;CAN DEV DO OUTPUT?
JRST ERR6A ;NO
TLNE 0,DTABIT ;DECTAPE?
TRO AUXFLG,DTAOUT ;YES
TLNE 0,PTPBIT ;PAPER TAPE PUNCH?
TRO AUXFLG,PPTOUT
TLNE 0,LPTBIT ;LINE PRINTER?
TRO AUXFLG,LPTOUT
TLNE 0,TTYBIT ;TELETYPE?
TRO AUXFLG,TTYOUT
TLNE 0,MTABIT ;MAGTAPE?
TRO AUXFLG,MTAOUT
MOVE 0,ODEV ;GET OUTPUT DEVICE AGAIN
DEVTYP 0, ;NEED TO FIND OUT ABOUT SPOOLING
SETZ 0, ;NEED 5.03 TO SPOOL
TLNE 0,.TYSPL ;IS DEVICE SPOOLED
TLOA CALFLG,OSPLFL ;YES
TLZ CALFLG,OSPLFL ;NO
POPJ P,
;ROUTINE TO CHECK IF DEVICE SYS AND SET [P,P], IF NONE GIVEN
IFN FTDSK,<
PSYSP: CAME 0,[SIXBIT /SYS/];IS DEVICE SYS?
POPJ P, ;NO
MOVE T1,SYSPP ;GET SYS PP
MOVEM T1,PP ;AND SET IT
TRO AUXFLG,SYSFLG ;SET FLAG TO INDICATE
POPJ P, ;CURRENT INPUT DEVICE IS SYS>
DEVER1: IFN TEMP,<
TROA CALFLG,TMPI>
DEVER2: IFN TEMP,<
TRO CALFLG,TMPO>
IFN TEMP,<HLRZ T1,DEVICE
CAIN T1,'TMP'
POPJ P, ;ALLOW DEVICE TMPCOR:
TRZ CALFLG,TMPI!TMPO ;JUST IN CASE>
MOVE T1,DEVICE
DEVER: MOVEM T1,DEVERR
ERRPNT </?Device />
PUSHJ P,P6BIT
DEVERR
ERRPN2 </ does not exist!/>
;ROUTINE TO INIT PDL POINTER AND TTY
INICN1: MOVEI P,PDL-1 ;INITIALIZE PUSHDOWN POINTER
SETZM DTJBFF ;ALWAYS REINITIALIZE IF * OUTPUT
INICN2: MOVE 0,SVJBFF ;IS INITIALIZED AT PIP1
MOVEM 0,.JBFF ;SET JOBFF TO BEGINNING OF BUFFER AREA
PUSHJ P,INICON ;INITIALIZE THE TTY
INBUF CON,1 ;ONE INBUFFER
OUTBUF CON,1 ;ONE OUTBUFFER
MOVE 0,DTJBFF ;SEE IF THIS IS FIRST TIME HERE
JUMPN 0,[MOVEM 0,.JBFF ;NO, SO SAVE POSSIBLE STORED COMMAND
JRST INICN3]
MOVE 0,.JBFF
HRRZM 0,DTJBFF ;JOBFF AFTER 2 TTY BUFFERS SET
INICN3: OUTPUT CON, ;INITIALIZE BUFFER POINTERS
JRST (T5)
;ROUTINE TO CLEAR LINE BUFFER
CLRBUF: SETZM LBUF ;SUBR. TO CLEAR LINE BUFFER
MOVE 0,[LBUF,,LBUF+1]
BLT 0,LBUFE
POPJ P,
;COMMAND SCANNER ROUTINE
NAME: TRNN CALFLG,SSWTCH ;RETURN NULL IF _ OR END-OF-LINE SEEN
SKIPGE ESWTCH
JRST NM13 ;
TRZ CALFLG,NSWTCH
SKIPE T1,XNAME ;IF COMMAND SCAN OVERSHOOT PICKED UP
;DEVICE NAME, USE IT NOW
JRST NM7
TRZ CALFLG,DEV
;LOOK FOR FILE NAME, EXT
NM1: SETZM FILEX
SETZM QMASK+1 ;CLEAR WILD CHAR. MASK
TLZ CALFLG,MFLG ;AND FLAG
TRZ CALFLG,COMAFL ;CLEAR COMMA FLAG
NM2: SETZM FILNAM
SETZM QMASK
SKIPA T1,NM15
IDFIN: POP P,T1 ;RESTORE OLD POINTER
;LOOP TO PICK OFF FILENAME, EXT
NM3: PUSHJ P,GETCOM ;GO GET 7 BIT ASCII CHAR. FROM COMMAND STRING
NM3A: CAIN 0,"*" ;TO ALLOW FN.EX = *.*
JRST NMSTAR ;GO SET MASK
CAIL 0,"A" ;ALPHABETIC CHARACTER?
CAILE 0,"Z"
JRST NM4A ;NO
NM4: SUBI 0,40 ;CONVERT TO SIXBIT
TLNE T1,770000 ;6 CHARS. YET?
IDPB 0,T1 ;NO
JRST NM3 ;GET NEXT CHAR.
NM4A: CAIL 0,"0" ;NUMERIC?
CAILE 0,"9"
JRST NM5 ;NO
JRST NM4
NMBIN: TLC T1,500 ;MAKE BYTE SIZE 3
NMBIN1: PUSHJ P,GETBUF ;GET A CHARACTER
CAIL 0,"0" ;MUST BE OIT
CAILE 0,"7"
JRST NMBIN2 ;NOT NUMERIC
SUBI 0,"0" ;MAKE BINARY
TLNE T1,770000 ;STILL ROOM?
IDPB 0,T1 ;YES
JRST NMBIN1 ;GET NEXT
NMBIN2: TLNE T1,010000 ;ODD NUMBER OF 3 BIT BYTES?
IBP T1 ;YES, MAKE EVEN
TLC T1,500 ;BACK TO SIXBIT BYTES
JRST NM3A ;PROCESS THIS CHAR.
;CHARACTER NOT *,0-9,A-Z
NM5: CAIG 0,CR ;CARRIAGE RETURN
CAIGE 0,LF ;LINE FEED
CAIN 0,ALTMOD ;ALTMODE
JRST NM5A ;YES
CAIN 0,CZ ;END-OF-FILE(CCL)?
NM5A: JRST NM5C ;YES, OR EOF
CAIN 0,COMMA ;COMMA
JRST NM6 ;YES
CAIN 0,PERIOD ;PERIOD
JRST NM10 ;YES
CAIN 0,COLON ;COLON
JRST NM9 ;YES
CAIN 0,";" ;IS THE REST A COMMENT?
JRST NM16 ;YES
IFN CCLSW,<CAIN 0,"@" ;INDIRECT COMMAND
JRST INDRCT ;YES
CAIN 0,"!" ;RUN COMMAND?
JRST RUNIT ;YES>
CAIN 0,"?" ;WILD CHAR.?
JRST WLDCH ;YES, SET UP MASK
CAIN 0,"^" ;TAPE ID ?
JRST ID ;YES
CAIN 0,"#" ;SPECIAL OCTAL FILE NAME ?
JRST NMBIN ;YES
CAIE 0,LA ;LEFT ARROW
CAIN 0,"=" ;OR EQUALS
SKIP 1 ;YES
JRST NM5B ;NO
TRNE CALFLG,DEV ;HAS A DEVICE BEEN SEEN?
TRO CALFLG,DVSWTH ;YES-NEEDED FOR /Z/,/D
TROA CALFLG,SSWTCH!ARWSW ;SET LEFT ARROW SWITCHES
NM5C: SOS ESWTCH ;END OF LINE OR FILE
JRST NM6A ;BUT NOT COMMA
NM6: TRNN CALFLG,ARWSW ;COMMA'S ILLEGAL BEFORE "_"
JRST ERR6A ;GIVE MESSAGE
TRO CALFLG,COMAFL ;MARK COMMA SEEN, MORE TO COME
NM6A:
IFN FTDSK,<SKIPE PP ;IF PPN ALREADY SET UP
SKIP 2 ;GO ON
SKIPE T1,PPP ;GET DEFAULT PPN
MOVEM T1,PP ;AS PPN>
SKIPN T1,FILEX ;COMMA ROUTINE - FIGURE OUT WHAT WE HAVE
JRST NM17 ;NO FILE NAME TEMPORARILY IN FILEX
EXCH T1,FILNAM ;PUT THE FILE NAME WHERE IT BELONGS
HLLZM T1,FILEX ;PUT THE EXTENSION WHERE IT BELONGS
MOVE T1,QMASK+1 ;GET FILE NAME MASK
EXCH T1,QMASK ;INTO RIGHT PLACE
HLR T1,T1 ;PUT MASK IN BOTH HALVES
MOVEM T1,QMASK+1 ;SINCE NEEDED IN EITHER HALF
MOVE T1,[QMASK,,OQMASK] ;PUT MASK ON OUTPUT SIDE
TRNE CALFLG,SSWTCH ;SEEN LEFT ARROW YET?
BLT T1,OQMASK+1 ;SINCE IT MAY DIFFER FROM INPUT MASK
POPJ P,
NM7: SETZM XNAME ;USE XNAME ONLY ONCE
CAIN T1,1 ;1 FLAGS A NULL OVERSHOOT
JRST NM13 ;RETURN NULL NAME
NM8: MOVEM T1,DEVICE ;NEW DEVICE
SETZM FILNAM ;FILE NAME OUT OF DATE BY NOW
IFN FTDSK,<SETZM PPP ;CLEAR PERM PPN
SETZM DEFPTH ;AND DEFAULT PATH>
TRO CALFLG,DEV
JRST NM1 ;LOOK FOR A FILE NAME AND EXTENSION
NM9: TRNN CALFLG,DEV ;COLON ROUTINE - IS DEVICE NAME IN YET?
JRST NM12 ;NO
SKIPN T1,FILNAM ;SCAN OVERSHOOT - NULL OVERSHOOT?
MOVEI T1,1 ;YES - FLAG NULL OVERSHOOT WITH A 1
MOVEM T1,XNAME ;XNAME = OVERSHOOT NAME
JRST NM14
ID: PUSH P,T1 ;SAVE BYTE POINTER
MOVE T1,[POINT 6,TAPEID]
ID1: PUSHJ P,GETBUF ;ALLOW ALL 6 BIT CHARS.
CAIN 0,"^" ;END OF TAPE ID?
JRST IDFIN ;YES
SUBI 0,40 ;MAKE SIXBIT
JUMPL 0,ERR6 ;MUST BE SIXBIT
TLNN T1,770000 ;TOO MANY CHAR.?
JRST ERR6 ;YES, GIVE ERROR
IDPB 0,T1 ;STORE CHAR.
JRST ID1 ;GET MORE
NM10: SKIPE FILEX ;FILENAME SEEN ALREADY?
JRST ERR6 ;YES, GIVE COMMAND ERROR
MOVE 0,FILNAM ;PERIOD ROUTINE - SAVE FILE NAME
MOVEM 0,FILEX ;TEMPORARILY IN FILEX
MOVE 0,QMASK ;GET WILD CHAR. MASK
MOVEM 0,QMASK+1 ;SAVE IT ALSO
JRST NM2 ;LOOK FOR EXTENSION
NM11: SKIPN FILNAM ;WAS A FILE NAME SPECIFIED?
TRNE CALFLG,DEV ;WAS ANYTHING SPECIFIED?
POPJ P, ;YES
NM12: SKIPE T1,FILNAM ;NULL NAME SPECIFIED?
JRST NM8 ;NO - SO REMEMBER AND LOOK FOR FILE NAME
NM13: TRO CALFLG,NSWTCH ;RETURN A NULL NAME
SETZM FILEX
NM14: SETZM FILNAM
POPJ P,
NM15: POINT 6,FILNAM
NM5B: CAIE 0,TAB ;IGNORE TAB
CAIN 0,SPACE ;SPACES IGNORED
JRST NM3 ;IGNORE NOT LEGAL SIXBIT
PUSH P,0 ;SAVE CHARACTER
ERRPNX </?Illegal character />
POP P,0 ;RECOVER CHAR.
CAIL 0,SPACE ;INVISIBLE CHAR.?
JRST .+4 ;NO
MOVEI CHR,"^" ;USUAL UP ARROW MARKER
PUSHJ P,PUTCON ;OUTPUT TO TTY
TRC 0,100 ;MAKE CHAR. VISIBLE
MOVE CHR,0 ;NOW FOR THE CHAR.
PUSHJ P,PUTCON
ERRPN2 </ in command!/>
NM16: PUSHJ P,GETBUF ;GET NEXT ASCII CHAR.
CAILE 0,LF
CAIG 0,CR ;IF LF,FF,VT,OR CR
JRST NM5A ;RETURN
CAIE 0,ALTMOD ;SAME IF ALTMOD
CAIN 0,CZ ;OR ^Z
JRST NM5A
JRST NM16 ;GET NEXT CHARACTER
IFE FTDSK,<SYN NM11,NM17>
IFN FTDSK,<
NM17: MOVE T1,[QMASK,,OQMASK] ;PUT MASK ON OUTPUT SIDE
TRNE CALFLG,SSWTCH ;SEEN LEFT ARROW YET?
BLT T1,OQMASK+1 ;SINCE IT MAY DIFFER FROM INPUT MASK
MOVS T1,FILNAM ;GET EXT
CAIN T1,(SIXBIT 'UFD') ;CHECK FOR .UFD
SKIPN PP ;AND [PPN]
JRST NM11 ;NO, NOT A UFD LOOKUP
MOVSM T1,FILEX ;EXT IN CORRECT PLACE
MOVE T1,PP ;GET PPN
MOVEM T1,FILNAM ;INTO FILNAM
MOVE T1,PP11 ;MFD IS ON [1,,1]
MOVEM T1,PP ;FOR DSK LOOKUP
POPJ P,>
IFN CCLSW,<
INDRCT: MOVE T3,DEVICE ;GET DEVICE
MOVEM T3,CCLINI+1 ;SET IT UP FOR OPEN
SKIPN T3,PP ;SOMEONE ELSES AREA
SETZ T3, ;NO, USE OWN
MOVEM T3,CFILE+3 ;STORE PPN
MOVE T3,FILEX ;GET FILE NAME OR EXTENSION
MOVEM T3,CFILE ;ASSUME FILE NAME
MOVE T3,FILNAM ;GET FILE NAME
SKIPN CFILE ;HAVE WE A FILE NAME
EXCH T3,CFILE ;PUT IN RIGHT PLACE
JRST P12 ;STORE EXT
RUNIT: TRNE CALFLG,DEV ;USE SYS IF NO DEVICE SEEN
SKIPN T3,DEVICE ;GET DEVICE IF SPECIFIED
MOVSI T3,'SYS'
MOVEM T3,RUNDEV
MOVE T3,FILNAM ;GET FILE NAME
MOVEM T3,RUNFIL ;SAVE IT
PUSHJ P,GETEND ;DELETE COMMAND FILE
SKIPN T3,PP ;SOMEONE ELSES AREA?
SETZ T3, ;NO, SO USE OWN
MOVEM T3,RUNPP
MOVEI 16,RUNDEV ;XWD 0,RUNDEV
SKIPE COMFLG ;CCL IN PROGRESS?
HRLI 16,1 ;YES START AT C(JOBSA)+1
RUN 16,
HALT ;SHOULD NOT RETURN
>
;HERE IF A "?" SEEN IN FILE NAME OR EXTENSION
WLDCH: TLO CALFLG,MFLG ;SET FLAG
TLNN T1,770000 ;6 CHAR. YET?
JRST NM3 ;YES, NO MORE
IDPB 0,T1 ;DEPOSIT IN NAME
HRRI T1,QMASK ;MASK BYTE POINTER
DPB 0,T1 ;PUT IN MASK ALSO
HRRI T1,FILNAM ;BACK AS IT WAS
JRST NM3 ;RETURN FOR MORE
;HERE IF "*" SEEN IN FILE NAME OR EXTENSION
NMSTAR: SKIPE (T1) ;NAME BETTER BE ZERO
JRST ERR6A ;YOU LOSE
SETOM QMASK ;MASK ALL CHARACTERS
SETOM (T1) ;AND NAME OF ??????
TLZ T1,770000 ;MAKE SURE NOTHING ELSE GETS HERE
TLO FL,MFLG ;SET FLAG
JRST NM3 ;BACK FOR MORE
;ROUTINE TO OUTPUT ONE LINE FROM LBUF
OUTLBF: TRNE FLAG,LINE
JRST OUTLBA ;OUTPUT LINE-BY-LINE
OUTCH1: MOVE T2,OPTRA ;OUTPUT CHARACTER-BY-CHARACTER
OUTLB1: CAMN T2,OPTR ;ARE ALL CHARACTERS OUT?
POPJ P, ;YES
ILDB CHR,T2 ;NO
PUSHJ P,PUT ;GO OUTPUT CHARACTER
JRST OUTLB1
OUTLBA: TLNE FLAG,CHKFLG;PAREN COUNTING?
JRST OUTCHK ;YES, SO DO IT
TRNE AUXFLG,TTYOUT+LPTOUT
JRST OUTCH1 ;IF OUTPUT TO TTY OR LPT DO CHR BY CHR
MOVEI T1,4 ;CLEAR UNUSED PORTION OF LAST WORD USED IN LBUF
MOVEI T2,0
MOVE T3,OPTR
IDPB T2,T3
SOJG T1,.-1
MOVEI T2,5
HRRZ T1,OPTR ;COMPUTE NUMBER OF WORDS FILLED
SUBI T1,LBUF-1
JUMPE T1,OUTLB3 ;DO NOTHING IF BUFFER EMPTY
IMULM T1,T2 ;COMPUTE CHARACTER COUNT=5 TIMES WORD CT
;THIS IS WHERE OLD FORTRAN MODE WAS TESTED.
CAMG T2,OBF+2 ;WILL LINE FIT IN THE OUTBUFFER?
JRST OUTLB2 ;YES
PUSHJ P,OUTP ;NO, SO DUMP BUFFER AND CHECK ERROR BITS
MOVEI T6 ,1
TDNE T6,LBUF ;SEQUENCED?
TRNN AUXFLG,DTAOUT ;YES, ON DTA?
SKIP 1 ;NO
ADDI T2,40*5 ;LEAVE EDITING ROOM
OUTLB2: MOVNS T2
ADDM T2,OBF+2 ;UPDATE OUTBUFFER CHARACTER COUNT
HRLI T2,LBUF
HRR T2,OBF+1
ADDI T2,1
ADDB T1,OBF+1 ;UPDATE OUTBUFFER BYTE POINTER
BLT T2,(T1) ;MOVE DATA TO OUTBUFFER
OUTLB3: POPJ P,
;ROUTINE TO PUT ONE CHAR INTO OUT BUFFER
TABOUT: MOVEI CHR,TAB ;OUTPUT A TAB
PUT: SOSG OBF+2 ;SUBR. TO OUTPUT ONE CHARACTER IN AC CHR
PUSHJ P,OUTP ;IF BUFFER FULL, DUMP AND CHECK ERR BITS
IDPB CHR,OBF+1 ;PUT CHARACTER IN BUFFER
POPJ P,
LISTIT: TLOA T1,(POINT 7) ;FORM BYTE POINTER
PUSHJ P,PUT ;OUTPUT CHAR
ILDB CHR,T1 ;GET CHAR.
JUMPN CHR,.-2 ;BACK FOR MORE
POPJ P, ;DONE
;ROUTINE TO DUMP OUT BUFFER WHEN FULL
OUTP: OUT OUT, ;SUBR. TO DUMP OUTBUFFER AND CHECK ERR BITS
JRST CPOPJZ ;NO ERRERS,BUT CLEAR IOS JUST IN CASE
OUTP1: GETSTS OUT,IOS ;HERE FOR BIT CHECKING ONLY
PUSHJ P,OUTP4
SETSTS OUT,(IOS);ERRORS WERE DETECTED
POPJ P, ;NO ERRORS
OUTP4: TRNN AUXFLG,MTAOUT
JRST .+3
OUTP3: TRNE IOS,EOTBIT ;EOT?
JRST .+3 ;YES
TRNN IOS,740000 ;ANY ERROR BITS ON?
JRST CPOPJ1 ;NO
PUSHJ P,COMERR ;YES
JSP T5,INICN2 ;INIT TTY
PUSHJ P,QUEST
ERRPN2 </Output device />
PUSHJ P,P6BIT
ODEV
SKIPN DTON ;ONLY IF THERE IS A FILE NAME
JRST .+4 ;DON'T PRINT IF NOT
ERRPN2 </: file />
MOVEI T3,DTON ;OUTPUT FILE NAME LOC
PUSHJ P,FN.EX ;PRINT FILE NAME EXT
MOVE T2,AUXFLG
ANDI T2,MTAOUT+DSKOUT+DTAOUT
IOERR: MOVEI T1,TXTC ;PHYSICAL END OF TAPE
TRNE IOS,EOTBIT
JRST PTEXT2 ;YES
MOVEI T1,TXTD2 ;7-9 PUNCH MISSING
TRNN T2,CDRIN
IFN FTDSK,<
MOVEI T1,TXTD3
TRNN T2,DSKIN>
MOVEI T1,TXTD ;WRITE LOCK ERROR
TRNN T2,DSKIN+DSKOUT+DTAIN+DTAOUT+MTAIN+MTAOUT
MOVEI T1,TXTD1
TRNE IOS,WRTLOK
JRST PTEXT2
MOVEI T1,TXTA ;DEVICE ERROR
TRNE IOS,200000
JRST PTEXT2
MOVEI T1,TXTB ;CHECKSUM/PARITY ERROR
TRNE IOS,100000
JRST PTEXT2
IFN FTDSK,<
HRRZ T1,TABLE+14
TRNN T2,DSKOUT ;QUOTA EXCEDED>
MOVEI T1,TXTC1 ;BLOCK TOO LARGE
JRST PTEXT2
;DEVICE ERROR COMMENTS
TXTD: ASCIZ /write (lock) error/
JRST IOERRN ;NO RECOVERY
TXTD1: ASCIZ /binary data incomplete/
JRST IOERRG
TXTD2: ASCIZ /7-9 punch missing/
JRST IOERRG
TXTA: ASCIZ /device error/
JRST IOERRG
TXTB: ASCIZ /checksum or parity error/
JRST IOERRG
TXTC: ASCIZ /physical eot/
JRST IOERRG
TXTC1: ASCIZ /block or block number too large/
;FALLS THROUGH TO IOERRN
IOERRN: PUSHJ P,TCRLF ;OUTPUT A CR-LF ON TTY
RELEAS TAPE, ;NO RECOVERY ERRORS EXIT HERE
RELEAS DIR,
RELEAS OUT,
RELEAS IN,
SETZM TAPEID ;CLEAR REQUEST TO WRITE TAPE ID
JRST PIP2 ;GET NEXT COMMAND
IFN FTDSK,<
TXTD3: ASCIZ /monitor detected software error/>
;TEST IF /G FLAG(IGNORE ERRORS) SET
IOERRG: TLNN FLAG,GFLG ;PRINTED CURRENT MESSAGE
JRST IOERRN ;NO RECOVERY
ERRPN2</
/> ;PRINT CR, LF DON'T MOVE>
RELEAS CON,
TRNE AUXFLG,TTYOUT ;TTY OUTPUT DEVICE?
PUSHJ P,OMODE ;YES, INIT OUTPUT DEVICE
TRNE AUXFLG,TTYIN ;REINIT TTYIN,TTYOUT
PUSHJ P,ININIT
TRZ IOS,740000 ;CLEAR FILE STATUS, I/O ERRORS
TRNE T2,MTAIN+MTAOUT
TRZ IOS,EOTBIT ;CLEAR PHYSICAL EOT I/O ERROR
MOVS 0,[XWD 1,SAVAC]
BLT 0,3
MOVE T5,SAVAC+3
MOVE T6,SAVAC+4
POPJ P,
COMERR: MOVE 0,[XWD 1,SAVAC] ;SAVE ACS T1,T2,T3,T5,T6
BLT 0,SAVAC+2
MOVEM T5,SAVAC+3
MOVEM T6,SAVAC+4
TRNE AUXFLG,TTYOUT ;RELEASE ANY TTYIO
RELEAS OUT,
TRNE AUXFLG,TTYIN
RELEAS IN,
POPJ P,
;PRINT FILE NAME AND EXTENSION FROM (T3), 1(T3).
FN.EX: MOVE T1,(T3) ;T1=FILENAME
HLRZ T6,1(T3) ;T6=FILE EXT
MOVEM T1,DERR2 ;STORE FILE NAME
JUMPE T6,DERR2A ;FILE EXT=0?
JUMPL T1,DERR2B ;MUST BE SIXBIT, SIGN BIT ON
CAIE T6,'UFD'
JRST DERR2B ;NO
SETZB T1,DERR2 ;CLEAR FILE NAME IF 'UFD'
HLRZ DOUT,(T3) ;YES, GET PROJ. NO.
MOVEI T2,PUTCON ;PRINT PROJ-PROG. NO.
MOVEI CHR,"[" ;BETWEEN SQUARE BRACKETS
PUSHJ P,PUTCON
PUSHJ P,OUTOCT ;CONVERT TO ASCII
MOVEI CHR,COMMA
PUSHJ P,PUTCON
HRRZ DOUT,(T3) ;GET PROG. NO.
PUSHJ P,OUTOCT ;CONVERT TO ASCII
MOVEI CHR,"]"
PUSHJ P,PUTCON
DERR2B: TLO T6,"."-40 ;PUT SIXBIT PERIOD
DERR2A: MOVEM T6,DERR2+1 ;INTO EXTENSION
PUSHJ P,P6BIT
DERR2
PUSHJ P,P6BIT
DERR2+1
MOVEI CHR," "
JRST PUTCON
;THIS ROUTINE GETS A 7 BIT ASCII CHARACTER FROM THE COMMAND STRING
;AND RETURNS IT TO THE COMMAND SCANNER ROUTINE (NAME) IN AC0
GETCOM: PUSHJ P,GETBUF
CAIN 0,"/" ;SINGLE CHARACTER SWITCH
JRST GETT6
CAIN 0,"(" ;LOOK FOR (MULTI-CHAR.) SWITCH
JRST GETT3
CAIN 0,"<" ;GO LOOK FOR PROTECTION
JRST GETT9
CAIE 0,"["
POPJ P,
GETT10: PUSHJ P,GETNUM ;LOOK FOR PROJECT-PROGRAMMER NUMBER
IFN FTDSK,<SETZM PTHADD ;CLEAR FULL PATH IN CASE ONLY PPN>
CAILE T7,-1 ;GREATER THAN HALF WORD?
JRST ERR2 ;YES, ERROR
JUMPN T7,.+4 ;NUMBER SPECIFIED?
CAIN 0,"-" ;CHECK FOR SPECIAL [-]
JRST [SETZM PP ;MEANS [0,0]
PUSHJ P,GETBUF ;MAKE SURE ENDS RIGHT
CAIE 0,"]"
JRST ERR2 ;NO, GIVE ERROR
JRST GETT11] ;OK, USE 0
HLRZ T7,MYPPN ;NO, GET IT
HRLZM T7,PP
CAIE 0,"," ;SEPARATOR?
JRST GETT11 ;OR TERMINATOR (NON-NUMERIC)
PUSHJ P,GETNUM ;GET RIGHT HALF
CAILE T7,-1 ;GREATER THAN HALF WORD
JRST ERR2A ;YES, ERROR
SKIPN T7 ;OTHER THAN 0
HRRZ T7,MYPPN ;NO, GET USER'S
HRRM T7,PP ;STORE RIGHT HALF
IFN FTDSK,<CAIE 0,"," ;SFD'S
JRST GETT11 ;NO
PUSHJ P,GETPTH ;GET FULL PATH>
GETT11: CAIG 0,CR ;ALLOW END OF LINE
CAIGE 0,LF ;TO TERMINATE PPN
JRST .+3 ;NOT CR/LF
AOS COMCNT ;ALLOW FOR EXTRA CHAR READ
JRST .+3 ;AND SKIP TEST
CAIE 0,"]" ;FORCE CORRECT TERMINATOR
JRST ERR2
IFN FTDSK,<SKIPE FILNAM ;IF NO FILE SEEN YET
JRST GETCOM ;NOT DEFAULT PPN
MOVE T7,PTHADD ;GET FULL PATH FLAG
MOVEM T7,DEFPTH ;SET AS NEW DEFAULT FULL PATH
MOVE T7,PP ;GET TEMP PP
MOVEM T7,PPP ;MAKE PERM>
JRST GETCOM ;CONTINUE SCAN
GETT9: PUSHJ P,GETNUM
CAIN 0,">" ;TERMINATE ON RIGHT BRKT ONLY
CAILE T7,777 ;PR. IN RANGE?
JRST ERR2A
ROT T7,-11
HLLOM T7,PR ;RHS=1'S MEANS <> SEEN (PR MAY BE 0)
JRST GETCOM
GETNUM: MOVEI T7,0 ;TO PICK UP P-P NUMBER
GETN1: PUSHJ P,GETBUF ;AND PROTECTION
CAIN 0," " ;IGNORE SPACES
JRST GETN1
CAIL 0,"0"
CAILE 0,"7"
POPJ P, ;GOT A NON-NUMERIC
MOVE T5,0
LSH T7,3
ADDI T7,-60(T5) ;PROCESS TO BINARY
JRST GETN1
GETT3: PUSHJ P,GETT5 ;PROCESS SWITCH CHARACTER
CAIN 0,")" ;CLOSING PAREN?
JRST GETCOM ;YES
CAIN 0,"M" ;MTA FLAG?
TRO FLAG, MTFLG ;SET MTA, LOOK FOR MULTI CHAR. SWITCH
CAIE 0,"#" ;MTA#
JRST GETT3 ;NO
TRNN FLAG,MTFLG ;ONLY LOOK AFTER # IF MTFLG IS ON.
JRST ERR6A ;I.E. IF MT SWITCH IS IN PROGRESS.
PUSHJ P,GETNUD ;GET A NUMBER
SKIPN T7 ;SKIP IF NOT EXPLICIT ZERO
SETO T7, ;MAKE IT DIFFERENT FROM DEFAULT ZERO
CAIE 0,"D" ;TERMINATED BY D?
CAIN 0,"A" ;TERMINATED BY A?
JRST GETT3A ;YES, MARK AB UPPER
CAIE 0,"P" ;ONLY A,D,P AND B CAN BE
CAIN 0,"B" ;PRECEDED BY #.
SKIP 1
JRST ERR6A
HRRM T7,AB ;NO. FILES/RECS TO ADVANCE
;GOES IN AB (RH)
GETT3B: PUSHJ P,GETT5A
JRST GETT3
GETT3A: HRLM T7,AB ;NO. FILES/RECS TO BACK SPACE
JRST GETT3B ;GOES IN AB (LH)
GETT6: PUSHJ P,GETT5 ;PROCESS ONE SWITCH CHAR
CAIE 0,"M"
CAIN 0,")" ;THESE ARE ILLEGAL 1-SWITCH CHARS.
JRST ERR6A
JRST GETCOM
GETNUD: MOVEI T7,0 ;GET A DECIMAL NUMBER
GETN2: PUSHJ P,GETBUF ;GET CHAR FROM COMMAND STRING
CAIN 0,SPACE ;SPACE?
JRST GETN2 ;YES, IGNORE
CAIL 0,"0" ;NUMBER?
CAILE 0,"9"
POPJ P, ;NO
IMULI T7,^D10 ;T7*10
ANDI 0,17 ;ADD ON LAST DIGIT
ADD T7,0 ;+ LOW 4 BITS
JRST GETN2
;GET NEXT COMMAND STRING CHAR(SWITCH),CHECK WITH TABLE,SET FLAGS
GETT5: PUSHJ P,GETBUF ;GET CHAR FROM COMMAND STRING
GETT5A: MOVE T2,[POINT 7,DISPTB,6] ;SET DISPTB NEXT SEARCH
MOVEI T6,MTAREQ ;SET MTAREQ NEXT SEARCH
TRNN FLAG,MTFLG ;SET UP TABLE TO SEARCH AND FLAG TO SET.
HRRI T2,DISPTA ;PUT IN BYTE POINTER, NOT MTA REQUEST
;SET TO LOOK AT NON-MTA LETTERS FIRST
TRNN FLAG,MTFLG ;IF MTFLG SET, START AT DISPTB AND STORE RESULT IN
MOVEI T6,AUXFLG ;MTAREQ, ELSE START AT DISPTA AND STORE RESULT IN
;AUXFLG OR FLAG
;GET FIRST CHAR DISPTA OR DISPTB, LOOK FOR MATCH, SET SWITCH FLAGS.
GETT7: LDB T3,T2 ;COMPARE WITH LEFT 7 BITS OF
JUMPN T3,GETT8 ;TABLE ENTRIES
TRZ FLAG, MTFLG ;SEARCHED TABLE 1 (DISPTB) DROP MTA FLAG
MOVEI T6,AUXFLG ;SET AUXFLG NEXT TABLE SEARCH
TLNE AUXFLG,NOMORE ;AFTER FIRST INPUT DEVICE ONLY ACCEPT MTA FLAGS
POPJ P,
GETT8: CAIN T3,1 ;END OF DISPTA 1ST HALF?
MOVEI T6,FLAG ;YES, SEARCH DISPTA 2ND HALF FROM NOW ON
CAIN T3,2 ;END OF DISPTA 2ND HALF?
JRST ERR6A ;SEARCHED TABLE 3, ERROR EXIT
CAME T3,0 ;MATCHING CHARACTER?
AOJA T2,GETT7 ;NO, GET NEXT SWITCH IN TABLE.
MOVE T5,(T2) ;YES, SET FLAG OR AUXFLG OR MTAREQ
TLZ T5,DEL*4000 ;CLEAR ASCII CHAR SINCE IT'S NOT A FLAG
ORM T5,(T6) ;FLAG OR AUXFLG
TRNE FLAG,MTFLG
ORM T5,AUX ;MTA REQUESTS SAVED IN AUX
IFE RIMSW,<
TLNE FLAG,RIMFLG
JRST RIMTB ;NO RIM IF RIMSW=0
> ;PRINT ERROR MESSAGE
POPJ P, ;EXIT ON MATCHING CHAR
;ROUTINE TO GET ONE TTY OR CCL COMMAND STRING CHAR INTO AC 0
GETTA:
IFN CCLSW,<
SKIPE COMFLG ;STORED COMMANDS?
JRST GETSC ;YES>
SOSLE TFI+2 ;SUBR TO GET ONE TTY CHAR IN AC 0
JRST GETT2 ;BUFFER NOT EMPTY
MOVE 0,TFI ;BUFFER EMPTY, SAVE
MOVE T5,TFO ;CURRENT BUFFER LOCS
PUSHJ P,INICON ;BUFFER EMPTY SO RE-ATTACH TTY
HRROM 0,TFI ;RESTORE OLD BUFFER LOCS
HRROM T5,TFO ;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY
INPUT CON, ;GET THE NEXT LINE
MOVE T5,TFI+2 ;SAVE CHAR COUNT
RELEAS CON, ;LET GO OF TTY FOR USE AS IN-OUT DEVICE
MOVEM T5,TFI+2 ;RESTORE CHAR COUNT LOST DURING RELEASE
GETT2: ILDB 0,TFI+1 ;FETCH CHAR
GETT4: CAIE 0,ALT175 ;OLD ALTMODE?
CAIN 0,ALT176
MOVEI 0,ALTMOD ;YES,MAKE NEW ALTMOD
JUMPE 0,GETTA ;IGNORE NULL CHARS
CAIL 0,140 ;LOWER CASE?
TRZ 0,40 ;YES MAKE UPPER CASE?
CAIE 0,XON ;IGNORE XON,XOFF ONLY FOR
CAIN 0,XOFF ;TTY SERVICE TO SIGNAL TTY
JRST GETTA ;PTR READ IN MODE
POPJ P,
;ROUTINE TO GET ONE TTY CHAR FROM COMBUF INTO AC0
GETBUF: IFN CCLSW,<
SKIPE COMFLG ;CCL COMMAND?
JRST GETSC ;YES, GET CHARS FROM DSK, CORE>
SOSGE COMCNT ;ANY CHARS LEFT?
JRST ERR6B ;NO, COMMAND ERROR
ILDB 0,COMPTR ;PICK UP CHAR FROM COMBUF
POPJ P,
;ROUTINE TO INITIALIZE THE TTY, ASCII LINE MODE
INICON: INIT CON,1 ;SUBR TO INITIALIZE THE TTY
SIXBIT /TTY/
XWD TFO,TFI ;TTY OUT/IN BUFFER HEADERS
EXIT ;IF TTY NOT AVAILABLE,FATAL.JOB DET?
POPJ P,
;GET 7 BIT ASCII CHARACTER - INPUT FROM CCL COMMAND FILE
IFN CCLSW,<GETSC:
IFN TEMP,<SKIPN TMPFLG ;IS TMPCOR UUO IN ACTION?
JRST GETTM1 ;NO CONTINUE AS USUAL
GETTM2: ILDB 0,TMPPNT ;PICK UP NEXT CHARACTER
HRRZ DOUT1,TMPPNT ;GET BYTE POINTER POISITION
CAML DOUT1,TMPEND ;HAS THE COMMAND FINISHED YET
JRST GETEND ;YES, EXIT
JRST GETT4 ;CHECK FOR ALTMODE,NULL,LOWER CASE
GETTM1: >
SOSLE CFI+2 ;ANY REMAINING?
JRST GETSC0 ;YES
IN COM,
JRST GETSC0 ;NO ERRORS
STATZ COM,EOFBIT ;END-OF-FILE
JRST GETEND ;YES
ERRPNT </Read error-CCL command file!/>
GETSC0: ILDB 0,CFI+1 ;GET A CHARACTER
MOVE DOUT1,@CFI+1 ;GET PRESENT WORD
TRNN DOUT1,1 ;IS IT A SEQUENCE NUMBER?
JRST GETT4 ;NO - CONTINUE
AOS CFI+1 ;YES - ADD 1 TO BYTE POINTER
MOVNI DOUT1,5 ;I.E. IGNORE SEQ. NO.
ADDM DOUT1,CFI+2 ;SUBTRACT 5 FROM COUNT FOR SEQ. NO.
JRST GETSC ;CONTINUE
GETEND:
IFN TEMP,<SKIPE TMPFLG ;TMPCOR
JRST GETEN3 ;YES>
SKIPN COMFLG ;CCL END OF CS?
JRST GETEN2 ;NO
GETEN1: CLOSE COM, ;NO, DSK FILE CCL
SETZ 0, ;DIRECTORY ENTRY FOR RENAME
HLRZ 1,CFILE+1 ;GET EXT
CAIN 1,'TMP' ;IF EXT IS TMP
RENAME COM,0 ;WIPE OUT COMMAND FILE
JFCL
RELEASE COM,0 >
GETEN2: SETOM COMEOF ;INDICATE END OF FILE
MOVEI 0,CZ ;NEEDED TO TERM CCL CS SCAN
POPJ P,
IFN TEMP,<
GETEN3: MOVE 1,[XWD 2,TMPFIL]
TMPCOR 1, ;READ AND DELETE
JFCL ;NOT FOUND
JRST GETEN2 ;CONTINUE>
;TABLE OF RECOGNIZED COMMAND LETTERS AND CORRESPONDING FLAG BITS
DEFINE DISP (A,B,C)
< XWD <<"A">*4000>!C,B>
;MAGTAPE SWITCHES AND FLAG BITS. TABLE 1 (MTAREQ)
DISPTB: DISP A,MTAFLG
DISP B,MTBFLG
DISP T,MTTFLG
DISP W,MTWFLG
DISP 8,MT8FLG
DISP 5,MT5FLG
DISP 2,MT2FLG
DISP E,MTEFLG
DISP U,MTUFLG
DISP F,MTFFLG
DISP D,MTDFLG
DISP P,MTPFLG
DISP I,MTIFLG
DISP S,MTSFLG
DISP #,0
OCT 000000000000
;1ST BYTE 0=END OF DISPTB
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 2 (AUXFLG)
DISPTA: DISP Q,,QFLG
DISP E,,CDRFLG
DISP F,FFLG
OCT 004000000000
;1ST BYTE 1=END OF DISPTA 1ST HALF
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 3 (FLAG)
DISP A,LINE
DISP B,BMOD
DISP C,TBMOD
DISP D,DFLG
DISP G,,GFLG
DISP H,,IBFLG
DISP I,,IFLG
DISP J,,JFLG
IFN FORSW,<DISP K,BMOD,KFLG>
DISP L,LFLG
DISP M,0
DISP ),0
DISP N,NSMOD
DISP O,SQMOD+NSMOD+STS+OSFLG
DISP P,,PFLG!PCONV
DISP R,RFLG
DISP S,SQMOD+NSMOD+STS
DISP T,SPMOD
DISP U,,OFLG
DISP V,LINE,CHKFLG
DISP W,,WFLG
DISP X,XFLG
DISP Y,,IBFLG!RIMFLG
DISP Z,ZFLG
OCT 010000000000
;FIRST BYTE 2=END OF DISPTA 2ND HALF
;SUBR TO GET NEXT CHAR INTO AC CHR
;NO SKIP RETURN IS END OF FILE, SINGLE SKIP IS NORMAL RETURN
GET: TLNN FLAG,NEWFIL ;NEW FILE?
TLZN FLAG,PCONV+NEWFIL ;NO,CONVERT THIS CHAR?
JRST GETPC1 ;YES
LDB CHR,IBF+1 ;GET CHAR
CAIN CHR," " ;SPACE?
JRST GETPC2 ;YES, CONVERT TO LINE FEED
CAIG CHR,"3" ;IS THE CHAR A PROPER FORMAT CONTROL CHAR?
CAIGE CHR,"*"
JRST GETPC3 ;NO, SO OUTPUT LINE FEED FOLLOWED BY BAD CHAR
CAIG CHR,"." ;USE LEFT HALF OF TABLE?
SKIPA CHR,PCHTAB-<"*">(CHR)
MOVS CHR,PCHTAB-<"/">(CHR)
GETPC4: DPB CHR,IBF+1 ;CLOBBER OLD CHAR, USUALLY BECOMES NULL
LSH CHR,-7 ;BUT OTHERWISE BECOMES ANOTHER FORMAT CHAR
ANDI CHR,377 ;EXTRACT THE CHAR TO BE OUTPUT
TRZE CHR,200 ;=1 FOR GENERATING MULTIPLE LINE FEEDS
TLO FLAG,PCONV ;CONTINUE TO CONVERT
JUMPN CHR,CPOPJ1;OUTPUT THE GENERATED CHAR UNLESS NULL
POP P,(P) ;IGNORE NULL CHARS
JRST PSCAN4 ;DUMP THE LINE BUFFER
GETPC1: TRNN FLAG,SUS ;SUPPLYING SEQ. NUM. NOW?
JRST GET2 ;NO
ILDB CHR,PTRPT ;YES, SO GET CHAR OF SEQ NUM
JUMPN CHR,CPOPJ1;0 MARKS LAST CHAR
LDB CHR,IBF+1 ;GET FIRST CHAR OF THIS LINE
CAIG CHR,15 ;PREPARE TO OUTPUT A CR,LF
CAIGE CHR,12 ;IS FIRST CHAR OF LINE AN END OF LINE CHAR?
JRST [TRNE CALFLG,SQNSN ;REPLACING OLD SQ. NUM.?
TRZA FLAG,ESQ ;YES, SO DON'T REPEAT CHAR.
MOVEI CHR,TAB ;NO, SO OUTPUT A TAB
JRST .+2] ;SKIP RETURN
MOVEI CHR,15 ;END OF LINE, NO TAB
TRZ FLAG,SUS ;TURN OFF SUS SUPPLY
JRST GETA5
GET5: AOS IBF+1 ;HERE IF A SEQ NUM FOUND IN INBUFFER
TRO CALFLG,SQNSN ;SIGNAL SQ. NUM. SEEN
MOVNI T1,5 ;IGNORE SEQ NUM, AND DECREMENT CHAR COUNT
ADDB T1,IBF+2
TRNE FLAG,NSMOD ;REMOVE SEQ NUMS MODE?
JRST GET2A ;YES, SO GET NEXT CHAR
MOVEM T2,SQNUM ;SEQ NUM FROM BUFFER BECOMES NEW SEQ NUM
PUSHJ P,OUTLBF ;DUMP THE LINE BUFFER (IF REQUIRED)
TRON FLAG,STS+SNI ;TURN ON START OF LINE
;AND NO-INCREMENT SEQ NUM FLAG
PUSHJ P,CLRBUF ;CLEAR LBUF IF IN THE MIDDLE OF A LINE
JRST GET1 ;GET CHAR. AFTER SEQ. NUMBER
GET2A: TRNN FLAG,SQMOD ;IF RESEQUENCING COPY FIRST CHAR.
GET2: TRZE FLAG,ESQ ;REPROCESS LAST CHAR?
JRST GET1 ;YES
SOSL T1,IBF+2 ;CHARS REMAINING IN INBUFFER?
JRST GET4 ;YES
PUSHJ P,INP ;NO, SO REFILL AND CHECK ERR BITS
TRNE IOS,EOFBIT ;END OF FILE? IOS HAS STATUS BITS
POPJ P, ;YES
REPEAT 0,< ;REMOVED UNTIL CORRECT FIX FOUND
;EDIT #107 SPR 7795
TRNE FLAG,SQMOD ;SEQUENCED?
TRNN FLAG,NSMOD ;AND REMOVING?
JRST GET2 ;NO, SO PROCESS INBUFFER
IBP IBF+1 ;IGNORE TAB
SOS IBF+2
>;END OF REPEAT 0
JRST GET2
GETPC3: TRO FLAG,ESQ ;REPROCESS BAD CHAR
TROA CHR,12*200 ;PRECEED BAD CHAR WITH LINE FEED
GETPC2: MOVEI CHR,12*200;CHANGE SPACE TO LINE FEED
JRST GETPC4
PCHTAB: XWD 24*200,23*200+"." ;/ *
XWD 212*200+" ",177*200 ;0 + VJC 4/16/49
XWD 14*200,21*200 ;1 ,
XWD 20*200,212*200+"0" ;2 -
XWD 13*200,22*200 ;3 .
GET4: ILDB CHR,IBF+1 ;FETCH CHAR FROM INBUFFER
TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN, IB, I OR SBIN MODE?
TLNE AUXFLG,SBIN
JRST CPOPJ1 ;YES, SO NO PROCESSING REQUIRED
GET1: LDB CHR,IBF+1 ;AFTER SEQ NUM, HERE FOR 1ST CHAR
JUMPE CHR,GET2 ;IGNORE NULL CHARS
TLNE FLAG,WFLG ;CONVERTING TABS TO SPACES?
CAIE CHR,11 ;A TAB?
JRST GET1D ;NO
MOVEI CHR,40 ;YES, PREPARE A SPACE INSTEAD
TLZN FLAG,TBSN ;SEEN THIS TAB BEFORE?
JRST GET1B ;NO, THIS SPACE OUTPUT UNCONDITIONALLY
MOVE T2,CDRCNT ;YES, AT A TAB STOP?
TRNN T2,7
JUMPN T2,GET2 ;YES, STOP CONVERSION AND GET NEXT CHAR.
GET1B: TDO FLAG,[XWD TBSN,ESQ] ;NO, SIGNAL REPROCESS THIS TAB
GET1D: CAIN CHR,LF ;IGNORE LINE FEED IN FORTRAN OUTPUT
TLNN FLAG,PFLG ;/P SWITCH IN EFFECT?
JRST GET1A ;NO
TLO FLAG,PCONV ;CONVERT THE NEXT LIVE CHAR
JRST GET2 ;GET NEXT CHAR
GET1A: MOVE T2,@IBF+1 ;BIT 35 OF BUFFER SET?
TRZE T2,1
JRST GET5 ;YES, THIS IS A SEQ NUM
TRZE FLAG,STS ;START SEQ (NEW LINE) FLAG ON?
TRNN FLAG,SQMOD+SNI ;YES, SEQ MODE OR SEQ COPY?
JRST GET7 ;NO, SO PROCESS CHAR
MOVE T2,SQNUM ;NO, SO ADD 10. TO SEQ NUM
MOVE T1,K1
TRNE FLAG,OSFLG ;TEST FOR INCR. BY ONE
MOVE T1,K4
ADD T2,T1 ;ASCII INCREMENT
AND T2,K3 ;MASK SIGNIFICANT DIGITS
MOVE T1,T2
AND T1,ZRO ;MASK CARRY BITS
ASH T1,-3
SUB T2,T1 ;ADJUST CARRIES
IOR T2,ZRO
TRZN FLAG,SNI ;NON-INCREMENT SEQ NUM FLAG ON?
MOVEM T2,SQNUM ;NO, SO SAVE THE RESULT
TRO FLAG,LINE+SUS+ESQ ;TURN ON SUPPLY SEQ, REPROCESS
;LAST CHAR, AND LINE-BY-LINE FLAGS
AOS LBUF ;SET BIT 35 IN LBUF TO MARK SEQ NUM
MOVE T1,[POINT 7,SQNUM]
MOVEM T1,PTRPT ;INITIALIZE SEQ NUM PICK-UP POINTER
JRST GET ;GO OUTPUT FIRST CHAR OF SEQ NUM
;ROUTINE TO INPUT INPUT FILE
INP: IN IN, ;INPUT DATA
JRST CPOPJZ ;NO ERRORS ,BUT CLEAR IOS JUST IN CASE
GETSTS IN,IOS ;CHECK INPUT ERR BITS
TRNN AUXFLG,MTAIN ;MTA INPUT?
TRNE IOS,740000 ;ANY ERROR BITS SET?
TRNN IOS,740000+EOTBIT ;EOT FOR MTA?
POPJ P, ;NO
PUSHJ P,COMERR ;SAVE AC'S RELEASE TTY
JSP T5,INICN2 ;YES SO PRINT OUT COMPLETE FILE DESCRIPTOR
PUSHJ P,QUEST
ERRPN2 </Input device />
PUSHJ P,P6BIT
DEVICE
SKIPN ZRF ;IS THERE A FILE NAME
JRST .+4 ;NO,SO DON'T PRINT
ERRPN2 </: file />
MOVEI T3,ZRF ;LOC OF INPUT FILE NAME TO T3
PUSHJ P,FN.EX ;DEPOSIT FILE NAME, EXT INTO TTY OUT BUFFER
MOVE T2,AUXFLG
ANDI T2,CDRIN+DTAIN+DSKIN+MTAIN
PUSHJ P,IOERR ;GO PRINT ERROR DESCRIPTOR
SETSTS IN,(IOS)
POPJ P,
;ROUTINE TO TEST IF BLOCK TOO LARGE, OR WRITE LOCKED
QUEST: MOVEI CHR,"?" ;DEPOSIT "?" IN ERROR MSG
TLNN FLAG,GFLG ;ONLY IF /G NOT ON
JRST PUTCON ;/G NOT ON, PRINT ?(FATAL) BEFORE ERR MSG
TRNN IOS,BIGBLK ;BLOCK NO. TOO LARGE?
JRST QUEST2 ;NO
TRNN AUXFLG,DTAIN+DTAOUT ;YES
MOVEI CHR,"%" ;WARNING SYMBOL
JRST PUTCON ;DEPOSIT "?" FATAL EVEN IF /G ON
QUEST2: TRNE IOS,WRTLOK ;WRITE LOCKED?
TRNN AUXFLG,DTAIN+DTAOUT+MTAIN+MTAOUT+DSKOUT
MOVEI CHR,"%" ;NO
JRST PUTCON ;DEPOSIT "?" FATAL EVEN IF /G ON
GET7: TLNE FLAG,PCONV ;CONVERTING FORTRAN CARRAIGE CONTROL CHAR?
JRST GET+1 ;YES, GO DO IT
AOS T1,CDRCNT
CAIN CHR,SPACE ;SPACE?
JRST GETA2 ;YES
CAIN CHR,CR ;CAR. RET.?
JRST GETA3 ;YES
TLNE AUXFLG,CDRFLG
JRST GET7B ;CARD READER INPUT
GET7C: TRZ FLAG,SPOK ;CHAR NOT A SPACE STOP COUNTING CONSEC. SPACES
CAIN CHR,TAB ;TAB?
JRST GETA5 ;KEEP TRACK OF TAB STOPS
CAIGE CHR,DEL
CAIGE CHR,SPACE ;NON-SPACING CHARACTER?
JRST CPOPJ1 ;YES, SO RETURN IMMEDIATELY
SOSG TABCT ;COUNT DOWN THE TAB STOP COUNTER
JRST GETA5 ;RESET THE COUNTER IF TAB STOP IS PASSED
CPOPJ1: AOSA (P) ;SKIP RETURN
CPOPJZ: SETZ IOS, ;CLEAR IOS JUST IN CASE
CPOPJ: POPJ P,
GETA3: TRZE FLAG,SPOK ;CAR. RET. SEEN, ANY TRAILING SPACES?
TRNN FLAG,SPMOD+TBMOD ;YES, ARE WE FLUSHING TRAILING SPACES
JRST GETA5 ;NO, RESET TAB COUNTER ONLY
MOVE 0,SVPTR1
MOVEM 0,OPTR ;CLOBBER THE OUTPUT POINTER TO LBUF
GETA5: MOVEI 0,TABSP
MOVEM 0,TABCT ;RESET THE TAB COUNTER
JRST CPOPJ1
GET7B: CAIG CHR,SPACE
JRST GET7C ;DON'T CONSIDER CONTROL CHARS.
CAIL T1,^D73 ;LT COL 73?
CAILE T1,^D80 ;NO, LE COL 80?
JRST GET7C ;CAN'T BE A CARD SEQUENCE NUMBER
MOVEI CHR,SPACE ;REPLACE CARD SEQUENCE NOS. BY SPACE
GETA2: TROE FLAG,SPOK ;SPACE WAS SEEN, IS THIS ONE OF A SEQUENCE?
JRST GETA7 ;YES
MOVE 0,OPTR ;THIS IS THE FIRST SPACE SEEN, SAVE LBUF
;POINTER IN CASE THIS SPACE MUST BE FLUSHED
MOVEM 0,SVPTR1 ;THIS POINTER FOR FLUSHING FINAL SPACES
MOVEM 0,SVPTR2 ;THIS POINTER FOR CHANGING MULT. SPACES TO TABS
SETZM SPCT ;INITIALIZE THE SPACE COUNTER
GETA7: AOS T1,SPCT
SOSLE TABCT ;ARE WE AT THE NEXT TAB STOP?
JRST CPOPJ1 ;NO
CAIL T1,2 ;DONT BOTHER CHANGING ONE SPACE TO A TAB
TRNN FLAG,TBMOD ;TAB GENERATING MODE?
JRST GETA5A ;NO, GO RESET TAB COUNTER
MOVE 0,SVPTR2
MOVEM 0,OPTR ;BACK UP THE OUTPUT POINTER OVER THE LAST
;GROUP OF SPACES
MOVEI CHR,TAB ;OUTPUT A TAB
SETZM SPCT ;RESET THE SPACE COUNTER
GETA5A: IBP SVPTR2 ;UPDATE THE CHANGE-SPACES-TO-TABS POINTER
JRST GETA5 ;RESET THE TAB COUNTER
;ERROR ROUTINES
IFN RIMSW,<
ERR8A: MOVEI T4,ERR382
JRST E10B
ERR3B: MOVEI T4,ERR381
JRST E10B>
ERR10: MOVEI T4,E10A
E10B: SKIPN ZRF
SKIP 3
ERRPNT </?File />
MOVEI T3,ZRF
PUSHJ P,FN.EX
JRST (T4)
IFN RIMSW,<
ERR381: ERRPN2 </illegal extension!/>
ERR382: ERRPN2 </illegal format!/>
ERR5B: ERRPN2 </? DTA to PTP only!/>>
ERR9: MOVEI T3,DTON
IFN FTDSK,<MOVEI T7,4 ;REALLY ERROR TYPE 4
SKIPE DTON ;UNLESS FILE NAME IS ZERO
JRST DERR4 ;NOT, SO USE DSK ERROR ROUTINES>
ERRPNT </?/>
PUSHJ P,FN.EX
IFE FTDSK,<SKIPN DTON ;SKIP IF NON-ZERO FILE NAME>
JRST ERR4B
IFE FTDSK<ERRPNT </(4) rename file name already exists!/>>
ERR1: SKIPA T2,ODEV ;OUTPUT UNAVAILABLE
ERR1A: MOVE T2,DEVICE ;INPUT UNAVAILABLE
ERR1B: ERRPNT </?Device />
PUSHJ P,P6BIT
T2
ERRPN2 </ not available!/>
ERR3:
IFN FTDSK,<TRNE AUXFLG,DSKIN
JRST DERR5 ;ERR ON DSK>
PUSHJ P,ERR3A
JRST IOERRN ;EXIT
ERR3A: SKIPN FILNAM ;IF FILE NAME IS ZERO
JRST ERR4B ;GIVE ILLEGAL FILE NAME MESSAGE
TRNE FLAG,DFLG ;DELETING?
JRST ERR3AD ;YES, GIVE NON-FATAL MESSAGE
ERRPNT </? /> ;NO, FATAL
ERR3AB: ERRPN2 </No file named />
SKIPN T3,QMASK ;USING WILD CHAR. ?
JRST ERR3AX ;NO
ANDCAM T3,FILNAM ;CLEAR GARBAGE CHARS.
AND T3,['??????'] ;CREATE MASK OF ??S
IORB T3,FILNAM ;FILL IN FILE NAME
CAME T3,['??????'] ;BUT IF ALL CHARS ARE WILD
JRST ERR3AX ;NOT
MOVSI T3,'* ' ;USE *
MOVEM T3,FILNAM
ERR3AX: SKIPN T3,QMASK+1 ;SAME FOR EXT
JRST ERR3AY
ANDCAM T3,FILNAM+1
AND T3,['??????']
IORB T3,FILNAM+1
CAME T3,['??????'] ;BUT IF ALL CHARS ARE WILD
JRST ERR3AY ;NOT
MOVSI T3,'* ' ;USE *
MOVEM T3,FILNAM+1
ERR3AY: MOVEI T3,FILNAM
PUSHJ P,FN.EX ;PRINT NAME OF FILE THAT CANNOT BE FOUND
PUSHJ P,INFO2 ;OUTPUT MESS. WITH CR-LF
TRNN AUXFLG,TTYIN!TTYOUT ;WAS TTY IN USE?
POPJ P, ;NO
TRNE AUXFLG,TTYIN ;INPUT DEVICE?
JRST ININIT ;YES ,RE-INIT
JRST OMODE ;MUST BE OUTPUT
ERR3AD: ERRPNT </% /> ;NON-FATAL
JRST ERR3AB ;AND COMMON MESSAGE
ERR4: SKIPN DTON
JRST ERR4A
HRRZ T7,DTON+1 ;MIGHT BE ILL FILE NAME
TRNE AUXFLG,DSKOUT ;ON DSK
JUMPE T7,ERR4A ;FULL OF ? WILD CARDS
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;ERR ON DSK
JRST DERR6>
ERRPNT </?/>
PUSHJ P,P6BIT
ODEV ;OUTPUT DEVICE
ERRPN2 </: />
MOVEI T3,DTON
PUSHJ P,FN.EX ;GIVE NAME.EXT
ERRPN2 </enter failure!/>
ERR4A:
ERR4B: ERRPNT </?(0) Illegal file name!/>
ERR6: SETZM TAPEID ;CLEAR ID TO PREVENT LOOP
ERR6A: ERRPNX </?PIP command error!/>
ERR6B: ERRPNT </?PIP command too long!/>
E10A: ERRPN2 </ line too long!/>
ERR5A: ERRPNT </?Too many input devices!/>
;FILE MANIPULATION COMMANDS TO NON-DIRECTORY DEVICES COME HERE
ERR5: ERRPNT </?Disk or DECtape input required!/>
ERR2: ERRPNX </?Incorrect Project-Programmer number!/>
ERR2A: ERRPNX </?Illegal protection!/>
ERR7A: ERRPNT <Z?DECtape I/O only!Z>
ERR8: ERRPNT </?Explicit output device required!/>
;ROUTINE TO CHECK INPUT DEV, SET XXXIN.E.G.DTAIN
CHECK1: TRZ AUXFLG,DTAIN+DSKIN+CDRIN+PPTIN+TTYIN+MTAIN
MOVE 0,DEVICE ;INPUT DEVICE NAME TO AC 0
JUMPE 0,CHECK ;IGNORE IF NO INPUT DEVICE
IFN FTDSK,<PUSHJ P,PSYSP ;CHECK IF DEVICE IS SYS:>
DEVCHR ;GET INPUT DEVCHR
IFN FTDSK,<TLNN 0,DSKBIT ;INPUT DEVICE DISK?
JRST CHECK2 ;NO
TRO AUXFLG,DSKIN;INPUT DEVICE IS DSK, SET BIT
PUSH P,DEVICE ;GET DEVICE
POP P,ADSK ;AND SAVE IT FORDIRECTORY READ
JRST CHECK>
CHECK2: JUMPE 0,DEVER1 ;NON-EX. DEVICE
TLNN 0,INBIT ;CAN DEVICE DO INPUT?
JRST ERR6A ;NO, COMMD ERROR
TLNE 0,PTRBIT ;PAPER TAPE READER?
TRO AUXFLG,PPTIN;YES
TLNE 0,DTABIT ;DECTAPE?
TRO AUXFLG,DTAIN
TLNE 0,MTABIT ;MAGTAPE?
TRO AUXFLG, MTAIN
TLNE CDRBIT ;CARD READER?
TRO AUXFLG,CDRIN
TLNE 0,TTYBIT ;TELETYPE?
TRO AUXFLG,TTYIN
CHECK: TRNE CALFLG,SSWTCH ;_FLAG STILL ON?
JRST ERR6A ; YES ,COMMAND ERROR
POPJ P, ; NO, RETURN
;SUBR TO PRINT ERROR MESSAGES
;! MARKS THE END OF MESSAGE & SIGNALS GO TO PIP2
;NULL IS A FLAG TO RETURN TO THE NEXT LOCATION
PRETXT: IFN CCLSW,<
SKIPN COMFLG ;IN CCL MODE
JRST PTEXT ;NO, SO DON'T BOTHER
PRTXT1: PUSHJ P,GETBUF ;GET A CHAR.
CAIG 0,FF ;TEST FOR LF, VT, FF
CAIGE 0,LF
JRST PRTXT1 ;NOT A LINE TERMINATOR>
PTEXT: TRNE AUXFLG,TTYOUT ;OUTPUT DEVICE TTY?
OUTPUT OUT, ;YES, OUTPUT LAST LINE
JSP T5,INICN2 ;INITIALIZE THE TTY
PUSHJ P,TCRLF ;OUTPUT A CR-LF
PTEXT2: HRLI T1,440700 ;GET SET TO SCAN 7-BIT DATA
PTEXT1: ILDB 0,T1 ;GET CHAR OF ERR MESSAGE
JUMPE 0,1(T1) ;RETURN ON ZERO
CAIN 0,"!" ;!?
JRST PTEXT3 ;YES, END OF MESSAGE
IDPB 0,TFO+1 ;DEPOSIT CHAR IN OUTBUFFER
JRST PTEXT1 ;GET NEXT CHAR
PTEXT3: TRZN CALFLG,RTRNFL ;FATAL
JRST IOERRN ;YES, END OF MESSAGE, APPEND CAR.RET., LF
PUSHJ P,TCRLF ;END WITH CR-LF
TRNE AUXFLG,TTYOUT ;NEED TO RE-INIT TTY FOR OUTPUT?
PUSHJ P,OMODE ;YES
TRNE AUXFLG,TTYIN ;OR TTY INPUT?
PUSHJ P,ININIT ;YES
POPJ P,
;ROUTINE TO DEPOSIT CHARACTER IN TTY OUT BUFFER
PUTCON: SOSG TFO+2 ;STORED MORE THAN BUFFER HOLDS?
OUTPUT CON, ;YES
IDPB CHR,TFO+1
POPJ P,
;ROUTINE TO CONVERT ONE WORD OF SIXBIT
;FROM ADDRESS IN LOCATION AFTER CALL AND DEPOSIT INTO TTY OUT BUFFER
P6BIT: MOVE T1,@(P) ;PICK UP WORD OF 6-BIT
HRLI T1,440600 ;SET UP POINTER
P6BIT1: ILDB CHR,T1
JUMPE CHR,P6BIT2
ADDI CHR,40
PUSHJ P,PUTCON ;DEPOSIT IN TTY
P6BIT2: TLNE T1,770000 ;DONE SIX?
JRST P6BIT1 ;NO
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO CLEAR DSK OR DTA DIRECTORY (/Z SWITCH)
DTCLR: TRNN CALFLG,DVSWTH ;HAS A DEVICE BEEN SEEN?
JRST ERR8 ;NO,SO DON'T SCREW USER
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;CLEAR DSK OR DTA DIR.
JRST DSKZRO>
IFN TEMP,<TRNE CALFLG,TMPO ;TMPCOR
JRST TMPZRO>
TRNN AUXFLG,DTAOUT ;MUST BE DTA
JRST ERR5
UTPCLR OUT, ;CLEAR DIRECTORY
POPJ P,
;ROUTINE TO WRITE ID IN DTA
SYN QMASK,DDIOW ;SAVE SPACE
WRTID: MOVEI 0,117 ;NON-STANDARD DUMP MODE
MOVEM 0,OMOD ;IN OPEN DATA
SETZM OMOD+2 ;NO BUFFERS
OPEN DD,OMOD ;INIT DEVICE
JRST ERR1 ;NOT AVAILABLE
USETI DD,144 ;SET ON DIRECTORY
HRRZ T1,.JBFF ;GET CURRENT TOP OF FREE CORE
ADDI T1,200 ;DIRECTORY BUFFER
CAMLE T1,.JBREL ;WILL IT FIT
JSP T4,MORCOR ;NO, GET SOME
SUBI T1,201 ;IOWD ADDRESS
HRLI T1,-200 ;NUMBER OF WORDS
MOVEM T1,DDIOW ;STORE I/O WORD
SETZM DDIOW+1 ;TERMINATE LIST
INPUT DD,DDIOW ;DO INPUT
MOVE 0,TAPEID ;GET ID
MOVEM 0,200(T1) ;PUT IT IN DIRECTORY
USETO DD,144 ;SET TO WRITE IT OUT
OUTPUT DD,DDIOW ;OUT IT GOES
RELEAS DD,0 ;CLEAR DIRECTORY IN CORE BIT
SETZM TAPEID ;SO WE DON'T COME BACK TOO OFTEN
POPJ P,
;ROUTINE TO SET UP TO COPY EVERYTHING
PRECOP:IFN TEMP,<
TRNE CALFLG,TMPI ;INPUT DEV. IS TMPCOR?
JRST TMPIN ;YES>
TRO CALFLG,FNEX ;/X IMPLIES MANY FILES
PUSHJ P,ININIT ;INIT INPUT FILE
TRNN AUXFLG,DTAIN ;DECTAPE INPUT
SKIP 2 ;NO
PUSHJ P,DTCH2 ;YES, GET DIRECT, SET POINTERS TO DIRECT
DTCOPY: PUSHJ P,DTADI1 ;START (T5)
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT. ENTER HERE FROM DTD2
PUSHJ P,DSKDIR ;YES, PREPARE TO LOOKUP FILES
JFCL>
COPY1A: MOVEI T2,6 ;FILL 0 CHARS. IN DEST-FILE
MOVE T1,[POINT 6,DTON] ;NAME WITH X'S. THIS IS
TRNN FL,RXFLG ;TWO NAMES GIVEN?
JRST .+3 ;NO
MOVE 0,[FILNAM,,DTON] ;GET INPUT FILE NAME
BLT 0,DTON+1 ;AS OUTPUT
MOVE 0,QMASK ;GET INPUT MASK
ANDCAM 0,DTON ;AND CLEAR WILD CHARACTERS
HLLZ 0,QMASK+1 ;SAME FOR EXT
ANDCAM 0,DTON+1
XSS: ILDB 0,T1 ;THEN THE BASE FOR GENERATED
JUMPN 0,.+2 ;DESTINATION FILES FROM
MOVEI 0,"X"-40 ;NON-DIR. DEVICES IN /X
DPB 0,T1
SOJG T2,XSS ;DON'T YET KNOW IF ONE
;OF THE INPUT DEV. WILL BE NON-DIR
MOVE 0,[DTON,,DTONSV]
BLT 0,DTONSV+1
COPY1: PUSHJ P,SR2 ;SET INIT. COPYING MODE
PUSHJ P,LOOK ;GET A FILE TO COPY
JRST CAL6 ;NO MORE
IFN FTDSK<PUSHJ P,XDDSK ;GOT ONE, CHECK (XD) FROM DSK, NAMTAB
JRST COPY1 ;IN LIST, DON'T COPY>
TRNN AUXFLG,MTAIN+PPTIN+CDRIN+TTYIN ;OK, COPY FILE
JRST COPY6A ;MUST BE DIRECTORY DEVICE
PUSHJ P,MTPTCR ;SET UP A DEST. FN.
JRST COPY6
COPY6A:
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;YES, USE IT>
LOOKUP IN,ZRF ;LOOKUP INPUT FILE NAME
JRST CAL5 ;INPUT FILE FILE PROTECTED
COPY6: PUSHJ P,FILTYP ;CHECK FOR DMP,SAV,REL,CHN
TRNN AUXFLG,DSKIN!DTAIN ;ALLOW NULL FILE ON DIRECTORY DEVICES
PUSHJ P,COPY3 ;INPUT FIRST BLOCK AND CHECK FOR EOF
COPY6B: MOVE 0,ZRF ;INPUT FILE NAME
MOVEM 0,DTON ;IS OUTPUT FILE NAME
HLLZ 0,ZRF+1 ;LIKEWISE EXT
HLLZM 0,DTON+1
;THIS CODE OPERATES AS FOLLOWS - FOR E+2, SET = 0
;TO START (ASSUMING /X)
;DSK TO DSK IF EDIT SWITCHES PUT E+2 = 0 IF NO EDITS TRANSFER
; DATE, TIME, BITS 13-35
;DSK TO DTA FOR EDITS E+2 = 0, NO EDITS TRANSFER 24-35 FOR
;DATE, FOR"SAV" FILES TRANSLATE NO. 1K BLOCKS
;DTA TO DSK FOR NO EDITS XFER BITS 24-35, ELSE E+2 = 0
;DTA TO DTA ALWAYS XFER 18-23, (1K BLOCK) NO EDITS XFER 24-35(DATE)
SETZM DTON+2 ;CLEAR DATE. OUTPUT FILE, DSK/DTA
LDB 0,DATE ;GET DSK/DTA DATE CREATED
TDNN FLAG,[XWD PFLG+WFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]
TLNE AUXFLG,CDRFLG
JRST COPY6C
DPB 0,DATED ;DEPOSIT IF NO EDITS
IFN FTDSK,<LDB 0,TIME
TRC AUXFLG,DSKIN+DSKOUT
TRCN AUXFLG,DSKIN+DSKOUT
DPB 0,TIMED ;DSK TO DSK TIME>
COPY6C: PUSHJ P,OKBLKS ;SETUP 1K BLOCKS
IFN FTDSK,<SKIPE LEVEL ;IF LEVEL D
TLNN AUXFLG,NSPROT ;AND NON-STANDARD PROTECTION
JRST .+3 ;NOT BOTH TRUE
LDB 0,PRPTL ;GET PROTECTION CODE
DPB 0,PRPTD ;INTO ENTER BLOCK>
GETSTS OUT,T1 ;GET OUTPUT STATUS
LDB T2,[POINT 4,ZRF+2,12] ;GET INPUT MODE
SETSTS OUT,(T2) ;SET OUTPUT TO IT
PUSHJ P,CHKDTON ;MAKE SURE NO WILD CARDS LEFT
ENTER OUT,DTON ;GOT DATA, CREATE NEW FILE
JRST ERR4 ;DIRECTORY FULL
SETSTS OUT,(T1) ;BACK TO ORIGINAL STATUS
MOVE 0,ZRO ;GET ASCII/00000/AND
MOVEM 0,SQNUM ;RESET SEQUENCE NO.
TLO FLAG,NEWFIL ;SET NEW FILE FLAG
SETZM TOTBRK ;CLEAR PAREN COUNTER
TLNN AUXFLG,CDRFLG+SBIN ;SPECIAL PROCESSING?
TDNE FLAG,[XWD PFLG+WFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]
JRST PSCAN ;YES, DO IT
TRNE AUXFLG,LPTOUT!TTYOUT
TLNE CALFLG,OSPLFL ;IS IT HARD COPY BUT NOT SPOOLED
JRST COPY5 ;NO
JRST PSCAN ;YES, MAKE SURE CONTROL CHARS. ARE HANDLED
COPY5: SOSGE IBF+2 ;INPUT BUFFER EMPTY?
JRST COPY4 ;YES
ILDB CHR,IBF+1 ;GET NEXT WORD AND
PUSHJ P,PUT ;OUTPUT IT
JRST COPY5
COPY4: PUSHJ P,COPY3 ;GET NEXT FULL SOURCE BLOCK
PUSHJ P,OUTP ;OUTPUT PREV. BLOCK-DONT ALTER DATA
AOS OBF+2 ;MAKE PUT HAPPY BECAUSE OF
JRST COPY5 ;OUTPUT HERE.
COPY2A: CLOSE IN,
CLOSE OUT,
IFN FTDSK,<TLNE AUXFLG,NSPROT ;NON-STANDARD PROTECTION?
TRNN AUXFLG,DSKOUT ;RENAME ALL OUTPUT FILES IF
JRST COPY2B ;NON-STANDARD PROTECTION
LDB 0,PRPTL ;GET NEW PROTECTION
SKIPE LEVEL ;IF LEVEL D
JUMPN 0,COPY2B ;AND NOT ZERO, DONE ALREADY
DPB 0,PRPTD
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,DTON+3 ;NON-SKIP RETURN, USE IT
RENAME OUT,DTON ;RENAME OUTPUT FILE
JRST DERR6>
COPY2B: PUSHJ P,OUTP1
JRST COPY1 ;GO GET NEXT FILE
IFE FTDSK,<SYN COPY1,CAL5>
IFN FTDSK,<
CAL5: PUSHJ P,DERR5R ;PRINT DSK ERROR TYPE
JRST COPY1 ;COUNT READ FAILURES>
;NO MORE FILES TO COPY
CAL6: TLZ AUXFLG,NSPROT
JRST MAIN1
COPY3B: SKIPE IBF+2 ;EMPTY BLOCK?
POPJ P, ;NO, RETURN
COPY3: PUSHJ P,INP ;READ NEXT BLOCK
TRZE AUXFLG,READ1
PUSHJ P,TTYZ ;END OF FILE FROM TTY?
TRNN IOS,EOFBIT ;END OF FILE? IOS HAS STATUS BITS
JRST COPY3B ;NO.
POP P,0 ;CLEAR ITEM FROM STACK
HRRZS 0 ;ADDRESS ONLY
TRNN AUXFLG,DSKIN!DTAIN ;ALLOW NULL FILE FOR THESE ONLY
CAIE 0,COPY6B ;DID WE COME FROM COPY6B-1?
JRST COPY2A ;NO, CLOSE OUT FILES
TRZ CALFLG,ALLCLF ;YES, END OF INFO ON NON-DIR DEVICE
JRST COPY1
;CREATE DESTINATION FILE NAME. RANGE IS ...001 TO ...999
MTPTCR: TRNE FL,RXFLG ;OUTPUT NAME SEEN?
HLLOS OQMASK ;YES, ONLY USE FIRST 3 CHARS.
AOS T1,NO.
CAILE T1,^D999
JRST MPC2
PUSHJ P,MTPTC1
MOVE 0,[DTONSV,,ZRF] ;FILNAM=DTON IS ONLY WAY TO IDENTIFY
BLT 0,ZRF+1 ;INPUT FILE
POPJ P,
MPC2: ERRPNT <Z?Terminate /X, max. of 999 files processed!Z>
MTPTC1: MOVEI DOUT,^D1000(T1)
MOVE T1,[POINT 6,DTONSV,17]
JSP T2,OUTDC1
AOJA T2,CPOPJ
SUBI CHR,40
IDPB CHR,T1
POPJ P,
;ROUTINE TO RESTORE BYTE POINTERS TO INITED MODE
;FOR INPUT AND OUTPUT DEVICES
SR2: MOVE 0,SVIBF
HLLM 0,IBF+1
MOVE 0,SVOBF
HLLM 0,OBF+1
POPJ P,
;ROUTINE TO SEE IF ^Z FIRST CHAR ON TTY
TTYZ: TRNN AUXFLG,TTYIN ;SEE IF FIRST CHAR. IS ^Z
POPJ P, ;NOT TTY INPUT
HRRZ T1,IBF+1 ;ON TTY
HLRZ 0,1(T1) ;GET FIRST CHARACTER
TRZ 0,3777 ;CLEAR ANY OTHER CHAR.
CAIN 0,(<CZ>B6) ;IS IT ^Z?
TROA IOS,EOFBIT ;YES,SET END OF FILE
CAIE 0,(<XON>B6) ;IS IT XON "^Q"
POPJ P, ;NO
MOVSI 0,(<DEL>B6) ;A RUBOUT
IORM 1(T1) ;CLEAR "^Q" FROM BUFFER
POPJ P, ;AND RETURN
;DTA TO DTA MAINTAIN BITS 18-23 OF E+2 IF SET
;DSK TO DSK NO TRANSLATION (E+2)
;DSK TO DTA TRANSLATE E+3 (LHS) INTO E+2 (18-23)
;DTA TO DSK NO TRANSLATION (E+2)
;THIS ROUTINE ENSURES "SAVE" FILES MAINTAIN
;CORRECT DATA FOR LOADING. FOR DSK INPUT
;A "SAVE" FILE IS ONE WITH THE EXTENSION
;"SAV". E+3 = (-[(200XN)+NO. WDS IN LAST BLOCK]
;IN LHS TRANSLATE TO NO. 1K BLOCKS NEEDED
;TO LOAD FILE - BEFORE IT IS EXPANDED IN CORE.
OKBLKS: TRNN CALFLG,RXFLG ;(RX)?
JRST OKBLK0 ;NO
MOVE 0,MATCH ;GET FILE NAME
HLRZ T1,MATCH+1 ;AND EXT.
MOVEM 0,DTON ;REPLACE NAME
HRLM T1,DTON+1
SKIPN T1,OQMASK ;WILD CARD OUTPUT
JRST .+4 ;NO
ANDCAM T1,DTON ;CLEAR OUT MASK CHARS
AND T1,ZRF ;GET SUBSTITUTE ONES
ORM T1,DTON ;PUT THEM IN
HLLZ T1,OQMASK+1 ;TRY EXT
JUMPE T1,.+4 ;NO
ANDCAM T1,DTON+1 ;SAME AS ABOVE
AND T1,ZRF+1
ORM T1,DTON+1
OKBLK0: MOVE 0,DTON ;GET OUTPUT FILE NAME
REPEAT 0,<
HLRZ T1,DTON+1 ;AND EXT
CAIE T1,'SAV' ;SAV FILE?
CAIN T1,'SVE' ;OR SVE (SPMON) FILE?
TRNN AUXFLG,DTAOUT ;AND OUTPUT TO DTA?
SKIP 1 ;NO
UGETF OUT,0 ;SET TO FIRST FREE BLOCK
> ;END OF REPEAT 0
IFN FTDSK,<TRC AUXFLG,DSKIN+DSKOUT ;DSK I/O
TRCN AUXFLG,DSKIN+DSKOUT
POPJ P, ;YES, EXIT
TRC AUXFLG,DTAIN+DTAOUT ;NO
TRCE AUXFLG,DTAIN+DTAOUT ;DTA I/O
JRST OKBLK1 ;NO>
LDB 0,OKB ;DTA I/O - 1K BLKS
DPB 0,OKBD ;DEPOSIT IN DTON
POPJ P,
IFN FTDSK,<
OKBLK1: TRC AUXFLG,DTAIN+DSKOUT ;DTA-TO-DSK
TRCN AUXFLG,DTAIN+DSKOUT
POPJ P, ;YES
TRC AUXFLG,DSKIN+DTAOUT ;NO,DSK-TO-DTA?
TRCE AUXFLG,DSKIN+DTAOUT ;NO
POPJ P,
HLRZ 0,ZRF+1 ;YES DSK-TO-DTA
CAIE 0,'SAV' ;GET LOOKED UP EXT,(INPUT).
CAIN 0,'SVE'
SKIP 1
POPJ P,
HLRO T1,ZRF+3 ;EXTENSION=SAV
MOVNS T1 ;WORD COUNT
IDIVI T1,2000 ;DIVIDE BY 1K CORE(OCTAL LOCS.)
JUMPN T2,.+2
SOJ T1, ;N-1
DPB T1,OKBD
POPJ P,>
IFN FTDSK,<
;ARE WE DOING (XD) FROM DSK? IF NOT, EXIT.
;SEE IF CURRENT FILE SELECTED IN ZRF IS IN THE
;LIST OF FILES NOT TO BE COPIED. (POPJ IF IT IS)
XDDSK: TRC FLAG,XFLG+DFLG ;COMPLEMENT
TRCN FLAG,XFLG+DFLG ;RESET AND TEST
TRNN AUXFLG,DSKIN ;/X AND /D WERE SET
JRST CPOPJ1 ;NOT DSKIN SO COPY FILE
HRROI T1,-12 ;SET TO LOOP NAMTAB
XDDSK2: MOVE T2,ZRF ;GET FILE NAME
SKIPN T3,NAMTAB+12(T1) ;END OF TABLE ENTRIES?
JRST CPOPJ1 ;YES, EXIT
IOR T2,QMASK ;MASK OUT WILD CHARS
CAME T2,T3 ;FN IS * OR MATCH?
JRST XDDSK1 ;NO MATCH
HLLZ T2,ZRF+1 ;GET EXT
SKIPN T3,NAMTAB+24(T1) ;NO EXT MATCH WANTED
POPJ P, ;EXIT THEN
IOR T2,QMASK+1 ;MASK OUT WILD CHARS
CAMN T2,T3 ;EXT IS * OR MATCH?
POPJ P, ;FN EX MATCH, NO COPY
XDDSK1: AOJL T1,XDDSK2 ;TRY ANOTHER FOR MATCH
JRST CPOPJ1 ;SEARCHED TABLE, NO MATCH>
;ROUTINE TO DELETE OR RENAME FILES ON DTA OR DSK OR SET UP NAMTAB
;FOR (DX) (DISK ONLY)
DTDELE: IFN TEMP,<
TRNE CALFLG,TMPO ;TMPCOR
JRST TMPDEL ;YES>
TRNE FLAG,XFLG ;/X
JRST DELE1 ;YES
TRNN FLAG,DFLG ;/D NEED EXPLICIT DEVICE
SKIP 2
TRNN CALFLG,DVSWTH ;-1 IF DEVICE SEEN
JRST ERR8 ;NO, ERROR
MOVE 0,ODEV ;OUTPUT DEVICE
MOVEM 0,DEVICE ;NO,SET DEVICE FOR INPUT
MOVEM 0,DEVA
DELE1: PUSHJ P,CHECK1 ;RESET INPUT DEVICE DESCRP
MOVE 0,[DTON,,NAMTAB] ;FOR /R GET NEW NAME
;SET TO BLT OUTPUT DIRECT ENTRY
BLT 0,NAMTAB+3 ;TO NAMTAB
TRNN AUXFLG,DTAIN+DSKIN
JRST ERR5 ;NOT DTA OR DSK
PUSHJ P,FNSET ;SET UP CALFLG CORRECTLY
TRNE FLAG,XFLG ;/X?
JRST DTD1 ;YES, (DX). RX ILLEGAL
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;NO, HAS TO BE /D OR /R
JRST DSKDR0 ;ON DSK>
JRST DTADR ;OR DTA
DTD1:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST DTD1A ;YES>
PUSHJ P,DTCHECK ;NO, HAS TO BE DTA, GET DIR
JRST DELE3 ;DELETE, FILES FROM DIR
IFN FTDSK,<
DTD1A: SETZM NAMTAB ;COLLECT NAMES FOR DX, DSK SOURCE
MOVE T1,[XWD NAMTAB,NAMTAB+1]
BLT T1,NAMTAB+23 ;FIRST CLEAR TABLE
MOVEI T1,NAMTAB ;LOCATION OF NAMTAB
MOVEM T1,LOCNAM
DTD4: MOVE 0,FILNAM
JUMPE 0,DTD4A ;FN=0 ILLEGAL
MOVE T1,LOCNAM
MOVEM 0,(T1) ;STORE FILENAME FROM CS
MOVE 0,FILEX ;STORE FILE EXT
MOVEM 0,12(T1) ;TABLE FULL?
MOVEI T2,NAMTAB+11
CAMN T2,T1
SOS ESWTCH ;YES
SKIPE ESWTCH ;NO, END OF CS SCAN?
JRST DTD2 ;END OF NAME PROCESSING
AOSA T1,LOCNAM ;SET TO STORE IN NEXT SLOT NAMTAB
DTD4A: PUSHJ P,ERR3A
DTD4B: PUSHJ P,DESCRP ;NO, GET NEXT FILENAME FROM CS
TRNE CALFLG,NEWPP!NEWDEV
JRST ERR5A ;ERROR, NEW DEV OR# PP
JRST DTD4
;END OF CS OR NAMTAB FULL
DTD2: PUSHJ P,ININIT ;INIT INPUT FILE
MOVEI T1,1 ;SET TO RETURN DTCOPY+1
JRST DTD5>
;ROUTINE TO DELETE OR RENAME FILES ON DTA
DTADR: PUSHJ P,DTCHECK ;GO GET DTA DIRECTORY
MOVE T1,IBF ;CURRENT INPUT BUFFER
USETO OUT,144 ;THIS SHOULD GIVE ERROR MSG
OUTPUT OUT,(T1) ;IF DTA WRITE LOCKED
PUSHJ P,DTCHECK ;GO GET DTA DIRECTORY
PUSHJ P,INFO ;WRITE "FILES DELETED/RENAME
;*********************************************************************
;LOOP TO DELETE/RENAME. FOR (DX) DELETE FILES FROM DTA DIR
;THEN USE REVISED DIRECTORY TO COPY ALL REMAINING FILES
DELE3: PUSHJ P,LOOK ;GET FILE TO DELETE OR RENAME FROM CS
JRST DELE5 ;NO MORE FILES
TRNN FLAG,XFLG ;/X?
PUSHJ P,INFO3 ;PRINT FILENAME-EXT
MOVE T1,DIRST ;GOT A MATCH - PROCESS IT
TRNE FLAG,RFLG ;AND IT IS AT (T5) IN (DTA) DIR
JRST DTRNAM ;RENAME
SETZM (T1) ;DELETE FILENAME IN CORE DIRECT
SETZM 26(T1) ;DELETE EXT
TRNE FLAG,XFLG ;(DX)?
JRST DELE3 ;YES, DON'T ACTUALLY DELETE FILE FROM TAPE
LOOKUP OUT,ZRF ;DO LOOKUP
JRST DELE3 ;SHOULD NEVER FAIL
SETZM DTON ;SET NAME TO ZERO
DELE4: RENAME OUT,DTON ;GET RID OF IT
JRST ERR9 ;SHOULD NEVER HAPPEN EITHER
JRST DELE3 ;GET NEXT FILE NAME
DELE5: MOVE T1,IBF ;LOC OF INPUT BUFFER
TRNE FLAG,XFLG ;DX SWITCH?
JRST DTD6 ;YES, NOW MUST COPY REMAINING FILES
RELEAS CON, ;OUTPUT DELETE OR RENAME INFO TO TTY
JRST MAINB
;ROUTINE TO RENAME FILE ON DECTAPE
DTRNAM: PUSHJ P,RENAME ;SET UP FILE NAME
SETZM DTON+3 ;
SKIPE DTON ;JUST INCASE 0 FILE NAME
LOOKUP OUT,ZRF ;LOOK UP FILENAME-EXT ON OUTPUT DEV
JRST DELE3 ;SHOULD NEVER FAIL
JRST DELE4 ;RENAME TO NEW NAME
;END OF LOOP
;*********************************************************************
;DX SWITCH ON, COPY ALL BUT SPECIFIED FILES. I.E. THOSE NOT DELETED
DTD6: MOVEI T1,0 ;SET TO RETURN TO DTCOPY
DTD5: SETOB 0,FILNAM ;FORCE COPY-ALL
HLLZM 0,FILEX ;BY MAKING FILE-EXT=*.*
SETOM QMASK ;AND MASKS
HLLZM 0,QMASK+1
SETOM OQMASK ;SAME FOR OUTPUT SIDE
HLLZM 0,OQMASK+1
TLO FL,MFLG ;SET FLAG ALSO
PUSHJ P,FNSET ;FIND DETAILS OF FILE-EXT
TRNE AUXFLG,DTAIN ;DTA INPUT
PUSHJ P,DTCH1 ;INIT DIRST,DIRST1
IFN RIMSW, <
TLNE FLAG,RIMFLG ;NO
JRST RIMTB
>
JRST DTCOPY(T1)
;SET UP OUTPUT DIRECTORY ENTRY FOR RENAME
;ONLY ONE FILE NAME ALLOWED, BUT MAY BE *.EXT OR FN.*
;ALSO MUST HANDLE WILD CARD MASK
RENAME: SKIPL ESWTCH ;SKIP IF CR,LF SEEN IN C.S.
JRST ERR6A ;ONLY 1 SOURCE FILE DESCRIPTOR ALLOWED
SKIPN T2,NAMTAB ;AN OUTPUT NAME SPECIFIED?
JRST RENAM0 ;NO, USE INPUT
MOVEM T2,DTON ;STORE IT
MOVE 0,OQMASK ;WILD CHARS.
JUMPE 0,.+4 ;NO
ANDCAM 0,DTON ;YES, CLEAR FROM OUTPUT NAME
AND 0,ZRF ;PICKUP FROM INPUT NAME
ORM 0,DTON ;PUT IN OUTPUT
HLLZ 0,NAMTAB+1 ;USER SUPPLIED EXT
MOVEM 0,DTON+1
HLLZ 0,OQMASK+1 ;SAME FOR EXT
JUMPE 0,.+4 ;NO CHARS.
ANDCAM 0,DTON+1
AND 0,ZRF+1
ORM 0,DTON+1
SETZM DTON+2 ;LET MONITOR SUPPLY
POPJ P,
RENAM0: MOVE 0,[XWD ZRF,DTON];NO NAME SET SO USE LOOKUP NAME
BLT 0,DTON+2 ;AND EXT SO FILE NOT DELETED
POPJ P,
;THIS ROUTINE GETS NEXT FILENAME.EXT FROM CS
;THEN SEES IF ONE IN DIRECTORY MATCHES
;IF IT DOES - EXIT IS CPOPJ1
;NO-MORE-FN.EX-TO-HANDLE-EXIT IS POPJ
;PREPARE ZRF FOR A "LOOKUP" ON THE NEXT REQUESTED FILE.
LOOK: TRNE CALFLG,NSWTCH ;NULL NAME?
SKIPN TAPEID ;AND TAPE ID SEEN?
JRST LOOK0 ;NO
SETZM GENERI ;YES, SAVES TIME
TRO AUXFLG,REDFLG ;FAKE SO COMMAND WILL BE ERROR FREE
TRO CALFLG,ASTFLG ;SAME AGAIN
POPJ P, ;RETURN TO WRITE ID
LOOK0: TRNE CALFLG,FNEX ;DOES FILNAM, FILEX CONTAIN
JRST LOOK6 ;A FILE TO THINK ABOUT? YES
LOOK01: PUSHJ P,LOOKA ;GET ONE (NOTE: DEVICE MAY ALTER)
POPJ P, ;NONE, END OF CS
;RETURN SKIP FROM LOOKA
LOOK6: MOVE T2,FILEX ;GET FILE EXT INTO T2
SKIPN T1,FILNAM ;FILNAME AND EXT=0?
JUMPE T2,LOOK7C ;FN.EX=0, ONE FILE COPY
TLNE CALFLG,MFLG ;WILD CHAR. MASKING?
JRST LOOK1 ;YES, ALLOW FOR MANY FILES
TRNE AUXFLG,DTAIN+DSKIN ;DONT REQUIRE FILENAME
JUMPE T1,LOOK6C ;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL
LOOK7B: TRZ CALFLG,FNEX ;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.
TRNN AUXFLG,DTAIN+DSKIN
JRST LOOK4 ;GOT A FILE TO HANDLE
TRNE FLAG,DFLG!RFLG ;/R OR /D ?
JRST LOOK8 ;YES, MUST SCAN DIRECTORY IN THAT CASE
MOVE T1,[FILNAM,,ZRF] ;SET UP NAME AND EXT
BLT T1,ZRF+1 ;IN LOOKUP BLOCK
MOVE T1,PP ;AND PROJ-PROG #
MOVEM T1,ZRF+3 ;ALSO
JRST CPOPJ1 ;OK RETURN
LOOK8: PUSHJ P,PICUP ;GET A FILE (ANY) FROM DIRECTORY
JRST LOOK2 ;WE GOT A FILE, DOES IT MATCH?
LOOK6C:
LOOK6D:
IFN FTDSK,<SKIPE GENERI ;SEARCHING F/S ?
POPJ P, ;YES, WAIT TIL END OF F/S SEARCH LIST>
TRZ FL,FNEX ;CLEAR FLAG (FOR LOOK0:)
TRZN FL,ASTFLG ;DID WE FIND AT LEAST ONE
PUSHJ P,ERR3A ;NO, PRINT MSG.
JRST LOOK ;YES, GET NEXT FILE FROM CS
;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R
;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*
MLOOK2: XOR T1,FILNAM ;XOR TOGETHER
ANDCM T1,QMASK ;MASK
JUMPN T1,LOOK8 ;NO MATCH
MOVE T1,ZRF ;GET GOOD FILENAME
MOVEM T1,FILNAM ;WHERE IT BELONGS
JRST LOOK3
MLOOK3: XOR T1,FILEX
ANDCM T1,QMASK+1
JUMPN T1,LOOK8
MOVE T1,ZRF+1
MOVEM T1,FILEX
JRST LOOK5
LOOK2: TRNN CALFLG,MATFN ;SHOULD FILENAMES MATCH
JRST LOOK3 ;NO
MOVE T1,ZRF ;YES
TLNE CALFLG,MFLG ;MASKING NEEDED?
JRST MLOOK2 ;YES
CAME T1,FILNAM
JRST LOOK8 ;NO MATCH
LOOK3: TRNN CALFLG,MATEX ;SHOULD EXTENSIONS MATCH
JRST LOOK5 ;NO
MOVE T1,ZRF+1 ;YES
TLNE CALFLG,MFLG ;MASKING?
JRST MLOOK3 ;YES
CAME T1,FILEX
JRST LOOK8 ;NO MATCH
LOOK5:
LOOK4: TRO AUXFLG,READ1 ;READY FOR FIRST READ
TRO CALFLG,ASTFLG ;FOUND A FILE *.EXT, F.*,*.*
JRST CPOPJ1 ;MATCH OR NO CARES
LOOK7C: TRNE AUXFLG,DSKIN+DTAIN
JRST LOOK6C ;0.0 ON DIR DEVICE
SETZM ZRF
SETZM ZRF+1
JRST LOOK7B ;0.0 ON NON-DIR. DEV.
LOOK1: TRNE AUXFLG,DTAIN+DSKIN
JRST LOOK8
SETZM ZRF
SETZM ZRF+1
JRST LOOK4
;ROUTINE TO GET NEXT FILE NAME FROM DIRECTORY
;FILNAM, FILEX CONTAIN THE FILE NAME. EXT TO BE
;MATCHED WITH DIR. NAMES. PUT SUGGESTED FILE
;NAME EXT IN ZRF, ZRF+1 AND #P-P IN ZRF+3
;NOTE THAT WE HAVE TO HANDLE *.EXT,FILE.*
PICUP:
IFN FTDSK,<TRNN AUXFLG,DSKIN ;DSK INPUT?
JRST PICUP2 ;N0, DTA
SOSLE UFDIN+2 ;YES
JRST .+3
PICUP1: PUSHJ P,UIN ;INPUT USER'S FILE DIRECTORY
JRST CPOPJ1 ;EOF ON DSK
ILDB 0,UFDIN+1 ;PICK UP FILENAME
JUMPE 0,PICUP1 ;IGNORE NULL
MOVEM 0,ZRF ;SET FILE NAME
MOVE 0,FNPPN
MOVEM 0,ZRF+3 ;SET DSK #P-P
SOS UFDIN+2 ;COUNT DOWN FOR NEXT TIME
ILDB 0,UFDIN+1 ;SET FILE EX
HLLZM 0,ZRF+1
POPJ P,>
PICUP2: MOVE T3,DIRST1 ;SETUP TO CHECK ALL FILENAME SLOTS
ADDI T3,26 ;IN DIRECTORY (22 FILE NAMES)
MOVE T5,DIRST ;LOC OF FIRST/NEXT FILE
PICUP4: ADDI T5,1 ;
CAMLE T5,T3 ;END OF FILE SLOTS?
JRST CPOPJ1 ;END OF FILE NAMES
MOVEM T5,DIRST ;NEXT SLOT TO LOOK AT
MOVE 0,(T5) ;GOT FILE NAME FROM DIRECT
JUMPE 0,PICUP4 ;IGNORE IF 0
MOVEM 0,ZRF
MOVE 0,26(T5) ;GET EXT ETC
HLLZM 0,ZRF+1
POPJ P,
;READ DTA DIR. AND PREPARE T5 TO PICK UP FIRST ENTRY.
DTADIR: PUSHJ P,DTCH2 ;READ DTA DIR INTO INPUT BUF
DTADI1: MOVEI T3,DBUF ;SET BLT FROM INBUF TO DBUF
HRL T3,T5 ;FIRST DATA WORD OF DIRECTORY IN T5
BLT T3,DBUF+176 ;MOVE FROM INBUF TO DBUF
MOVEI T5,DBUF+123-1 ;LOC OF FIRST FILE NAME
MOVEM T5,DIRST ;T5 POINTS TO FILNAME JUST HANDLED
MOVEM T5,DIRST1 ;TO RESTORE DIRST
POPJ P, ;(IE NONE BUT NEXT WILL BE FIRST)
SUBTTL ROUTINE TO OUTPUT FILENAMES THAT WERE DELETED OR RENAMED
;PRINT "FILES DELETED:" OR "FILES RENAMED:"
INFO: MOVE T1,TFO ;SETUP TTY FOR OUTPUT
MOVE T2,TFI ;SAVE BUFFER LOCS
PUSHJ P,INICON ;INIT TTY
HRROM T2,TFI ;SET BUFFER LOCS
HRROM T1,TFO
OUTPUT CON,
TRNN FLAG,DFLG ;DELETE?
JRST INFO1 ;NO, MUST BE RENAME
IFN CCLSW,<SKIPE COMFLG
SKIPG RENSN
SKIP 1
POPJ P,
HRRZM T1,RENSN ;SET POSITIVE>
ERRPN2 </Files deleted:/>
IFN FTDSK,<SETZM BLKSUM ;SET TOTAL TO ZERO>
JRST INFO2
INFO1: IFN CCLSW,<
SKIPE COMFLG ;IF NOT CCL
SKIPL RENSN ;OR FIRST TIME
SKIP 1
POPJ P, ;ONLY PRINT ONCE IF CCL
SETOM RENSN ;DON'T PRINT IT TWICE>
ERRPN2 </Files renamed:/> ;RENAME (/R)
TCRLF:
INFO2: MOVEI CHR,CR ;OUTPUT CR/LF
PUSHJ P,PUTCON ;ON TTY
MOVEI CHR,LF
PUSHJ P,PUTCON
OUTPUT CON,
POPJ P,
;**********************************************************************
;PRINT FILENAME.EXT OR [P,P].UFD OF FILE DELETED
INFO3: MOVEI T3,ZRF ;LOCATION OF FILENAME
PUSHJ P,FN.EX
IFN FTDSK,<TRNE FLAG,DFLG ;SKIP IF /D
TRNN AUXFLG,DSKIN ;AND INPUT DEVICE IS DSK>
JRST INFO2 ;NO
IFN FTDSK,<HLRE DOUT,ZRF+3 ;GET BLOCK SIZE
PUSHJ P,BLKSD ;STORE BLOCK SIZE
JRST INFO2 ;AND CR-LF>
SUBTTL /X OR /D. FIND OUT DETAILS OF FILE NAME AND
;EXTENSION (0 FN.EX=*.*) AND ANY CHANGE IN
;SOURCE DEV. SET BITS IN CALFLG.
FNSET: TRZ CALFLG,ALLCLF ;CLEAR FLAGS ON ENTRY
SKIPN FILNAM
TROA CALFLG,FNEX ;FILENAME = * OR 0
TRO CALFLG,MATFN ;FILENAME MUST BE MATCHED
SKIPN FILEX ;EXT=0?
TRNN AUXFLG, MTAIN+CDRIN+PPTIN+TTYIN ;YES
TROA CALFLG,MATEX ;FILE EXTENSION MUST BE MATCHED
TRO CALFLG,FNEX ;YES
IFN FTDSK,<TRNN AUXFLG,DSKIN
JRST FNSET1
SKIPN T2,PP
JRST FNSET2 ;IF #P-P=0 IT IS COUNTED AS UNCHANGED
CAME T2,FNPPN
TRO CALFLG,NEWPP ;CHANGE IN # P-P
JRST FNSET1
FNSET2: MOVE T2,FNPPN ;IF P-P#=0, SET TO PREVIOUS VALUE
MOVEM T2,PP>
FNSET1: MOVE T2,DEVICE
CAME T2,DEVA
TRO CALFLG,NEWDEV ;CHANGE IN SOURCE DEV.
MOVEM T2,DEVA ;SET DEVA=DEVICE
TRNN FLAG,XFLG!RFLG!DFLG ;NEED MULTIPLE FILES FOR THESE
TLNE CALFLG,MFLG ;WILD CHAR.?
TRO CALFLG,FNEX ;YES, SET FOR MULTIPLE FILES
POPJ P,
;POPJ EXIT IF END OF COMMAND STRING, OTHERWISE RESET
;POINTER TO START OF DIRECTORY, READING IN NEW DIR.
;IF DEV OR #P-P CHANGED (EXIT CPOPJ1)
;IF DIR. IS ON DSK RESET BY REINIT.
LOOKA: SKIPE T4,ESWTCH ;MORE C.S.?
POPJ P, ;NO
PUSHJ P,DESCRP ;YES, GET NEXT FN.EX FROM CS
PUSHJ P,INLOOK ;CHECK FOR MTA REQUESTS, MODE
PUSHJ P,M4 ;CHECK FOR /I,/B,/H
HRRZM T4,ININI1 ;SET MODE
RELEAS DIR,
TRNN FLAG,DFLG ;FOR DELETE, ONE SOURCE FILE
JRST LOOKB ;...
TRNE CALFLG,NEWDEV ;ONLY IS PERMITTED
JRST ERR5A
LOOKB: TRNN CALFLG,NEWDEV!NEWPP ;PREPARE TO LOOK FOR NEW FILE
JRST LOOKC ;NAME AT HEAD OF DIRECTORY
PUSHJ P,ININIT ;INIT INPUT FILE
TRNN AUXFLG,DTAIN+DSKIN
JRST CPOPJ1
IFN FTDSK,<TRNN AUXFLG,DTAIN ;DTA INPUT?
JRST LOOKD ;NO, MUST BE DSK>
PUSHJ P,DTADIR ;YES, READ IN DTA DIRECT
LOOKC:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST LOOKD ;YES>
MOVE T5,DIRST1 ;NO, RESET DIRECTORY START
MOVEM T5,DIRST
JRST CPOPJ1
IFN FTDSK,<
LOOKD: PUSHJ P,DSKDIR ;GET USER'S FILE DIRECTORY
JFCL
SETZM UFDIN+2 ;DSK DIR BUF EMPTY
JRST CPOPJ1>
SUBTTL ROUTINE TO LIST DTA OR DSK DIRECTORIES
DEFINE P6 (A,B)<
MOVEI T2,A ;;NUMBER OF CHARACTERS
MOVE 0,[POINT 6,B] ;;BYTE POINTER TO SIXBIT STRING
PUSHJ P,PDIR2 ;;OUTPUT THE STRING
>
DTPDIR: TROE AUXFLG,ONEOUT ;ONLY DO ENTRY ONCE
JRST DTPDN ;SO MULTIPLE LISTINGS DON'T LOSE
ENTER OUT,DTON ;OUTPUT DEV ENTRY
JRST ERR4 ;DIRECTORY FULL
DTPDN: IFN FTDSK,<
TRNE AUXFLG,FFLG ;/F? SHORT FORM?
SKIPE DEVICE ;INPUT DEVICE SPECIFIED?
JRST PDIR1A ;YES
HRRZI 0,'DSK' ;ASSUME DSK IF NO DEVICE GIVEN
HRLZM 0,DEVICE
TROA AUXFLG,DSKIN ;SET DSK INPUT
PDIR1A: TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST DSKLST ;YES, GO AND TRY TO LIST DSK>
IFN TEMP,<
TRNE CALFLG,TMPI ;LIST TMPCOR DIRECTORY?
JRST TMPLST ;YES>
TRNN AUXFLG,DTAIN ;DECTAPE INPUT?
JRST ERR5 ;NOT DSK OR DTA. ERROR
;ROUTINE TO LIST DTA DIRECTORY. /L OR /F SWITCH
DTALST: PUSHJ P,DTCHECK ;CHECK FOR DTA INPUT-MUST BE DECTAPE AND
;GET DIRECTORY
PUSHJ P,CRLF ;PRINT NO. OF FREE BLOCKS LEFT
MOVE T1,IBF ;START OF BUFFER
MOVE DOUT,200(T1) ;GET POSSIBLE TAPE ID
JUMPE DOUT,NOTPID ;NOT IF ZERO
CAMN DOUT,[-1] ;OR -1
JRST NOTPID ;JUST GARBAGE
P6 9,[SIXBIT /TAPE ID: /]
P6 6,DOUT
PUSHJ P,CRLF ;NEW LINE
NOTPID: SETZ DOUT, ;CLEAR NO. FREE BLOCKS
MOVEI T4,1102 ;OCTAL NO. OF BLOCKS ON DECTAPE
MOVSI T1,(POINT 5,0) ;5 BIT BYTES
HRRZ T5,IBF ;CURRENT INPUT BUFFER
ADDI T1,1(T5) ;POINTER TO 1ST DATA WORD IN DIRECT
PDIR8: SOJLE T4,PDIR1 ;ALL THROUGH?
ILDB T3,T1 ;CALCULATE NO. OF FREE BLOCKS
JUMPN T3,PDIR8
;THIS BLOCK FULL
AOJA DOUT,PDIR8 ;COUNT NO. WITH ZERO IN
PDIR1: P6 6,['FREE: ']
PUSHJ P,OUTDC3 ;PRINT RESULT
P6 6,<[' BLKS,']>
PUSHJ P,DTCH1 ;FIX T5, TO POINT AT BEGIN OF DIR
MOVE T4,T5 ;ANOTHER COPY
MOVEI T2,26 ;NUMBER OF POSSIBLE FILES
MOVEI DOUT,26
SKIPE 123(T4) ;SKIP IF NO FILE THERE
SUBI DOUT,1 ;ONE LESS FREE
ADDI T4,1 ;SET FOR NEXT FILE
SOJG T2,.-3 ;LOOP FOR ALL FILES
PUSHJ P,OUTDC3 ;OUTPUT NUMBER FREE
P6 6,[' FILES']
PUSHJ P,CRLF ;CARRIAGE RET, LINEFEED
SUBTTL LOOP TO EXAMINE FILE NAMES DTA DIRECTORY
PDIR4:
SKIPN 123(T5) ;NULL (=0) FILE NAME?
JRST PDIR6 ;YES SO LOOK FOR ANOTHER
MOVEI T2,6 ;TRANSMIT UP TO 6 CHARACTERS
MOVSI 0,440600+T5 ;SET UP SOURCE BYTE POINTER
HRRI 0,123 ;SET TO PICK UP FILE NAME
SETZ T4,
;FOLLOWING CODE TO OUTPUT PROJ, PROG FILENAME
HLRZ CHR,151(T5) ;GET EXT
CAIE CHR,'UFD' ;UFD?
JRST PDIR4A ;NO
HLRZ DOUT,123(T5) ;PROJ NO.
MOVEI T2,PUT
PUSHJ P,OUTOCT
MOVEI CHR,COMMA ;COMMA
PUSHJ P,PUT
HRRZ DOUT,123(T5) ;PROG NO.
PUSHJ P,OUTOCT
JRST PDIR4B
PDIR4A: PUSHJ P,PDIR2 ;OUTPUT 6-BIT DATA AND INCR DIRECTORY PTR
PDIR4B: HLLZ CHR,151(T5) ;PICK UP EXTENSION
MOVSI 0,440600+T5 ;SET BYTE POINTER
HRRI 0,151 ;PICK UP EXTENSION
MOVEI T2,4 ;PRINT UP TO 4 CHRS. (PERIOD+3*EXT)
JUMPN CHR,.+3 ;EXTENSION NULL?
PUSHJ P,PDIR2A+1 ;YES
SKIP 2 ;NO
MOVEI CHR,PERIOD-40 ;NO, SO PRINT A PERIOD
PDIR3: PUSHJ P,PDIR2A ;OUTPT 6 BIT OR INCR T5
MOVEI CHR,SPACE ;OUTPUT 2 SPACES
PUSHJ P,PUT
PUSHJ P,PUT
TRNE AUXFLG,FFLG ;SHORT FORM DIRECT ?
JRST PDIR3A ;YES VJC 4/16/69
SETZ DOUT, ;CALCULATE NBR OF BLOCKS PER FILE
MOVEI T4,1101
MOVSI 0,(POINT 5,0)
HRRZ T2,IBF
ADDI 0,1(T2)
HRRZ T7,T5
SUBI T7,(T2)
ILDB T6,0 ;LOAD CONTENTS OF S.A.T. BLOCK
CAMN T6,T7 ;COMPARE WITH FILE SLOT NBR
ADDI DOUT,1 ;ADD 1 TO COUNT IF EQUAL
SOJG T4,.-3
PUSHJ P,OUTDC3 ;OUTPUT NBR OF BLOCKS PER FILE
MOVEI CHR,TAB
PUSHJ P,PUT
MOVE 0,151(T5) ;GET ENTRY DATE
ANDI 0,7777 ;LEFT BITS ARE IRRELEVENT
PUSHJ P,DATOUT ;OUTPUT THE DATE
PDIR3A: PUSHJ P,CRLF ;GIVE CR,LF 4/16/69
PDIR6: HRRZ T1,IBF ;PROCESS NEXT ENTRY
SUBM T5,T1
CAIL T1,26 ;FILE "NUMBER" OK?
JRST MAIN1 ;NO, END OF ENTRIES
AOJA T5,PDIR4 ;END OF LOOP, GET NEXT FILENAME
IFN FTDSK,<
CLRF: SOS LIN>
CRLF: MOVEI CHR,CR ;OUTPUT CAR. RET.
PUSHJ P,PUT
MOVEI CHR,LF ;LINE FEED
JRST PUT
PDIR2: ILDB CHR,0 ;ROUTINE TO OUTPUT 6-BIT DATA
TRNN 0,-1 ;PRINT SPACES WHEN PRINTING THE FREE BLOCKS
PDIR2A: JUMPE CHR,PDIR21 ;TERMINATE ON SPACE
ADDI CHR,40 ;CONVERT TO 7 BIT
PUSHJ P,PUT ;OUTPUT CHARACTER
ADDI T4,1
SOJG T2,PDIR2 ;COUNT DOWN MAX-CHARS COUNTER
PDIR21: POPJ P, ;CONTINUE
;OUTPUT THE DATE FOUND IN AC 0.
DATOUT: MOVEI T2,PUT ;PUT CHAR IN OUT
IDIVI 0,^D31
MOVEI T3,1(1)
IDIVI 0,^D12
MOVE DOUT,T3 ;DOUT=DAY
PUSHJ P,OUTDC1 ;PRINT DAY
PUSHJ P,DATO2 ;PRINT -MONTH-
MOVE DOUT,0
ADDI DOUT,^D64 ;DOUT=YEAR
OUTDC1: SKIPA DOUT+1,TWL ;RADIX 10
;*******************************************************************
;ROUTINE TO CONVERT OCTAL TO ASCII
;DOUT CONTAINS OCTAL VALUE ON ENTRY
OUTOCT: MOVEI DOUT+1,10 ;RADIX 8
PRNUMA: HRRZM DOUT+1,T4
MOVEI CHR,"0"
CAMGE DOUT,DOUT+1 ;PRINT AT LEAST 2 DIGITS
PUSHJ P,(T2) ;PUT OR PUTCON
PRN: IDIVI DOUT,(T4) ;DIVIDE BY RADIX
HRLM DOUT+1,(P) ;SAVE NO. FOR PRINT
JUMPE DOUT,.+2 ;ENUF DIGITS?
PUSHJ P,PRN ;NO, GET MORE
HLRZ CHR,(P) ;YES, GET LEFTMOST
ADDI CHR,60 ;CONVERT TO ASCII
JRST (T2) ;PUT OR PUTCON
OUTDE4: MOVEI CHR," " ;SET UP FOR SPACES
CAIL DOUT,^D1000 ;PRINT 4 CHAR.
JRST OUTDC1 ;AT LEAST 4 SEEN
PUSHJ P,(T2) ;OUTPUT ONE SPACE
CAIGE DOUT,^D100 ;3 CHAR.?
PUSHJ P,(T2) ;NO,SO ANOTHER SPACE
JRST OUTDC1
OUTDC3: MOVEI CHR," " ;GET A SPACE READY
CAIGE DOUT,^D100 ;LESS THAN 3 CHAR.
PUSHJ P,PUT ;YES, COMPENSATE WITH A SPACE
OUTDEC: MOVEI T2,PUT ;PUT CHAR IN OUT BUF
JRST OUTDC1
DATO2: MOVEI T4,5
MOVE T6,MNPT
ADDM 1,T6
ILDB CHR,T6
PUSHJ P,(T2) ;PUT OR PUTCON
SOJG T4,.-2
POPJ P,
;READ DTA DIRECTORY AND INITIALIZE DIRST AND DIRST1
DTCHECK:PUSHJ P,ININIT ;INITIALIZE INPUT DEVICE
DTCH2:
USETI IN,144 ;GET DTA DIR
PUSHJ P,INP ;INPUT DIRECTORY
CLOSE IN, ;FINISHED WITH CHAN FOR NOW
DTCH1: HRRZ T5,IBF ;LOC. OF CURRENT BUF, 2ND WORD
MOVEI 0,123(T5) ;83 WORDS,7, FIVE-BIT BYTES
ADDI T5,1 ;COMPUTE ADD. OF DIR. START
MOVEM 0,DIRST ;FIRST FILE NAME LOC
MOVEM 0,DIRST1 ;TO RESTORE DIRST
POPJ P,
;ROUTINE TO CHECK BRACKET COUNT/MATCHING
OUTCHK: SETZB T3,TLBRKT ;COUNT <> ON THIS LINE, CLEAR THINGS
MOVE T1,OPTRA ;BYTE POINTER FOR READING OUT THE LINE
OUTCH2: CAMN T1,OPTR ;LINE DONE?
JRST OUTCH3 ;YES, SO DECIDE WHETHER TO PRINT
ILDB T2,T1 ;GET CHAR
CAIN T2,"<" ;LEFT BRACKET?
AOS TLBRKT ;YES, SO INCREMENT BRACKET COUNT
CAIN T2,">" ;RIGHT BRACKET?
SOSL TLBRKT ;YES, SUBTRACT BRACKET COUNT, GONE NEG?
JRST OUTCH2 ;NO, SO DO NEXT CHAR
AOJA T3,OUTCH2 ;YES, SO FLAG COUNT GONE NEG.
OUTCH3: SKIPN T2,TLBRKT ;BRACKET COUNT OFF THIS LINE?
JUMPE T3,CPOPJ ;NO, WENT NEG.?
ADDM T2,TOTBRK ;YES, SO ADD INTO CUMULATIVE COUNT
MOVEI CHR,"-" ;PRINT MINUS FOR NEG TOTAL
SKIPGE TOTBRK
PUSHJ P,PUT
MOVM DOUT,TOTBRK;PRINT MAGNITUDE OF TOTAL
PUSHJ P,OUTDEC
MOVEI CHR,TAB ;FOLLOW WITH TAB
PUSHJ P,PUT
JRST OUTCH1 ;AND PRINT THE LINE
SUBTTL ROUTINE TO FIND FILE TYPE AND SET MODE
FILTYP: TDNE FLAG,[XWD IFLG+IBFLG,BMOD]
POPJ P, ;BIN MODE DON'T CARE IF DMP, ETC
TLZ AUXFLG,SBIN ;CLEAR BINARY FLAG
TDNN FLAG,[XWD PFLG!WFLG,LINE!TBMOD!NSMOD!SQMOD!SPMOD]
TLNE AUXFLG,CDRFLG ;/E FROM DSK IS NOT BINARY
JRST FIL2 ;SO TURN OFF SBIN
TRNN FLAG,XFLG ;NO CONCATENATION ALLOWED
TRNN CALFLG,COMAFL ;CONCATENATION, SO TAKE IT SLOWLY
TRNN AUXFLG,DSKIN!DTAIN!MTAIN ;BINARY INPUT POSSIBLE?
JRST FIL11 ;NO
TRNE AUXFLG,DSKOUT!DTAOUT!MTAOUT ;BINARY OUTPUT?
JRST FIL3 ;YES, USE BINARY MODE
FIL11: HLLZS ZRF+1 ;CLEAR RIGHT HALF
MOVE T1,[-TYTLEN,,TYPTAB]
FIL11A: HLLZ 0,(T1) ;GET AN EXT
CAMN 0,ZRF+1 ;MATCH?
JRST FIL3 ;YES, USE BINARY
HRLZ 0,(T1) ;TRY OTHER
CAMN 0,ZRF+1
JRST FIL3
AOBJN T1,FIL11A ;NO, KEEP TRYING
HLLZS DTON+1 ;CLEAR RIGHT HALF INCASE NOT ZERO
MOVE T1,[-TYTLEN,,TYPTAB]
FIL11B: HLLZ 0,(T1) ;GET AN EXT
CAMN 0,DTON+1 ;MATCH?
JRST FIL3 ;YES, USE BINARY
HRLZ 0,(T1) ;TRY OTHER
CAMN 0,DTON+1
JRST FIL3
AOBJN T1,FIL11B ;NO, KEEP TRYING
TRNN FLAG,XFLG ;DO NORMAL PROCESSING ON ALL
JRST FIL2 ;BUT DMP ETC FILES IF NOT /X
POPJ P, ;NO SIGNIFICANT SWITCHES
TYPTAB: 'SHR',,'HGH'
'SAV',,'LOW'
'XPN',,'SVE'
'REL',,'CHN'
'DMP',,'BIN'
'RIM',,'RTB'
'RMT',,'BAC'
'BUG',,'CAL'
'DAE',,'DCR'
'MSB',,'OVR'
'QUC',,'QUE'
'QUF',,'SFD'
'SYS',,'UFD'
TYTLEN==.-TYPTAB
FIL4: TLO AUXFLG,RSDCFL ;SET REL,SAV,DMP,CHN FLAG
FIL1: HRLZI 0,004400 ;FORCE 36-BIT.
HLLM 0,IBF+1 ;INPUT BYTE POINTER
HLLM 0,OBF+1 ;OUTPUT BYTE POINTER
GETSTS IN,T1 ;GET CURRENT MODE
TRZ T1,17 ;CLEAR
IORI T1,14 ;SET TO BINARY
SETSTS IN,(T1)
GETSTS OUT,T1 ;SAME FOR OUTPUT
TRZ T1,17
IORI T1,14
SETSTS OUT,(T1)
POPJ P, ;CHANGE TO FORCED BINARY
FIL3: TLO AUXFLG,SBIN ;INPUT EXT = DMP,SAV,CHN,REL
TRNE FLAG,XFLG
JRST FIL1
TLON AUXFLG,FRSTIN ;NOT /X TEST FURTHER
JRST FIL4 ;IS THIS FIRST SOURCE, YES
TLOE AUXFLG,RSDCFL ;NOT FIRST, WAS PREVIOS FILE RSCD?
JRST FIL1 ;ENSURE BINARY AT ALL TIMES
OUTPUT OUT, ;NO CHANGE TO 36-BIT
MOVE 0,OBF+2 ;CURRENTLY 7-BIT I/O, MUST CHANGE TO 36-BIT
;OUTPUT CURRENT BUFFER
IDIVI 0,5 ;DIVIDE OBF+2 BY 5 (CHAR. COUNT)
MOVEM 0,OBF+2
JRST FIL1
FIL2: TLOE AUXFLG,FRSTIN ;NOT A RSCD FILE
TLZN AUXFLG,RSDCFL ;NO, WAS PREV. FILE RSCD?
POPJ P, ;NO, NO CHANGE
OUTPUT OUT, ;YES, CHANGE 36-BIT TO 7-BIT
MOVEI 0,5
IMULM 0,OBF+2
MOVE 0,SVIBF ;RESTORE 7-BIT
HLLM 0,IBF+1
MOVE 0,SVOBF
HLLM 0,OBF+1
GETSTS IN,T1 ;GET CURRENT MODE
TRZ T1,17 ;CLEAR
IORI T1,1 ;SET TO ASCII LINE
SETSTS IN,(T1)
GETSTS OUT,T1 ;SAME FOR OUTPUT
TRZ T1,17
IORI T1,1
SETSTS OUT,(T1)
POPJ P,
SUBTTL ROUTINES TO HANDLE DEVICE TMPCOR:
IFN TEMP,<
;ZERO TMPCOR DIRECTORY
TMPZRO: MOVE T1,[XWD 5,TMPNAM]
PUSHJ P,TMPXCT
JRST TMPNAV ;ONLY GETS HERE IF NO TMPCOR
JRST PIP2 ;GET NEXT COMMAND
;LIST TMPCOR DIRECTORY
TMPLST: SETZ T1, ;0 TO GET FREE SPACE
TMPCOR T1, ;GET IT
JRST TMPNAV ;NO TMPCOR IN THIS MONITOR
MOVE DOUT,T1 ;GET WORD COUNT
MOVEI T2,PUT
PUSHJ P,OUTDC1 ;OUTPUT IT
LSTLIN TMPHDR ;AND MESSAGE
MOVE T1,[XWD 4,TMPNAM]
PUSHJ P,TMPXCT
JRST MAIN1 ;SHOULD NEVER HAPPEN
JUMPLE T1,MAIN1 ;DIRECTORY EMPTY
MOVNS T1 ;GET - WORD COUNT
HRL T5,T1 ;MAKE AOBJN WORD
TMPLS2: HLLZ 0,(T5) ;GET NAME
PUSHJ P,SIXOUT ;OUTPUT IT
PUSHJ P,TABOUT ;AND A TAB
HRRZ DOUT,(T5) ;GET WORD COUNT
MOVEI T2,PUT
PUSHJ P,OUTDC1 ;OUTPUT IN OCTAL
PUSHJ P,CRLF ;NEW LINE
AOBJN T5,TMPLS2
JRST MAIN1 ;END OF DIRECTORY
;INPUT ONE FILE FROM TMPCOR
TMPIN: SKIPL ESWTCH ;MORE COMMAND
JRST TMPERR ;YES
MOVE T1,[XWD 1,TMPNAM]
PUSHJ P,TMPXCQ
JRST [PUSHJ P,ERR3A ;ERROR
PUSHJ P,GETEND;DELETE CCL FILE
JRST PIP2]
TROE AUXFLG,ONEOUT ;ONLY DO ENTRY ONCE
JRST TMPIN1 ;DONE ALREADY
ENTER OUT,DTON ;ENTER FILE IN CASE DIRECTORY DEV.
JRST ERR4 ;FAILURE
TMPIN1: HRLI T5,440700 ;MAKE A BYTE POINTER
IMULI T1,5 ;WORD COUNT
ADDI T1,1 ;BONUS FOR SOSGE
SOJLE T1,MAIN1 ;JUMP WHEN DONE
ILDB CHR,T5 ;GET CHARACTER
PUSHJ P,PUT ;OUTPUT IT
JRST .-3 ;LOOP 'TIL DONE
;DELETE ONE FILE FROM TMPCOR
TMPDEL: TRNE FLAG,RFLG!XFLG
JRST TMPERR
MOVE T1,[XWD 2,TMPNAM]
PUSHJ P,TMPXCQ
JRST [PUSHJ P,ERR3A
PUSHJ P,GETEND
JRST PIP2]
ERRPNT </File deleted: />
PUSHJ P,P6BIT ;OUTPUT FILE NAME
FILNAM
PUSHJ P,TCRLF ;OUTPUT CR-LF
JRST PIP2
;OUTPUT ONE FILE TO TMPCOR
TMPOUT: MOVE T1,DTON ;OUTPUT FILE NAME
MOVEM T1,TMPNAM ;FOR TMPCOR
SETZ T1, ;GET FREE WORD
PUSHJ P,TMPXCT ;DO IT
JRST TMPNAV ;NO TEMPCOR
MOVEM T5,TMPNAM+1 ;SAVE START
HLL T5,IBF+1 ;FORM BYTE POINTER
HRRZ T2,.JBFF ;TOP OF BUFFER
INPTMP: PUSHJ P,INP ;GET A BUFFER FULL
PUSHJ P,TTYZ ;CHECK TTY FOR EOF
TRNE IOS,EOFBIT ;CHECK FOR EOF ON ALL DEVICES
JRST TMPEOF ;YES IT WAS
TMPILP: SOSGE IBF+2 ;ANYTHING IN BUFFER?
JRST INPTMP ;NO, GET MORE
ILDB T1,IBF+1 ;GET A CHARACTER
CAIGE T2,(T5) ;TOO MANY CHARS.?
JRST TMPFUL ;YES, ERROR
IDPB T1,T5 ;DEPOSIT CHAR
JRST TMPILP ;LOOP
TMPEOF: HRRZ T5 ;CLEAR OUT BYTE POSITION
SUB T5,TMPNAM+1 ;TOTAL NO OF WORDS
MOVNS T5 ;NEGATE IT
HRLM T5,TMPNAM+1 ;MAKE IOWD
MOVE T1,[3,,TMPNAM] ;SET TO WRITE
TMPCOR T1, ;DO IT
JRST TMPFUL ;FAILED, NOT ENOUGH ROOM
JRST PIP2 ;ONLY ONE BUFFER ALLOWED
;SET UP AND XCT TMPCOR UUO
TMPXCQ: MOVE T2,FILNAM ;GET FILE NAME
SKIPE QMASK ;CANN'T HANDLE WILD CHARS. YET
JRST TMPERR ;YES
MOVEM T2,TMPNAM ;PUT IN LOOKUP BLOCK
TMPXCT: MOVSI T2,-200 ;ALLOW 200 WORDS
HRR T2,.JBFF ;WHERE TO PUT CHARS.
HRRZ T5,.JBREL ;GET TOP OF CORE
CAIGE T5,200(T2) ;WILL BUFFER FIT IN
JRST [ADDI T5,200 ;ASK FOR ENUF CORE
CORE T5, ;TRY TO GET IT
JRST OMODER ;FAILED
JRST .+1] ;OK NOW
MOVEM T2,TMPNAM+1 ;STORE IN LOOKUP BLOCK
SOS TMPNAM+1 ;MAKE AN IOWD
TMPCOR T1, ;THIS IS IT
POPJ P, ;ERROR RETURN
MOVE T5,T1 ;NUMBER OF WORDS
ADD T5,.JBFF ;FIX UP JOBFF JUST IN CASE
EXCH T5,.JBFF ;PUT START OF BUFFER IN T5
JRST CPOPJ1 ;AND SKIP RETURN
TMPERR: ERRPNT </?Command not yet supported for TMPCOR!/>
TMPFUL: ERRPNT </?Not enough room in TMPCOR:!/>
TMPHDR: ASCIZ / TMPCOR words free
/
TMPNAV: ERRPNT </?TMPCOR not available!/>
>
SUBTTL BLOCK 0 CODE
;THIS CODE COPIES BLOCK 0,1,2 ONLY. I/O MUST BE DECTAPE.
;MODE SELECTED MUST BE BIT 100, 20 AND NOT DUMP MODE (134).
BLOCK0: TRC AUXFLG,DTAIN+DTAOUT
TRCE AUXFLG,DTAIN+DTAOUT;FORCE DTA I/O
JRST ERR7A
MOVEI 0,134
MOVEM 0,OMOD
MOVEM 0,ININI1
MOVSI 0,OBF
MOVEM 0,ODEV+1
MOVEI 0,IBF
MOVEM 0,DEVICE+1
OPEN OUT,OMOD
JRST ERR1 ;UNAVAILABLE
OUTBUF OUT,1
OUTPUT OUT,
OPEN IN,ININI1
JRST ERR1A
INBUF IN,1
SETZB T1,BL0CNT
BL4: USETI IN,(T1)
INPUT IN, ;READ
GETSTS IN,IOS
TRNN IOS,740000 ;ANY ERRORS
JRST BL1 ;NO
JSP T5,INICN2
PUSHJ P,QUEST
ERRPN2 </Input device />
PUSHJ P,P6BIT
DEVICE
ERRPN2 </: />
MOVE T2,AUXFLG ;DECTAPE FOR ERROR MESSAGE
ANDI T2,DTAIN
PUSHJ P,IOERR ;PRINT ERROR TYPE
BL1: HRLZ T5,IBF+1
HRR T5,OBF+1
MOVEI T4,177(T5)
BLT T5,(T4) ;SHIFT DATA TO OUTPUT BUFFER
USETO OUT,@BL0CNT
OUTPUT OUT, ;WRITE BLOCK
PUSHJ P, OUTP1 ;CHECK ERRORS
AOS T1,BL0CNT
CAIGE T1,3
JRST BL4
BL3: RELEASE OUT, ;IF ANY, PDL IS RESET
JRST PIP2
SUBTTL MAGTAPE ROUTINES
;TEST TO SEE IF MORE THAN ONE OF THE LOWEST EIGHT MTA FLAGS
;HAVE BEEN SELECTED. IF SO ERROR. OTHERWISE, IMPLEMENT
;REQUEST. T1, T3, T6 SET AT ENTRY BY INLOOK OR OUTLOOK
;TO EQUAL AUX/AUXOUT, AB/ABOUT,INIMTA/INOMTA
MT1: HRRZ T2,T1 ;T1 CONTAINS REQUEST
ANDI T2,-1(T2) ;KNOCK OFF RIGHT MOST 1
TRNE T2,377
JRST MTR1 ;PRINT ERROR MESSAGE
TRNN T1,MTAFLG+MTBFLG+MTWFLG+MTTFLG+MTFFLG+MTUFLG+MTDFLG+MTPFLG
JRST MTC1
CAIN T6,INOMTA ;OUTPUT DEVICE?
TRNE CALFLG,DVSWTH ;YES, AN EXPLICIT DEVICE?
JRST .+2 ;INPUT DEVICE, OR EXPLICIT OUTPUT ONE
JRST ERR8 ;NOT OUTPUT DEVICE SEEN
PUSHJ P,(T6) ;THERE IS A REQUEST
;GO TO INIMTA/INOMTA
;PERFORM POSITIONING REQUESTS
TRNE T1,MTUFLG
JRST UNLOAD
TRNE T1,MTWFLG
JRST REWIND
TRNE T1,MTFFLG
JRST MARKEF
TRNE T1,MTTFLG
JRST SLEOT
TRNE T1,MTBFLG+MTPFLG ;MULTIPLE REQUESTS ALLOWED
JRST BSPF
TRNE T1,MTAFLG+MTDFLG ;MULTIPLE REQUESTS ALLOWED
JRST ADVF
;T1=AUX,AUXOUT. T3=AB,ABOUT. T6=INIMTA,INOMTA.
MTCONT: RELEAS TAPE,
TRNN T1,MTUFLG ;UNLOAD?
TRNE CALFLG,NSWTCH ;IS THERE AN INPUT DEVICE?
CAIE T6,INOMTA ;OUTPUT TAPE?
POPJ P, ;NO
JRST PIP2 ;YES, END OF COMMAND
;ROUTINE TO CHECK AND SET DENSITY FOR NEW DEVICE
MTC1: MOVE T4,T1 ;GET AUX/AUXOUT
ANDI T4,MT2FLG+MT5FLG+MT8FLG
ANDI T4,-1(T4) ;REMOVE RIGHT MOST 1
JUMPN T4,MTR1 ;MORE THAN 1 REQ, ERROR
TRC T1,MTIFLG!MTSFLG
TRCN T1,MTIFLG!MTSFLG
JRST MTR1 ;CAN NOT BOTH BE ON
MOVEI T4,1 ;ASCII LINE STANDARD MODE
TRNE T1,MT2FLG
TRO T4,DENS2 ;SET 200 BPI
TRNE T1,MT5FLG
TRO T4,DENS5 ;SET 556 BPI
TRNE T1,MT8FLG
TRO T4,DENS8 ;SET 800 BPI
TRNE T1,MTEFLG
TRO T4,PARE ;EVEN PARITY
TRNE T1,MTIFLG ;INDUSTRIAL COMPATIBLE?
TRO T4,MTIFLG
TRNE T1,MTSFLG ;DEC STANDARD?
TRO T4,MTSFLG
POPJ P,
;REWIND AND UNLOAD
UNLOAD: MTAPE TAPE,11
JRST MTCONT
;REWIND ONLY
REWIND: MTAPE TAPE,1
MTWAIT: WAIT TAPE,
JRST MTCONT
;MARK END OF FILE
MARKEF: MOVE T5,MTANAM
EXCH T5,ODEV
MTAPE TAPE,3
GETSTS TAPE,IOS
PUSHJ P,OUTP3
SETSTS TAPE,(IOS)
MOVEM T5,ODEV
JRST MTCONT
;SKIP TO LOGICAL END OF TAPE.
SLEOT: MTAPE TAPE,10
JRST MTWAIT
;BACKSPACE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE
BSPF: HRRE T3,T3 ;T3=NO. OF FILES/RECORDS TO BACK
MOVEI T5,7 ;BSPR
TRNN T1,MTPFLG ;BSPR?
MOVEI T5,17 ;BSPF
BSPF2: WAIT TAPE, ;WAIT
STATO TAPE,LDP ;AT LOAD POINT?
JRST BSPF3 ;NOT LDP
ERRPNT </?Load point before end of backspace request!/>
BSPF3: MTAPE TAPE,(T5) ;BACKSPACE FILE/RECORD
SOJGE T3,BSPF2 ;MORE FILES/RECORDS TO BSP?
;NO, END OF LOOP
WAIT TAPE,
GETSTS TAPE,IOS
TRNN T1,MTBFLG ;BACKSPACE FILE?
JRST MTCONT ;NO
TRNN IOS,LDP ;IF AT LOAD POINT
MTAPE TAPE,16 ;(MOVE FWD. OVER EOF)
JRST MTCONT ;DON'T SKIP A RECORD
;ADVANCE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE
ADVF: HLRE T3,T3 ;T3=NO. FILES (OR REC) TO ADVANCE
MOVEI T5,6 ;ADVR
TRNN T1,MTDFLG ;ADVR ?
MOVEI T5,16 ;ADVF
MTAPE TAPE,(T5) ;ADVANCE FILE/RECORD
SOJG T3,.-1 ;MORE FILES/RECORDS TO ADV?
;NO, END OF LOOP
SKIPGE T3 ;WAS ITEXPLICIT ZERO
MTAPE TAPE,7 ;YES , POSITION BEFORE EOF MARK
WAIT TAPE, ;WAIT...
GETSTS TAPE,IOS
TRZE IOS,EOFBIT
SETSTS TAPE,(IOS) ;END OF FILE
JRST MTCONT
;ROUTINE TO INITIALIZE MAGTAPE FOR INPUT OR OUTPUT
INOMTA: SKIPA T2,ODEV ;INIT OUTPUT DEVICE
INIMTA: MOVE T2,DEVICE ;INIT INPUT DEVICE
SETZM MTANAM+1
MOVEM T2,MTANAM
TRNN CALFLG,NEWDEV
JRST INMTA ;SAME DEVICE
PUSHJ P,MTC1 ;NEW DEVICE
HRRZM T4,INMTA1 ;SET MODE,DENSITY,PARITY
INMTA: OPEN TAPE,INMTA1
JRST ERR1B
POPJ P,
;ROUTINE TO PRINT ERROR MSG IF MORE THAN 1/8 FLAGS SET
MTR1: MOVE T4,DEVICE ;TENTATIVELY SET I/DEV
CAIE T6,INIMTA ;INPUT DEVICE?
MOVE T4,ODEV ;NO, SET O/DEV
ERRPNT </?Too many requests for />
PUSHJ P,P6BIT
T4
JRST PIP2
SUBTTL CONSTANTS/STORAGE/VARIABLES
;CONSTANTS
OKBD: POINT 6,DTON+2,23 ;FOR NO. 1K BLOCKS
OKB: POINT 6,ZRF+2,23
DATE: POINT 12,ZRF+2,35
DATED: POINT 12,DTON+2,35 ;CREATION DATE /X
ZRO: ASCII /00000/
OPTRA: XWD 700,LBUF-1 ;INITIAL POINTER TO LINE BUFFER
K1: 432150643240 ;MAGIC ASCII INCREMENT BY 10
K3: 375767737576 ;CHARACTER MASK 077
K4: 432150643216 ;MAGIC ASCII INCREMENT BY 1
TWL: OCT 12
IFN FTDSK,<
PP11: XWD 1,1
PRPTL: POINT 9,PROTS,8 ;PROTECTION FOR RENAME
PRPTD: POINT 9,DTON+2,8
PRNM: POINT 9,ZRF+2,8 ;PROT FOR /R
TIME: POINT 11,ZRF+2,23 ;CREATE TIME /X
TIMED: POINT 11,DTON+2,23 ;DEPOSIT CREATE TIME
ADATE: POINT 12,FILNAM+1,35 ;ACCESS DATE
CTIME: POINT 11,FILNAM+2,23 ;CREATION TIME
CDATE: POINT 12,FILNAM+2,35 ;CREATION DATE
PROT: POINT 9,FILNAM+2,8 ;PROTECTION
MODE: POINT 4,FILNAM+2,12 ;RECORDING MODE
>
MONTH: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
MNPT: POINT 7,MONTH
;PROGRAM STORAGE AREA
SWSEG
LOW:
IFN TEMP,<
TMPPNT: BLOCK 1
TMPFLG: BLOCK 1
TMPEND: BLOCK 1
TMPFIL: BLOCK 2
TMPNAM: BLOCK 2 >
BL0CNT: BLOCK 1 ;COUNT
IFN CCLSW,<
CFI: BLOCK 3 ;STORED COMMAND INPUT HEADER
CFILE: BLOCK 4 ;NAME OF STORED CCL COMMAND FILE
COMFLG: BLOCK 1 ;-1 IF STORED COMMANDS,0 IF TTY>
SVIBF: BLOCK 1 ;SAVE INIT MODE (INPUT)
SVOBF: BLOCK 1 ;SAVE INIT MODE (OUTPUT)
IBF: BLOCK 3 ;INPUT BUFFER HEADER
OBF: BLOCK 3 ;OUTPUT BUFFER HEADER
OBI: BLOCK 3 ;OUTPUT BUFFER INPUT HEADER FOR DSK /Z
TFI: BLOCK 3 ;CONSOLE INPUT HEADER
TFO: BLOCK 3 ;CONSOLE OUTPUT HEADER
SAVAC: BLOCK 5 ;SAVE SOME ACS
NAMTAB: BLOCK 24 ;FOR (XD) ON DSK OR RENAME
IFN FTDSK,<
SYSPP: BLOCK 1 ;PP OF DEVICE SYS
LOCNAM: BLOCK 1 ;POINTER FOR NAMTAB>
DIRST: BLOCK 1 ;LOC. OF LAST DIR. FILE NAME REFERENCED
DIRST1: BLOCK 1 ;SAVE INITIAL DIRST
SQNUM: BLOCK 1 ;CURRENT SEQUENCE NUMBER
DTJBFF: BLOCK 1 ;VALUE OF JOBFF AFTER CONSOLE I/O BUFFERS
SVJBFF: BLOCK 1 ;INITIAL VALUE OF JOBFF
SVJBF1: BLOCK 1 ;VALUE OF JOBFF AFTER OUTBUF UUO
OPTR: BLOCK 1 ;CURRENT POINTER FOR LINE PRESCAN
DTONSV: BLOCK 2 ;OUTPUT DIRECTORY ENTRY COPY
SVPTR1: BLOCK 1 ;POINTER TO LAST PRINTING CHARACTER
SVPTR2: BLOCK 1 ;POINTER TO LAST GENERATED TAB
TLBRKT: BLOCK 1 ;TOTAL PARENS ON THIS LINE
TOTBRK: BLOCK 1 ;TOTAL CUMULATIVE PARENS
TABCT: BLOCK 1 ;SPACES TO NEXT TAB STOP
SPCT: BLOCK 1 ;CONSECUTIVE SPACES COUNTER
ABOUT: BLOCK 1 ;AB FOR OUTPUT UNIT
AUXOUT: BLOCK 1 ;AUX FOR OUTPUT UNIT
PROTS: BLOCK 1 ;SAVE PROTECTION
CDRCNT: BLOCK 1 ;COUNT CARD COLS.
PTRPT: BLOCK 1 ;STORE SEQ. NO. POINTER
;THIS IS A BLOCK OF VARIABLE LOCATIONS, ZEROED AT THE START OF EACH
;PIP RUN, I.E EACH TIME PIP TYPES *.
FZERO==.
;***** DO NOT SPLIT THIS BLOCK *****
IFN FTDSK,<
RIBFIR: BLOCK 1 ;NUMBER OF WORDS IN LOOKUP
PPN: BLOCK 1 ;PROJ-PROG FOR EXTENDED LOOKUP>
FILNAM: BLOCK 1 ;FILE NAME FROM COMMAND SCANNER
FILEX: BLOCK 1 ;EXTENSION
PR: BLOCK 1 ;PROTECTION
PP: BLOCK 1 ;P-P NUMBER TYPED BY USER
IFN FTDSK,<BLOCK 20+RIBFIR-.> ;TOTAL LENGTH OF LOOKUP BLOCK
;***** END OF BLOCK *****
DTON: BLOCK 4 ;OUTPUT DIR. ENTRY
DEVA: BLOCK 1 ;SAVE INPUT DEV. NAME
NO.: BLOCK 1 ;GENERATE FILE NAMES
ZRF: BLOCK 4 ;LOOKUP FILE NAMES
MTAREQ: BLOCK 1 ;STORE MTA REQUESTS
COMEOF: BLOCK 1 ;EOF INDICATOR
COMCNT: BLOCK 1 ;COMBUF CHARS COUNT
COMPTR: BLOCK 1 ;POINTER FOR STORING/EXTRACTING CS
AUX: BLOCK 1 ;COPT AUXFLG (MTA)
IFN FTDSK,<
PPP: BLOCK 1 ;PERMANENT PPN
FNPPN: BLOCK 1 ;RESERVE #P-P
FNPPNS: BLOCK 1 ;COPY FNPPN FOR LATEST NON-SYS #P-P
LSTPPN: BLOCK 1 ;PPN FOR LIST COMMAND>
ESWTCH: BLOCK 1 ;-1 INDICATES END OF LINE
XNAME: BLOCK 1 ;-1 INDICATES SCAN OVERSHOOT WITH A NULL NAME
;0 INDICATES NO SCAN OVERSHOOT
;CONTAINS OVERSHOOT NAME IF NOT NULL
AB: BLOCK 1 ;MTA VALUE SWITCHES
PTHADD: BLOCK 1 ;FIRST ADDRESS OF FULL PATH
PTHSCN: BLOCK 1 ;SCAN SWITCH
PTHPPN: BLOCK 1 ;PATH PPN
PTHSFD: BLOCK PTHLEN+1 ;SFD LIST + 0
DEFPTH: BLOCK PTHLEN+4 ;DEFAULT PATH
PTHOUT: BLOCK PTHLEN+4 ;OUTPUT PATH
MATCH: BLOCK 2 ;NAME AND EXT FOR /L OR (RX)
TAPEID: BLOCK 1 ;TAPE ID IN SIXBIT
QMASK: BLOCK 2 ;MASK FOR MATCHING FILE NAME AND EXT
OQMASK: BLOCK 2 ;SAME BUT FOR OUTPUT
STRARG: BLOCK 3 ;ARGUMENTS FOR GOBSTR UUO
GENERI=STRARG+2 ;FILE STRUCTURE NAMES IF GENERIC DSK
BLOCK 2 ;BUG IN 5.03 RETURNS 5 WORDS FROM GOBSTR
LZERO==.-1 ;THIS IS THE END OF THE INIT. ZEROED BLOCK.
PDL: BLOCK 20 ;PUSHDOWN LIST
LBUF: BLOCK 204 ;LINE BUFFER. ALLOW FOR FORTRAN DATA
LBUFE: BLOCK 1 ;ALLOW FOR OVERFLOW
DBUF: BLOCK 204 ;DIRECTORY BUFFER
OMOD: BLOCK 1 ;OUTPUT DEVICE MODE, STATUS
ODEV: BLOCK 2 ;OUTPUT DEVICE NAME
;BUFFER HEADER(S) LOC
ININI1: BLOCK 1 ;INPUT DEVICE
DEVICE: BLOCK 2
IFN CCLSW,<
RENSN: BLOCK 1 ;-1 IF RENAME MESSAGE SEEN
RUNDEV: BLOCK 1 ;RUN UUO DEVICE
RUNFIL: BLOCK 3 ;FILE NAME
RUNPP: BLOCK 2
CCLINI: BLOCK 3 ;CCL INPUT DEVICE OPEN BLOCK>
DEVERR: BLOCK 1
DERR2: BLOCK 2
INMTA1: BLOCK 1
MTANAM: BLOCK 2
IFN FTDSK,<
MYPPN: BLOCK 1 ;LOGGED IN PPN
ADSK1: BLOCK 1 ;OPEN DIRECTORY, MODE
ADSK: BLOCK 2 ;FILENAME, EXT
LIN: BLOCK 1 ;COUNT FOR DSK DIR LIST
PGCNT: BLOCK 1 ;COUNT OF PAGES FOR DSK DIR
UFDIN: BLOCK 3 ;HEADER FOR READING DISK DIRECTORY
UFD: BLOCK 4 ;[P,P] OR *FD*
;UFD OR SYS
BLKSUM: BLOCK 1 ;TOTAL NBR BLOCKS PER PROJ. PROG NBR
LEVEL: BLOCK 1 ;-2 IF LEVEL D DISK SERVICE
JOBPTH: BLOCK PTHLEN+4 ;DEFAULT JOB PATH
JOBPPN=JOBPTH+2 ;DEFAULT JOB PPN
JOBSFD=JOBPTH+3 ;DEFAULT JOB SFD LIST
>
IFN RIMSW,<
CHKSM: BLOCK 1 ;CHECKSUM ACCUMULATED (RIM10B)
POINTA: BLOCK 1 ;SAVE POINTER FOR RIM10B BLOCK
LENGTH: BLOCK 1 ;CALC. LENGTH OF RIM10 FILE
ZERO: BLOCK 1 ;NO OF 0'S NEEDED TO FILL SPACES IN
COUNT: BLOCK 1 ;RIM10B COUNT WORDS OUT
XFERWD: BLOCK 1 ;RIM-10-B XFER WD. ;FILE.
>
VAR ;JUST IN CASE
LOWTOP: ;LAST DATA LOCATION PLUS ONE
SWSEG
SUBTTL RIM LOADER
IFE RIMSW,<
RIMTB: ERRPNT <Z? /Y switch option not available this assembly!Z>
XLIST>
IFN RIMSW,<
LODAL==16 ;LENGTH OF RIM LOADER
HLTBIT==200 ;CHANGES JRST TO HALT
BLKSZ==17 ;NORMAL BLOCK LENGTH IN RIM10B
.JBDA==140 ;START OF USER AREA
RIMTB: TRNN AUXFLG,DTAIN!DSKIN!MTAIN
JRST ERR5B
PUSHJ P,ININIT
OUTPUT OUT,
PUSHJ P,FNSET ;SEE WHAT WE HAVE FOR FILNAM.EXT
TRNN CALFLG,FNEX ;SINGLE FILE SPECIFICATION?
JRST [MOVE 0,[FILNAM,,ZRF] ;YES, DON'T READ DIRECTORY
BLT 0,ZRF+3 ;SET UP FILE NAME,EXT, AND PPN
SETZM GENERI ;JUST IN CASE
JRST RIMTB0+2]
TRNE AUXFLG,DTAIN
PUSHJ P,DTADIR
IFN FTDSK,<
TRNE AUXFLG,DSKIN
PUSHJ P,DSKDIR>
RIMTB0: PUSHJ P,LOOK ;GET FILE TO CONVERT
JRST MAIN1 ;NONE LEFT
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT>
LOOKUP IN,ZRF
JRST ERR3
MOVEI 0,254000
HRLM 0,XFERWD ;ASSUME JRST
HLRZ 0,ZRF+1
CAIN 0,'RTB'
JRST RIMTB1
CAIE 0,'SAV'
CAIN 0,'RMT'
JRST RIMTB2
JRST ERR3B ;NO LEGAL EXTENSION - SAVE JOBFF TOO
RIMTB1: MOVE T1,OBF+1 ;PUNCH RIM10B LOADER
HRLI T1,RMLODA
AOS T2,T1 ;XFER IT TO OUTPUT BUFFER
BLT T1,LODAL(T2)
ADDI T2,LODAL
HRRM T2,OBF+1 ;FIX BUFFER POINTER
MOVNI T2,LODAL
ADDM T2,OBF+2 ;AND COUNTER
CLOSE OUT, ;BLANK TAPE
RIMTB2: PUSHJ P,RINP ;GET FIRST BUFFER
JRST ERR8A ;FILE OF ZERO LENGTH
JUMPGE CHR,ERR8A ;FIRST WORD MUST BE POINTER
HLRZ 0,ZRF+1
CAIN 0,'SAV'
JRST RIMTB4 ;"SAV" FILE
MOVEI T2,^D126(CHR) ;FIND VALUE OF .JBSA
MOVEI T3,.JBDA-1
CAMGE T2,T3 ;(JOBDA) IS FIRST LOC. OF USER PROF,
JRST ERR8A ;NO, ERROR
MOVE T1,IBF+1
MOVEI T3,.JBSA
PUSHJ P,RMS1
HRRM CHR,XFERWD ;SAVE TRANSFER WORD
MOVEI T3,.JBFF
MOVE T1,IBF+1
PUSHJ P,RMS1
HRRZM CHR,LENGTH ;SAVE (JOBFF)
HLRZ 0,ZRF+1
CAIN 0,'RTB' ;RIM 10B CONVERSION
JRST RIMTB4
;RIM10 1ST WD IS -N,X X IS 1ST WORD IN DATA BLOCK
;CONTAINING FIRST NON-ZERO WORD AFTER END
;OF JOBDATA AREA, FROM THERE TO JOBFF GIVES
;VALUE OF N. XFER ADD. COMES FROM JOBSA.
RMT1: MOVEI T1,.JBDA ;FIRST LOC. AVAILABLE TO USER
LDB CHR,IBF+1
SUBI T1,1(CHR)
JUMPLE T1,RMT2 ;CURRENT "X" GT OR EQ JOBDA
HLRO T2,CHR
MOVNS T2 ;GET "N"
AOJ T1, ;GET REL. LOC. OF JOBDA IN BLOCK
CAMG T1,T2
JRST RMT2
AOJ T2, ;NOT IN BLOCK, TRY NEXT
ADDM T2,IBF+1
MOVNS T2
ADDM T2,IBF+2 ;READY TO GET NEXT POINTER
JRST RMT1
RMT2: LDB CHR,IBF+1 ;POINTS TO FIRST USEFUL I/O WORD
MOVNI T1,(CHR)
ADDB T1,LENGTH
MOVNS T1 ; -N
HRLM T1,POINTA
HRRM CHR,POINTA ;(-N,X) IN POINTA
SETZM ZERO
;NOW OUTPUT RIM10 FILE. IBF+1 POINTS TO FIRST I/O WORD. POINTA HAS I/O
;WORD FOR FILE. LENGTH = NO. WDS TO GO OUT INCLUDING XFER WD.
;COUNT COUNTS NO. WDS IN CURRENT LOGICAL BLOCK
;ZERO COUNTS ZERO FILL
MOVE CHR,POINTA
PUSHJ P,PUT ;PUNCH I/O WORD
RMT8: LDB CHR,IBF+1 ;-N,X
MOVEM CHR,POINTA
HLRO T1,CHR
MOVNM T1,COUNT
RMT6: SETZ CHR, ;PUNCH ZERO IF NECESSARY
SOSL ZERO
JRST RMT4 ;DEPOSIT ZERO
SOSGE COUNT
JRST RMT5 ;GET NEW LOGICAL BLOCK
PUSHJ P,RINP1
JRST ERR8A
RMT4: SOSG LENGTH
JRST RIMTB8
PUSHJ P,PUT
JRST RMT6
RMT5: HRRZ T1,POINTA
HLRO T2,POINTA
SUBM T1,T2
PUSHJ P,RINP1
JRST RMT9
JUMPGE CHR,RIMTB8
HRRZ CHR,CHR
SUB CHR,T2
JUMPL CHR,ERR8A
MOVEM CHR,ZERO
JRST RMT8
RMT9: MOVE CHR,LENGTH
SOJ CHR,
MOVEM CHR,ZERO
SETZ CHR,
RMT10: SOSGE ZERO
JRST RIMTB8
PUSHJ P,PUT
JRST RMT10
;RIM10B: COMES FROM RTB AND SAV FILES. SAV=RTB EXCEPT IT HAS NO
;RIM LOADER AND NO TRANSFER WORD
RIMTB3: PUSHJ P,RINP1 ;NONE, GET NEW POINTER
JRST RIMTB8 ;EOF
JUMPL CHR,RIMTB4 ;POINTER WORD
CAME CHR,XFERWD ;IS IT FINAL JRST XXX
JRST ERR8A ;NO,ERROR
JRST RIMTB8 ;YES,OUTPUT IT
RIMTB4: LDB CHR,IBF+1
HRRZM CHR,POINTA ;LOAD WORDS HERE
HLROM CHR,COUNT
MOVNS COUNT ;NO. WDS IN THIS BLOCK
RIMTB7: SKIPN T1,COUNT ;ANY WORDS LEFT IN BLOCK?
JRST RIMTB3 ;NONE
SETZM CHKSM ;INITIALIZE CHECKSUM
CAIL T1,BLKSZ
MOVEI T1,17
MOVN T2,T1 ;T1 HAS NO. OF WDS TO GO OUT
ADDM T2,COUNT ;ADJUST COUNT
HRL CHR,T2
HRR CHR,POINTA ;I/O WD IN CHR
ADDM T1,POINTA ;SET POINTA FOR NEXT TIME
ADDM CHR,CHKSM ;ADD I/O WD TO CHECKSUM
RIMTB5: PUSHJ P,PUT ;PUTPUT I/O WORD
SOJL T1,RIMTB6 ;FINISHED THIS BLOCK
PUSHJ P,RINP1 ;GET DATA
JRST ERR8A ;EOF (ILLEGAL)
ADDM CHR,CHKSM ;CHECKSUM
JRST RIMTB5
RIMTB6: MOVE CHR,CHKSM
PUSHJ P,PUT
OUTPUT OUT,
JRST RIMTB7
RIMTB8: MOVE CHR,XFERWD ;EOF HERE, XFERWD=JOBSA
TRNN CHR,-1
TLO CHR,HLTBIT
HLRZ 0,ZRF+1
CAIN 0,'SAV' ;NO XFER WD FOR "SAV" FILES
JRST RIMA
PUSHJ P,PUT
SETZ CHR,
PUSHJ P,PUT ;TRAILING ZERO
OUTPUT OUT,
RIMA: CLOSE IN,
TRNN FLAG,XFLG
JRST MAIN1 ;END OF SINGLE FILE
CLOSE OUT,
JRST RIMTB0
;THIS IS THE I/O SECTION
RINP: PUSHJ P,INP
TRNE IOS,EOFBIT ;EOF?
POPJ P, ;EOF EXIT
RINP1: SOSGE IBF+2
JRST RINP
ILDB CHR,IBF+1
JRST CPOPJ1
RMS2: SUB T1,T4 ;(IBF+1)+N
AOJ T1,
RMS1: LDB CHR,T1 ;GET POINTER
HRRZ T2,CHR ;X
HLRO T4,CHR ;-N
SUB T2,T4 ;X+N IN T2
CAMGE T2,T3
JRST RMS2
SUBI T3,(CHR) ;HOW FAR FROM POINTER?
ADD T1,T3 ;INCREMENT POINTER
LDB CHR,T1 ;(JOBSA/FF)
POPJ P,
;THIS IS THE RIM LOADER FOR THE PDP-10
RMLODA: PHASE 0
XWD -16,0
ST:! CONO PTR,60
ST1:! HRRI A,RD+1
RD:! CONSO PTR,10
JRST .-1
DATAI PTR,@TBL1-RD+1(A)
XCT TBL1-RD+1(A)
XCT TBL2-RD+1(A)
A:! SOJA A,
TBL1:! CAME CKSM,ADR
ADD CKSM,1(ADR)
SKIPL CKSM,ADR
TBL2:! HALT ST
AOBJN ADR,RD
ADR:! JRST ST1
CKSM:! BLOCK 0
DEPHASE>
LIST
IFE FTDSK,< END PIP1>
SUBTTL DISK ROUTINES
;* * * ALL THE FOLLOWING ARE DISK ROUTINES * * *
;DISK DELETE AND RENAME ROUTINES
SYN AB,STRCNT ;SOMEWHERE TO COUNT NO. OF F/S SEEN
SYN MTAREQ,SAVSTR ;FIRST F/S NAME SEEN
DSKDR0: MOVE T1,DTON+3 ;GET OUTPUT PPN
SKIPE PP ;ALREADY SET?
JRST .+4 ;YES
MOVEM T1,PP ;OUTPUT=INPUT FOR /D,/R
SKIPE PTHSFD ;INPUT SFD SPECIFIED?
SETOM PTHADD ;YES, USE IT
PUSHJ P,ININIT ;GET DSK AS INPUT DEVICE
PUSHJ P,DSKDIR ;GET USER'S FILE DIRECTORY
JFCL
PUSHJ P,INFO ;PRINT FILES DELETED:/RENAMED:
DSKDR5: PUSHJ P,LOOK ;PREPARE FOR LOOKUP/ENTER
;OF FILE TO /D OR /R
JRST DSKDR1 ;ALL THROUGH WITH UFD
TRNN FLAG,DFLG ;ONLY MAKE NON-AMBIGUITY CHECK FOR /D
JRST DSKDR ;/R WILL ALWAYS FAIL
TRC CALFLG,MATEX!MATFN
TRCE CALFLG,MATEX!MATFN
JRST DSKDR+1 ;YES MUST NOT BE AMBIGUOUS
TLNN CALFLG,MFLG ;TEST FOR ???
DSKDR: PUSHJ P,INITFS ;INITIALIZE THE F/S SEARCH LIST
JRST DSKDR6 ;LEVEL C, OR NOT GENERIC "DSK"
SETOM STRCNT ;START WITH -1
PUSH P,DEVICE ;SAVE DSK DEVICE
DSKDR3: PUSHJ P,NXTFS ;GET NEXT F/S
JRST RENFIN ;NO MORE
PUSH P,ZRF+3 ;SAVE PPN
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
LOOKUP IN,ZRF ;TRY THIS F/S
JRST DSKDRE ;LOOKUP FAILED, FILE NOT ON THIS F/S
; OR FILE ERROR (BAD RIB ETC)
MOVE 0,STRCNT ;GET COUNT
AOS STRCNT ;INCRENENT COUNT
JUMPL 0,[MOVE 0,GENERI
MOVEM 0,SAVSTR ;SAVE FIRST F/S
JRST DSKDRF] ;AND CONTINUE
JUMPG 0,DSKDRA ;NOT FIRST TIME
ERRPN2 </?Ambiguous /> ;GIVE MESSAGE
PUSHJ P,P6BIT ;PRINT
SAVSTR ;FIRST F/S
PUSHJ P,TYPSTR ;AND :
DSKDRA: PUSHJ P,P6BIT ;PRINT THIS F/S
GENERI
PUSHJ P,TYPSTR ;FOLLOWED BY COLON SPACE
JRST DSKDRF ;RESTORE PPN AND CONTINUE
DSKDRE: HRRZ T7,ZRF+1 ;GET ERROR CODE
JUMPE T7,DSKDRF ;FILE NOT FOUND IS OK
PUSHJ P,DERR5R ;GIVE CORRECT ERROR CODE
DSKDRF: POP P,ZRF+3 ;PUT PPN BACK
JRST DSKDR3 ;TRY NEXT F/S
TYPSTR: MOVEI CHR,":" ;FOLLOW WITH COLON
PUSHJ P,PUTCON
MOVEI CHR," " ;AND A SPACE
JRST PUTCON ;POPJ RETURN
DSKR6I: PUSHJ P,ININIT ;INIT CORRECT DEVICE
DSKDR6: PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
LOOKUP IN,ZRF ;IS SOURCE FILE THERE?
JRST DERR5 ;ERROR
CLOSE IN, ;YES
TRNN FLAG,DFLG ;DELETE?
JRST DSKDR4 ;NO, RENAME
SETZM DTON ;YES
MOVE 0,FNPPN ;SET DEST. DEVICE SAME AS SOURCE FOR DELETE,
MOVEM 0,DTON+3 ;I.E. PROJ-PROG NUMBER
JRST DSKDR7
RENFIN: POP P,DEVICE ;GET DSK DEVICE BACK
MOVE 0,STRCNT ;GET COUNT
JUMPL 0,DERR5 ;NOT EVEN ONE FOUND
JUMPE 0,DSKR6I ;UNIQUE, DO RENAME/DELETE
SETZM ZRF+3 ;CLEAR PPN IN LOOKUP BLOCK
JRST DSKDR9 ;SINCE TOO MANY F/S
DSKDR4: PUSHJ P,RENAME
MOVE 0,ZRF+2 ;GET DATE,MODE,PROT ETC.
MOVEM 0,DTON+2 ;SAVE AS BEFORE
LDB 0,[POINT 9,NAMTAB+2,8]
TLNE AUXFLG,NSPROT ;USE THE CURRENT PROTECTION
DPB 0,PRPTD ;UNLESS NEW PROT. SPECIFIED
MOVE 0,NAMTAB+3 ;GET PROJ-PROG
MOVEM 0,DTON+3
JUMPN 0,DSKDR7 ;PPN ALREADY SETUP
PUSHJ P,SETPTH ;NO, SO USE INPUT
MOVEM 0,DTON+3 ;FULL PATH WAS SET SO USE IT
DSKDR7: RENAME IN,DTON
JRST [PUSHJ P,DERR7 ;OUTPUT ERROR CODE
JRST DSKDR5] ;AND CONTINUE
DSKDR9: PUSHJ P,INFO3 ;PRINT FILENAME DELETED/RENAMED
JRST DSKDR5
DSKDR1: TLZ AUXFLG,NSPROT ;NON-ST. PROT FIXED
SOS ESWTCH ;ENSURE ESWTCH NEGATIVE
SKIPE DOUT,BLKSUM ;GET TOTAL FREED BLOCKS
TRNN FLAG,DFLG ;BUT ONLY IF /D
JRST DSKDR2 ;BOTH NOT TRUE
MOVEI T2,PUTCON ;ON TTY
SKPINC ;CLEAR ^O
JFCL
PUSHJ P,OUTDC1 ;OUTPUT IN DECIMAL
ERRPN2 </ Blocks freed/>
PUSHJ P,TCRLF ;FINISH WITH CR-LF
SETZM BLKSUM ;CLEAR RUNNING TOTAL
DSKDR2: RELEAS CON,
JRST MAIN1
;ZERO DSK DIRECTORY OF ALL POSSIBLE FILES. IF ANY ARE PROTECTED, GIVE
;A MESSAGE AND DO NOT PROCESS ANY OTHER SWITCHES.
DSKZRO: SKIPE T1,ODEV ;GET REAL DSK
MOVEM T1,ADSK ;SO AS TO INIT CORRECT F/S
PUSHJ P,DIRSK1
JFCL
INBUF OUT,1 ;FOR LOOKUPS ON OUT
DSKZ1: SOSLE UFDIN+2
SKIP 2
DSKZ3: PUSHJ P,UIN
POPJ P,
ILDB 0,UFDIN+1
JUMPE 0,DSKZ3
MOVEM 0,ZRF
MOVEM 0,DTON ;INCASE OF FAILURE
SOS UFDIN+2
ILDB 0,UFDIN+1
HLLZM 0,ZRF+1 ;EXTENSION
MOVE 0,FNPPN
MOVEM 0,ZRF+3
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
LOOKUP OUT,ZRF
JRST [PUSHJ P,DERR5R ;ERROR
JRST DSKZ1] ;IGNORE RENAME TO ZERO
CLOSE OUT,
SETZM ZRF
MOVE 0,FNPPN
MOVEM 0,ZRF+3
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
RENAME OUT,ZRF
PUSHJ P,DERR7Z
JRST DSKZ1 ;REPEAT
;ROUTINES TO HANDLE LEVEL D FILE STRUCTURES
;TO INITIALIZE THE SEARCH LIST
INITFS: SKIPN LEVEL ;ONLY IF LEVEL D
POPJ P, ;LEVEL C - NON-SKIP RETURN
SETZM GENERI ;CLEAR INCASE OF ERROR RETURN
TRNE AUXFLG,SYSFLG ;SYS DEVICE
JRST INISYS ;YES
MOVEI 0,ADSK ;ADDRESS OF DEVICE
DSKCHR 0, ;SEE IF DSK
POPJ P, ;NOT LEVEL D DSK
TLNE 0,(7B17) ;GENERIC DEVICE DSK
POPJ P, ;NO
INIFS1: SETOM STRARG ;CURRENT JOB NUMBER
SETOM STRARG+1 ;CURRENT PPN
INIFS2: SETOM GENERI ;YES, MARK START OF SEARCH LIST
JRST CPOPJ1 ;GIVE SKIP RETURN
;TO INITIALIZE SYSTEM SEARCH LIST
INISYS: MOVE 0,SYSPP ;GET SYS PPN
CAME 0,[1,,4] ;IS IT THE REAL SYS
JRST INIFS1 ;NO, SET UP FOR CURRENT JOB
SETZM STRARG ;SYS IS JOB 0
MOVEM 0,STRARG+1 ;PPN INTO ARG BLOCK
JRST INIFS2 ;YES
;TO FIND NEXT F/S IN SEARCH LIST
NXTFS: MOVEI 0,STRARG ;GET ADDRESS
SKIPE GENERI ;FINISHED IF IT IS ZERO
GOBSTR 0, ;GET FILE STRUCTURE
TDZA 0,0 ;ERROR
MOVE 0,GENERI ;GET DEVICE
CAMN 0,[-1] ;MIGHT BE MISSING FENCE, CHECK FOR END
JRST NOFNCE ;IT WAS
JUMPE 0,ENDFS ;FINISHED
MOVEM 0,DEVICE ;FOR RETRIEVAL INFO
PUSHJ P,ININIT ;INIT
JRST CPOPJ1 ;GIVE SKIP RETURN
;TO INIT NEXT UFD
NXTFSU: PUSHJ P,NXTFS ;GET NEXT F/S
POPJ P, ;SIMPLE NON-SKIP RETURN
MOVE 0,DEVICE ;OTHERWISE GET IT
MOVEM 0,ADSK ;FOR DIR INIT
PUSHJ P,DSKDIR ;INIT NEW UFD
JRST NXTFSU ;FAILED, TRY NEXT F/S (NO UFD)
JRST CPOPJ1 ;SKIP RETURN
NOFNCE: AOS GENERI ;SIGNAL END OF F/S
ENDFS: MOVSI 0,'DSK' ;GENERIC "DSK"
TRNE AUXFLG,SYSFLG ;IS IT SYS?
MOVSI 0,'SYS' ;YES
MOVEM 0,ADSK ;RESTORE INCASE
MOVEM 0,DEVICE ;INPUT TO PROCESS
POPJ P, ;RETURN
;ROUTINES TO HANDLE SFD'S
GETPTH: SETOM PTHADD ;SIGNAL FULL PATH TO BE USED
MOVE T7,[PTHSCN,,PTHPPN]
SETZM PTHSCN ;ZERO START OF FULL PATH
BLT T7,PTHSFD+PTHLEN ;AND REST OF IT
MOVE T7,PP ;GET PPN
MOVEM T7,PTHPPN ;STORE PPN
MOVEI T7,PTHSFD ;ADDRESS OF SFD LIST
GTPTH1: HRLI T7,(POINT 6,,) ;ILDP LOOP
PUSHJ P,GETBUF ;GET A CHARACTER
CAIL 0,"A" ;ALPHABETIC
CAILE 0,"Z"
JRST .+2 ;NO
JRST GTPTH2 ;YES , FOUND ONE
CAIL 0,"0" ;NUMERIC
CAILE 0,"9"
JRST GTPTH3 ;NO
GTPTH2: SUBI 0,40 ;MAKE SIXBIT
TLNE T7,770000 ;SIX CHAR. YET?
IDPB 0,T7 ;NO DEPOSIT
JRST GTPTH1+1 ;LOOP
GTPTH3: CAIE 0,"," ;MORE SFD'S
JRST GTPTH4 ;NO
MOVEI T7,1(T7) ;ADVANCE BYTE POINTER
CAIGE T7,PTHSFD+PTHLEN-1 ;TOO MANY SFD'S
JRST GTPTH1 ;NO, GET NEXT SFD
ERRPNX </?SFD list too long!/>
GTPTH4: SKIPE FILNAM ;FILE NAME SEEN YET?
POPJ P, ;YES, SO NOT DEFAULT
MOVE T7,[PTHADD,,DEFPTH]
BLT T7,DEFPTH+PTHLEN+3
POPJ P,
;PUT PATH ADDRESS IN AC0
;SKIP IF ZER0, NON-SKIP IF FULL PATH IN USE
SETPTH: MOVEI 0,PTHADD ;TRY FULL PATH
SKIPN JOBPTH ;SKIP IF SFD'S
JRST CPOPJ1 ;SKIP RETURN NON-SFD MONITOR
SKIPE PTHADD ;IN USE
POPJ P, ;YES
MOVE 0,@(P) ;IF A PPN HAS BEEN SET , DON'T USE DEFAULT
SKIPN @0 ;LOOK AT @RETURN ADDRESS
SKIPN DEFPTH ;IS DEFAULT PATH IN USE
AOSA (P) ;NO, SKIP RETURN
MOVEI 0,DEFPTH ;YES, USE DEFAULT PATH
POPJ P, ;RETURN
;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY
;NON-SKIP RETURN IF LOOKUP FAILED BECAUSE OF NO UFD ON F/S
;SKIP RETURN IF OK
DIRSK1: SKIPA T1,DTON+3
DSKDIR: MOVE T1,PP ;GET [P,P] INTO T1
TRNE AUXFLG,SYSFLG ;DEVICE SYS
MOVE T1,SYSPP ;GET SYS [PP]
MOVEM T1,FNPPN
MOVE 0,[XWD FILNAM,UFD]
BLT 0,UFD+3 ;SAVE LOOKUP BLOCK
MOVSI 0,'UFD'
MOVEM 0,FILEX ;USER HAS SPECIFIED [P,P]
TRNN CALFLG,SYSFLG ;CURRENT DEVICE SYS?
MOVEM T1,FNPPNS ;SAVE LATEST NON-SYS #P-P
JUMPN T1,.+3 ;IS IT ZERO?
SKIPN T1,JOBPPN ;GET DEFAULT JOB PPN
MOVE T1,MYPPN ;LOGGED IN PPN AS LAST RESORT
MOVEM T1,FILNAM ;[P,P] TO UFD
MOVEM T1,LSTPPN ;SAVE ACTUAL UFD LOOKED UP
MOVE 0,PP11 ;MAKE [P,P]=[1,1]
MOVEM 0,PP
MOVEM 0,PPN ;SAVE FOR EXTENDED LOOKUP
PUSHJ P,DSKDST ;INIT TO READ DIRECTORY
MOVEI T1,RIBSTS ;NO. OF WORDS FOR EXTENDED LOOKUP
MOVEM T1,RIBFIR
SKIPE PTHADD ;SFD SPECIFIED?
JRST SFDDIR ;YES, LOOKUP PATH
SKIPN FNPPN ;REAL PPN SEEN?
SKIPN JOBSFD ;OR A DEFAULT PATH WITH SFDS
CAIA ;IGNORE JOB PATH
JRST JOBDIR ;YES
MOVE T1,LEVEL ;LEVEL D = -2
LOOKUP DIR,FILNAM(T1) ;GET USERS FILE DIRECTORY
JRST DERR5A ;ONE OF MANY LOOKUP ERRORS
DIRSK3: AOS (P) ;SET FOR SKIP RETURN
JUMPE T1,DIRSK2 ;IF LEVEL C
HRRZ T1,RIBFIR+RIBSTS
ANDI T1,777 ;GET ERROR BITS
JUMPN T1,DIRSK2 ;JUMP IF ERRORS IN UFD
MOVEI T1,RBSIZ ;SET LOOKUP
MOVEM T1,RIBFIR ;FOR SHORT EXTENDED
DIRSK2: MOVS T1,[XWD FILNAM,UFD]
BLT T1,PP ;RESTORE LOOKUP BLOCK
POPJ P, ;LOOKUP OK
;HERE TO DO LOOKUP ON SPECIFIED PATH
JOBDIR: SKIPA T1,[EXP JOBPTH]
SFDDIR: MOVEI T1,PTHADD ;ADDRESS OF FULL PATH
MOVEM T1,PPN ;THIS IS THE DIRECTORY REQUIRED
MOVSI 0,'SFD' ;CHANGE EXTENSION
MOVEM 0,FILEX ;TO EXPECTED
ADDI T1,PTHLEN+3 ;LOOP FOR ALL SFD'S
MOVE 0,(T1) ;GET SFD
SKIPN 0 ;END WHEN NON-ZERO
SOJA T1,.-2 ;NOT YET
SETZM (T1) ;BACKUP PATH ONE SFD
MOVEM 0,FILNAM ;THIS IS WHAT WE ARE LOOKING UP
LOOKUP DIR,RIBFIR ;GIVE IT A TRY
JRST DERR5A ;FAILED
MOVEM 0,(T1) ;RESTORE FULL PATH IN ALL IT GLORY
JRST DIRSK3 ;AND RETURN TO COMMON CODE
;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH
SYN AB,FILCNT ;COUNT OF NUMBER OF FILES FOUND
SYN MTAREQ,FILERR ;ERROR BIT IN FILE
DSKLST: PUSHJ P,ININIT ;ASSIGN "IN" FOR RETRIEVAL INFO
SETZM BLKSUM ;CLEAR TOTAL BLOCKS FOR ALL FILES
SETZM FILCNT ;START AT ZERO
SETZM LIN ;SET UP APPROPRIATE CONTROLS
MOVS T1,ODEV ;FOR THIS LISTING DEVICE
CAIN T1,'TTY' ;IF ODEV IS TTY
TRO CALFLG,LISTTY ;SET LISTTY=1 (TTY)
SKIPN FILNAM ;IF NO FILNAM GIVEN
TRZ CALFLG,MATFN!MATEX ;LIST ALL OF DIRECTORY
MOVE T1,FILNAM
MOVEM T1,MATCH
HLRZ T1,FILEX
MOVEM T1,MATCH+1
PUSHJ P,DSKDIR
JFCL
PUSHJ P,CRLF ;GIVE A BLANK LINE
TRNN AUXFLG,FFLG ;SHORT LISTING
PUSHJ P,HEADER ;PUT OUT HEADER LINES
TLO CALFLG,LPPFLG ;OUTPUT PPN LATER
PUSHJ P,INITFS ;INIT F/S SEARCH LIST
JRST LSTU0A ;NOT GENERIC "DSK"
LSTU0: PUSHJ P,NXTFSU ;GET NEXT F/S IN LIST
JRST DIRFIN ;NO MORE
LSTU0A: TLO CALFLG,LDVFLG ;SIGNAL NEW DEVICE TO OUTPUT
MOVE T1,PP ;GET PROJ-PROG
MOVEM T1,PPN ;SAVE FOR EXTENDED LOOKUP
LSTU1: SOSLE UFDIN+2
SKIP 2
LSTU2: PUSHJ P,UIN ;GO READ DIRECTORY
JRST BLKLST ;(EOF) - OUTPUT BLOCKS USED
ILDB 0,UFDIN+1
JUMPE 0,LSTU2
MOVEM 0,FILNAM ;PREPARE TO GET RETRIEVAL INFO
MOVE T1,FNPPN ;EACH LOOKUP DESTROYS P-P NO.
MOVEM T1,FILNAM+3 ;RESTORE P-P NO.
SKIPG LIN
PUSHJ P,HEDR3 ;YES, PUT OUT HEADER LINES
SOS UFDIN+2
ILDB DOUT,UFDIN+1 ;PICK UP EXTENSION
HLRZS DOUT ;CLEAR RIGHT HALF
HRLZM DOUT,FILNAM+1 ;KEEP FOR LOOKUP
TLNE CALFLG,MFLG ;NEED TO MASK?
JRST MLSTU ;YES
TRNN CALFLG,MATEX ;MATCH EXTENSIONS?
SKIP 2 ;NO,TRY MATFN
CAME DOUT,MATCH+1 ;MATCH?
JRST LSTU1 ;NO,GET NEXT FILE
TRNN CALFLG,MATFN ;MATCH FILENAME?
JRST LSTU2A ;NO
CAME 0,MATCH ;FILNAM MATCH?
JRST LSTU1 ;NO
LSTU2A: CAIE DOUT,'UFD' ;IS FILE MFD
JRST LSTU3 ;GO PRINT NAME HELD IN 0.
HLRZ DOUT,FILNAM ;HERE FOR MFD ONLY
MOVEI T2,PUT
PUSHJ P,OUTOCT ;PRINT #,#. PROJ. NO.
MOVEI CHR,COMMA ;","
PUSHJ P,PUT ;...
HRRZ DOUT,FILNAM ;PROG. NO.
PUSHJ P,OUTOCT
JRST LSTU3A ;...
LSTU3: MOVE 0,FILNAM
PUSHJ P,SIXOUT ;OUPUT FILENAME
LSTU3A: MOVEI T4,5 ;SET LOOP FOR OUTPT EXT
MOVE 0,FILEX
JUMPE 0,LSTU4
PUSHJ P,TABOUT
PUSHJ P,SIXOUT ;OUTPUT EXTENSION
LSTU4: AOS FILCNT ;COUNT ONE MORE FILE SEEN
TRNN AUXFLG,FFLG ;SHORTEST LISTING?
SKIP 2
PUSHJ P,CLRF ;YES
JRST LSTU1
SKIPN FILEX
PUSHJ P,TABOUT ;ACCOUNT FOR LACK OF EXTENSION
PUSHJ P,SPACES
MOVE T4,LEVEL ;-2 IF LEVEL D,0 IF LEVEL C
LOOKUP IN,FILNAM(T4) ;GET RETRIEVAL INFO.
JRST LSTU5 ;NOT AVAILABLE
JUMPE T4,LSTU4A ;LEVEL C OR NO UFD ERRORS
HRRZ DOUT,RIBFIR+RIBSTS ;FILE ERROR STATUS
ANDI DOUT,777 ;ONLY ERROR BITS
MOVEM DOUT,FILERR ;STORE ERROR BIT OR ZERO
LSTU4A: PUSHJ P,BLKS ;DETERMINE NO. BLK IN FILE
;AND TOTAL FOR UFD
LDB 0,PROT ;GET PROTECTION BITS
PUSHJ P,PROTO ;PRINT OCTAL NUMBERS
TRNE CALFLG,LISTTY ;OUTPUT DEVICE A TTY?
JRST LSTU7 ;YES, SKIP LONG DIRECTORY
LDB 0,ADATE ;PRINT ACCESS DATE
PUSHJ P,DATOUT
PUSHJ P,TABOUT
LDB 0,CTIME ;PRINT CREATION TIME
PUSHJ P,TIMOUT
LDB 0,CDATE
PUSHJ P,DATOUT ;PRINT CREATION DATE
PUSHJ P,SPACE2
LDB 0,MODE ;PRINT MODE
PUSHJ P,OCTLS2
JRST LSTU8
LSTU5: PUSHJ P,TABOUT ;THE FILE WAS PROTECTED
HRRZ T7,FILEX ;GET PARTICULAR ERROR TYPE
CAIL T7,TABLND-TABLE ;IS IT LEGAL ERROR
PUSHJ P,DERRQ ;NO,PICK UP CATCH ALL MESSAGE
MOVE T1,TABLE(T7) ;PICK UP POINTER FOR ERROR MSG
LSTU6: ILDB CHR,T1 ;PICK UP CHAR FROM ERROR MSG
JUMPE CHR,LSTU8 ;PRINT ERROR MESSAGE, END SEEN
CAIN CHR,"!"
JRST LSTU8 ;ALTERNATE END SEEN (!)
IFE REENT,<
PUSHJ P,CCASE> ;DEPOSIT CHARACTER
PUSHJ P,PUT
JRST LSTU6
LSTU7: LDB 0,CDATE
PUSHJ P,DATOUT ;PRINT CREATION DATE ONLY FOR TTY
LSTU8: CLOSE IN,
SKIPE DOUT,FILERR ;ANY FILE ERRORS
PUSHJ P,ERROUT ;YES, LIST CODE INSIDE PARENS.
PUSHJ P,LSTU8A ;COMMON ROUTINE TO OUTPUT "DEV:[PPN]"
JRST LSTU1
LSTU8A: TLZN CALFLG,LDVFLG ;DEVICE TO OUTPUT?
JRST LSTU9 ;NO
PUSHJ P,SPACE2
MOVE 0,ADSK ;GET F/S NAME
PUSHJ P,SIXOUT ;PRINT IT
MOVEI CHR,":" ;FOLLOW WITH COLON
PUSHJ P,PUT
LSTU9: TLZN CALFLG,LPPFLG ;PPN TO LIST?
JRST LSTU9A ;NO
PUSHJ P,SPACE2
MOVEI CHR,"[" ;FORM PPN
PUSHJ P,PUT
HLRZ 0,LSTPPN
PUSHJ P,OCTLST
MOVEI CHR,","
PUSHJ P,PUT
HRRZ 0,LSTPPN
PUSHJ P,OCTLST
MOVEI CHR,"]"
PUSHJ P,PUT
LSTU9A: JRST CLRF ;PRINT CR-LF AND RETURN
ERROUT: PUSHJ P,SPACE2 ;SEPARATE BY SOME SPACES
MOVEI CHR,"(" ;PUT ERROR CODE IN PARENS
PUSHJ P,PUT
SKIPA T4,[POINT 7,[ASCII /a*cm**rwf*/]]
LSH DOUT,-1 ;SHIFT ERROR BIT TOWARDS BIT 35
ILDB CHR,T4 ;GET AN ERROR CHARACTER
TRNN DOUT,1 ;IS IT THIS ERROR?
JRST .-3 ;NO
PUSHJ P,PUT ;YES,OUT IT GOES
MOVEI CHR,")"
JRST PUT ;RETURN
DIRFIN: SKIPE FILCNT ;HAVE WE SEEN ANY FILES?
JRST MAIN1 ;YES, EXIT
TRO CALFLG,RTRNFL ;SET TO RETURN
PUSH P,DIRFIN+1 ;STORE RETURN ADDRESS
ERRPNT </Directory has no such files!/>
MLSTU: TRNN CALFLG,MATFN ;MATCH FILE NAME
JRST MLSTU1 ;NO, TRY EXT
XOR 0,MATCH
ANDCM 0,QMASK
JUMPN 0,LSTU1 ;MATCH FAILED
MLSTU1: TRNN CALFLG,MATEX ;MATCH EXT
JRST LSTU2A ;NO
XOR DOUT,MATCH+1
ANDCM DOUT,QMASK+1
JUMPN DOUT,LSTU1 ;FAILED
JRST LSTU2A ;MATCH FOUND
;ROUTINE TO OUTPUT SPACES, T4=NO. TO OUTPUT
SPACE2: MOVEI T4,2 ;SET FOR 2 SPACES
SPACES: MOVEI CHR,SPACE
PUSHJ P,PUT
SOJG T4,.-1
POPJ P,
;ROUTINE TO DEPOSIT T4.SIXBIT CHARACTERS
;FROM AC0 INTO OUTPUT BUFFER
SIXOUT: MOVSI T2,(POINT 6,0)
JUMPE 0,SIXO1 ;ZERO WORD
TLNE 0,770000 ;LEADING SPACE
JRST LSTO0 ;NO
LSH 0,6 ;GET NEXT CHAR.
MOVEI CHR," " ;BUT OUTPUT SPACE
SKIP 3
LSTO0: ILDB CHR,T2
JUMPE CHR,SIXO1
ADDI CHR,40 ;MAKE ASCII
PUSHJ P,PUT
SOJ T4,
TLNN T2,770000
SIXO1: POPJ P,
JRST SIXOUT+2
;DETERMINE NUMBER OF BLOCKS PER FILE AND TOTAL NUMBER OF
;BLOCKS USED BY USERS PROJECT,PROGRAMMER NUMBER
BLKS: MOVEI T2,PUT ;SET OUTPUT
MOVE DOUT,RIBFIR+RBSIZ
SKIPE LEVEL ;SKIP IF LEVEL C
SKIP 3 ;LEVEL D WORD COUNT
HLRE DOUT,PP ;GET WORD COUNT OF FILE
BLKSD: JUMPGE DOUT,BLKADD ;IF POS = NO. OF BLOCKS
MOVNS DOUT ;MAKE POSITIVE
TRZE DOUT,177 ;TAKE CARE OF PARTIAL BLOCKS
ADDI DOUT,200
IDIVI DOUT,200 ;CALCULATE BLOCK COUNT
BLKADD: ADDM DOUT,BLKSUM ;CALCULATE TOTAL FOR ALL FILES
TRNE FLAG,DFLG ;IF /D
POPJ P, ;JUST RETURN
PUSHJ P,OUTDE4 ;OUTPUT NUMBER OF BLOCKS IN DECIMAL
JRST SPACE2 ;RETURN WITH 2 SPACES
;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX
BLKLST: SKIPN BLKSUM ;ANY INFORMATION TO OUTPUT
JRST BLKLS1 ;NO - FINISHED
SKPINC ;CLEAR ^O
JFCL
LSTLIN TOTAL ;OUTPUT CR,LF "TOTAL BLOCKS"
MOVE DOUT,BLKSUM
MOVEI T2,PUT ;SET OUTPUT
PUSHJ P,OUTDE4 ;PRINT TOTALS
PUSHJ P,CRLF ;BONUS CR-LF
BLKLS1: SKIPN GENERI ;MORE FILE STRUCTURES?
JRST MAIN1 ; FINISHED
SETZM BLKSUM ;START AFFRESH
MOVE T1,PPN ;RESTORE PP
MOVEM T1,PP
JRST LSTU0 ;YES
TOTAL: ASCIZ /
Total Blocks /
IFE REENT,<
CCASE: CAIL CHR,"a" ;FLUSH LOWER CASE LETTERS
CAILE CHR,"z" ;FROM OUTPUT IN CASE PDP-6 LPT
POPJ P,
SUBI CHR,40
POPJ P,>
;INPUT USERS FILE DIRECTORY
UIN: SETZ IOS, ;JUST IN CASE
IN DIR,
JRST CPOPJ1 ;NO ERRORS
STATUS DIR,IOS
TRZN IOS,EOFBIT
JRST UIN2 ;ERROR PRINT
POPJ P,
;INIT DIRECTORY DEVICE
DSKDST: MOVE T2,.JBFF ;SAVE JOBFF IN T2
MOVEI T1,DBUF
MOVEM T1,.JBFF ;MAKE MONITOR USE DBUF FOR DISK DIR.
MOVEI T1,14 ;BINARY MODE
MOVEM T1,ADSK1
MOVEI T1,UFDIN ;LOC OF DIRECTORY ENTRY
MOVEM T1,ADSK+1 ;FOR UFD
OPEN DIR,ADSK1
JRST ERR1A
INBUF DIR,1 ;RESET JOBFF SAME AS ENTRY
MOVEM T2,.JBFF
POPJ P,
;OUTPUT THE DIRECTORY LISTING HEADER
HEDR3: TRNN AUXFLG,FFLG ;POP BACK IF SHORT LISTING
TRNE CALFLG,LISTTY
POPJ P,
HEADER: PUSHJ P,HEDR4
HEDR1: LSTLIN HEDL1
DATE ;DATE REQ.
PUSHJ P,DATOUT
PUSHJ P,TABOUT
PUSHJ P,NOWOUT ;PRINT CURRENT TIME, DATE
AOS PGCNT ;INCREMENT PAGE COUNT
LSTLIN HEDPG
MOVE 0,PGCNT ;GET PAGQ NUMBER
IDIVI 0,^D10 ;DECIMAL PAGES
JUMPE 0,.+4
MOVE CHR,0
ADDI CHR,"0"
PUSHJ P,PUT
MOVEI CHR,"0"(1)
PUSHJ P,PUT
SOS LIN
LSTLIN HEDLIN
HEDR2: JRST CLRF
HEDLIN: ASCIZ /
Name Extension Len Prot Access ---Creation--- Mode
/
HEDL1: ASCIZ / Directory listing /
HEDPG: ASCIZ / Page /
UIN2: PUSHJ P,COMERR
JSP T5,INICN2
ERRPN2 </?Disk directory read />
MOVEI T3,UFD ;LOCATION OF FILENAME(AND EXT)
PUSHJ P,FN.EX ;PRINT FILE NAME EXTENSION
MOVE T2,AUXFLG
ANDI T2,DSKIN
PUSHJ P,IOERR
SETSTS DIR,(IOS)
JRST CPOPJ1
;OUTPUT THE TIME FOUND IN AC 0
NOWOUT: MSTIME ;CALL MILLISEC TIMER
IDIVI 0,^D60000 ;CONVERT TO MINUTES
TIMOUT: IDIVI 0,^D60
MOVE DOUT,0
PUSHJ P,OUTDEC
MOVEI CHR,":" ;SEPARATE BY A COLON
PUSHJ P,PUT
MOVE DOUT,1
PUSHJ P,OUTDEC
JRST TABOUT
;SKIP TO HEAD OF FORM OR NEXT HALF PAGE, RESET COUNT
HEDR4: TRNE CALFLG,LISTTY
JRST [POP P,(P) ;BACKUP ONE LEVEL
POPJ P,] ;AND EXIT IF TTY
SKIPLE LIN
JRST HEDR6 ;ANYTHING ON THIS PAGE?
HEDR5: MOVEI CHR,FF ;FORM FEED IF FULL OR
MOVEI T2,^D50
HEDR5A: MOVEM T2,LIN ;ALMOST FULL
PUSHJ P,PUT
MOVEI CHR,LF
PUSHJ P,PUT
PUSHJ P,PUT
JRST PUT ;PRINT LINEFEEDS AND EXIT
HEDR6: CAIGE T2,^D25
JRST HEDR5
MOVEI CHR,HPAGE
MOVEI T2,^D16
JRST HEDR5A
;OUTPUT OCTAL WORD FOUND IN AC 0
OCTLS2: MOVEI CHR," "
CAIGE 0,10 ;AT LEAST 2 CHAR.?
PUSHJ P,PUT ;NO,SO OUTPUT A BLANK
OCTLST: MOVSI T1,(POINT 3,0)
ILDB CHR,T1
TLNE T1,770000 ;ALLOW UPTO 12 OCTAL NOS
JUMPE CHR,.-2 ;GET MOST SIG. NUMBER
OCTL1: ADDI CHR,60 ;CONVERT TO ASCII
PUSHJ P,PUT ;OUTPUT CHAR
ILDB CHR,T1 ;GET SUCCEEDING CHARS
TLNN T1,400000 ;WAIT TILL POINTING TO NEW
JRST OCTL1 ;WORD, THEN EXIT. MEAN WHILE
POPJ P, ;PRINT OCTAL NUMBERS
;OUTPUT PROTECTION BITS FOUND IN AC 0
PROTO: MOVEI CHR,"<"
MOVSI T1,(POINT 3,,26)
PUSHJ P,OCTL1+1
MOVEI CHR,">"
PUSHJ P,PUT
MOVEI T4,3 ;SET FOR THREE SPACES
JRST SPACES ;AND EXIT
;THIS IS THE DISK ERROR ROUTINE. CALL DERR4 WITH T3=FIRST WORD ADDRESS
;OF LOOKUP OR ENTER. USE T7 FOR SAVING THE ERROR CODE.
DERR5A: MOVEI T3,FILNAM ;LOCATION OF FILENAME
HRRZ T7,1(T3) ;GET ERROR CODE
SKIPE GENERI ;FATAL IF NOT GENERIC "DSK"
CAILE T7,1 ;NO UFD IF 0 OR 1
JRST DERR4 ;ANY OTHER ERROR
TRNN FLAG,LFLG ;IF /L
TRNE AUXFLG,FFLG ;OF /F
CAIA ;YES, OUTPUT MESSAGE
POPJ P, ;NO, JUST RETURN (NON-SKIP)
LSTLIN NOUFD
TLO CALFLG,LDVFLG!LPPFLG ;PRINT "DEV:[PPN]"
PUSHJ P,LSTU8A
JRST DIRSK2 ;GET NEXT FILE STRUCTURE
NOUFD: ASCIZ /%no UFD created for /
DERR7Z: MOVE T3,DTON ;RECOVER NAME
MOVEM T3,ZRF
JRST DERR5R ;PRINT AND RETURN
DERR6R: TRO CALFLG,RTRNFL
DERR6: MOVEI T3,DTON ;LOCATION OF FILENAME (OUTPUT)
JRST DERTYP
DERR7: HRRZ T3,DTON+1 ;GET ERROR CODE
CAIN T3,4 ;IF RENAME ERROR =4
JRST DERR6R ;USE OUTPUT NAME
HRRM T3,ZRF+1 ;PUT IT IN EXPECTED PLACE
DERR5R: TRO CALFLG,RTRNFL ;SET TO RETURN FROM ERROR PRINTER
DERR5: MOVEI T3,ZRF ;LOCATION OF FILENAME (INPUT)
DERTYP: HRRZ T7,1(T3) ;ERROR TYPE
DERR4: ERRPNT </? />
PUSHJ P,FN.EX ;PRINT FILE NAME .EXT
CAIL T7,TABLND-TABLE ;LEGAL ERROR?
PUSHJ P,DERRQ ;NO USE CATCHALL MESSAGE
MOVE T1,TABLE(T7) ;PICK UP BYTE POINTER
JRST PTEXT1 ;AND PRINT MESSAGE
DERRQ: MOVEI CHR,"(" ;ENCLOSE ERROR NUMBER IN PARENS.
PUSHJ P,PUTCON ;OUTPUT IT
MOVE 0,T7 ;GET ERROR NUMBER
IDIVI 0,8 ;TWO OCTAL DIGITS
JUMPE 0,.+4 ;NO LEADING DIGIT
MOVE CHR,0
ADDI CHR,"0" ;ASCII
PUSHJ P,PUTCON ;OUTPUT IT
MOVEI CHR,"0"(1) ;REMAINDER
MOVEI T7,TABLND-TABLE ;SETUP MESSAGE
JRST PUTCON ;PRINT REMAINDER AND RETURN
TABLE: POINT 7,[ASCII /(0) file was not found!/]
POINT 7,[ASCII /(1) no directory for project-programmer number!/]
POINT 7,[ASCII /(2) protection failure!/]
POINT 7,[ASCII /(3) file was being modified!/]
POINT 7,[ASCII /(4) rename file name already exists!/]
POINT 7,[ASCII /(5) illegal sequence of UUOs!/]
POINT 7,[ASCII /(6) bad UFD or bad RIB!/]
POINT 7,[ASCII /(7) not a SAV file!/]
POINT 7,[ASCII /(10) not enough core!/]
POINT 7,[ASCII /(11) device not available!/]
POINT 7,[ASCII /(12) no such device!/]
POINT 7,[ASCII /(13) not two reloc reg. capability!/]
POINT 7,[ASCII /(14) no room or quota exceeded!/]
POINT 7,[ASCII /(15) write lock error!/]
POINT 7,[ASCII /(16) not enough monitor table space!/]
POINT 7,[ASCII /(17) partial allocation only!/]
POINT 7,[ASCII /(20) block not free on allocation!/]
POINT 7,[ASCII /(21) can't supersede (enter) an existing directory!/]
POINT 7,[ASCII /(22) can't delete (rename) a non-empty directory!/]
POINT 7,[ASCII /(23) SFD not found!/]
POINT 7,[ASCII /(24) search list empty!/]
POINT 7,[ASCII /(25) SFD nested too deeply!/]
POINT 7,[ASCII /(26) no-create on for specified SFD path!/]
TABLND: POINT 7,[ASCII /) lookup,enter,or rename error!/]
END PIP1
W Xl5