Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0128/copymt.mac
There are 2 other files named copymt.mac in the archive. Click here to see a list.
SUBTTL B. SCHREIBER UI HI ENERGY PHYSICS GROUP
SEARCH JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC .XTABM
SALL
TWOSEG
;SHOW UNIVERSAL VERSION NUMBERS
%%JOBD==:%%JOBD
%%UUOS==:%%UUOS
%%MACT==:%%MACT
%%SCNM==:%%SCNM
;SELECTIVELY LOAD SCAN AND COMPANY
.TEXT \/SEARCH REL:ALCOR/SEG:LOW\
.TEXT \/SEARCH REL:SCN7B/EXCLUD:(.SCAN)/SEG:LOW,REL:SCN7B\
.REQUI REL:HELPER ;LOAD HELPER IN HISEG
;COPYMT VERSION INFORMATION
CMTVER==7 ;MAJOR VERSION
CMTEDT==40 ;EDIT LEVEL
CMTMIN==0 ;MINOR VERSION LETTER
CMTWHO==0 ;WHO LAST EDITTED
LOC .JBVER ;SET THE VERSION
%%CPYM==:VRSN. (CMT)
EXP %%CPYM
DEFINE CTITLE (TEXT,MAJVER,EDIT)
<TITLE 'TEXT'MAJVER(EDIT)>
CTITLE (<COPYMT MAGNETIC TAPE COPY PROGRAM %>,\CMTVER,\CMTEDT)
SUBTTL REVISION HISTORY
COMMENT \
3(11) 23-SEP-76 ALL EDITS TO NOW RELEGATED TO DEVELOPMENT.
ADD /UNLOAD
3(12) 27-SEP-76 REPORT TAPOP. UUO FAILURES. ONLY ASK ABOUT
QUITTING ON BLOCK TOO LARGE ONCE.
4(13) 27-SEP-76 ADD IFTYP FACILITY...ENABLED BY /IFTYP IN COMMAND
4(14) 28-SEP-76 SPEED UP IFTYP HANDLING..USE JSP
5(15) 30-SEP-76 ADD CODE TO COPY MTA TO DSK AND DSK TO
MTA (IREAD MODE ONLY). ALSO ADD STATISTICS
SUCH AS RUNTIME AND ELAPSED TIME TO IFTYP STUFF
5(16) 04-OCT-76 USE RESULT OF DEVNAM FOR ALL MTCHR AND TAPOP
UUOS. LOGICAL NAMES SOMETIMES DON'T WORK
(ESP IF THEY ARE NUMERIC!) ALSO, WHEN TESTING
A TAPE, TYPE OUT DENSITY AND TRACKS
5(17) 05-OCT-76 ADD ROUTINE DOTPOP ON TOP OF ETAPOP TO
SAVE A FEW WORDS. ADD /TIME TO TYPE
ELAPSED AND CPU TIME.
6(20) 08-OCT-76 ADD /TO32 TO COPY 36-BIT TAPE TO 32-BIT TAPE
6(21) 11-OCT-76 TURN OFF FL$EOT AT COPDUN IF END OF LIST SEEN.
THIS WILL PREVENT EXTRA MTBSF. OUTC, AT DO.DUN
WHICH WAS IO TO UNASS CHN BECAUSE WE DID NOT
REOPEN OUTPUT
6(22) 22-OCT-76 ADD SETIBO/SETIBI
6(23) 27-OCT-76 FIX SWTCHS MACRO...MISPLACED CONDITIONAL AND
FS.VRQ MISSING ON A FEW SWITCHES.
6(24) 05-NOV-76 FIX BUG IN CPYMTD IF IREAD LOGICAL RECORD
ENDS ON BLOCK BOUNDARY (T3 GOT ZAPPED BY SETIBC)
6(25) 13-NOV-76 BF.IBC GOES IN BUFFER HEADER, NOT BUFFFER RING!
ALSO MUST CLEAR IO.UWC AT OUTCLS OR NEXT TO LAST
BUFFER GETS WRITTEN OUT AGAIN.
6(26) 15-NOV-76 ADD /ERROR:IGNORE. DEFAULT DSK EXTENSIONS TO .DAT.
ADD "I" OPTION TO IFTYPE.
6(27) 16-NOV-76 CLEARING IO.UWC SOMETIMES GET IO TO UNASS CHN.
SOLUTION: ADD FL$OPN=1 WHEN OUTPUT IS OPEN.
6(30) 1-26-77 BUG IF /COPY:N:M. DO NOT REOPEN OUTPUT IF N OR
M RUNS OUT.
6(31) 1-26-77 6(30) WAS NOT QUITE RIGHT. INSTEAD OF QUITTING
GET NEXT FUNCTION. ALSO CHECK FOR OUTPUT OPEN AT
DO.CPY IN CASE OF /COPY:X/SKIP:Y/COPY:Z.
6(32) 2-3-77 CHANGE TO ERROR., WARN., AND INFO.. ADD /RETRY:N
TO SET # RETRIES FOR TAPE TESTING AND MAKE THE
DEFAULT BE 4 INSTEAD OF 10 (TU70'S SHOULD NOT
NEED 10 TRIES!!!)
6(33) 11-FEB-77 ADD /REPEAT:N TO TRY THE TAPE TEST N TIMES
7(34) 11-FEB-77 IMPLEMENT LOG FILE CAPABILITY
WITH /LOG:FILESPEC, /COMMENT:"COMMENT FOR LOG FILE"
AND /CLOSE
7(35) 13-FEB-77 CLOSE LOG FILE ON FATAL ERROR!
7(36) 13-FEB-77 IF LOG DEVICE IS LPT FORGET THE LOOKUP
7(37) 18-FEB-77 ALLOW /LOG WITH NO FILE SPEC (DEFAULT = DSK:COPYMT.LOG)
7(40) 23-FEB-77 SHOW FILE AND RECORD COUNTS AT END OF COPY
FOR ALL MEDIA
\;END OF REVISION HISTORY
SUBTTL AC DEFINITIONS
;DEFINE THE ACCUMULATORS
DEFINE AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>
ZZ==0 ;START THE BALL ROLLING
AC$ F, ;FLAGS
AC$ T1, ;T1-4 ARE TEMPORARY AND FOR ARGUMENT PASSING
AC$ T2,
AC$ T3,
AC$ T4,
AC$ P1, ;P1-4 MUST BE PRESERVED (.SAVEX ARE BEAUTIFUL!)
AC$ P2,
AC$ P3,
AC$ P4,
AC$ L, ;LINK FOR JSP
AC$ PLP, ;PARAMETER LIST POINTER
AC$ ACT, ;HOLDS DESIRED ACTION IN DO.IT
P=17 ;THE PUSH DOWN POINTER
N=P3 ;VALUE HOLDER FROM SCAN .XXXNW, ETC.
C=P4 ;CHARACTER AC FOR SCAN, .TICAN, ETC.
SUBTTL BIT DEFINITIONS
;ASSEMBLY DIRECTIVES
ND LN$PRM,^D60 ;PARAM LENGTH
ND LN$PDL,^D40 ;PDL LENGTH
ND MY$NAM,'COPYMT' ;MY NAME IN SIXBIT
ND MY$PFX,'CMT' ;MESSAGE PREFIX
ND N$BUFS,2 ;# I/O BUFFERS (BOTH INPUT AND OUTPUT)
ND N$LOGB,2 ;# BUFFERS FOR LOG FILE
ND DF$BFZ,^D1024 ;DEFAULT BUFFER SIZE IF NO /BUFSIZ GIVEN
ND MX$NPL,^D8 ;# WORDS/LINE ON ERROR DUMP
ND FT$MTP,-1 ;NON-ZERO FOR MTAPE MONITORY COMMAND
ND FT$DEB,0 ;NON-ZERO FOR DEBUGGING CODE
ND FT$OPT,-1 ;NON-ZERO TO READ SWITCH.INI
ND FT$TST,-1 ;NON-ZERO TO INCLUDE /TAPTST CODE
IFN FT$TST,<
ND DF$TRY,4 ;DEFAULT # RETRIES ON TAPE ERRORS
ND N$TSTB,1 ;USE 1 BUFFER FOR /TAPTST
>;END IFN FT$TST
ND N$DSKB,6 ;USE THIS MANY BUFFERS FOR DSK I/O
;FDB
LN$FDB==.FXLEN ;USE STD SIZE FDB
ATSIGN==(1B13) ;THE INDIRECT BIT
INPC==1 ;INPUT CHANNEL
OUTC==2 ;OUTPUT CHANNEL
LPTC==3 ;LPT CHANNEL FOR ERROR DUMPING
LOGC==4 ;CHANNEL FOR LOG FILES
;FLAGS IN F
DEFINE FLAG$ (F)
<FL$'F==..FL ;;DEFINE THE FLAG BIT
..FL==..FL_-1
FL$'F==FL$'F> ;;SHOW THE FLAG VALUE
..FL==(1B0) ;START AT BIT 0
FLAG$ (MRG) ;ON WHEN MERGING (CONCATENATING) FILES
FLAG$ (OUT) ;ON WHEN OUTPUT SPEC ALLOCATED
FLAG$ (CPY) ;ON WHEN /COPY OR /CONCAT SEEN
FLAG$ (EOT) ;CLEARED WHEN RECORD OUTPUT, SET AT INPUT EOF
;TWO SETS IN A ROW IMPLIES LOGICAL EOT
FLAG$ (LPO) ;ON MEANS LPT FILE IS OPEN
FLAG$ (BAT) ;ON IF BATCH JOB (PREFIX A FEW MSGS WITH $)
FLAG$ (FLG) ;GENERAL PORPOISE FLAG
IFN FT$MTP,<
FLAG$ (MTP) ;ON IF MTAPE MONITOR COMMAND
>;END IFN FT$MTP
IFN FT$TST,<
FLAG$ (TST) ;ON WHEN PROCESSING /T
>;END IFN FT$TST
FLAG$ (BKT) ;HAVE SEEN BKT BEFORE AND USER SAID CONTINUE
FLAG$ (ITY) ;/IFTYP WAS SEEN
$FLITY==(FL$ITY);A LEFT HAND VALUE OF THE SAME THING
FLAG$ (DSI) ;ON IF INPUT IS DSK
FLAG$ (DSO) ;ON IF OUTPUT IS DSK
FLAG$ (232) ;ON IF 36-BIT TAPE TO 32-BIT TAPE
$FL232==(FL$232);NEED LH VALUE
FLAG$ (OPN) ;ON WHEN OUTPUT IS OPEN
FLAG$ (LOG) ;ON WHEN LOG FILE IS OPEN
FLAG$ (TSN) ;ON WHEN TIME STAMP NEEDED IN LOG FILE
;MACRO TO DEFINE FUNCTION VALUES
DEFINE FUNCTS
<FN (<BSP,SKP,EOF,REW,UNL,CPY,CON>)>
DEFINE FN (X)
<IRP X,<ZZ==ZZ+1
FN$'X==ZZ>>
ZZ==0 ;FUNCTIONS START AT 1
FUNCTS
FN$INP==-1 ;FUNCTIONS FOLLOWING THIS ONE ARE FOR INPUT SIDE
FN$EOL==-2 ;END OF FUNCTION LIST
;EXTRA FLAGS FOR SWTCHS MACRO
FS$XTR==1B7 ;THIS SWITCH CAN TAKE EXTRA PARAMETERS
;(I.E. /BACKSP:F:N)
FS$NVL==1B8 ;THIS SWITCH NEVER TAKES A VALUE
FS$OUT==1B9 ;THIS SWITCH IS OUTPUT ONLY
FS$INP==1B10 ;THIS SWITCH IS INPUT ONLY
FS$SPL==1B11 ;THIS SWITCH REQUIRES SPECIAL PROCESSING
;DO A JRST @SWTP(P1) TO DO IT
SUBTTL ERROR MACRO DEFINITIONS
;ERROR. ($FLGS,$PFX,$MSG)
;
;$FLGS IS THE COMBINITATION OF THE FOLLOWING BITS:
EF$ERR==0 ;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
EF$FTL==400 ;FATAL ERROR--ABORT AND RESTART
EF$WRN==200 ;WARNING MESSAGE--CONTINUE
EF$INF==100 ;INFORMATIVE MESSAGE--CONTINUE
EF$NCR==40 ;NO FREE CRLF AFTER MESSAGE
EF$OPR==20 ;MESSAGE SHOULD BE PREFIXED WITH CRLF-$ IF BATCH
EF$MAX==17 ;MAX # OF TYPE CODES ALLOWABLE (9 BITS - ABOVE USED)
DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>
ZZ==0 ;TYPE CODES ARE FROM 1-EF$MAX
ETYP DEC, ;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP OCT, ;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP SIX, ;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP PPN, ;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP STR, ;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP FIL, ;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP LEB, ;T1 POINTS AT OPEN BLOCK
;T2 POINTS AT LOOKUP/ENTER BLOCK
MX$ERR==ZZ ;MAXIMUM LEGAL ERROR TYPE
EF$NOP==0 ;INTERNAL FOR ERROR HANDLER
IFG ZZ-EF$MAX,<PRINTX ?TOO MANY ERROR TYPES>
;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF
NOOP== (CAI) ;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP
DEFINE ERROR. ($FLGS,$PFX,$MSG)
<PUSHJ P,EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>
;WARN. ($FLGS,$PFX,$MSG) -- GENERATE CALL TO ERROR HANDLER FOR WARNING
DEFINE WARN. ($FLGS,$PFX,$MSG)
<ERROR. (EF$WRN!$FLGS,$PFX,$MSG)>
;INFO. ($FLGS,$PFX,$MSG) -- GENERATE CALL TO ERROR HANDLING FOR INFO
DEFINE INFO. ($FLGS,$PFX,$MSG)
<ERROR. (EF$INF!$FLGS,$PFX,$MSG)>
;OPER$ ($FLGS,$PFX,$MSG) -- MESSAGE THAT OPERATOR WILL SEE IN BATCH JOB
DEFINE OPER$ ($FLGS,$PFX,$MSG)
<ERROR. (EF$OPR!$FLGS,$PFX,$MSG)>
SUBTTL IMPLEMENTATION NOTES
COMMENT \A NOTE ABOUT THE PARAMETER LIST -
THE LIST IS SET UP IN TWO WORD ARGUMENTS. THE FIRST WORD IS THE FUNCTION
AND THE SECOND CONTAINS <FILE REPEAT COUNT,,RECORD REPEAT COUNT>.
FOR FUNCTIONS THAT HAVE NO COUNTS (I.E. /EOF) THE COUNT IS SET
TO ONE BY THE SWITCH HANDLER. THE INTERNAL FUNCTIONS (FN$INP AND
FN$EOL) DO NOT USE THE SECOND ARGUMENT, BUT IS PRESENT FOR A HOMOGENOUS
LIST.
\;END NOTE
COMMENT \
IF THIS PROGRAM IS REASSEMBLED AND DOES NOT APPEAR TO FUNCTION
CORRECTLY, CHECK UUOSYM DEFINITIONS FOR MTCHR. AND TAPOP. UUO, AND WHAT
THE MONITOR ACTUALLY STORES IN THESE ARG BLOCKS. I EXPECT THAT THE
DEFINITIONS FOR .TFSTS (GET STATUS) ARE WRONG IN THE UUOSYM I USED
(.TSFIL==0, .TSREC==1).
\;END COMMENT
SUBTTL OTHER MACRO DEFINITIONS
;SAVE$ SAVES DATA ON THE STACK
DEFINE SAVE$ (X)
<XLIST
IRP X,<PUSH P,X>
LIST>
;RESTR$ RESTORES DATA FROM THE STACK
DEFINE RESTR$ (X)
<XLIST
IRP X,<POP P,X>
LIST>
;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE
DEFINE U ($NAME,$WORDS<1>)
<$NAME: BLOCK $WORDS>
;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG
DEFINE STRNG$ (S)
<MOVEI T1,[ASCIZ \S\]
PUSHJ P,.TSTRG##>
;HIGH$ SWITCHES TO HIGH SEGMENT
DEFINE HIGH$
<IFE SEG$,<HILOC$==.
SEG$==-1
RELOC LOLOC$>
>
;LOW$ SWITCHES TO LOW SEGMENT
DEFINE LOW$
<IFN SEG$,<LOLOC$==.
SEG$==0
RELOC HILOC$>
>
;RELOC$ DEFINES INITIAL CONDITIONS
DEFINE RELOC$
<RELOC 0
LOLOC$==400000
SEG$==0>
;LIT$ FORCES OUT LITERALS IN CURRENT SEGMENT
DEFINE LIT$
<XLIST
LIT
LIST>
SUBTTL GET THE BALL ROLLING
;MAIN AND ONLY ENTRY POINT. REMEMBER IF CCL ENTRY OR NOT, AND REMEMBER
;WHERE WE CAME FROM. THIS IS NECESSARY TO RECOVER THE SCAN HIGH SEGMENT
;AFTER WE HAVE FINISHED COPYING
RELOC$ ;INITIALIZE SEGMENTS
COPYMT: TDZA T1,T1 ;NOT CCL ENTRY
MOVEI T1,1 ;CCL START
MOVEM T1,OFFSET ;REMEMBER FOR SCANNING
RESET ;STOP ALL I/O
REPEAT 0,< ;UN-REPEAT WHEN DISTRIBUTED
MOVX T1,%CNDVN ;MONITOR VERSION
GETTAB T1,
SETZ T1, ;WILL LOOSE BIG
TXZ T1,VR.WHO!VR.MIN;GET MAJOR VERSION #
CAIGE T1,60200 ;MUST BE .GE. 602
ERROR. EF$FTL,N6M,<NEED 6.02 OR LATER MONITOR>
>;END REPEAT 0
SKIPE SAVRUN ;HAVE WE SAVED RUN UUO ARGS?
JRST RUNSVD ;YES--SKIP AHEAD
MOVEM .SGNAM,SGNAM ;NO--DO SO NOW
MOVEM .SGPPN,SGPPN ;
MOVEM .SGDEV,SGDEV
MOVEM .SGLOW,SGLOW ;LOW FILE EXTENSION
SETOM SAVRUN
RESTRT:
RUNSVD: STORE 17,0,16,0 ;CLEAR ALL ACCUMULATORS
STORE 17,FW$ZER,LW$ZER,0 ;AND ZEROED DATA BASE
SKIPA P,.+1 ;LOAD UP PUSH DOWN POINTER
INIPDP: IOWD LN$PDL,PDLIST
PUSHJ P,.RECOR## ;RESET CORE ALLOCATION
PUSHJ P,UPSCN ;IN CASE OF ABORT-RESTART
PUSHJ P,$CLOSE ;RESET THE /LOG SPEC BLOCK
MOVE T1,ISCNBL ;GET .ISCAN ARGUMENT BLOCK
PUSHJ P,.ISCAN## ;INITIALIZE THE SCANNER
MOVEM T1,ISCNVL ;REMEMBER VALUE RETURNED
IFN FT$MTP,<
SOJE T1,DOMTAP ;JUMP IF MTAPE COMMAND (VALUE=1)
>;END IFN FT$MTP
SKIPN OFFSET ;CCL START?
SKIPE TLDVER ;TOLD VERSION YET?
JRST CPYMT0 ;YES--GO CALL .TSCAN
STRNG$ <COPYMT %> ;NO--DO IT NOW
MOVE T1,.JBVER
PUSHJ P,.TVERW##
PUSHJ P,.TCRLF##
SETOM TLDVER
CPYMT0: PUSHJ P,UPSCN ;ENSURE SCAN AROUND
SETZ F, ;***CLEAR THE FLAGS
PUSHJ P,SCNCMD ;GET A COMMAND
MSTIME T1, ;GET TIME OF DAY
MOVEM T1,GOTIME ;SAVE AS GO-TIME
SETZ T1, ;GET MY RUNTIME
RUNTIM T1,
MOVEM T1,GORUNT ;SAVE AS INITIAL RUNTIME
MOVE T1,OUTSPC+.FXDEV;OUTPUT DEV NAME
DEVNAM T1, ;SEE WHAT IT REALLY IS
JRST ILLODV ;CAN'T
MOVEM T1,ODVNAM ;SAVE FOR LATER
IFN FT$TST,<
SKIPL TESTFL ;NO INPUT IF /TEST
JRST CPYMT1 ;SO DON'T TRY IT
>;END IFN FT$TST
MOVE T1,INPSPC+.FXDEV;INPUT NAME
DEVNAM T1, ;GET REAL NAME
JRST ILLIDV ;CAN'T
MOVEM T1,IDVNAM
PUSHJ P,CHKCMD ;CHECK COMMAND FOR GOODNESS
PUSHJ P,DWNSCN ;POOF GOES THE HISEG!
PUSHJ P,OPNOUT ;OPEN OUTPUT FILE
PUSHJ P,OPNINP ;GET NEXT INPUT FILE
PUSHJ P,CHKLOG ;SEE ABOUT THE LOG FILE NOW
PUSHJ P,DO.IT ;DO IT
CPYMT9: PUSHJ P,CLSLOG ;CLOSE LOG IF IT WAS OPEN
PUSHJ P,.RECOR## ;RESET CORE ALLOCATION
JRST CPYMT0 ;GET NEXT COMMAND
IFN FT$TST,<
CPYMT1: PUSHJ P,CHKBAT ;SEE IF BATCH JOB
PUSHJ P,DWNSCN ;MAKE ME SMALLER
PUSHJ P,OPNOUT ;OPEN OUTPUT
PUSHJ P,CHKLOG ;GO SEE ABOUT LOG FILE BEFORE WE FIRE IT UP
PUSHJ P,TESTIT ;TEST IT
JRST CPYMT9 ;LOOP
>;END IFN FT$TST
PLPINI: IOWD LN$PRM,PRMPDL ;INITIAL PARAM LIST PTR
LIT$ ;FORCE OUT LITERALS
HIGH$ ;THIS CODE CAN DISSAPPEAR
SCNCMD: MOVE T1,TSCNBL ;GET .TSCAN ARGUMENT BLOCK
PUSHJ P,.TSCAN## ;CALL .TSCAN TO SCAN COMMAND
IFN FT$TST,<
SKIPL TESTFL ;/TAPTST?
JRST SCNTST ;YES--SHOULD ONLY HAVE ONE DEVICE
>;END IFN FT$TST
SKIPE OUTSPC+.FXDEV ;OUTPUT THERE?
SKIPN INPSPC+.FXDEV ;YES--INPUT?
E$$CER: ERROR. EF$FTL,CER,<COMMAND ERROR>
IFN FT$OPT,<
MOVE T1,OSCNBL ;GET ARG PTR FOR .OSCAN
PUSHJ P,.OSCAN## ;SCAN DSK:SWITCH.INI[-]
>;END IFN FT$OPT
POPJ P, ;**SCNCMD RETURN
IFN FT$TST,<
SCNTST: SKIPE OUTSPC+.FXDEV ;WAS IT DEV:/TAPTST= ?
JRST [SKIPN INPSPC+.FXDEV ;YES--BUT WAS INPUT SPEC THERE ALSO?
JRST SCNTS0 ;NO--ALL IS WELL
JRST E$$CER] ;NO--COMMAND ERROR
SKIPE T1,INPSPC+.FXDEV;INPUT SPECIFIED?
CAME T1,[SIXBIT/DSK/] ;YES--IF IT IS DSK
SKIPA ;'DSK' MEANS /TEST WAS TYPED
SETZM INPSPC+.FXDEV ;FAKE-OUT SO WE USE TAPTST:
MOVE T1,[INPSPC,,OUTSPC] ;SETUP TO BLT SPEC TO PROPER PLACE
BLT T1,OUTSPE ;...MOVE IT
SCNTS1: MOVE T1,[SIXBIT/TAPTST/] ;LAST CHANCE TRY IF NO NAME NOW
SKIPN OUTSPC+.FXDEV ;DID WE GET ON?
MOVEM T1,OUTSPC+.FXDEV;NO--TRY THIS -- COMPLAIN IF FAILURE
SCNTS0: MOVEI T1,N$TSTB ;USE N$TSTB BUFFERS
MOVEM T1,NOBUFS ;AND SET IT
MOVE T1,OUTSPC+.FXDEV;CHECK DEVICE FOR MAGTAPE
DEVNAM T1, ;DO IT AGAIN IN CASE WE CHANGED IT (ABOVE)
JRST ILLODV ;CAN'T GET AT IT
MOVEM T1,ODVNAM ;SAVE FOR LATER
PUSHJ P,CKISMT ;BECAUSE WE WON'T TEST ANYTHING ELSE
JRST E..DNM ;NOT MTA
MOVE T2,ODVNAM ;GET NAME FOR MTCHR.
MTCHR. T2, ;GET IT
SETZ T2, ;BETTER THIS THAN A HALT!
PUSHJ P,STSTBZ ;SET UP 1 FOOT RECORD BUFFERSIZE
IFN FT$OPT,<
MOVE T1,OSCNBL ;CAN HAVE /IFTYP IN SWITCH.INI
PJRST .OSCAN## ;SCAN AND RETURN
>;END IFN FT$OPT
IFE FT$OPT,<
POPJ P, ;END OF SCNCMD
>;END IFE FT$OPT
>;END IFN FT$TST
;ARGUMENT BLOCK FOR .ISCAN
ISCNBL: XWD 5, .+1
IOWD N$CMDS,CMDLST ;LEGAL COMMAND LIST
XWD OFFSET,MY$PFX
XWD 0,CHROUT ;SO WE CAN MPX OUTPUT TO LOG FILE
EXP 0
XWD DOPRMP,0
;.TSCAN ARGUMENT BLOCK
TSCNBL: XWD 11, .+1
IOWD SWTL,SWTN
XWD SWTD,SWTM
XWD 0,SWTP
EXP -1 ;USE JOB NAME TABLE
XWD CLRANS,CLRFIL
XWD AIN,AOUT
EXP 0
EXP 0 ;NO FLAGS
EXP STOSWT
IFN FT$OPT,<
;.OSCAN ARGUMENT BLOCK
OSCNBL: XWD 4, .+1
IOWD OPSWL,OPSWN
XWD OPSWD,OPSWM
XWD 0,OPSWP
EXP -1
EXP 0
>;END IFN FT$OPT
IFN FT$MTP,< ;MTAPE FEATURE
;.TSCAN ARG BLOCK FOR MTAPE COMMAND
MTSCNB: XWD 11, .+1
IOWD MTSWL,MTSWN
XWD MTSWD,MTSWM
XWD 0,MTSWP
EXP -1
XWD CLRANS,CLRFIL
XWD AIN,AOUT
EXP 0
EXP 0
EXP STOSWT
>;END IFN FT$MTP
CMDLST: EXP MY$NAM ;IF ANY BODY WANTS IT...
IFN FT$MTP,< ;MTAPE COMMAND
SIXBIT /MTAPE/ ;
>;END IFN FT$MTP
N$CMDS==.-CMDLST
;SCAN CALLS HERE TO PROMPT
DOPRMP: SKIPL T1 ;INITIAL OR CONTINUATION?
SKIPA T1,PRMPT0 ;INITIAL
MOVSI T1,'# ' ;CONTINUATION
PJRST .TSIXN## ;TYPE IT
PRMPT0: XWD MY$PFX,'> '
SUBTTL MTAPE COMMAND HANDLER
IFN FT$MTP,<
DOMTAP: TLO F,FL$MTP ;FLAG MTAPEING
MOVE T1,MTSCNB ;TSCAN BLOCK FOR MTAPE COMMAND
PUSHJ P,.TSCAN## ;CALL COMMAND SCANNER
SKIPN T1,INPSPC+.FXDEV;CHECK FOR AN INPUT SPEC
JRST E$$CER ;NO--MUST HAVE SCREWED UP
CAMN T1,[SIXBIT/DSK/] ;IS IT DSK?
JRST [SKIPN T1,INPSPC+.FXNAM ;YES--PROBABLY FORGOT THE COLON
JRST E$$CER ;WHOOPS!! BAD COMMAND
MOVEM T1,INPSPC+.FXDEV ;SO TRY THE FILE NAME
JRST .+1]
DEVNAM T1, ;GET REAL NAME
JRST ILLIDV ;NOT REAL
MOVEM T1,IDVNAM ;SAVE FOR LATER
PUSHJ P,CKISMT ;ENSURE MTA
JRST E..DNM ;NOTT-GO BOMB
PUSHJ P,OPINOB ;OPEN INPUT WITH NO BUFFERS
PUSHJ P,CHKBAT ;BETTER CHECK FOR BATCH...
PUSHJ P,DO.IT ;PERFORM THE OPERATIONS
PUSHJ P,.MONRT## ;ALL DONE
JRST RESTRT ;ON .CONTINUE GET THE PROMPT
>;END IFN FT$MTP
SUBTTL CHECK COMMAND FOR REAL MAGTAPES AND OTHER GOOD THINGS
CHKCMD: MOVE T1,ODVNAM ;GET OUTPUT DEVICE REAL NAME
PUSHJ P,CKISMT ;ENSURE MTA
TLO F,FL$DSO ;FLAG DSK OUTPUT
MOVE T1,IDVNAM ;SAME FOR INPUT
PUSHJ P,CKISMT
TLO F,FL$DSI ;FLAG DSK INPUT
TLNE F,FL$DSO!FL$DSI ;CHECK FOR DSK IN OR OUT
JRST [TLC F,FL$DSI!FL$DSO ;YES--MAKE SURE NOT BOTH DSK
TLCE F,FL$DSI!FL$DSO ;
JRST CHKC.1 ;A-OK--MOVIN' ALONG
ERROR. (EF$FTL,BDD,<BOTH DEVICES ARE DSK>)]
MOVE T1,ODVNAM ;MAKE SURE NOT SAME MTA
MOVE T2,IDVNAM ;...
CAMN T1,T2 ;BETTER NOT BE THE SAME
JRST E$$CUS ;YES--STUPID
JRST CHKC.2 ;OK--NOW SKIP AHEAD
CHKC.1: HRLOI T2,'DAT' ;SETUP DEFAULT EXTENSION
TLNE F,FL$DSI ;DISK INPUT?
SKIPE INPSPC+.FXEXT ;NEED ONE?
SKIPA ;NO--DON'T TOUCH IT
MOVEM T2,INPSPC+.FXEXT ;YES--DEFAULT IT
TLNE F,FL$DSO ;DISK OUTPUT?
SKIPE OUTSPC+.FXEXT ;YES--NEED DEFAULT?
SKIPA ;NO
MOVEM T2,OUTSPC+.FXEXT ;YES--DEFAULT
CHKC.2:
CHKBAT: HRROI T1,.GTLIM ;NOW SEE IF I AM A BATCH JOB
GETTAB T1, ;ASK MON
SETZ T1, ;JE NE SAIS PAS
TLNE T1,(JB.LBT) ;BATCH JOB?
TLO F,FL$BAT ;YES--REMEMBER THAT
POPJ P, ;ALL IS WELL (I HOPE)
ILLODV: SKIPA T1,OUTSPC+.FXDEV;DEVNAM FAILED
ILLIDV: MOVE T1,INPSPC+.FXDEV
ERROR. EF$FTL!EF$SIX,IUD,<ILLEGAL OR UNKNOWN DEVICE - >
E$$CUS: ERROR. EF$FTL,CUS,<CAN'T USE SAME MTA FOR INPUT AND OUTPUT>
;CKISMT -- SEE IF DEVICE IS MTA
;CALL: MOVE T1,DEVNAM
; PUSHJ P,CKISMT
; *ITS A DSK*
; *ITS MTA*
;PRESERVES T1
CKISMT: MOVE T2,T1 ;COPY DEVICE NAME
DEVCHR T2, ;GET CHARACTERISTICS
TLNE T2,(DV.MTA) ;IS IT AN MTA?
TLNE T2,(DV.TTY) ; AND ALSO A TTY (IMPLIES NUL:)
JRST CKISM1 ;NO--SEE IF DSK
TLNE T2,(DV.AVL) ;MTA--IS IT AVAILABLE TO ME?
JRST .POPJ1## ;YES--DONE
ERROR. EF$FTL!EF$SIX,MNA,<MTA IS NOT AVAILABLE - >
CKISM1: TLNE T2,(DV.DSK) ;IS IT A DSK?
TLNE T2,(DV.TTY) ;YES--AND NOT TTY (I.E. NOT NUL:)
E..DNM: ERROR. EF$SIX!EF$FTL,DNM,<DEVICE NOT A MAGTAPE - >
POPJ P, ;DEVICE IS A DISK
SUBTTL SWITCH TABLE
DEFINE SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SS CLOSE,$CLOSE,0,FS.NFS!FS.NCM!FS$SPL
SP COMMENT,<POINT ^D65-^D28,UCOMNT>,.SWASQ##,,FS.NUE
SP CONCAT,FN$CON,.SWDEC##,MTN,FS.VRQ!FS$XTR!FS$INP
SP *COPY,FN$CPY,.SWDEC##,MTN,FS$XTR!FS$INP!FS.VRQ
SS *EOF,FN$EOF,FN$EOF,FS$NVL
SL ERROR,ERRFLG,ERL,ERLCON,FS.NUE
SP IBUF,NIBUFS,.SWDEC##,BFS,FS.NUE
SS *IFTYP,<POINTR (F,$FLITY)>,1,FS.NUE
SP LOG,$LOGSW,.POPJ##,LGF,FS.NFS!FS.NCM!FS$SPL
SL MODE,MODFLG,MOD,MODBIN,FS.NUE
SS NORETR,RTRYFL,1,FS.NUE
SP OBUF,NOBUFS,.SWDEC##,BFS,FS.NUE
IFN FT$TST,<
SP REPEAT,RPETFL,.SWDEC##,RPT,FS.NUE
>;END IFN FT$TST
SS REPORT,RPTFLG,1,FS.NUE
SP RETRY,NUMTRY,.SWDEC##,TRY,FS.NUE
SS *REWIND,FN$REW,FN$REW,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR!FS.VRQ
IFN FT$TST,<
SP TAPTST,TESTFL,.SWDEC##,TST,FS.NUE
SP *TEST,TESTFL,.SWDEC##,TST,FS.NUE
>;END IFN FT$TST
SS TIME,TIMEFL,1,FS.NUE
SS TO32,<POINTR(F,$FL232)>,1,FS.NUE
SS *UNLOAD,FN$UNL,FN$UNL,FS$NVL
>
MX.LGF==.FXLEN
PD.LGF==1
DM (BFS,^D20,6,6)
DM (MTN,177777,177777,177777)
DM (BFZ,^D4096,^D2048,^D1024)
IFN FT$TST,<
DM (RPT,177777,1,1)
DM (TRY,^D100,DF$TRY,DF$TRY)
DM (TST,177777,0,0)
>;END IFN FT$TST
KEYS (ERL,<CONTIN,IGNORE,QUERY>)
KEYS (MOD,<BINARY,INDUST,SEVENB>)
DOSCAN (SWT)
SUBTTL .OSCAN/MTAPE COMMAND SWITCH TABLES
IFN FT$OPT,< ;ONLY IF ASSEMBLED FOR OPTION SCANNNING
DEFINE SWTCHS,<
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SL ERROR,ERRFLG,ERL,ERLCON,FS.NUE
SP IBUF,NIBUFS,.SWDEC##,BFS,FS.NUE
SS *IFTYP,<POINTR (F,$FLITY)>,1,FS.NUE
SP LOG,$LOGSW,.POPJ##,LGF,FS.NFS!FS.NCM!FS$SPL
SP OBUF,NOBUFS,.SWDEC##,BFS,FS.NUE
SS TIME,TIMEFL,1,FS.NUE
>
DOSCAN (OPSW)
>;END IFN FT$OPT
IFN FT$MTP,<
DEFINE SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR
SS *EOF,FN$EOF,FN$EOF,FS$NVL
SS *REWIND,FN$REW,FN$REW,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR
SS *UNLOAD,FN$UNL,FN$UNL,FS$NVL
>
DOSCAN (MTSW)
>;END IFN FT$MTP
SUBTTL HELPER ROUTINES FOR SCANNING COMMANDS
;SCAN CALLS HERE TO ALLOCATE SPACE FOR INPUT SPEC
AIN: TLNN F,FL$CPY!IFN FT$MTP,<FL$MTP> ;DID WE SEE /COPY OR /CONCAT?
;OR IS THIS MTAPE COMMAND?
PUSHJ P,CPYHOL ;NO--SET UP TO COPY WHOLE TAPE
HRROI T1,FN$EOL ;SET END OF LIST
PUSHJ P,PRMSTO ;...
MOVEI T1,INPSPC ;POINT TO SPEC
PJRST ALEN ;GET LENGTH AND RETURN
;SCAN CALLS HERE TO ALLOC OUTPUT SPEC SPACE
AOUT: HRROI T1,FN$INP ;SET END OF OUTPUT LIST
PUSHJ P,PRMSTO ;...
PUSHJ P,ALEN ;SETUP MODFLG AND T2 (LENGTH)
TLO F,FL$OUT ;OUTPUT SPEC ALLOCATED
MOVEI T1,OUTSPC ;HERE IT IS!
POPJ P, ;RETURN FROM AOUT
ALEN: SKIPG T2,MODFLG ;/MODE:MODE SPECIFIED THIS SIDE?
JRST ALEN2 ;NO--DON'T BOTHER WITH IT
TLNE F,FL$OUT ;INPUT?
MOVEM T2,INPMOD ;YES
TLNN F,FL$OUT ;OUTPUT?
MOVEM T2,OUTMOD ;YES
SETOM MODFLG ;RESET MODFLG SO SCAN DOESN'T BARF
ALEN2: MOVEI T2,LN$FDB ;TELL SCAN LENGTH OF FDB
POPJ P,
;SCAN CALLS HERE TO CLEAR ALL ANSWERS
CLRANS: STORE T1,SCN$FZ,SCN$LZ,0
STORE T1,SWT$FO,SWT$LO,-1 ;WORD SWITCHES TO -1 PLEASE
MOVE PLP,PLPINI ;SETUP PARAM LIST PTR
IFN FT$MTP,<
TLNN F,FL$MTP ;MTAPE COMMAND?
POPJ P, ;NO
HRROI T1,FN$INP ;YES--FORCE TO INPUT SIDE ONLY
PUSHJ P,PRMSTO ;SET ON PARAM LIST
>;END IFN FT$MTP
POPJ P,
;FIX UP TO COPY WHOLE TAPE...NO /COPY OR /CONCAT
CPYHOL: MOVEI T1,FN$CPY ;FUNCTION
HRLOI T2,677777 ;LARGE NUMBER OF FILES/RECORDS
PJRST PRMSTO ;SET ON PARAM LIST AND RETURN
;HERE TO STORE /LOG SWITCH
$LOGSW: CAIE C,":" ;IS THERE A FILE SPEC?
JRST [MOVEI T1,1 ;NO--STORE A 1
MOVEM T1,LOGSPC;...
POPJ P,] ;RETURN TO SCAN
PUSHJ P,.FILIN## ;READ THE FILE SPEC
MOVEI T1,LOGSPC ;POINT AT MY STORAGE
MOVEI T2,.FXLEN
PUSHJ P,.GTSPC## ;COPY SPEC TO MINE AREA
MOVEI T1,1 ;NO SENSE IN SCAN CALLING CLRFIL NOW
PJRST .CLRFL## ;CLEAR FILE AREA AND RETURN
;SCAN CALLS HERE TO CLEAR ALL FILE ANSWERS
CLRFIL: POPJ P, ;***
;SCAN CALLS HERE TO STORE FILE SWITCHES
;WITH N=VALUE,T2=PTR (FUNCTION FN$XXX IN THIS CASE), AND T3=FLAGS (LH)
;ALSO P1=SWITCH INDEX
STOSWT:
TLNE T3,(FS$SPL) ;SPECIAL PROCESSING?
JRST @SWTP(P1) ;YES--GO THERE
TLNN T3,(FS$OUT) ;SWITCH OUTPUT ONLY?
JRST STOSWA ;NO
TLNE F,FL$OUT ;YES--IS OUTPUT DONE?
JRST E$$OSI ;YES--GO BOMB--OUTPUT SWITCH ON INPUT
STOSWA: TLNN T3,(FS$INP) ;INPUT ONLY?
JRST STOSWB ;NO--GO STORE IT
TLNN F,FL$OUT ;YES--OUTPUT DONE YET?
JRST E$$ISO ;NO--GO BOMB
STOSWB: TLNE T3,(FS$NVL) ;NEVER TAKE A VALUE?
JRST SWTS0A ;YES--MAKE SURE IT DOESN'T GET ONE
;(BUT SET VALUE OF ONE SO IT GETS DONE ONCE)
TLNN T3,(FS$XTR) ;NO--DOES IT TAKE EXTRA VALUES?
JRST SWTST0 ;NO--JUST MOVE ALONG
CAIE C,":" ;YES--IS THERE ONE?
JRST SWTST0 ;NO--ONLY RECORDS WERE GIVEN
SAVE$ <N,T2> ;YES--SAVE VALUE, AND PTR (FUNCTION)
PUSHJ P,.DECNW## ;READ SECOND VALUE
RESTR$ <T1,T2> ;RESTORE GOOD STUFF AND POSITION IN CORRECT ACS
MOVSS T2 ;BUT FILE COUNT GOES IN LEFT HALF
HRR T2,N ;AND RECORD COUNT TO RIGHT HALF
PJRST PRMSTO ;STORE PARAMS, AND SKIP SCAN SWITCH STORE
SWTS0A: MOVEI N,1 ;FS$NVL--MAKE SURE IT GETS DONE 1 TIME
SWTST0: MOVE T1,T2 ;POSITION FUNCTION
HRRZ T2,N ;AND VALUE (NOTE /BACKSP:N MEANS N RECORDS)
; PJRST PRMSTO ;GO STORE PARAMS AND RETURN
;CALL PRMSTO TO STORE PARAMETERS IN FUNCTION PARAMETER LIST
;WITH T1=FUNCTION, T2=VALUE
PRMSTO: PUSH PLP,T1 ;STORE PARAMETER
PUSH PLP,T2 ;AND VALUE (NOT USED IF DOESN'T TAKE ONE)
CAIE T1,FN$CPY ;IF THIS IS /COPY
CAIN T1,FN$CON ;OR /CONCAT
TLO F,FL$CPY ;THEN WE HAVE A COPY SWITCH
POPJ P, ;DONE
E$$OSI: MOVE T1,SWTN(P1) ;GET SWITCH NAME FOR DUM USER
ERROR. EF$FTL!EF$SIX,OSI,<OUTPUT SWITCH ILLEGAL ON INPUT - >
E$$ISO: MOVE T1,SWTN(P1) ;GET SWITCH NAME
ERROR. EF$FTL!EF$SIX,ISO,<INPUT SWITCH ILLEGAL ON OUTPUT - >
SUBTTL DETERMINE BUFFER SIZE FOR TAPE TESTING
IFN FT$TST,<
STSTBZ: LDB T1,[POINTR (OUTSPC+.FXMOD,FX.DEN)] ;SEE IF /DENSITY
SKIPN T1 ;GET ONE?
LDB T1,[POINTR (T2,MT.DEN)] ;NO--GET MTCHR. DENSITY
TRNE T2,MT.7TR ;7 TRACK?
CAIG T1,3 ;YES--.GT. 800 BPI?
JUMPN T1,STSBZ0 ;OK IF NON-ZERO
WARN. 0,CDD,<CAN'T DETERMINE DENSITY - 800 BPI ASSUMED>
MOVEI T1,3 ;800 BPI
STSBZ0: MOVEM T1,TSTDEN ;SAVE TEST DENISTY
TRNE T2,MT.7TR ;SEVEN TRACK?
SKIPA T1,BUFSZ7-1(T1) ;YES--GET PROPER LENGTH
MOVE T1,BUFSZ9-1(T1) ;NO--USE 9-TRACK LENGTH
MOVEM T1,BUFSIZ ;SET IT
POPJ P,
;TABLE OF RECORD LENGTHS FOR DIFFERENT DENSITIES ON 7/9 TRACK UNITS
;LENGTH FOR ONE FOOT RECORDS = <DENSITY>/<BYTES/WORD ON TAPE>*<1 FOOT-IRG>
;(IRG=INTER-RECORD GAP)
BUFSZ7: EXP ^D375,^D1042,^D1500 ;200/556/800
BUFSZ9: EXP 0,0,^D1824,^D3648,^D14250 ;200/556/800/1600/6250
>;END IFN FT$TST
LIT$ ;FORCE OUT HISEG LITERALS
SUBTTL HIGH SEGMENT HANDLING
LOW$
;DWNSCN -- REMOVE THE HISEG IF PRESENT
;CALL: PUSHJ P,DWNSCN
; *RETURN--ALL ACS SAVED*
DWNSCN: SKIPN .JBHRL ;HIGH SEGMENT AROUND?
POPJ P, ;NO--DON'T DO CORE UUO NOW
SAVE$ T1 ;PRESERVE T1 AS ADVERTIZED
MOVSI T1,1 ;YES--GET RID OF IT
CORE T1, ;BYE/!
JFCL ;SNH
PJRST TPOPJ ;GET T1 AND RETURN
;UPSCN -- REGET THE HISEGMENT
;CALL: PUSHJ P,UPSCN
; *RETURN--ALL ACS SAVED*
UPSCN: SKIPE .JBHRL ;HIGH SEGMENT THERE?
POPJ P, ;YES--SKIP COSTLY GETSEG
MOVEM 17,SAVAC+17 ;GETSEG DESTROYS ACS
MOVEI 17,SAVAC
BLT 17,SAVAC+16 ;SAVE ALL
SEGAGN: MOVE T1,SGDEV ;SETUP FOR GETSEG
MOVE T2,SGNAM
MOVE T3,SGLOW
SETZB T4,P2
MOVE P1,SGPPN
MOVEI P3,T1 ;POINT AT THE BLOCK
GETSEG P3,
SKIPA T1,P3 ;OOOPS--SET UP T1 TO TYPE OUT CODE
JRST [MOVSI 17,SAVAC
BLT 17,17
POPJ P,]
MOVE P,INIPDP ;JUST IN CASE..RESET PDL
ERROR. EF$ERR!EF$OCT,CGH,<CAN'T GET HIGH SEG - CODE = >
EXIT 1,
JRST SEGAGN ;MAYBE IT WAS JUST LOST?
SUBTTL LOG FILE HANDLING
;CHKLOG -- SEE IF LOG FILE NEEDED AND SETUP FOR IT
CHKLOG: MOVE T1,LOGSPC ;GET THE DEVICE NAME
AOJE T1,.POPJ## ;JUMP IF IT IS STILL (-1)
TLO F,FL$LOG ;NO--IT WAS /LOG OR /LOG:SPEC
PUSHJ P,LOGOPN ;YES--OPEN THE LOG FILE
MOVE T1,UCOMNT ;SEE IF A COMMENT GIVEN
AOJE T1,.POPJ## ; IF NOT, UCOMNT WILL BE -1
MOVEI T1,[ASCIZ/COMMENT: /]
PUSHJ P,STRLOG ;SEND TO LOG FILE
MOVEI T1,UCOMNT ;POINT AT COMMENTS
PUSHJ P,STRLOG ;SEND TO LOG FILE
CLFLOG: PJSP T1,STRLOG ;SEND CRLF TO LOG AND RTURN
ASCIZ .
.
CLGNTS: PUSHJ P,CLFLOG ;SEND CRLF TO LOG FILE
TLZ F,FL$TSN ;CLEAR TIME STAMP NEEDED
POPJ P, ;RETURN
;STRLOG -- SEND STRING TO LOG FILE
;CALL: MOVEI T1,<ASCIZ STRING ADDR>
; PUSHJ P,STRLOG
STRLOG: HRLI T1,(POINT 7) ;FORM BYTE PTR
PUSH P,T1 ;SAVE ON PDL
STRL.2: ILDB T1,(P) ;GET A CHAR
JUMPE T1,TPOPJ ;JUMP IF ALL DONE
PUSHJ P,CHRLOG ;SEND TO LOG FILE
JRST STRL.2
;CHROUT -- SEND CHARACTER TO TTY AND LOG FILE IF OPEN
;CHRLOG -- SEND CHARACTER TO LOG FILE
;CALL: MOVEI T1,<CHAR>
; PUSHJ P,CHRLOG/CHROUT
CHROUT: OUTCHR T1 ;SEND TO TTY
TLNN F,FL$LOG ;ARE WE LOGGING?
POPJ P, ;NO--DONE
CHRLOG: TLZE F,FL$TSN ;TIME FOR A TIME STAMP?
PUSHJ P,TIMSTM ;YES--DO ONE
SOSG GBHR+.BFCTR ;ROOM IN BUFFER?
JRST CHRLG1 ;NO--GO DUMP ONE
CHRLG0: IDPB T1,GBHR+.BFPTR ;YES--STORE IN BUFFER
CAIN T1,.CHLFD ;LINEFEED?
TLO F,FL$TSN
POPJ P,
CHRLG1: PUSHJ P,.PSH4T## ;PRESERVE T1-4
PUSHJ P,XCTIO ;SEND TO LOG FILE
OUT LOGC, ;XCT'D
TLZ F,FL$LOG ;!!EOT!!--NO MORE LOG FILE
PUSHJ P,.POP4T## ;RESTORE T1-4
TLNE F,FL$LOG ;IS LOG STILL ALIVE?
JRST CHRLG0 ;YES--GO STOW CHARACTER
JRST CLSLG2 ;SKIP SOME
;HERE FROM THE /CLOSE SWITCH TO CLOSE THE FILE IF OPEN, ETC.
$CLOSE: STORE T1,LOGSPC,LOGSPC+.FXLEN-1,-1 ;RESET THE SPEC
TLZ F,FL$LOG ;IN CASE OPEN
POPJ P, ;RETURN BYPASSING STORE
CLSLOG: TLNN F,FL$LOG ;LOG OPEN?
POPJ P, ;NO
PUSHJ P,CLGNTS ;DO A COUPLE OF NEW LINES TO SEPARATE
PUSHJ P,CLGNTS ;THE DIFFERENT RUNS
CLSLG2: CLOSE LOGC, ;CLOSE THE CHANNEL
RELEASE LOGC,
TLZ F,FL$LOG ;CERTAINLY NOT OPEN NOW
MOVEI T1,GBHR ;FREE BUFFERS
PJRST TSTBHR
;HERE TO OPEN LOG FILE
LOGOPN: PUSHJ P,.SAVE1## ;PRESERVE P1
MOVE T1,LOGSPC+.FXDEV;GET DEVICE NAME
SOJN T1,LOGO.2 ;JUMP IF DEFAULT NOT NEEDED
STORE T1,LOGSPC,LOGSPC+.FXLEN-1,0 ;NEED DEFAULT--ZERO THE BLOC
MOVSI T1,'DSK' ;USE A GOOD DEFAULT
MOVEM T1,LOGSPC+.FXDEV;REMEMBER WHAT WE DECIDED ON
LOGO.2: MOVE T1,[SIXBIT/COPYMT/] ;MY NAME IN CASE NEEDED
SKIPN LOGSPC+.FXNAM ;DEFAULT NEEDED?
SETOM LOGSPC+.FXNMM
SKIPN LOGSPC+.FXNAM
MOVEM T1,LOGSPC+.FXNAM
HRLOI T1,'LOG' ;DEFAULT EXTENSION
SKIPN LOGSPC+.FXEXT ;SEE IF EXTENSION GIVEN
MOVEM T1,LOGSPC+.FXEXT;NO--SET IT IN
MOVE T1,[XWD .FXLEN,LOGSPC] ;SETUP TO CONVERT SCAN BLOCKS
MOVEI T2,OPNBLK
MOVE T3,[XWD .RBTIM+1,LKPBLK]
MOVEI T4,PTHBLK
MOVSI P1,LOGSPC ;POINT TO SPEC IN CASE OF ERRORS
PUSHJ P,.STOPB## ;CONVERT TO SCAN BLOCKS
JRST WLDERR ;GO DIE IF WILD
MOVEI T1,.RBTIM ;SETUP BLOCK NOW
MOVEM T1,LKPBLK+.RBCNT
MOVEI T1,.IOASC ;IN ASCII
MOVEM T1,OPNBLK+.OPMOD
MOVSI T1,GBHR ;POINT AT BUFFER HEADER
MOVEM T1,OPNBLK+.OPBUF
OPEN LOGC,OPNBLK ;GET THE CHANNEL
JRST OPENER ;CAN'T--DIE
MOVE T2,OPNBLK+.OPDEV;GET THE DEVICE NAME
DEVTYP T2, ;SEE IF SPOOLED OR LOOKUP NOT NEEDED
JRST LOGO.3 ;WE'LL NEVER KNOW
TXNE T2,TY.MAN ;SEE IF LOOKUP/ENTER REQUIRED
TXNE T2,TY.SPL ;SEE IF SPOOLED
JRST [SETZ T1, ;SOME SORT OF SPOOLED DEVICE OR NO LKEN NEEDED
JRST LOGO.4] ;SKIP AHEAD
LOGO.3: SETO T1, ;FLAG THAT FILE EXISTS
LOOKUP LOGC,LKPBLK ;SEE IF FILE LIVES
JRST [HRRZ T1,LKPBLK+.RBEXT ;NO--GET FAIL CODE
JUMPN T1,LKENER ;JUMP IF REALLY AN ERROR
JRST .+1] ;NO--JUMP BACK IN TO ENTER FILE
LOGO.4: ENTER LOGC,LKPBLK ;WRITE THE FILE
JRST LKENER ;CAN'T
SKIPE T1 ;DON'T USETI IF FILE NOT FOUND
USETI LOGC,-1 ;PREPARE TO APPEND TO FILE
MOVSI T1,N$LOGB ;SETUP # BUFFERS
MOVE T2,[XWD OPNBLK,GBHR]
PUSHJ P,.ALCBF## ;ALLOCATE BUFFERS
OUTPUT LOGC, ;DUMMY OUTPUT
TLO F,FL$TSN ;FORCE A TIME STAMP ON FIRST LINE
POPJ P, ;LOG FILE IS OPEN
;HERE TO PUT A TIME STAMP INTO THE LOG FILE
TIMSTM: PUSHJ P,.PSH4T## ;PRESERVE REGISTERS--NO TELLING WHAT MIGHT BE UP
MOVEI T1,CHRLOG ;SETUP THE ROUTINE
PUSHJ P,.TYOCH##
PUSH P,T1 ;SAVE OLD ONE
TLZ F,FL$TSN ;PREVENT RECURSING TO OVERFLOW
PUSHJ P,.TTIMN## ;TYPE THE TIME
PUSHJ P,.TSPAC##
PUSHJ P,.TSPAC##
POP P,T1
PUSHJ P,.TYOCH## ;RESET OUTPUT ROUTINE
PJRST POP4J ;RESTORE REGS AND RETURN
SUBTTL OPEN FILES
OPNOUT: MOVEI T1,OUTSPC ;POINT AT SPEC
PUSHJ P,OPENIO ;OPEN IT
CAI OUTC,@OBHR(.IOBIN)
PUSHJ P,.SAVE3## ;SAVE P1-3
TLNE F,FL$DSO ;DSK OUTPUT?
JRST OPNO$1 ;YES--SKIP SOME
MOVEI T1,MODIND ;GET INDUSTRY MODE VALUE
TLNE F,FL$232 ;/TO32?
MOVEM T1,OUTMOD ;YES--THIS IS THE MODE
MOVEI P1,OUTC ;NO--GET MTCHR.
MTCHR. P1,
SETZ P1, ;SNH
MOVEI P2,OUTSPC ;GET FDB ADDRESS
MOVEI P3,OUTC ;CHANNEL FOR SETCHR
PUSHJ P,SETCHR ;SET DENSITY,PARITY AND MODE
GETSTS OUTC,T1 ;GET CURRENT STATUS
SETSTS OUTC,IO.UWC(T1) ;TELL MON TO USE MY WORD COUNT
OPNO$1: MOVE T1,NOBUFS ;GET USER VALUE FOR OBUFS
TLNE F,FL$DSO ;IF DSK OUTPUT
MOVEI T1,N$DSKB ;SPLURGE A LITTLE
TLNN F,FL$232 ;/TO32?
JRST OPNO$2 ;NO
SKIPG T2,BUFSIZ ;YES--GET /BUFSIZ VALUE
MOVEI T2,DF$BFZ ;NONE--USE DEFAULT
IMULI T2,^D9 ;# 9-BIT BYTES/WORD
IDIVI T2,^D8 ;# WORDS TO HOLD 8 4-BIT BYTES/WORD
ADDI T2,1 ;IN CASE OF PARTIAL WORD
SAVE$ BUFSIZ ;SAVE GIVEN BUFSIZ FOR INPUT OPEN
MOVEM T2,BUFSIZ ;SET AS THE BUFFERSIZE FOR BOTH
JSP L,STBUFZ ;SET UP # BUFFERS AND BUFFER SIZE
RESTR$ BUFSIZ ;PUT BUFSIZ BACK
SKIPA ;SKIP CALL TO STBUFZ
OPNO$2: JSP L,STBUFZ ;SET UP # BUFFERS AND BUFFER SIZE IN T1
SKIPA T2,.+1
XWD OPNBLK,OBHR ;FOR .ALCBF
PUSHJ P,.ALCBF## ;ALLOCATE BUFFERS
OUT OUTC, ;DUMMY OUTPUT
JFCL ;(IN CASE)
MOVSI T1,(BF.IBC) ;GET INHIBIT BUFFER CLEARING BIT
IORM T1,OBHR+.BFADR ;SET IN BUFFER HEADER
TLO F,FL$OPN ;OUTPUT IS OPEN
POPJ P,
OPNINP: MOVEI T1,INPSPC ;POINT AT INPUT SPEC
PUSHJ P,OPENIO ;OPEN ETC
CAI INPC,IBHR(.IOBIN)
PUSHJ P,.SAVE3## ;SAVE P1-3
TLNE F,FL$DSI ;DSK INPUT?
JRST OPNI$1 ;YES
MOVEI P1,INPC ;CHANNEL FOR MTCHR.
MTCHR. P1, ;GET ARGS
SETZ P1, ;SNH
MOVEI P2,INPSPC ;FDB ADDR
MOVEI P3,INPC ;INPUT CHANNEL
MOVEI T1,MODBIN ;GET MODE BINARY VALUE
TLNE F,FL$232 ;/TO32?
MOVEM T1,INPMOD ;YES--SET INPUT MODE
PUSHJ P,SETCHR ;SET DENSITY,PARITY, AND MODE
SKIPLE RTRYFL ;GET RETRY FLAG
JRST [GETSTS INPC,T1 ;AND SET NO RETRY IF DESIRED
SETSTS INPC,IO.NRC(T1);TELL TAPSER TO NOT RETRY
JRST .+1] ;JUMP IN AGAIN
OPNI$1: MOVE T1,NIBUFS ;GET USER VALUE
TLNE F,FL$DSI ;DSK INPUT?
MOVEI T1,N$DSKB ;RUN FAST
JSP L,STBUFZ ;SET UP # BUFFERS AND BUFSIZ IN T1
SKIPA T2,.+1
XWD OPNBLK,IBHR
PUSHJ P,.ALCBF## ;ALLOCATE BUFFER
MOVSI T1,(BF.IBC) ;GET INHIBIT BUFFER CLEARING BIT
IORM T1,IBHR+.BFADR ;SET IN BUFFER HEADER
POPJ P,
INPCLS: CLOSE INPC, ;CLOSE INPUT
RELEASE INPC, ;FREE CHANEL
MOVEI T1,IBHR ;GET BHR
; PJRST TSTBHR ;RELEASE BUFFERS
TSTBHR: SKIPN (T1) ;USE IT?
POPJ P, ;NO--DONE
SAVE$ T1 ;YES--SAVE IT A SEC
PUSHJ P,.FREBF## ;FREE BUFFERS
RESTR$ T1 ;GET BHR ADDR
SETZM .BFADR(T1)
SETZM .BFPTR(T1)
SETZM .BFCTR(T1)
POPJ P,
OUTCLS: TLZN F,FL$OPN ;IS OUTPUT OPEN?
POPJ P, ;NO--QUIT BEFORE WE DIE
GETSTS OUTC,T1 ;GET I/O STATS
TRZ T1,IO.UWC ;CLEAR USER WORD COUNT
SETSTS OUTC,(T1) ;ELSE MON WRITES AN EXTRA RECORD!!
CLOSE OUTC,
RELEASE OUTC,
MOVEI T1,OBHR
JRST TSTBHR
LPTCLS: CLOSE LPTC,
RELEASE LPTC,
MOVEI T1,LBHR
PJRST TSTBHR
STBUFZ: SKIPG T1 ;DID USER SPECIFY BUFFER COUNT?
MOVEI T1,N$BUFS ;NO--USE DEFAULT
SKIPG T2,BUFSIZ ;HOW ABOUT BUFSIZ?
MOVEI T2,DF$BFZ ;NO--DEFAULT
HRLI T1,(T2) ;POSITION
MOVS T1,T1 ;AND SWAP SIDES
JRST (L) ;RETURN
;CALL HERE TO COMPLAIN ABOUT TAPE BEING WRITE LOCKED
WRTLOK: MOVE T1,OUTSPC+.FXDEV;GET NAME
OPER$ EF$WRN!EF$SIX,MWL,<MTA IS WRITE LOCKED - >
OPER$ EF$FTL,JAB,<JOB ABORTED>
REPEAT 0,<
OPER$ EF$INF,WEG,<PLEASE WRITE-ENABLE AND TYPE ANY CHARACTER>
PUSHJ P,GCHNWL ;GET CHAR AND .TCRLF
GETSTS OUTC,T1 ;GET STATUS
TRZ T1,IO.IMP ;CLEAR IO.IMP WHICH GOT US HERE
SETSTS OUTC,(T1) ;AND TELL MON
POPJ P, ;NO--OK TO CONTINUE NOW
>;END REPEAT 0
;ROUTINE TO OPEN OUTPUT WITH NO BUFFERS -- FOR TAPE POSITIONING
OPONOB: MOVEI T1,.IODMP ;DUMP MODE -- WHY NOT?
MOVE T2,OUTSPC+.FXDEV;DEV NAME
SETZ T3, ;NO BUFFERS
OPEN OUTC,T1 ;DO IT
SKIPA T1,[OUTSPC] ;ERROR
POPJ P,
JRST E$$COD ;TELL OF FAILURE
OPINOB: MOVEI T1,.IODMP ;OPEN INPUT WITH NO BUFFERS
MOVE T2,INPSPC+.FXDEV;NAME
SETZ T3, ;NO BUFFERS
OPEN INPC,T1 ;DO IT
SKIPA T1,[INPSPC] ;FAILED!
POPJ P, ;RETURN
JRST E$$COD ;CAN'T OPEN DEVICE
SUBTTL SET TAPE CHARACTERISTICS
;SETCHR -- SET CHARACTERISTICS
;CALL -- MOVE P1,<RESULT OF MTCHR.>
; MOVEI P2,<FDB>
; MOVEI P3,<CHANNEL>
; PUSHJ P,SETCHR
SETCHR: LDB T1,[POINTR (.FXMOD(P2),FX.DEN)] ;GET THE DENSITY
JUMPE T1,SETCH1 ;JUMP IF NO DENSITY GIVEN
XCT DENDIS(T1) ;CHECK LEGALITY AND SETUP T4
MOVE T1,[XWD 3,T2] ;ARG WORD FOR TAPOP.
MOVEI T2,.TFDEN+.TFSET;FUNCTION
MOVE T3,P3 ;CHANNEL NUMBER
PUSHJ P,DOTPOP ;DO TAPOP AND HANDLE ERROR
SETCH1: LDB T1,[POINTR (.FXMOD(P2),FX.PAR)] ;GET PARITY VALUE
XCT PARDIS(T1) ;SET THE PARITY
IFN FT$TST,<
SKIPL TESTFL ;IF /TEST OR /TAPTST THEN IGNORE MODE
POPJ P, ;IGNORE IT
>;END IFN FT$TST
SKIPG T1,MODES-1(P3) ;/MODE FOR THIS SIDE?
POPJ P, ;NO--QUIT
XCT MODISP-1(T1) ;YES--GET TAPOP. ARGUMENT
MOVE T1,[XWD 3,T2] ;TAPOP. ARG WORD
MOVEI T2,.TFMOD+.TFSET;FUNCTION
MOVE T3,P3 ;CHANNEL
PUSHJ P,DOTPOP ;DO TAPOP
POPJ P, ;DONE WITH SETS
PARDIS: JFCL ;ODD PARITY IS THE DEFAULT
PUSHJ P,EVNPAR ;EVEN--MUST SET IT
EVNPAR: MOVE T1,[XWD 3,T2] ;ARG FOR TAPOP.
MOVEI T2,.TFPAR+.TFSET;FUNCTION+SET
MOVE T3,P3 ;CHANNEL
MOVEI T4,1 ;EVEN PARITY
PUSHJ P,DOTPOP ;SET IT
POPJ P,
DENDIS: JFCL ;0--SHOULD BE COVERED ABOVE
PUSHJ P,DEN200 ;1--200 BPI--7 TRACK ONLY
PUSHJ P,DEN556 ;2--556 BPI--7 TRACK ONLY
MOVEI T4,.TFD80 ;3--800 BPI--7/9 TRACK
PUSHJ P,DEN160 ;4--1600 BPI--9 TRACK ONLY
PUSHJ P,DEN625 ;5--6250 BPI--9 TRACK ONLY
DEN556:
DEN200: TRNN P1,MT.7TR ;MUST BE 7 TRACK
E$$ID9: ERROR. EF$FTL,ID9,<ILLEGAL DENSITY FOR 9-TRACK>
MOVE T4,T1 ;SET DENSITY
POPJ P,
DEN625:
DEN160: TRNE P1,MT.7TR ;CAN'T BE 7 TRACK
ERROR. EF$FTL,ID7,<ILLEGAL DENSITY FOR 7-TRACK>
MOVE T4,T1 ;SET DENSITY
POPJ P,
MODISP: PUSHJ P,DEFMOD ;1--DEC COMPATIBLE CORE DUMP (/MODE:BINARY)
PUSHJ P,INDMOD ;2--INDUSTRY COMPATIBLE 8BIT (/MODE:INDUST)
PUSHJ P,MODSVN ;3--SEVENBIT MODE (/MODE:SEVEN) TU70 ONLY
MODSVN: TRNE P1,MT.7TR ;NOT ON 7 TRACK
E$$IM7: ERROR. EF$FTL,IM7,<ILLEGAL MODE FOR 7-TRACK>
MOVEI T4,.TFM7B ;SET SEVEN BIT MODE
POPJ P,
INDMOD: TRNE P1,MT.7TR ;NOT ON 7
JRST E$$IM7 ;TSK,TSK
MOVEI T4,.TFM8B ;8 BIT FORMAT
POPJ P,
DEFMOD: TRNE P1,MT.7TR ;SEVEN OR NINE?
SKIPA T4,[.TFM7T] ;SEVEN
MOVEI T4,<.TFM9T==1> ;NO--NINE
POPJ P,
;DOTPOP -- DO TAPOP WITH ERROR REPORTING
;CALL: MOVE T1,[TAPOP. ARG BLOCK]
; MOVEI T2,<TAPOP. FN>
; MOVE T3,<TAPNAM,IOCHAN OR WHATEVER>
; MOVE T4,<ARG>
; PUSHJ P,DOTPOP
; *RETURN*
DOTPOP: TAPOP. T1, ;DO THE UUO
CAIA ;FAILED--SKIP OVER TO REPORT ERROR
POPJ P, ;OK--QUIT NOW
;ETAPOP -- REPORT TAPOP. UUO FAILURE
;SEE DOTPOP FOR CALLING SEQUENCE
ETAPOP: SAVE$ <T4,T3,T2,T1> ;SAVE T1-4 IN CONSPICUOUS PLACE
WARN. EF$OCT!EF$NCR,TUF,<TAPOP. UUO FAILURE--CODE = >
STRNG$ <, FN = >
MOVE T1,-1(P) ;GET FUNCTION (WAS IN T2)
PUSHJ P,.TOCTW## ;
PUSHJ P,.TCRLF##
RESTR$ <T1,T2,T3,T4>
POPJ P,
SUBTTL DO THE REQUIRED STUFF
DO.IT:
PUSHJ P,.SAVE4## ;SAVE THE REGISTERS
MOVE PLP,PLPINI ;SETUP PARM LIST PTR
STORE T1,FW$STS,LW$STS,0 ;CLEAR STATUS WORDS
TDZA P4,P4 ;CLEAR I/O FLAG (SET TO 2 WHEN INPUT)
OUTDUN: MOVEI P4,2 ;SET I/O FLAG TO 2 (OUTPUT SWTCHES DONE)
DANTHR:
JSP L,TYICHK ;SEE ABOUT TTY COMMANDS
JRST DO.DUN ;SAID TO KILL THE COMMAND
MOVE ACT,1(PLP) ;GET THE FUNCTION
ADDI PLP,2 ;MOVE TO NEXT FUNCTION
JUMPL ACT,@ACTDIS(ACT) ;DISPATCH IMMEDIATELY IF INTERNAL FUNCTION
MOVE P1,ACT ;COPY FOR ACTDIS XCT
SUBI ACT,1 ;COMPUTE ACT CORRECTLY FOR DOLOOP
IMULI ACT,4 ;...
ADD ACT,P4 ;ADD IN OFFSET FOR INPUT/OUTPUT
HLRZ P2,0(PLP) ;GET (POSSIBLE) FILE COUNT
HRRZ P3,0(PLP) ;GET (POSSIBLE) RECORD COUNT
JRST @ACTDIS(P1) ;DISPATCH FOR ACTION
JRST DO.DUN ;(-2) ALL DONE
JRST OUTDUN ;(-1) OUTPUT DONE--INPUT ACTION NEXT
ACTDIS: HALT . ;(0) ILLEGAL
DEFINE FN (X)
<IRP X,<EXP DO.'X>>
FUNCTS ;GENERATE THE DISPATCH TABLE
DO.BSP: DO.SKP: DO.EOF:
DO.REW: DO.UNL:
DOLOOP: JUMPLE P2,DOLOP2 ;JUMP IF NO MORE FILES
DOLOP1: XCT ACTABL(ACT) ;DO THE ACTION
IFN FT$MTP,<
TLNE F,FL$MTP ;MTAPE COMMAND?
JRST WAITCK ;YES
>;END IFN FT$MTP
MTWAT. INPC, ;WAIT FOR THINGS TO STOP
TLNE F,FL$OPN ;ONLY WAIT ON OUTPUT IF OPEN
MTWAT. OUTC,
SOJG P2,DOLOP1 ;DO ALL FILES
DOLOP2: JUMPLE P3,DANTHR ;NO RECORDS?
DOLOP3: XCT ACTABL+1(ACT) ;DO ACTION
IFN FT$MTP,<
TLNE F,FL$MTP ;MTAPE
JRST WAITCK ;YES
>;END IFN FT$MTP
MTWAT. INPC,
TLNE F,FL$OPN ;MAKE SURE CHAN IS OPEN
MTWAT. OUTC,
SOJG P3,DOLOP3
JRST DANTHR
IFN FT$MTP,< ;HERE TO DECIDE IF WE WAIT OR NOT
WAITCK: SOJG P2,MTPWAT ;WAIT IF MORE FILES TO DO
SOJG P3,MTPWAT ;OR MORE RECORDS
HRROI T1,FN$EOL ;GET END OF LIST MARKER
CAMN T1,1(PLP) ;WAIT IF NOT END OF LIST
JRST DANTHR ;END OF LIST--GO EXEC IT
MTPWAT: MTWAT. INPC, ;WAIT FOR OP TO FINISH
JUMPG P2,DOLOP1 ;JUMP IF MORE FILES
JUMPG P3,DOLOP3 ;JUMP IF MORE RECORDS
JRST DANTHR ;NO--DO NEXT COMMAND
>;END IFN FT$MTP
SUBTTL END OF PROCESSING
;HERE WHEN WE ARE ALL DONE
DO.DUN: TLZE F,FL$LPO ;LPT FILE OPEN?
PUSHJ P,LPTCLS ;YES--CLOSE IT
PUSHJ P,INPCLS ;CLOSE INPUT FILE
TLNE F,FL$MRG!FL$DSO ;MERGING? (OR DSK OUTPUT?)
JRST DODUN1 ;YES--NO EOF TO BSP OVER
TLNE F,FL$EOT ;DID WE STOP AT DOUBLE EOF?
MTBSF. OUTC, ;YES--BACK OVER ONE OF THEM
DODUN1: PUSHJ P,OUTCLS ;CLOSE OUTPUT
IFN FT$MTP,<
TLNE F,FL$MTP ;MTAPE COMMAND?
POPJ P, ;YES--RETURN NOW
>;END IFN FT$MTP
SKIPLE TIMEFL ;IF REQUESTED
PUSHJ P,TYISTS ;TELL TOTAL TIME + CPU TIME USED
SKIPG TIMEFL ;IF TIME NOT REQUESTED
PUSHJ P,TYITOT ;THEN SHOW FILE, RECORD COUNTS NOW
ERRCHK: MOVEI P1,1 ;SET INDEX TO REPORT ERRORS
TELERS: MOVE T1,ERRCNT(P1) ;GET COUNT
INFO. EF$NCR!EF$DEC,IOT,<TOTAL OF >
MOVE T1,ERRMES(P1) ;END THE MESSAGE
PUSHJ P,.TSTRG## ;...
PUSHJ P,.TCRLF## ;NEW LINE
IFN FT$TST,< ;ONLY DO OUTPUT IF /T
TLNN F,FL$TST ;/T?
>;END IFN FT$TST
SOJGE P1,TELERS ;TELL INPUT TOO
POPJ P, ;**DO.IT RETURN
ERRMES: [ASCIZ / INPUT ERRORS]/]
[ASCIZ / OUTPUT ERRORS]/]
SUBTTL PROCESS TELETYPE COMMANDS WHILE RUNNING
;TYICHK -- ATTEND TO TTY INPUT FROM TERMINAL
;CALL: JSP L,TYICHK
; *USER SAID TO QUIT*
; *KEEP GOING*
TYICHK: TLNN F,FL$BAT!IFN FT$MTP,<FL$MTP> ;BATCH JOB?
TLNN F,FL$ITY ;OR NOT /IFTYP
JRST 1(L) ;YES--RETURN QUICKLY
INCHRS T1 ;CHAR TYPED?
JRST 1(L) ;NO--QUICK RETURN
CLRBFI ;YES--EAT THE REST
ADDI L,1 ;BUMP TO RETURN
SAVE$ L ;REMEMBER IT ON THE STACK
PUSHJ P,.TCRLF## ;NEW LINE -- .TCRLF SAVES T1
MOVSI T2,-N$TYIO ;GET AOBJN LOOP CTR
CAME T1,IFTCHR(T2) ;THIS IT?
AOBJN T2,.-1
JUMPL T2,@TYIDSP(T2) ;JUMP IF GOT ONE
MOVEI T1,.CHBEL ;NO--GET A BELL
PJRST .TCHAR## ;BELL AND RETURN
IFTCHR: EXP "E","I","K","P","S" ;ERROR COUNT,IGNORE, KILL, PAUSE,STATS
N$TYIO==.-IFTCHR
TYIDSP: EXP ERRSUM,TYIIGN,TYIKIL,TYIPAU,TYISTS
TYIIGN: TLZ F,FL$ITY ;CLEAR IFTYP FLAG
POPJ P, ;SKIP BACK
ERRSUM: PUSHJ P,.SAVE1## ;WE USE P1 FOR THIS
PJRST ERRCHK ;TELL ERROR SUMMARIES
TYIPAU: INFO. 0,PTC,<PAUSING--TYPE ANY CHARACTER TO CONTINUE>
PJRST GCHNWL ;GET IT AND RETURN
TYIKIL: WARN. 0,FKC,<FUNCTION KILLED BY COMMAND>
SOS 0(P) ;CPOPJ PLEASE
POPJ P, ;CPOPJ TO DO A KILL
TYISTS: MSTIME T1, ;CURRENT TYME
SUB T1,GOTIME ;GET ELAPSED TIME
PUSHJ P,.TTIME## ;TYPE IT
STRNG$ < ELAPSED TIME
>
SETZ T1, ;MY RUNTIME
RUNTIM T1,
SUB T1,GORUNT ;ELAPSED RUNTIME
PUSHJ P,.TTIME## ;TYPE IT
STRNG$ < CPU TIME
>
TYITOT: TLNE F,FL$TST ;ARE WE TESTING TAPE?
POPJ P, ;YES--WE REALLY SHOULD NOT BE HERE
SKIPG T1,FILTOT ;ANY FILES TODAY?
JRST TYIT.2 ;NO
PUSHJ P,.TDECW## ;YES--SHOW THEM
STRNG$ < FILES, >
TYIT.2: MOVE T1,RECTOT ;GET RECORD TOTAL
PUSHJ P,.TDECW##
PJSP T1,.TSTRG## ;TYPE AND RETURN
ASCIZ . RECORDS COPIED
.
;HERE TO SET UP FOR MERGING
DO.CON: TLNN F,FL$DSO ;UNLESS DSK OUTPUT
TLO F,FL$MRG ;FLAG WE ARE MERGING
;(WILL HANDLE OTHER CORRECTLY)
;HERE TO COPY DATA FROM INPUT TO OUTPUT
DO.CPY:
TLNE F,FL$DSI ;DSK TO TAPE?
JRST [SETZ P2, ;YES--MAKE SURE FILE COUNT IS 0
JRST CPYDTM] ;AND GO COPY DSK TO TAPE
TLNE F,FL$DSO ;NO--TAPE TO DSK
JRST CPYMTD ;YES
TLNN F,FL$OPN ;MAKE SURE OUTPUT TAPE IS OPEN
PUSHJ P,OPNOUT ;GOOD THING WE CHECKED
COPYIT: SKIPG P2 ;FILE COUNT NOT ZERO?
SOJL P3,COPDUN ;YES--RECORDS RUN OUT?
PUSHJ P,XCTIO ;NO--GET A BUFFER
IN INPC, ; XCT'D
JRST CPYEOF ;END OF FILE
TLNE F,FL$232 ;/TO32 BIT?
JRST CPY232 ;YES--GO THERE
HRLZ T1,IBHR+.BFPTR ;COPY FROM INPUT
HRR T1,OBHR+.BFPTR ;TO OUTPUT BUFFER
AOBJP T1,.+1 ;BUT THEY ARE OFF BY ONE!
MOVE T2,IBHR+.BFCTR ;GET THE INPUT COUNT
HRRM T2,-1(T1) ;SET COUNT FOR MONITOR--IO.UWC IS ON
ADDM T2,IBHR+.BFPTR ;INCREASE THE POINTER
ADDB T2,OBHR+.BFPTR ;AND GET BLT TERMINATION PTR
SETZM IBHR+.BFCTR ;CLEAR COUNTER
BLT T1,(T2) ;COPY THE BUFFER
CPYDMP: PUSHJ P,XCTIO ;OUTPUT IT
OUT OUTC, ;...
JRST FULTAP ;HELP! TAPE IS FULL
TLZ F,FL$EOT ;FLAG DID OUTPUT (SET AT EOF ON INPUT)
AOS RECTOT ;COUNT RECORD
JSP L,TYICHK ;SEE ABOUT USER INPUT
JRST DO.DUN ;YES--SAID TO KILL IT
JRST COPYIT ;LOOP FOR MORE
SUBTTL COPY 36-BIT TO 32 BIT
CPY232: PUSHJ P,THRTY2 ;CALL A ROUTINE SO WE CAN SAVE REGISTERS
JRST CPYDMP ;GO DUMP THE BUFFER
THRTY2: PUSHJ P,.SAVE3## ;SAVE SOME REGISTERS
MOVE P1,IBHR+.BFCTR ;INPUT WORD COUNT
IMULI P1,^D9 ;# 4-BIT BYTES
MOVSI P2,(POINT 4) ;SETUP 4-BIT BYTE PTR
HRR P2,IBHR+.BFPTR ;GET THE PTR
HRRI P2,1(P2) ;POINT AT THE DATA
MOVSI P3,(POINT 8) ;FORM BYTE PTR TO STORE 8-BIT BYTES
HRR P3,OBHR+.BFPTR
HRRI P3,1(P3)
LUP32: ILDB T1,P2 ;GET A BYTE
LSH T1,4 ;POSITION TO HIGH FOUR BITS
ILDB T2,P2 ;GET NEXT BYTE
OR T1,T2 ;FORM A WORD
IDPB T1,P3 ;STORE 8 BITS
SUBI P1,2 ;COUNT BYTES USED
JUMPG P1,LUP32 ;JUMP IF NOT DONE YET
HRRZ T1,OBHR+.BFPTR ;GET THE OUTPUT PTR
MOVEI T2,(P3) ;BEGIN TO COMPUTE WORDS TO OUTPUT
SUBI T2,(T1) ;COMPUTE THEM
HRRM T2,(T1) ;SET FOR IO.UWC
MOVE T1,IBHR+.BFCTR ;GET INPUT WORD COUNT
SETZM IBHR+.BFCTR ;CLEAR INPUT WORD COUNT
ADDM T1,IBHR+.BFPTR ;LET MON KNOW WE USED THE BUFFER UP
POPJ P, ;RETURN TO WRITE BUFFER
SUBTTL COPY DSK TO MAGTAPE IN PHYSICS (IREAD) FORMAT
CPYDTM: JSP L,TYICHK ;SEE ABOUT THE TTY
JRST DO.DUN ;SAID TO KILL
SOJL P3,COPDUN ;DONE COPYING RECORDS? (OR WHOLE FILE?)
CPDM$A: JSP L,CKIBUF ;MAKE SURE BUFFER HAS GOODIES
JRST CPYEOF ;DONE--EOF
ILDB T3,IBHR+.BFPTR ;RECORD LENGTH
SOS IBHR+.BFCTR ;COUNT WHAT WE READ
JUMPE T3,CPDM$A ;IGNORE 0 LENGTH RECORDS (PROBABLY ERROR)
TLNE T3,-1 ;NO RECORDS THIS LONG EITHER!
JRST CPDM$A ;WE ARE PROBABLY LOST...
MOVE T2,OBHR+.BFADR ;ADDRESS CURRENT BUFFER
HRRM T3,1(T2) ;SET FOR IO.UWC
MOVEM T3,LSTBFZ ;SAVE IN CASE OF TOO LARGE RECORD
CPDM$0: JSP L,CKIBUF ;MAKE SURE SOMETHING IN INPUT BUFFER
JRST CPYEOF ;DSK END OF FILE
MOVE T1,IBHR+.BFCTR ;GET COUNT IN BUFFER
CPDM$1: CAIGE T3,(T1) ;CAN WE MOVE IT ALL?
MOVEI T1,(T3) ;NO--JUST PART
HRLZ T2,IBHR+.BFPTR ;INPUT ADDRESS
HRR T2,OBHR+.BFPTR ;TO OUTPUT
AOBJP T2,.+1 ;OFF BY ONE THO
ADDM T1,IBHR+.BFPTR ;UPDATE PTRS
ADDM T1,OBHR+.BFPTR ;...
MOVN T1,T1 ;- COUNT
ADD T3,T1 ;UPDATE WDS TO GO
ADDM T1,IBHR+.BFCTR ;UPDATE COUNTS
ADDB T1,OBHR+.BFCTR ;AND CHECK FOR REC TOO LARGE
JUMPL T1,BFTSML ;JUMP IF TOO SMALL
BLT T2,@OBHR+.BFPTR ;MOVE WORDS
JUMPG T3,CPDM$0 ;JUMP IF REC NOT DONE
AOS RECTOT ;COUNT THE RECORD
PUSHJ P,XCTIO ;YES--DUMP THE RECORD
OUT OUTC,
JRST FULTAP ;GET ANOTHER TAPE
JRST CPYDTM ;DO NEXT RECORD
BFTSML: MOVE T1,LSTBFZ ;GET SIZE OF OFFENDER
ERROR. EF$DEC!EF$FTL,BTS,<MTA BUFFER TOO SMALL FOR REC LENGTH = >
SUBTTL COPY MAGTAPE TO DSK FILE (IREAD FORMAT)
CPYMTD: SKIPG P2 ;FILES LEFT
SOJL P3,COPDUN ;OR RECORDS
JSP L,CKIBUF ;YES--SEE IF INPUT THERE
JRST CPYEOF ;ALL DONE
JSP L,TYICHK ;SEE ABOUT TTY
JRST DO.DUN ;SAID TO HANG IT UP
AOS RECTOT ;COUNT RECORDS COPIED
MOVE T4,IBHR+.BFCTR ;GET SIZE OF RECORD
SKIPLE OBHR+.BFCTR ;ROOM TO STORE WORD COUNT?
JRST CPMD$0 ;YES
PUSHJ P,XCTIO ;NO
OUT OUTC,
JRST E$$DIF ;**DSK IS FULL
TLZ F,FL$EOT ;WE HAVE WRITTEN DATA
CPMD$0: IDPB T4,OBHR+.BFPTR ;STORE IN OUTPUT
SOS OBHR+.BFCTR ;COUNT IT
CPMD0A: SKIPG IBHR+.BFCTR ;ANY WORDS LEFT THIS RECORD?
JRST CPYMTD ;NO--GET NEXT RECORD
CPMD$1: SKIPLE OBHR+.BFCTR ;ROOM IN OUTPUT?
JRST CPMD$2 ;YES
PUSHJ P,XCTIO ;NO--DUMP BUFFER
OUT OUTC,
JRST E$$DIF ;**DSK IS FULL
TLZ F,FL$EOT ;WE HAVE WRITTEN DATA
CPMD$2: MOVE T1,IBHR+.BFCTR ;GET INPUT COUNT
CAMLE T1,OBHR+.BFCTR ;ROOM FOR IT ALL?
MOVE T1,OBHR+.BFCTR ;NO--MOVE WHAT WE CAN
HRLZ T2,IBHR+.BFPTR ;SETUP AOBJN WORD
HRR T2,OBHR+.BFPTR ;...
AOBJP T2,.+1 ;OFF BY ONE AS USUAL
ADDM T1,IBHR+.BFPTR ;UPDATE PTRS
ADDM T1,OBHR+.BFPTR
MOVN T1,T1 ;- COUNT
ADDM T1,IBHR+.BFCTR ;UPDATE COUNTERS
ADDM T1,OBHR+.BFCTR
BLT T2,@OBHR+.BFPTR ;MOVE DATA
JRST CPMD0A ;LOOP FOR REST OF RECORD
E$$DIF: ERROR. EF$ERR,DIF,<DSK IS FULL -- ABORTING>
JRST DO.DUN
;CKIBUF -- SEE IF ANY INPUT THERE AND DO IN IF NOT
;CALL: JSP L,CKIBUF
; *EOF*
; *DATA IN BUFFER*
CKIBUF: SKIPLE IBHR+.BFCTR ;ANYTHING THERE?
JRST 1(L) ;YES--SKIP BACK
PUSHJ P,XCTIO ;NO--GET NEXT RECORD
IN INPC, ;XCT'D
JRST (L) ;EOF
JRST 1(L) ;GOT DATA
;THIS TABLE IS XCT'D TO DO THE PROPER FUNCTION
;THE ORDER IS:
; OUTPUT FILE ACTION
; OUTPUT RECORD ACTION
; INPUT FILE ACTION
; INPUT RECORD ACTION
ACTABL: MTBSF. OUTC,
MTBSR. OUTC,
MTBSF. INPC,
MTBSR. INPC,
MTSKF. OUTC,
MTSKR. OUTC,
MTSKF. INPC,
MTSKR. INPC,
JSP L,OMTEOF
JSP L,OMTEOF
JSP L,OMTEOF ;/EOF ON INPUT SIDE ONLY EOF'S OUTPUT TAPE
JSP L,OMTEOF ;...
MTREW. OUTC,
MTREW. OUTC,
MTREW. INPC,
MTREW. INPC,
MTUNL. OUTC,
MTUNL. OUTC,
MTUNL. INPC,
MTUNL. INPC,
OMTEOF:
IFN FT$MTP,<
TLNE F,FL$MTP ;MTAPE COMMAND?
JRST OMTEF1 ;YES--EOF INPUT SIDE THEN
>;END IFN FT$MTP
MTEOF. OUTC,
TLZ F,FL$MRG ;NOT MERGING ANY MORE
JRST (L)
IFN FT$MTP,<
OMTEF1: MTEOF. INPC, ;EOF INPUT IF MTAPE CMD
JRST (L) ;RETURN
>;END IFN FT$MTP
COPDUN: TLNE F,FL$MRG ;MERGING?
JRST DANTHR ;YES--CRUISE ON
PUSHJ P,OUTCLS ;CLOSE OUTPUT
HRROI T1,FN$EOL ;GET EOL FUNCTION
CAMN T1,1(PLP) ;END OF LIST FUNCTION NEXT?
TLZA F,FL$EOT ;YES--DON'T REOPEN OUTPUT AND CLEAR FL$EOT
PUSHJ P,OPNOUT ;NO--REOPEN OUTPUT
JRST DANTHR ;GO PROCESS THE NEXT FUNCTION
;HERE ON INPUT END-OF-FILE
CPYEOF: PUSHJ P,INPCLS ;CLOSE INPUT
TLOE F,FL$EOT ;SET/CHECK EOT FLAG
JRST DO.DUN ;YES--GO FINISH UP
TLNE F,FL$DSI ;DSK IN?
JRST CPYEFA ;YES--GO FINISH UP
AOS FILTOT ;COUNT A FILE AS DONE
PUSHJ P,OPNINP ;RE-OPEN INPUT
TLNE F,FL$MRG ;MERGING?
SOJA P2,COPYIT ;YES--DEC FILE COUNT AND GO
TLNE F,FL$DSO ;NO--DSK OUTPUT?
SOJA P2,CPYMTD ;YES--CONTINUE THERE
PUSHJ P,OUTCLS ;NO--CLOSE OUTPUT FILE
SOJG P2,CPYEF0 ;JUMP IF MORE TO DO
JUMPG P3,CPYEF0 ;OR IF MORE RECORDS
TLZ F,FL$EOT ;CLEAR EOT FLAG IN CASE MORE COPYING LATER
JRST DANTHR ;NO MORE COPYING--GO GET NEXT FUNCTION AND DISP
CPYEFA: TLZ F,FL$EOT ;NOTHING ELSE TO DO--CLEAR EOT FLAG FOR DO.DUN
JRST DO.DUN ;AND THEN GO THERE
CPYEF0: PUSHJ P,OPNOUT ;OPEN OUTPUT AGAIN
JRST COPYIT ;GO AGAIN
;HERE WHEN TAPE IS FULL
FULTAP: GETSTS OUTC,T1 ;GET STS BITS
TRZ T1,IO.EOT ;CLEAR SO WE CAN DUMP BUFFERS
SETSTS OUTC,(T1) ;TELL TAPSER
OPER$ EF$WRN,OTF,<OUTPUT TAPE IS FULL>
PUSHJ P,OUTCLS ;CLOSE OUTPUT FILE (WRITE EOFS)
ASKEOO: PUSHJ P,TYPDLR ;TYPE CRLF-$ IF BATCH
STRNG$ <OPTION (H FOR HELP): >
PUSHJ P,GCHNWL ;GET CHAR + .TCRLF
MOVSI T2,-N$EOTO ;AOBJN
CAME T1,EOTOPT(T2) ;CHECK THEM
AOBJN T2,.-1
JUMPL T2,@EOTDSP(T2) ;JUMP IF GOOD ANSWER
EOTHLP: SKIPA T1,.+1 ;LOAD UP FILNAME
SIXBIT /CMTETH/ ;COPYMT END-OF-TAPE HELP
PUSHJ P,TYHELP ;TYPE SOME HELP
JRST ASKEOO ;ASK AGAIN
EOTOPT: EXP "C","E","H","R","U"
N$EOTO==.-EOTOPT
EOTDSP: EXP FULCON
EXP EOTXIT
EXP EOTHLP
EXP EOTREW
EXP EOTUNL
EOTXIT: EXIT 1, ;EXIT TO MONITOR
JRST ASKEOO ;ON CONTINUE GO FOR ANOTHER ONE
EOTUNL: PUSHJ P,OPONOB ;OPEN -- NO BUFFERS
MTUNL. OUTC, ;UNLOAD
JRST EOTFIN ;CLOSE TAPE OUT
EOTREW: PUSHJ P,OPONOB ;OPEN WITH NO BUFFERS
MTREW. OUTC, ;REWIND MTA
EOTFIN: RELEASE OUTC, ;CLOSE DEVICE
JRST ASKEOO ;WAIT FOR CONTINUE
FULCON: PUSHJ P,OPNOUT ;OPEN OUTPUT TAPE
TLNE F,FL$DSI ;DSK INPUT?
JRST CPYDTM ;YES--CONTINUE THERE, ELSE
JRST COPYIT ;CONTINUE COPYING
SUBTTL TAPE TESTING
IFN FT$TST,< ;ALL UNDER FT$TST
TESTIT: PUSHJ P,.SAVE4## ;SAVE P1-4
TEST.2: MTREW. OUTC, ;REWIND OUTPUT TAPE
SETZM OUTERS ;CLEAR ERROR COUNT FOR "E" IFTYPE CMD
TLO F,FL$TST ;FLAG /T IN PROGRESS
MOVE T1,OUTSPC+.FXDEV;GET NAME
INFO. EF$SIX!EF$NCR,NTT,<TESTING >
PUSHJ P,.TCOLN## ;TYPE A COLON
STRNG$ </RETRY:>
SKIPG T1,NUMTRY ;GET # TRIES
MOVEI T1,DF$TRY ;NO--ON SECOND THOUGHT, USE THE DEFAULT
MOVEM T1,NUMTRY ;REMEMBER IT FOR LATER
PUSHJ P,.TDECW## ;TYPE # RETRIES
STRNG$ </REPEAT:> ;TELL HOW MANY TIMES WE ARE REPEATING
SKIPG T1,RPETFL
MOVEI T1,1
PUSHJ P,.TDECW##
STRNG$ </DENSITY:>
MOVE T1,TSTDEN ;GET TEST DENSITY
MOVEI T1,DENSTR-1(T1) ;GET ASCIZ STRING FOR IT
PUSHJ P,.TSTRG## ;SEND IT
STRNG$ </TRACK:>
MOVE T1,ODVNAM ;GET REAL NAME
MTCHR. T1, ;SEE IF SEVEN OR NINE-TRACK
SETZ T1, ;NEVER KNOW
TRNE T1,MT.7TR ;SEVEN?
SKIPA T1,[EXP 7]
MOVEI T1,^D9 ;NINE
PUSHJ P,.TDECW## ;TYPE 7 OR 9
MOVEI T1,[ASCIZ/]
/]
PUSHJ P,.TSTRG## ;END INFO
MTWAT. OUTC, ;WAIT NOW WHILE TTY IS BUSY
GETSTS OUTC,T1 ;GET STATUS
SETSTS OUTC,IO.NRC(T1) ;TELL TAPSER TO NOT RETRY
SETZB P1,P3 ;P1=RECORD COUNT, P3=TOTAL ERRORS
JSP T1,RESTRY ;RESET THE RETRY COUNTER
SKIPG P4,TESTFL ;GET VALUE OF /TEST:N
HRLOI P4,377777 ;JUST /T...DO WHOLE TAPE
PUSHJ P,TSTBUF ;TEST THE TAPE
ENDTST: PUSHJ P,OUTCLS ;CLOSE OUTPUT
PUSHJ P,OPONOB ;OPEN FOR REWINDING
SKIPG TESTFL ;UNLESS USER ONLY WANTED PART TESTED
MTREW. OUTC, ;REWIND IT
MOVE T1,P3 ;COPY ERROR COUNT
INFO. EF$DEC,TNE,<TOTAL NUMBER OF ERRORS = >
MOVE T1,P1 ;REC TOTAL=LENGTH
INFO. EF$DEC!EF$NCR,TLI,<TAPE LENGTH = >
MOVEI T1,[ASCIZ/ FEET]
/]
PUSHJ P,.TSTRG## ;
SKIPLE TIMEFL ;IF /TIME
PUSHJ P,TYISTS ;THEN DO IT
IFN FT$DEB,<
SOSG T1,BUFZER ;SEE IF MON CLEARED BUFFERS DESPITE UU.IBC
PJRST TEST.4 ;NO--FINISH UP
INFO. EF$DEC,MCB,<MON CLEARED BUF = >
>;END IFN FT$DEB
TEST4: SKIPG TESTFL ;IF USER SAID /TEST:N
SOSG RPETFL ; OR /REPEAT:1 OR NO /REPEAT AT ALL
PJRST OUTCLS ; THEN JUST CLOSE OUTPUT AND RETURN
;***UNCOMMENT NEXT LINE IF WANT TO NOT DO MULTIPLE RETRIES IF TAPE OK
; JUMPLE P3,OUTCLS ;IF TAPE IS OK, THEN SKIP MULTIPLE PASSES
PUSHJ P,OUTCLS ;NO /TEST:N AND .GT. /REPEAT:1
PUSHJ P,OPNOUT ; SO REOPEN THE OUTPUT TAPE
TLNN F,FL$LOG ; ARE WE LOGGING ALL OF THIS?
JRST TEST.2 ;NO--JUST GO AHEAD
PUSHJ P,CLGNTS ;YES--SEPARATE THE RUNS
PUSHJ P,CLFLOG
JRST TEST.2 ;GO TEST IT NOW
DENSTR: ASCIZ /200/ ;1--200 BPI
ASCIZ /556/ ;2--556
ASCIZ /800/ ;3--800
ASCIZ /1600/ ;4--1600
ASCIZ /6250/ ;5--6250
RESTRY: MOVN P2,NUMTRY ;GET -(NUMBER OF RETRIES)
HRLZ P2,P2 ;PUT IN THE LH FOR AN AOBJN
JRST (T1) ;RETURN
TSTBUF: JSP L,TYICHK ;SEE ABOUT USER INPUT
POPJ P, ;SAID TO KILL IT OFF
SOJL P4,.POPJ## ;CHECK FOR REC COUNT OUT
MOVE T1,OBHR+.BFPTR ;GET PTR
MOVE T2,OBHR+.BFCTR ;AND COUNT
HRRM T2,(T1) ;SET IN BUFFER SO IO.UWC WORKS
SETZM OBHR+.BFCTR ;IN CASE IO.UWC DOESN'T WORK
ADDB T2,OBHR+.BFPTR ;ADJUST PTR AND GET BLT TERM (IN CASE
; UU.IBC DIDN'T WORK)
SKIPE 1(T1) ;MON CLEAR THE BUFFER (OR FIRST TIME)?
JRST BFOTST ;NO--SKIP AHEAD
SETOM 1(T1) ;YES--MAKE IT ALL ONES
HRLI T1,1(T1) ;FORM BLT WORD
HRRI T1,2(T1) ;...
BLT T1,(T2) ;FILL THE BUFFER
IFN FT$DEB,<AOS BUFZER> ;COUNT THE TIMES MON CLEARED BUFFER
BFOTST: OUT OUTC, ;DUMP THE BUFFER
AOSA P1 ;OK--COUNT REC AND SKIP
JRST OCHERR ;OOPS--PONDER THE ERROR
HRRZ T1,P2 ;GET ERROR RETRIES
JUMPE T1,TSTBUF ;JUMP IF FIRST TRY THIS RECORD
PUSHJ P,.TDECW## ;NO--TYPE # OF TRIES
STRNG$ < ATTEMPTS TO WRITE TAPE AT >
MOVE T1,P1 ;REC #
PUSHJ P,.TDECW##
PUSHJ P,TYFEET ;FEET<CRLF>
OCHIEC: JSP T1,RESTRY ;RESET THE RETRY COUNTER IN P2
AOS OUTERS ;COUNT OUTPUT ERROR
AOJA P3,TSTBUF ;COUNT ERROR AND LOOP
OCHERR: GETSTS OUTC,T2 ;GET ERROR BITS
TRNE T2,IO.EOT ;END OF TAPE?
POPJ P, ;YES--DONE WITH TEST
TRZ T2,IO.ERR ;CLEAR ERROR BITS
SETSTS OUTC,(T2) ;TELL MON
AOBJN P2,OCHFIX ;COUNT AND JUMP IF NOT ENOUGHT TRIES
ADDI P1,1 ;COUNT THE RECORD
MOVE T1,NUMTRY ;GET # TRIES
WARN. EF$DEC!EF$NCR,FAR,<FAILED AFTER >
STRNG$ < TRIES AT >
MOVE T1,P1 ;GET RECORD COUNT
PUSHJ P,.TDECW## ;SHO THE FEET
PUSHJ P,TYFEET ;TYPE FEET<CRLF>
JRST OCHIEC ;GO FIX UP ERROR COUNTERS
OCHFIX: MTBSR. OUTC, ;BACKSPACE A RECORD (ONE IN ERROR)
MTWAT. OUTC, ;WAIT FOR IT
JUMPLE P1,TSTBUF ;IF FIRST REC THEN ALL DONE
MTBSR. OUTC, ;BACKSPACE ANOTHER
MTWAT. OUTC, ;WAIT
MTSKR. OUTC, ;FORWARD ONE
MTWAT. OUTC, ;WAIT
JRST TSTBUF ;GO AGAIN
>;END IFN FT$TST
SUBTTL FIND BUFFER IN ERROR
REPEAT 0,< ;NOBODY USES IT YET
;FNDBFE -- FIND BUFFER IN ERROR
;CALL: MOVE T1,<1ST WORD OF BUFFER HEADER>
; PUSHJ P,FNDBFE
; *NOT FUND*
; *FOUND--T1 HAS COUNTER OF # BUFS FROM PRESENT ONE,,PTR TO IT
FNDBFE: PUSHJ P,.SAVE3## ;NEED REGS
SETZ P3, ;CLEAR COUNT
HRRZ P1,T1 ;COPY PTR
BFELUP: MOVE P2,-1(P1) ;GET STATUS BITS
ANDI P2,IO.IMP!IO.DER!IO.BKT!IO.DTE
JUMPN P2,GOTBFE ;JUMP IF FOUND SOME ERROS
HRRZ P1,(P1) ;NO--MOVE ALONG RING
CAME P1,T1 ;BACK TO WHERE WE STARTED?
AOJA P3,BFELUP ;NO--COUNT AND LOOP
RTZER: SETZ T1, ;NONE FOUND
POPJ P,
;HERE WITH FOUND BUFFER IN ERROR
GOTBFE: ANDCAM P2,-1(P1) ;CLEAR ERROR BITS
HRLZ T1,P3 ;COUNT
HRRI T1,(P1) ;BUFFER ADDR
JRST .POPJ1## ;SKIP BACK
>;END REPEAT 0
SUBTTL OPENIO OPENS I/O CHANNELS
;OPENIO
;CALL: MOVEI T1,<FDB ADDR>
; PUSHJ P,OPENIO
; CAI CHANNEL,BUFADR ;@ IF OUTPUT, (MODE)
; *ALL IS WELL RETURN* ;ABORT IF FAIL
OPENIO: HRL T1,0(P) ;REMEMBER CALLER
AOS (P) ;DO A SKIP BACK
PUSHJ P,.SAVE3## ;PRESERVE REGISTERS
MOVS P1,T1 ;COPY ARGUMENTS
MOVE P2,(P1) ;GET REST OF THEM
MOVSI T1,.FXLEN ;SETUP FOR .STOPB
HLR T1,P1 ;...
MOVEI T2,OPNBLK ;
SKIPA T3,.+1
.RBTIM+1,,LKPBLK
MOVEI T4,PTHBLK ;PATCH
PUSHJ P,.STOPB## ;CONVERT TO OPEN/LOOKUP BLOCKS
JRST WLDERR ;NO WILDCARDING!
DOOPEN: MOVEI T1,.RBTIM ;SETUP COUNT
MOVEM T1,LKPBLK+.RBCNT
LDB T1,[POINT 4,P2,17] ;GET MODE
MOVEM T1,OPNBLK+.OPMOD;STORE IN OPEN BLOCK
HRRZ T1,P2 ;BUFFER HEADER ADDRESS
TLNE P2,ATSIGN ;READ OR WRITE?
MOVSS T1 ;WRITING, POSITON FOR IT
MOVEM T1,OPNBLK+.OPBUF;STORE
LDB P3,[POINT 4,P2,12] ;GET I/O CHANNEL
MOVSI T1,(UU.IBC) ;GET INHIBIT BUFFER CLEARING BIT
CAIN P3,OUTC ;IF OUTPUT CHANNEL
TLO T1,(UU.SOE) ;THEN STOP ON ERROR ALSO
CAIE P3,LPTC ;UNLESS LINE PRINTER CHANNEL
IORM T1,OPNBLK+.OPMOD;STORE IN OPEN BLOCK
LSH P3,5 ;POSITION CHANNEL
MOVSS P3 ;IN CHANNEL POSITION
MOVE T1,[OPEN OPNBLK];FORM INSTR
OR T1,P3 ;FINISH
XCT T1 ;TRY TO OPEN DEVICE
JRST OPENER ;CAN'T--BOMB OUT
MOVE T1,P3 ;REGET I/O CHANNEL
TLNE P2,ATSIGN ;READ/WRITE?
TLOA T1,(ENTER) ;WRITE
TLO T1,(LOOKUP) ;READ
HRRI T1,LKPBLK ;COMPLETE INSTR
XCT T1 ;FIND/WRITE THE FILE
JRST LKENER ;CAN'T
POPJ P, ;RETURN
;OPENIO ERRORS
OPENER: HLRZ T1,P1 ;COPY FDB ADDR
E$$COD: ERROR. EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >
WLDERR: MOVE T1,OPNBLK+.OPDEV;GET DEVICE
DEVCHR T1, ;MAKE SURE MTA
TLNN T1,(DV.MTA) ;IS IT?
JRST WLDNMT ;NO
JRST DOOPEN ;YES--GO ON
WLDNMT: HLRZ T1,P1 ;GET FDB
E$$DNM: ERROR. EF$FTL!EF$FIL,DNM,<DEVICE NOT A MAGTAPE - >
LKENER: HRRZ T1,LKPBLK+.RBEXT;GET FAIL CODE
ERROR. EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
STRNG$ <) FILE >
HLRZ T1,P1
PUSHJ P,.TFBLK## ;TYPE SCAN BLOCK
PUSHJ P,.TCRLF## ;NEW LINE
JRST ERRFTL ;GO DIE
;SCAN BLOCK FOR LPT SPEC
LPTSPC: SIXBIT /LPT/ ;.FXDEV
EXP MY$NAM ;.FXNAM
EXP -1 ;.FXNMM
'LPT',,-1 ;.FXEXT
BLOCK .FXLEN-.FXEXT ;THE REST
SUBTTL XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING
;XCTIO
;CALL: PUSHJ P,XCTIO
; <INSTR TO XCT> ;IN/OUT UUO
; *EOF/EOT RETURN*
; *NORMAL RETURN*
XCTIO: SAVE$ T1 ;SAVE POSSIBLE CHAR/WORD
MOVE T1,@-1(P) ;GET INSTR TO XCT
AOS -1(P) ;SKIP INSTR ON RETURN
PUSHJ P,XCTIOD ;DO THE I/O
AOS -1(P) ;OK--SKIP BACK
JRST TPOPJ ;RESTOR T1 AND RETURN
;THIS ROUTINE DOESN'T SKIP IF XCTIO SHOULD, AND SKIPS IF XCTIO SHOULDN'T
XCTIOD: XCT T1 ;DO THE UUO
POPJ P, ;OK--CPOPJ SO XCTIO WILL CPOPJ1
PUSHJ P,.SAVE2## ;ERROR--SAVE P1 - 2
SAVE$ T1 ;SAVE OPERATION IN CASE OPTION=S
XCTIOE: AND T1,[17B12] ;ERROR--GET THE CHANNEL
; MOVE P1,T1 ;COPY CHANNEL
; OR P1,[WAIT] ;FORM UUO TO WAIT FOR I/O TO FINISH
; XCT P1 ;WAIT FOR IT
MOVE P1,T1 ;COPY CHANNEL
HLRZ P2,P1 ;GET IN RH FOR FUTURE TESTING
LSH P2,-5 ;...
OR T1,[GETSTS T2] ;GET ERRROR BITS
XCT T1
TRNE T2,IO.EOF!IO.EOT;END OF SOMETHING?
JRST TPOPJ1 ;YES--CPOPJ1 SO XCTIO WILL CPOPJ
HRRZ T1,T2 ;NO--GET BITS IN RIGHT PLACE
MOVEM T2,TEMP ;SAVE IN A VERY VOLATILE PLACE
TRZ T2,IO.ERR ;CLEAR ERROR BITS
TLO P1,(SETSTS (T2)) ;FORM INSTR TO RESET STATUS
XCT P1 ;MAKE ERROR DISSAPPEAR
TRNE T1,IO.IMP ;CHECK FOR WRITE LOCK
JRST FIXWLK ;YES--GO HANDLE IT
CAIN P2,LOGC ;IF LOG FILE
JRST [TLZ F,FL$LOG;STOP OUTPUT FOR A WHILE
JRST XCTIO0] ;AND GO PUT MSG TO TTY
CAIE P2,LPTC ;UNLESS LPT CHANNEL
AOS ERRCNT-1(P2) ;COUNT THE ERROR
CAIE P2,INPC ;IF THIS IS INPUT CHANNEL
JRST XCTIO0 ;NO
MOVE T2,ERRFLG ;GET /ERROR VALUE
SKIPLE RTRYFL ;/NORETRY??
SKIPLE RPTFLG ;YES--/REPORT?
CAIN T2,ERLIGN ;HOW ABOUT /ERROR:IGNORE?
JRST TPOPJ ;/NORETRY AND /NOREPORT OR /ERROR:IGNORE
XCTIO0: WARN. EF$NCR!EF$OCT,IOE,<I/O STATUS = >
PUSHJ P,TELPRB ;TELL WHAT THE BITS MEAN
STRNG$ <, ON >
MOVE T1,[EXP INPSPC,OUTSPC,LPTSPC,LOGSPC]-1(P2) ;GET RIGHT FDB
PUSHJ P,.TFBLK## ;TYPE IT OUT
CAIN P2,LOGC ;IS THIS THE LOG CHANNEL?
JRST [TLO F,FL$LOG;YES--MARK IT OPEN FOR BUSINESS AGAIN
JRST TPOPJ] ;AND GO RETURN
CAIN P2,LPTC ;OR LPT CHANNEL
JRST TELCON ;YES--JUST GO CONTINUE
MOVE T1,P2 ;COPY CHANNEL FOR TAPOP.
PUSHJ P,GMTSTS ;GET FILE AND RECORD COUNTS
STRNG$ <, FILE > ;TELL FILE AND RECORD COUNTS
MOVE T1,TPOPBL+.TSFIL;GET FILE
PUSHJ P,.TDECW##
STRNG$ < RECORD >
MOVE T1,TPOPBL+.TSREC;AND REC #
PUSHJ P,.TDECW##
TLNN F,FL$BAT ;IF BATCH JOB JUST CONTINUE
CAIE P2,INPC ;THIS INPUT CHANNEL?
JRST TELCON ;NO--JUST CONTINUE
MOVE T1,TEMP ;GET SAVED I/O STATUS
TRNE T1,IO.BKT ;IF BLOCK TOO LARGE
PUSHJ P,BKTERR ;GO HANDLE SEPARATELY
SKIPLE T1,ERRFLG ;GET /ERROR:LEVEL
CAIE T1,ERLQUE ;/ERROR:QUERY?
JRST TELCON ;NO--CONTINUE
PUSHJ P,.TCRLF## ;NEW LINE
JRST GETOPT ;GO GET ERROR OPTION
;HERE WHEN OUTPUT IS WRITE LOCKED--ASK USER TO WRITE-ENABLE IT
FIXWLK: PUSHJ P,WRTLOK ;TELL AND WAIT FOR WRTENBL
MOVE T1,0(P) ;GET I/O INSTR
XCT T1 ;CLANK IT AGAIN
JRST TPOPJ ;SUCCESS!
JRST XCTIOE ;OOPS..ERROR AGAIN
GETOPT: STRNG$ <
OPTION (H FOR HELP): >
PUSHJ P,GCHNWL ;INCHRW T1 + .TCRLF
MOVSI T2,-N$OPTN ;AOBJ
CAME T1,OPTLST(T2)
AOBJN T2,.-1
JUMPL T2,@OP$DSP(T2) ;JUMP IF VALID
OP$HLP: SKIPA T1,.+1 ;LOAD UP FILENAME
SIXBIT /CMTERH/ ;COPYMT I/O ERROR HELP
PUSHJ P,TYHELP ;GO TYPE HELP
JRST GETOPT
OPTLST: EXP "C","D","E","G","H","I","S"
N$OPTN==.-OPTLST
OP$DSP: EXP TPOPJ ;CONTINUE
EXP OP$DMP ;DUMP IT
EXP OP$EXI ;EXIT
EXP OP$G ;GO
EXP OP$HLP ;HEP ME
EXP OP$IGN ;IGNORE FURTHER ERRORS
EXP OP$SKP ;SKIP IT
OP$IGN: MOVEI T1,ERLIGN ;/ERROR:IGNORE
MOVEM T1,ERRFLG ;SET FOR LATER ERRORS
JRST TPOPJ ;AND RETURN
OP$G: SETOM ERRFLG ;FLAG NOT TO BOTHER USER
JRST TPOPJ ;CPOPJ SO XCTIO WILL CPOPJ1
OP$EXI: EXIT 1,
JRST GETOPT ;IF HE CONTINUES
OP$SKP: RESTR$ T1 ;GET THE I/O INSTR BACK
JRST XCTIOD ;AND TRY AGAIN
TELCON: STRNG$ < - CONTINUING
>
JRST TPOPJ ;CPOPJ SO XCTIO WILL CPOPJ1
TPOPJ1: AOS -1(P)
TPOPJ: RESTR$ T1
POPJ P,
;CALL HERE WITH ERROR BITS IN T1--REPORTS WHAT THEY ALL MEAN
TELPRB: PUSHJ P,.PSH4T## ;SAVE T1-4
MOVE P1,T1 ;COPY BITS
ANDI P1,IO.IMP!IO.DER!IO.DTE!IO.BKT ;NARROW TO WHAT WE NEED
JUMPE P1,PRBDUN ;JUMP IF NOT A PROBLEM!
LSH P1,-<ALIGN. (IO.BKT)> ;POSITION
MOVEI T1,[ASCIZ/ (/] ;START THE LIST
PUSHJ P,.TSTRG##
TLZ F,FL$FLG ;FL$FLG=1 MEANS NOT FIRST ONE--TYPE A COMMA
MOVE T4,[POINT 18,PRBNAM] ;POINT TO THE PROBLEM
PRBLUP: ILDB T2,T4 ;GET ONE
TRNN P1,1 ;THIS ONE A PROBLEM?
JRST PRBNXT ;NO
TLOE F,FL$FLG ;YES--FIRST ONE?
PUSHJ P,TYSLSH ;NO--SLASH 1
MOVSI T1,(T2) ;POSITION ERROR CODE
PUSHJ P,.TSIXN## ;TYPE IT
PRBNXT: LSH P1,-1 ;MOVE OVER ONE
JUMPN P1,PRBLUP
MOVEI T1,")" ;FINISH IT OFF
PUSHJ P,.TCHAR## ;...
PRBDUN:
POP4J: PUSHJ P,.POP4T## ;RESTORE T1-4
POPJ P,
PRBNAM: 'BKTPAR' ;BLOCK TOO LARGE/PARITY (DATA) ERROR
'DERIMP' ;DEVICE ERROR/IMPROPER MODE
EXP 0 ;SNH
BKTERR: TLOE F,FL$BKT ;BEEN HERE BEFORE?
POPJ P, ;YES--JUST RETURN
PUSHJ P,.TCRLF## ;NEW LINE
INFO. 0,BKT,<BLOCK TOO LARGE ON INPUT--TRY LARGER /BUFSIZ>
ASKCON: STRNG$ <CONTINUE (Y OR N)? >
PUSHJ P,GCHNWL ;GET HIS REPLY
CAIE T1,"Y" ;WHAT DID HE SAY?
JRST [CAIE T1,"N" ;BUT DID HE REALLY SAY NO?
JRST ASKCON ;NO--MAKE SURE
JRST ERRFTL] ;YES--GO DIE
POPJ P, ;HE SAID TO CONTINUE OK
SUBTTL ERROR DUMP ROUTINES
OP$DMP: TLOE F,FL$LPO ;LPT OPEN?
JRST DUMP0 ;YES
MOVEI T1,LPTSPC ;NO--GET SPEC ADDR
PUSHJ P,OPENIO ;DO IT
CAI LPTC,@LBHR(.IOASC) ;
MOVSI T1,2 ;USE 2 BUFFERS
SKIPA T2,.+1 ;
XWD OPNBLK,LBHR ;ARG FOR .ALCBF
PUSHJ P,.ALCBF## ;ALLOCATE BUFFERS
DUMP0: PUSHJ P,LHEDER ;HEADER FOR RECORD
PUSHJ P,LDMPBF ;DUMP THE BUFFER
JRST GETOPT ;ASK AGAIN
LDMPBF: PUSHJ P,.SAVE2## ;SAVE P1-2
MOVEI P1,MX$NPL ;PRESET COUNTER
MOVN T1,IBHR+.BFCTR ;GET NEG LENGTH OF BUFFER
HRRZ P2,IBHR+.BFPTR ;POINT TO BUFFER
HRRI P2,1(P2) ;POINT TO DATA WORDS
HRLI P2,(T1) ;FORM AOBJN WORD
LDMLUP: MOVE T2,(P2) ;GET A WORD
PUSHJ P,LOCTFW ;DUMP WITH FORMATTING
AOBJN P2,LDMLUP ;DO ALL WORDS
PJRST LCRLF ;NEW LINE AND RETURN
;CALL WITH WORD TO DUMP IN T2 (DUMPS ALL 12 OCTAL DIGITS WITH FORMATIING)
LOCTFW: SOJGE P1,LOCTF0 ;JUMP IF COOL
PUSHJ P,FLCRLF ;NO--NEW LINE
LOCTF0: MOVEI T1," " ;NO--SPACE TWO
PUSHJ P,LCHR
PUSHJ P,LCHR
MOVEI T3,^D12 ;12 DIGITS
LOCLUP: SETZ T1, ;CLEAR RESULT
LSHC T1,3 ;GET BYTE
MOVEI T1,"0"(T1) ;ASSKEY-IZE IT
PUSHJ P,LCHR ;LIST IT
SOJG T3,LOCLUP ;DO ALL
POPJ P,
;LOCT--LIST OCTAL
LOCT: IDIVI T1,^D8 ;GET A DIGIT
HRLM T2,(P) ;SAVE ON PDL
SKIPE T1 ;DONE?
PUSHJ P,LOCT ;NO--RECURZE
HLRZ T1,(P) ;YES--GET DIGIT
MOVEI T1,"0"(T1) ;ASCII
PJRST LCHR ;UNRECURSE OR RETURN
;FLCRLF -- LIST CRLF TO PRINTER AND RESET P1
FLCRLF: MOVEI P1,MX$NPL ;RESET P1
; PJRST LCRLF ;CRLF AND RETURN
;LCRLF -- LIST CRLF TO PRINTER
LCRLF: MOVEI T1,.CHCRT ;CARRIAGE RETURN
PUSHJ P,LCHR
MOVEI T1,.CHLFD ;NEW LINE
; PJRST LCHR ;DUMP AND RETURN
;LCHR -- DUMP CHAR IN T1 TO LPT
LCHR: SOSG LBHR+.BFCTR ;ROOM?
JRST LBUFO ;NO
LCHRC: IDPB T1,LBHR+.BFPTR ;YES--STORE IT
POPJ P,
LBUFO: PUSHJ P,XCTIO ;DO OUTPUT
OUT LPTC,
HALT . ;EOT ON LPT!!??
JRST LCHRC ;DUMP CHAR AND RETURN
;LSTR -- T1 POINTS TO ASCIZ STRING TO DUMP TO LPT
LSTR: HRLI T1,(POINT 7) ;BYTE PTR
PUSH P,T1 ;SAVE ON PDL
LSTRL: ILDB T1,(P) ;GET CHAR
JUMPE T1,TPOPJ ;PRUNE PDL AND RETURN
PUSHJ P,LCHR ;DUMP
JRST LSTRL
;LHEDER -- LIST HEADER FOR THIS RECORD
LHEDER: MOVEI T1,[ASCIZ \DUMP OF FILE \]
PUSHJ P,LSTR
MOVE T1,TPOPBL+.TSFIL;INPUT FILE #
PUSHJ P,LOCT
MOVEI T1,[ASCIZ \ RECORD \]
PUSHJ P,LSTR
MOVE T1,TPOPBL+.TSREC;RECORD #
PUSHJ P,LOCT
PUSHJ P,LCRLF ;NEW LINE
PJRST LCRLF ;AND ANOTHER AND RETURN
SUBTTL MINOR SUBROUTINES
;GCHNWL -- INCHRW T1 + CLRBFI + .TCRLF
;USES NO ACS EXCEPT RETURNS CHAR IN T1
GCHNWL: MOVEI T1,.CHBEL ;TYPE A BELL IF NOT BATCH
TLNN F,FL$BAT ;IS IT?
PUSHJ P,.TCHAR## ;NO--TYPE DING
INCHRW T1 ;GET THE CHARACTER
CLRBFI ;IN CASE DUMP USER
PJRST .TCRLF## ;NEW LINE AND RETURN
;TYPDLR -- TYPE CRLF-DOLLAR SIGN IF BATCH SO WE TALK TO OPERATOR
TYPDLR: TLNN F,FL$BAT ;BATCH JOB
POPJ P, ;NOT TODAY
PUSH P,T1 ;YES--SAVE T1
STRNG$ <
$> ;SEND CRLF-$
PJRST TPOPJ ;GET T1 BACK AND RETURN
;TYSLSH -- TYPE A SLASH
TYSLSH: MOVEI T1,"/" ;GET ONE
PJRST .TCHAR## ;SEND IT
;TYFEET -- TYPE "FEET<CR><LF>"
TYFEET: PJSP T1,.TSTRG##
ASCIZ . FEET
.
;GMTSTS -- GET FILE AND RECORD COUNT
;CALL: MOVE T1,IOCHAN
; PUSHJ P,GMTSTS
; *RETURN, STATUS IN TPOPBL*
;USES T1-T2
GMTSTS: MOVEM T1,TPOPBL-2 ;STORE CHANNEL
MOVEI T2,.TFSTA ;FUNCTION
MOVEM T2,TPOPBL-3 ;SET IN BLOK
SKIPA T2,.+1 ;UUO ARG
XWD 5,TPOPBL-3 ;5 WORDS,,ADDR
TAPOP. T2, ;ASK MON
JFCL ;(CAN'T POSSIBLY HAPPEN, SAID THE OPTIMIST)
POPJ P,
;TYHELP -- TYPE HELP FILE SPECIFIED BY C(T1)
;WILL RESTORE AND RELEASE HISEG IF IT IS CURRENTLY GONE
TYHELP: TLZ F,FL$FLG ;ASSUME NOT GONE
SKIPE .JBHRL ;BUT CHECK
JRST TYHLP0 ;IT'S THERE--GO ON
PUSHJ P,UPSCN ;OOPS--PUT IT BACK
TLO F,FL$FLG ;REMEMBER WHAT WE DID
TYHLP0: PUSHJ P,.HELPR## ;CALL HELPER TO TYPE THE HELP
TLNN F,FL$FLG ;CHECK THE FLAG
POPJ P, ;IT WAS ALREADY THERE
PJRST DWNSCN ;GO DISMISS IT
SUBTTL ERROR HANDLER
;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERROR. MACRO
EHNDLR: PUSHJ P,SAVACS ;SAVE THE ACS
MOVE P1,@0(P) ;GET FLAGS AND ADDRESSES
EHND.0: MOVEI T1,"?" ;ASSUME AN ERROR
TLNE P1,EF$WRN ;CHECK WARNING
MOVEI T1,"%" ;YES
TLNE P1,EF$INF ;IF BOTH OFF NOW THEN INFO
MOVEI T1,"[" ;GOOD THING WE CHECKED
TLNE P1,EF$OPR ;OPERATOR SEE IT ALSO?
PUSHJ P,TYPDLR ;YES--TYPE THAT FIRST (NOTE: T1 IS PRESERVED)
PUSHJ P,.TCHAR## ;OUTPUT THE START OF MESSAGE
MOVSI T1,MY$PFX ;SET UP MY PREFIX
HLR T1,(P1) ;GET MESSAGE PREFIX
PUSHJ P,.TSIXN## ;OUTPUT THE PREFIXES
PUSHJ P,.TSPAC## ;AND A SPACE
HRRZ T1,(P1) ;GET STRING ADDRESS
PUSHJ P,.TSTRG## ;SEND IT
MOVE T1,SAVAC+T1 ;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
MOVE T2,SAVAC+T2 ;ORIGINAL T2 IN CASE .TOLEB
LDB T3,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
CAILE T3,MX$ERR ;CHECK FOR IN-RANGE
MOVEI T3,EF$NOP ;NO--MAKE IT CPOPJ
PUSHJ P,@ERRTAB(T3) ;CALL THE ROUTINE
TLNE P1,EF$NCR ;IF NO CRLF THEN DON'T CLOSE INFO
JRST EHND.1 ;NO--DON'T CHECK
MOVEI T1,"]" ;PREPARE TO CLOSE INFO
TLNE P1,EF$INF ;CHECK FOR INFO
PUSHJ P,.TCHAR## ;SEND INFO CLOSE
TLNN P1,EF$NCR ;NO CARRIAGE RETURN?
PUSHJ P,.TCRLF## ;YES--SEND ONE
EHND.1: TLNE P1,EF$FTL ;NOW CHECK FATAL
JRST ERRFTL ;YES--GO DIE
MOVEM F,SAVAC+F ;NO--BUT PUT F INTO SAVAC SO UPDATED
;FLAGS WILL BE SEEN
;FALL INTO RESACS
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
; PUSHJ P,RESACS
; *ACS RESTORED FROM SAVAC*
RESACS: MOVEM 17,SAVAC+17 ;SAVE 17 TO RESTORE INTO IT
MOVSI 17,SAVAC
BLT 17,17 ;REGISTERS ARE RESTORED
POPJ P, ;RETURN
ERRTAB: .POPJ## ;CODE 0 -- NO ACTION
.TDECW## ;CODE 1 -- TYPE T1 IN DECIMAL
.TOCTW## ;CODE 2 -- TYPE T1 IN OCTAL
.TSIXN## ;CODE 3 -- TYPE T1 IN SIXBIT
.TPPNW## ;CODE 4 -- TYPE T1 AS PPN
.TSTRG## ;CODE 5 -- T1 POINTS TO ASCIZ STRING
.TFBLK## ;CODE 6 -- T1 POINTS AT FDB
.TOLEB## ;CODE 7 -- T1 POINTS AT OPEN BLOCK
; -- T2 POINTS AT LOOKUP BLOCK
;HERE TO DIE--
ERRFTL: PUSHJ P,CLSLOG ;CLOSE THE LOG IF WE ARE USEING IT
RESET ;KILL ALL FILES
MOVE P,INIPDP ;RESET PDL
PUSHJ P,UPSCN ;MAKE SURE SCAN IS THERE
SKIPN OFFSET ;CCL ENTRY
SKIPL ISCNVL ;OR A RECOGNIZED COMMAND
PUSHJ P,.MONRT## ;YES--RETURN TO MONITOR
JRST RESTRT ;GO CONTINUE
;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
; *ACS SAVED IN SAVAC* BEWARE!!
SAVACS: MOVEM 17,SAVAC+17 ;SAVE ONE
MOVEI 17,SAVAC
BLT 17,SAVAC+16
MOVE 17,SAVAC+17
POPJ P, ;ACS ARE SAVED
SUBTTL STORAGE
;STORAGE THAT IS CONSTANT BETWEEN RUNS
U (ISCNVL) ;VALUE RETURNED BY .ISCAN
U (TLDVER) ;-1 WHEN VERSION HAS BEEN TYPED ON TTY
U (SAVRUN) ;-1 WHEN RUN UUO ARGS SAVED
U (SGDEV) ;SAVEGET DEVICE NAME
U (SGNAM) ;SAVEGET PROGRAM NAME
U (SGLOW) ;SAVEGET LOW SEGMENT NAME
U (SGPPN) ;SAVEGET PPN
U (OFFSET) ;STARTING OFFSET (REMEMBER FOR .ISCAN)
FW$ZER==.
U (LOGSPC,.FXLEN) ;SPACE FOR LOG FILE SPEC
U (ODVNAM) ;REAL NAME (FROM DEVNAM)
U (IDVNAM) ;REAL NAME (FROM DEVNAM)
U (GOTIME) ;MSTIME FOR START
U (GORUNT) ;RUNTIM FOR START
U (LSTBFZ) ;LAST BUFFER SIZE SEEN WHEN DSKTOTAPE
U (TEMP) ;VERY TEMPORARY STORAGE
IFN FT$DEB,<
U (BUFZER) ;COUNT TIMES MON CLEARED BUFFERS WITH UU.IBC ON
>;END IFN FT$DEB
U (IBHR,3) ;INPUT BHR
U (OBHR,3) ;OUTPUT BHR
U (LBHR,3) ;LPT BHR
U (GBHR,3) ;LOG FILE BHR
U (PDLIST,LN$PDL) ;ALLOCATE SPACE FOR PUSH DOWN LIST
U (SAVAC,20) ;AC SAVE BLOCK WHEN IN ERROR HANDLER
U (OPNBLK,3) ;OPEN BLOCK
U (LKPBLK,.RBTIM+1) ;LOOKUP/ENTER BLOCK
U (PTHBLK,^D9) ;PATH BLOCK (NOT USED, BUT CAN'T USE .STOPN)
U (PRMPDL,LN$PRM) ;PARAM PUSHDOWN LIST
BLOCK 3 ;***DO NOT TOUCH***USED BY TAPOP.
U (TPOPBL,2) ;TAPOP. ARG BLOCK
FW$STS==.
ERRCNT:
U (INPERS) ;INPUT ERROR COUNT
U (OUTERS) ;OUTPUT ERROR COUNT
U (RECTOT) ;RECORD TOTAL
U (FILTOT) ;FILE TOTAL
LW$STS==.-1
SCN$FZ==. ;FIRST WORD CLEARED FOR SCAN
U (INPSPC,LN$FDB) ;INPUT SPEC STORAGE
INPSPE==.-1
U (OUTSPC,LN$FDB) ;OUTPUT SPEC SPACE
OUTSPE==.-1 ;END OF OUTPUT SPEC SPACE
SWT$FO==. ;FIRST SWITCH WORD (SET TO -1 BY CLRANS)
U (UCOMNT,^D28) ;FOR /COMMENT:"COMMENT STRING" FOR LOG FILE
IFN FT$TST,<
U (TSTDEN) ;SAVE DENSITY HERE
U (TESTFL) ;/TAPTST FLAG
U (NUMTRY) ;/RETRY:N
U (RPETFL) ;/REPEAT:N
>;END IFN FT$TST
U (RTRYFL) ;RETRY FLAG
U (TIMEFL) ;/TIME FLAG
U (RPTFLG) ;REPEAT FLAG
U (IFTYFL) ;/IFTYP FLAG
BFRSIZ: ;**DO NOT SEPARATE
U (NIBUFS) ;# INPUT BUFFERS
U (NOBUFS) ;# OUTPUT BUFFERS
;**END DO NOT SEPARATE
U (BUFSIZ) ;/BUFSIZ:N
U (ERRFLG) ;/ERROR:CONTIN OR /ERROR:QUERY
U (MODFLG) ;/MODE:MODE
U (MODES,2) ;/MODE:MODE FOR INPUT AND OUTPUT
INPMOD=MODES ;INPUT/MODE:MODE
OUTMOD=MODES+1 ;OUTPUT/MODE:MODE
SWT$LO==.-1
SCN$LZ==.-1
LW$ZER==.-1
LIT$ ;OUT GO THE LITERALS
CMTEND::END COPYMT