Trailing-Edge
-
PDP-10 Archives
-
bb-bt99m-bb
-
plrlbp.x19
There are no other files named plrlbp.x19 in the archive.
TITLE PLRLBP - Label Processing Module
SUBTTL Author: Cliff Romash/Dave Cornelius/WLH/DPM 3-Aug-83
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,1986,1987. ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;Get the GALAXY library
SEARCH PLRMAC ;SEARCH UNIVERSAL FILE
SEARCH ORNMAC ;Get WTO symbols
SEARCH QSRMAC ;For message block definitions
PROLOG (PLRLBP) ;SEARCH OTHER NEEDED FILES
;THIS MODULE IS THE HEART OF THE TAPE LABEL PROCESSOR. MOST GLOBAL ENTRY
;POINTS ARE CALLED BY THE MESSAGE DISPATCHER ON A MESSAGE FROM
;[SYSTEM]IPCC TO DO THE ACTUAL LABEL PROCESSING. L$XXXX ROUTINES ARE
;CALLED WITH M POINTING TO THE TAPE LABELLING MESSAGE AND HAVE
;ALL AC'S AVAILABLE
GLOB NUMBER ;For ITEXT "<number>"
SUBTTL Directory for PLRLBP
SUBTTL Constants for verifying labels
;EIGHT BIT ASCII CONSTANTS USED TO CHECK ALL LABEL
ASCII8(VOL1,VOL1WD,VL1PTR) ;'VOL1'
ASCII8(VOL2,VOL2WD,VL2PTR) ;'VOL2'
ASCII8(UVL1,UVL1WD,UVLPTR) ;'UVL1'
ASCII8(D%A,D10WD,D10PTR) ;'D%A' TO SEE IF DECSYSTEM-10 LABEL
ASCII8(HDR1,HDR1WD,HD1PTR) ;'HDR1'
ASCII8(DEC,DECWD,DECPTR) ;'DEC' TO CHECK IF DIGITAL HDR LABEL
ASCII8(HDR2,HDR2WD,HD2PTR) ;'HDR2'
ASCII8(EOF1,EOF1WD,EF1PTR) ;'EOF1'
ASCII8(EOF2,EOF2WD,EF2PTR) ;'EOF2'
ASCII8(EOV1,EOV1WD,EV1PTR) ;'EOV1'
ASCII8(EOV2,EOV2WD,EV2PTR) ;'EOV2'
ASCII8(DECSYSTEM10 ,S10WD,S10PTR) ;'DECSYSTEM10' TO GO IN SYSTEM CODE IN HDR1 LABEL
; ASCII8(SCRTCH,SCRTWD,SCRPTR) ;'SCRTCH' FOR VOLID
ASCII8(FILE.,FILWD,FILPTR) ;'FILE' FOR DUMMY NAME IN HDR1 LABEL
ASCII8( ,BNKWD,BNKPTR) ;SIX EIGHT BIT ASCII BLANKS
;FOR A BLANK VOLUME ID
INTERNAL BNKWD ;Make the blanks externally referenceable
IBMVL1: XWD 713533,237420 ;VOL1 IN EBCDIC
RECFMT: $BUILD (.TRFMX+1)
$SET (.TRFDF,,"U") ;NO MATCH FOR ZERO (SHOULD NOT BE USED)
$SET (.TRFFX,,"F") ;FIXED RECORDS
$SET (.TRFVR,,"D") ;VARIABLE RECORDS
$SET (.TRFSP,,"S") ;SPANNED RECORDS
$SET (.TRFUN,,"U") ;UNDEFINED RECORDS
$EOB
RECFRM: $BUILD (.TFCMX+1)
$SET (0,," ") ;Assume no form control
$SET (.TFCNO,," ") ;No form control in records
$SET (.TFCAS,,"A") ;1st char of record is form control
$SET (.TFCAM,,"M") ;Record contains all form control
$EOB
SUBTTL L$INIT - Initialization For The Label Processor
L$INIT::MOVEI S1,0 ;GET SEQUENCE ERROR CHECK CODE
MOVEM S1,G$SEQC## ;SET IT (DEBUGGING HACK IF NON-ZERO)
POPJ P, ;RETURN
SUBTTL L$MDC - Routine to Process the MDC message
ENTRY L$MDC
;This routine is invoked to read the labels on a
; unit which has just come on-line.
;All this routine does is read the VOL1 label to see if the tape
;is labeled. No attempt is made to give this new volume away to a
;waiting TCB. The status of the drive is given to MDA via O$STAT
;CALLED WITH B POINTING TO THE TCB
L$MDC: $TRACE (L$MCD,1) ;ENTRY
PUSHJ P,T$OPEN## ;Grab the tape
JUMPF .POPJ ;Can't, so quit
PUSHJ P,L$RVOL ;Read the VOL1
JUMPF MDC.5 ;Can't, so complain
CAXN LT,LT.NL ;Is it unlabeled?
JRST MDC.4 ;Yes, set that up
MOVE T1,[CPTRI ^D5,0(BUF)] ;Aim at VOLID portion of label (CP 5-10)
MOVE T2,[POINT 8,TCB.VL(B)] ;AND IN TCB
HRRZI T3,6 ;SIX CHARACTERS
HRL T3,CVTTAB(LT) ;GET CONVERSION ROUTINE ADDR
PUSHJ P,STGSTR ;SAVE IT AWAY
JUMPF MDC.5 ;DIDN'T WORK, TELL OPR OF ERROR
MOVEI S1,TCB.VL(B) ;AND POINT AT THIS VOLID
PUSHJ P,I$RLID## ;SET REELID AND RETURN
JUMPF MDC.4 ;ILLEGAL VOLUME ID (TREAT UNLABELED)
PUSHJ P,O$STAT## ;Update staus to MDA
$RETT ;RETURN
;Here when we have read the label area, and there is no VOL1
;Therefore, the tape is unlabeled.
MDC.4: ;FOUND AN UNLABELED TAPE VIA AVR
MOVX LT,LT.NL ;Get code for no labels
STORE LT,TCB.LT(B) ;Save in TCB
MOVEI S1,'REW' ;GET THE REWIND COMMAND
MDC.4B: PUSHJ P,T$POS## ;LEAVE IT AT BOT (OR UNLOAD IT)
DMOVE S1,BNKWD ;Get both pieces of volid
DMOVEM S1,TCB.VL(B) ;Store it to send back
MOVEI S1,BNKWD ;GET SOME BLANKS FOR A REEL ID
PUSHJ P,I$RLID## ;SET IT IN THE MONITOR
PJRST O$STAT## ;Send updated status to MDA
;Here when we cannot read the labels due to parity errs, or density errs
;We don't know that the tape is unlabeled, since it may be written
;at a density which this drive does not support
MDC.5: MOVX S1,.TFD00 ;GET DEFAULT DENSITY
STORE S1,TCB.PS(B),TP.DEN ;SET DEFAULT DENSITY IN TCB
PUSHJ P,I$SDEN## ;SET IT IN MONITOR
SKIPT
STOPCD (CSD,HALT,,<Can't set density>)
MOVEI S1,[ITEXT(Can't read this tape's labels on this drive)]
MOVEI S2,[ITEXT(<Type 'RESPOND ^I/number/ ABORT' to unload the tape on ^W/TCB.DV(B)/
Type 'RESPOND ^I/number/ PROCEED' to treat the tape on ^W/TCB.DV(B)/ as unlabled>)]
PUSHJ P,O$LERT## ;Ask the OPR what to do
JUMPT MDC.4 ;Proceed, treat as unlabeled
MOVX S1,'UNL' ;Get code to throw away this tape
JRST MDC.4B ;Get it out of here
SUBTTL L$RVOL - Read the VOL1 label
;This routine will read the first record on the tape
; and try to determine what type of labels this tape has.
; If there are any data errors, this routine will try all the
; densities that the drive supports.
;Call -
; B/ TCB adrs
;Returns -
; FALSE If no data can be read without errors
; TRUE,
; TCB.LT, LT/ Label type
L$RVOL::
PUSHJ P,L$CLEF ;Clear out any errors
PUSHJ P,T$OPEN## ;NO, OPEN THE TAPE FOR I/O
JUMPF .RETF ;CAN'T
$CALL .SAVE2 ;GET PRESERVED ACS
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
MOVX S1,TS.INI ;Get the initializing bit
ANDM S1,TCB.ST(B) ;Clear all but that bit
PUSHJ P,I$PDEN## ;PICK A STARTING DENSITY
RVOL.1: MOVEI S1,'REW' ;OK, SET UP TO REWIND THE TAPE
PUSHJ P,T$POS## ;DO IT
JUMPF .POPJ ;ERROR ON REWIND
PUSHJ P,T$WRCK## ;GET THE WRITE STATUS
STORE S2,TCB.PT(B),TP.RWL ;STORE THE WRITE STATUS
SETZM P2 ;CLEAR ERROR FLAG
PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF RVOL.2 ;Couldn't go see why
MOVE T1,(BUF) ;GET FIRST WORD FROM LABEL
SETZ LT, ;DON'T KNOW THE LABEL TYPE YET
TRZ T1,17 ;CLEAR UNNEEDED LOW ORDER 4 BITS
CAMN T1,VOL1WD ;IS IT 'VOL1' IN ASCII
MOVEI LT,LT.SL ;YES, LABEL TYPE IS STANDARD
CAMN T1,IBMVL1 ;IS IT 'VOL1' IN EBCDIC?
MOVEI LT,LT.IL ;YES, LABEL TYPE IS IBM
JUMPN LT,RVOL.4 ;Any match?
JRST RVOL.5 ;TRY THE NEXT DENSITY
RVOL.2: SETOM P2 ;INDICATE ERROR
MOVE S1,G$TERM## ;GET THE TERMINATION WORD
CAIE S1,LE.DTE ;TAPE PARITY ERROR
CAIN S1,LE.DER ;OR DEVICE ERROR (TU45'S)
JRST RVOL.5 ;TRY A DIFFERENT DENSITY
MOVEI S1,'REW' ;REWIND CODE
PUSHJ P,T$POS## ;DO IT
$RETF ;RETURN (UNKNOWN LABELS)
RVOL.5: JUMPL P1,RVOL5A ;ONLY DO THIS ONCE
LOAD S2,TCB.PS(B),TP.DEN ;GET DENSITY WE TRIED TO READ AT
PUSHJ P,I$GDEN## ;NOW GET DENSITY WE READ AT
CAIE S1,(S2) ;SAME?
HRROI P1,(S1) ;NO--DRIVE DID AUTO DENSITY DETECTION
JUMPE P2,RVOL.3 ;IF NO ERROR, ASSUME UNLABLED
STORE S2,TCB.PS(B),TP.DEN ;REPLACE DENSITY LAST USED
;HERE WE ASSUME DRIVE DOESN'T DO AUTO DENSITY DETECTION
RVOL5A: JUMPE P2,RVOL.3 ;IF NO ERROR, ASSUME UNLABELED
PUSHJ P,I$NDEN## ;GET A DIFFERENT DENSITY
JUMPF RVOL.6 ;TRIED ALL DENSITIES !!!
PUSHJ P,I$SDEN## ;SET IT
SKIPT
PUSHJ P,S..CSD ;PUT FAILING ADDR ON STACK
SETZM G$TERM## ;CLEAR THE ERROR FLAGS
JRST RVOL.1 ;AND TRY AGAIN
RVOL.6: MOVEI S1,.TFD00 ;SET DEFAULT DENSITY BECAUSE SOME
PUSHJ P,I$SDEN## ; DRIVE DONT DO AUTO-DENSITY DETECT
; JRST RVOL.3 ; AND ASSUME UNLABELED
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;If we get here we have an unlabeled tape.
RVOL.3: MOVX LT,LT.NL ;Must be unlabeled
RVOL.4: PUSHJ P,I$GDEN## ;Get the default density
STORE LT,TCB.LT(B) ;STORE THE LABEL TYPE
MOVE T1,[2,,S1] ;Set up AC
MOVX S1,.TFCEC ;Function code
MOVE S2,TCB.DV(B) ;Get device name
TAPOP. T1, ;Clear hard and soft error counters
JFCL ;Ignore errors
MOVEI S1,'REW' ;REWIND CODE
PUSHJ P,T$POS## ;DO IT
$RETT ;AND RETURN
SUBTTL L$RUVL - Read UVL1 record
; This routine is used by PLRINI to read the owner and protection
; information stored in the UVL1 record. This is needed when tapes
; will be re-initialized (/NEW-VOLUME processing).
L$RUVL::PUSHJ P,L$CLEF ;CLEAR PENDING ERRORS
PUSHJ P,T$OPEN## ;OPEN
JUMPF .POPJ ;RETURN ON FAILURES
CAIE LT,LT.SL ;ANSI?
CAIN LT,LT.SUL ;ANSI WITH USER LABELS?
SKIPA ;YES
$RETT ;NO USEFUL INFO ON THIS TAPE
PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF .POPJ ;RETURN ON FAILURES
MOVE T1,[CPTRI ^D1,0(BUF)] ;CHECK LABEL IDENTIFIER (CP 1-4)
MOVE T2,UVLPTR ;POINT TO "UVL1"
HRRZI T3,4 ;4 CHARACTERS
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRCMP ;COMPARE
JUMPT RUVL1 ;UVL1, PROCEED
MOVEI S1,'BBL' ;NO MATCH
PUSHJ P,T$POS## ;BACKUP THE TAPE
JUMPF .POPJ ;RETURN ON FAILURES
$RETT ;DONE HERE
; Protection
RUVL1: MOVE T1,[CPTRI ^D5,0(BUF)] ;POINT AT PROT (CP 5-10)
HRRZI T2,6 ;6 CHARS, NO CONVERT
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;MAKE IT A NUMBER
SKIPT ;CHECK FOR JUNK IN LABELS
MOVE S2,G$PSTP## ;DEFAULT TO STANDARD FILE PROTECTION
SKIPGE S1,TCB.IP(B) ;WAS ONE SPECIFIED?
MOVE S1,S2 ;OLD TAPE PROT WILL BE USED
CAILE S1,777 ;IT MUST BE REASONABLE
MOVE S1,G$PSTP## ;USE STANDARD FILE PROTECTION
MOVEM S1,TCB.IP(B) ;STORE PROTECTION CODE
; PPN
RUVL2: MOVE T1,[CPTRI ^D11,0(BUF)] ;POINT AT PROJ # (CP 11-16)
HRRZI T2,6 ;6 CHARS, NO CONVERT
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;GET A #
JUMPF .RETT ;NOT A NUMBER?
MOVE P2,S2 ;SAVE PROJ # IN P2 FOR NOW
MOVE T1,[CPTRI ^D17,0(BUF)] ;POINT AT PROG # (CP 17-22)
HRRZI T2,6 ;6 CHARS, NO CONVERSION
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;CHANGE STRING TO OCTAL NUMBER
JUMPF .RETT ;NOT A NUMBER
MOVE T1,P1 ;GET PROT IN T1
HRRZ T2,S2 ;AND MAKE T2=PPN
HRL T2,P2 ;...
MOVEM T2,TCB.VO(B) ;STORE OWNER (PPN) FOR LATER REFERENCE
$RETT ;RETURN
SUBTTL L$MOUN - Routine to Process Mount Message
ENTRY L$MOUN
;This routine is the running intialization routine
; for a newly mounted tape
L$MOUNT: $TRACE (L$MOUNT,1)
PUSHJ P,T$OPEN## ;Open up the drive
JUMPF .RETF ;Can't... too bad
PUSHJ P,L$CLEF ;CLEAR ERRORS
MOVEI S1,TCB.VL(B) ;Get the addrs of the volid
PUSHJ P,I$RLID## ;Set the reelid, and the label type
MOVX S1,TS.SLR ;BIT TO SKIP LABEL RELEASE
IORM S1,TCB.ST(B) ;DON'T UNINTENTIONALLY START JOB
MOVEI S1,1 ;SET INITIAL FILE
STORE S1,TCB.PS(B),TP.POS ; SEQUENCE NUMBER TO ONE
PJRST I$CLLP## ;AND ZAP THE LABEL PARAMETER BLOCK
SUBTTL L$FINP - Routine To Handle Call On First Input
ENTRY L$FINPUT
L$FINP: MOVEI S1,1 ;RESET THE FILE SECTION NUMBER
STORE S1,TCB.SN(B) ;EVERY TIME USER OPENS A FILE
;Internal Entry point for volume switching
L$FINT: $TRACE (L$FINPUT,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE FOR IO
JUMPF .RETF ;COULDN'T?????
PUSHJ P,INPCHK ;CHECK IF ITS OK TO DO INPUT
JUMPF .RETF ;RETURN IF NOT
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
MOVX P2,TS.NFI ;GET BIT WHICH SAYS THIS IS DONE
TDNN P2,TCB.ST(B) ;IS IT SET?
JRST FINP.1 ;NO, JUST PROCEED
ANDCAM P2,TCB.ST(B) ;CLEAR THE BIT
PJRST SETIUD ;SET 'IN USER DATA' AND RETURN
FINP.1: PUSHJ P,VERVOL ;NO, VERIFY THE VOLUME LABELS
JUMPF .RETF ;VOLUME LABELS FAILED, RETURN BAD
FINP.2: MOVX P2,TS.INP ;TAPE DOING INPUT BIT
IORB P2,TCB.ST(B) ;TURN IT ON AND GET STATUS IN P2
JMPUNL LT,SETIUD ;UNLABELED,,SET 'IN USER DATA' & RETURN
TXNE P2,TS.IHL ;ARE WE IN HEADER LABELS
JRST FINP.3 ;;YES, JUST READ LABELS
TXNN P2,TS.ATM ;AT A TAPE MARK?
JRST FINP.5 ;NO, POSITION TO LABELS
TXC P2,TS.ATM!TS.IHL ;CHANGE TO SAY IN HEADER LABELS
FINP.3: LOAD S1,TCB.SN(B) ;GET THE FILE SECTION NUMBER
CAIE S1,1 ;FILRST FILE SECTION
JRST FINP.4 ;NO, IGNORE PARAMETERS
PUSHJ P,I$RDLP## ;YES, READ THE LABEL PARAMETERS
PUSHJ P,POSTAP ;POSITION THE TAPE
JUMPF .RETF ;OOPS, POSITIONING FAILED, RETURN
FINP.4: PUSHJ P,T$RDRC## ;GO READ A RECORD
JUMPF .RETF ;ERROR READING HDR1 LABEL, RETURN
LOAD P1,TCB.IO(B) ;GET IO STATUS
TXNE P1,TI.EOF ;LAST READ SAW EOF?
JRST FINP.6 ;YES, JUST BACK UP AND RETURN EOF
; SINCE WE ARE AT LEOT
PUSHJ P,VERHDR ;NOW VERIFY HEADER LABELS
JUMPF .RETF ;LOST, GIVE BAD RETURN
LOAD S1,TCB.SN(B) ;GET THE FILE SECTION NUMBER
CAIN S1,1 ;SET ONLY FOR FIRST SECTION
PUSHJ P,I$STLP## ;SET LABEL PARAMS FOR USER TO READ
MOVE S1,TCB.IN(B) ;GET FUNCTION CODE WORD
CAIE S1,77 ;IS IT 'READ LABEL PARMS' ???
PJRST SETIUD ;SET 'IN USER DATA' AND RETURN
PUSHJ P,FNDHD1 ;YES,,FIND THE HDR1 RECORD
JUMPF .RETF ;NO,,LOSE !!!
MOVEI S1,'BBL' ;GET 'BACKSPACE A RECORD' FUNCTION
PUSHJ P,T$POS## ;POSITION BEFORE HDR1
MOVE S1,TCB.ST(B) ;GET STATUS WORD
TXZ S1,TS.INP+TS.NFI+TS.IHL ;CLEAR INPUT AND HDR LABELS BITS
TXO S1,TS.ATM ;SET AFTER TAPE MARK
MOVEM S1,TCB.ST(B) ;UPDATE STATUS
SETZM TCB.IN(B) ;ZAP FUNCTION WORD
$RETT ;AND RETURN
FINP.5: PUSHJ P,NXTFIL ;SKIP TO NEXT FILE IF POSSIBLE
JUMPF .RETF ;WE WERE IN A BAD SPOT
JRST FINP.2 ;OK,,TRY AGAIN !!!
FINP.6: MOVX S1,LE.EOF ;GET ERROR CODE TO SAY EOF
MOVEM S1,G$TERM## ;STORE FOR RELEASE
LOAD P2,TCB.ST(B) ;GET STATUS FROM TCB
TXZ P2,TS.POS ;CLEAR POSITION INFO
TXO P2,TS.ATM ;FLAG AFTER TAPE MARK
STORE P2,TCB.ST(B) ;STORE IT IN TCB
MOVEI S1,'BBL' ;SET TO BACK OVER LAST TAPE MARK
PJRST T$POS## ;DO IT AND RETURN
SUBTTL L$FOUT - Routine to Process First Output Message
ENTRY L$FOUTPUT
L$FOUT: MOVEI S1,1 ;RESET THE FILE SECTION NUMBER
STORE S1,TCB.SN(B) ;EVERY TIME USER WRITES A FILE
;Internal Entry for volume switching
L$FOUI: $TRACE (L$FOUTPUT,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE FOR I/O
JUMPF FOUT.8 ;COULDN'T, RETURN BAD
LOAD S1,TCB.PT(B),TP.RWL ;USER SAID /WL?
JUMPN S1,FOUT.9 ;YES, GIVE WRITE LOCK ERROR
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
MOVX P2,TS.NFO ;GET NO FIRST OUTPUT FLAG
TDNN P2,TCB.ST(B) ;IS IT ON?
JRST FOUT.0 ;NO, PROCEED
ANDCAM P2,TCB.ST(B) ;CLEAR IT
PJRST SETIUD ;SET 'IN USER DATA' AND RETURN
FOUT.0: PUSHJ P,VERVOL ;NO, NOW'S THE TIME
JUMPF FOUT.8 ;THEY DIDN'T VERIFY, RETURN
MOVX P2,TS.OUT ;TAPE DOING OUTPUT BIT
IORB P2,TCB.ST(B) ;TURN IT ON AND GET STATUS IN P2
JMPUNL LT,SETIUD ;UNLABELED,,SET 'IN USER DATA' & RETURN
;Here if appending to the tape
TXNN P2,TS.IUD ;ARE WE IN THE USERS DATA ???
JRST FOU.0A ;NO,,HE IS NOT APPENDING.....
TXNN P2,TS.NOW!TS.EXP!TS.WLK ;DOES USER HAVE ACCESS ???
$RETT ;YES,,LETERRIP !!!
TXNE P2,TS.NOW ;WHOLE TAPE WRITE-PROTECTED?
JRST [PUSHJ P,VPCCHK ;YES--CHECK WITH OPERATOR
JUMPF FOUT.8 ;OPR SAID ABORT
$RETT] ;DONE
TXNE P2,TS.EXP ;IS IT UNEXPIRED FILE ???
MOVEI S1,[ITEXT (<Output to unexpired file>)]
TXNE P2,TS.WLK ;IS IT FILE PROTECTION ERROR
MOVEI S1,[ITEXT (<File protection prohibits output>)]
PUSHJ P,O$LERR## ;ASK OPR WHAT TO DO
JUMPF FOUT.7 ;OPR SAID ABORT,,SO GIVE'M THE GONG
$RETT ;WIN,,RETURN NOW
FOU.0A: TXNN P2,TS.NOW ;IS WHOLE TAPE WRITE-PROTECTED?
JRST FOUT.1 ;NO, PROCEED
PUSHJ P,VPCCHK ;QUERY OPERATOR IF NECESSARY
JUMPF FOUT.8 ;GO ABORT (TERMINATION CODE SET)
;ELSE PROCEED (TERMINATION CODE ZEROED)
FOUT.1: MOVE P2,TCB.ST(B) ;RELOAD THE STATUS BITS
TXNN P2,TS.ATM!TS.IHL ;AFTER A TAPE MARK OR IN HEADER LABELS?
JRST FOUT.6 ;NO, GIVE ERROR
LOAD S1,TCB.SN(B) ;GET FILE SECTION NUMBER
CAIE S1,1 ;IF FIRST FILE SECTION, READ LABEL PARAMS
JRST FOUT.A ;DON'T READ UNLESS FIRST SECTION
PUSHJ P,I$RDLP## ;READ THE LABEL PARAMETERS
PUSHJ P,POSTAP ;SEE IF A POSITIONING REQUEST
JUMPF FOUT.8 ;ERROR ON POSITIONING
FOUT.A: PUSHJ P,T$RDRC## ;GO READ A RECORD
JUMPF FOUT.8 ;ERROR, RETURN
MOVE P1,TCB.IO(B) ;GET THE IO STATUS
TXNE P1,TI.EOF ;DIR LAST READ HIT EOF?
JRST FOUT.4 ;YES, BACK OVER IT AND WRITE HDR
PUSHJ P,VERHDR ;NO, CHECK AS HDR LABELS
JUMPF FOUT.8 ;DIDN'T CHECK, RETURN ERROR
LOAD P2,TCB.ST(B) ;GET TAPE STATUS
TXNN P2,TS.EXP ;FILE NOT EXPIRED?
JRST FOUT.2 ;NO, TRY PROTECTED
MOVEI S1,[ITEXT (<Output to unexpired file>)]
PUSHJ P,O$LERR## ;TELL OPR,,WAIT FOR RESPONSE
JUMPF FOUT.7 ;HE SAID ABORT
FOUT.2: TXNN P2,TS.WLK ;WRITE PROTECTED FILE?
JRST FOUT.3 ;NO,,THIS GUY WINS...
MOVEI S1,[ITEXT (<File protection prohibits output>)]
PUSHJ P,O$LERR## ;TELL OPR,,WAIT FOR RESPONSE
JUMPF FOUT.7 ;HE SAID ABORT
FOUT.3: PUSHJ P,FNDHD1 ;BACK UP AND FIND HDR1
JUMPF FOUT.8 ;COULDN'T, GIVE ERROR
PUSHJ P,I$RDLP## ;Re-read label parms (VERHDR zapped 'em)
MOVX S1,TS.PSN+TS.PSF ;GET 'POSITION REQ'D' BITS
ANDCAM S1,TCB.ST(B) ;AND CLEAR THEM SO WE'RE NOT RECURSIVE
FOUT.4: MOVEI S1,'BBL' ;ARG TO BACK UP RECORD
PUSHJ P,T$POS## ;GO POSITION
JUMPF FOUT.8 ;ERROR WHILE POSITIONING
SETZM TCB.BC(B) ;CLEAR BLOCK COUNT
MOVEI BUF,TCB.WB(B) ;GET OUTPUT BUFFER ADDRESS
PUSHJ P,WRTHDR ;NO GO WRITE HDR LABELS
JUMPF FOUT.8 ;ERROR WRITING LABELS
LOAD S1,TCB.SN(B) ;GET THE FILE SECTION NUMBER
CAIN S1,1 ;FIRST SECTION
PUSHJ P,I$STLP## ;YES, SET THE LABEL PARAMETERS
LOAD P1,TCB.IO(B) ;GET THE IO STATUS BACK
TXNE P1,TI.EOT ;ARE WE PAST EOT?
PJRST L$EOT ;YES, DON'T WRITE ANY DATA, GET NEXT
; VOLUME NOW
PJRST SETIUD ;SET 'IN USER DATA' AND RETURN
FOUT.6: MOVEI S1,LE.IOP ;ILLEGAL OPERATION
MOVEM S1,G$TERM## ;SET TERMINATION CODE
JRST FOUT.8 ;FINISH UP
FOUT.7: MOVEI S1,LE.VPF ;ASSUME VOLUME PROTECTION FAILURE
TXNE P2,TS.EXP ;IS IT UNEXPIRED FILE ???
MOVEI S1,LE.UEF ;YES
TXNE P2,TS.WLK ;IS IT WRITE-LOCKED?
FOUT.9: MOVEI S1,LE.WLK ;YES
MOVEM S1,G$TERM## ;AS TERMINATION CODE
FOUT.8: MOVX S1,TS.OUT+TS.NFI+TS.NFO ;GET OUTPUT+NO INPUT+NO OUTPUT
ANDCAM S1,TCB.ST(B) ;CLEAR THEM
$RETF ;AND GIVE BAD RETURN
SUBTTL L$CLIN - Routine to Process Input Close
ENTRY L$CLIN
L$CLIN: $TRACE (L$CLIN,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE FOR I/O
JUMPF .RETF ;COULDN'T?????
SKIPN TCB.IN(B) ;DID MONITOR SEE A TAPE MARK OR EOF?
JRST CLOSIN ;NO
MOVX S1,TS.ATM ;IF WE'VE ALREADY SEEN A TAPE MARK,
TDNN S1,TCB.ST(B) ; THEN WE DON'T WANT TO TRY TO PROCESS
PJRST L$TMAR ; ANOTHER ONE.
CLOSIN: SETZM TCB.IN(B) ;CLEAR 'TAPE MARK SEEN BY MONITOR' FLAG
MOVX S1,TS.NFI!TS.NFO!TS.INP ;GET SUPPRESS FINP+FOUT, DOING INPUT
ANDCAM S1,TCB.ST(B) ;CLEAR THEM
JMPUNL LT,.RETT ;Unlabeled, just return
PUSHJ P,INPCHK ;CHECK IF INPUT OPERATIONS ARE LEGAL
JUMPF .RETF ;THEY ARE NOT, RETURN NOW
MOVEI S1,1 ;SET THE FILE SECION NUMBER
STORE S1,TCB.SN(B) ;FOR THE NEXT FILE
PJRST I$CLLP## ;CLEAR THE PARAMETER BLOCK
SUBTTL L$CLOU - Routine to Process Close Output
ENTRY L$CLOU
L$CLOU: $TRACE (L$CLOU,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE FOR I/O
JUMPF .RETF ;COULDN'T?????
MOVX P2,TS.NFI!TS.NFO ;GET SUPPRESS FINP+FOUT
ANDCAB P2,TCB.ST(B) ;CLEAR THEM AND LOAD STATUS
TXNE P2,TS.OUT ;IS TAPE DOING OUTPUT
;CLOSE OUT ON INP ONLY TAPE IS A NOOP
TXNN P2,TS.IUD ;ARE WE IN USER DATA?
$RETT ;CLOSE OUT WHILE NOT IN DATA
JMPUNL LT,CLOU.1 ;Unlabeled, hadled differently
MOVEI BUF,TCB.WB(B) ;GET OUTPUT BUFFER ADDRESS
PUSHJ P,I$BCNT## ;COMPUTE FILE BLOCK COUNT
ADDM S1,TCB.BC(B) ;SAVE IT IN TCB
PUSHJ P,T$WRTM## ;WRITE A TAPE MARK
JUMPF .RETF ;ERROR WRITING TAPE MARK
PUSHJ P,WRTEOF ;WRITE EOF LABEL
JUMPF .RETF ;ERROR WRITING LABELS
INCR TCB.PS(B),TP.POS ;ADJUST THE POSITION
PUSHJ P,I$CLLP## ;CLEAR LABEL PARAMS AREAS
MOVX P2,TS.OUT ;GET BIT WHICH SAYS DOING OUTPUT
ANDCAM P2,TCB.ST(B) ;CLEAR IT IN THE TCB
MOVEI S1,1 ;GET A 1
STORE S1,TCB.SN(B) ;SAVE AS FILE SECTION NUMBER
$RETT ;RETURN
CLOU.1: PUSHJ P,T$WRTM## ;WRITE A TAPE MARK
JUMPF .RETF ;OOPS
PUSHJ P,T$WRTM## ;AND ANOTHER
JUMPF .RETF ;OOPS
MOVEI S1,'BFL' ;BACK OVER LAST TAPE MARK
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;...
LOAD P2,TCB.ST(B) ;GET STATUS
TXZ P2,TS.OUT!TS.POS ;NOT WRITING, CLEAR POSITION
TXO P2,TS.ATM ;FLAG AFTER TAPE MARK
STORE P2,TCB.ST(B) ;SAVE IN TCB
$RETT ;AND GIVE GOOD RETURN
SUBTTL L$EOT - Routine to Process EOT
;This routine gets control when the user is writing data and
; rolls past the EOT sticker.
L$EOT:: $TRACE (L$EOT,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE
JUMPF .RETF ;COULDN'T
JMPUNL LT,EOV.NL ;Unlabeled, do it another way
MOVEI BUF,TCB.WB(B) ;GET OUTPUT BUFFER ADDRESS
PUSHJ P,I$BCNT## ;COMPUTE FILE BLOCK COUNT
ADDM S1,TCB.BC(B) ;STORE IT IN THE TCB
PUSHJ P,T$WRTM## ;WRITE A TAPE MARK
JUMPF EOV.2 ;WE LOST
PUSHJ P,WRTEOV ;WRITE EOV LABELS
JUMPF EOV.2 ;WE LOST
INCR TCB.SN(B) ;BUMP THE FILE SECTION NUMBER
EOV.1: PUSHJ P,NXTVOU ;NOW MOUNT NEXT VOLUME FOR OUTPUT
JUMPF .RETF ;THAT LOST, OH WELL (MAYBE EOF!)
MOVX S1,TS.FFF ;GET FIRST FILE FLAG
IORM S1,TCB.ST(B) ;SET TO BYPASS SEQ # AND SECTION # CHECK
PJRST L$FOUI ;AND ACT AS IF FIRST OUTPUT
;But don't reset file section #
;Here when we hit EOT for an unlabeled tape
EOV.NL: CAXN LT,LT.NLV ;User processed EOV already?
JRST EOV.1 ;Yes, just get the next volume
;Note: We can only get here
; on an internal call from FEOV,
; since the monitor does NOT
; notify us of EOT on NLV tape.
PUSHJ P,T$WRTM## ;Write a tape mark
JUMPF EOV.3 ;Too bad
PUSHJ P,T$WRTM## ;Mark eot for next reader of the tape
JUMPF EOV.3 ;Bad day!
MOVEI S1,'BBL' ;Then back up over
PUSHJ P,T$POS## ;the first... (Stay between marks)
JRST EOV.1 ;And then get the next tape up
EOV.2: SKIPA S1,[[ITEXT(<Error writing EOV labels>)]]
EOV.3: MOVEI S1,[ITEXT(<Error writing tape marks at EOT>)]
PUSHJ P,O$LERR## ;GO WAIT FOR OPR RESPONSE
JUMPT EOV.1 ;CONTINUE ON IF OK - SUCKER
MOVX S2,LE.CAN ;GET CANCELLED STATUS
MOVEM S2,G$TERM## ;SAVE IT
SETZM TCB.WS(B) ;SET TCB IDLE
MOVX S1,TS.NTP ;Get no tape bit
MOVEM S1,TCB.ST(B) ;That's all we know about the TCB
$RETF ;Return
SUBTTL L$FEOV - Process User Request to Force End Of Volume
L$FEOV:: $TRACE (L$FEOV,2)
MOVE P2,TCB.ST(B) ;GET THE STATUS
TXNE P2,TS.OUT ;IS THE TAPE DOING OUTPUT
PJRST L$EOT ;YES,,JUST DO LEOT IF OUTPUT
;HERE ON FEOV ON INPUT
PUSHJ P,T$OPEN ;GO OPEN THE TAPE
JUMPF .RETF ;COULDN'T, RETURN
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
PUSHJ P,NXTVIN ;GET NEXT VOLUME MOUNTED FOR INPUT
JUMPF .RETF ;CAN'T
JMPUNL LT,L$FINP ;UNLABELED,,ACT AS FIRST INPUT
AOS TCB.SN(B) ;LABELED,,BUMP SECTION NUMBER
PJRST L$FINT ;ACT AS FIRST INPUT,,NEW SECTION NUMBER
SUBTTL L$TMAR - Routine Called On Encountering a Tape Mark
L$TMAR::$TRACE (L$TMARK,2)
PUSHJ P,T$OPEN## ;OPEN THE TAPE
JUMPF .RETF ;COULDN'T?
MOVX S1,TS.NFI!TS.NFO ;GET SUPPRESS FINP+FOUT
ANDCAM S1,TCB.ST(B) ;CLEAR THEM
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
CAIN LT,LT.NL ;NOLABELES?
JRST TMAR.N ;A CROSS BETWEEN LABELD AND UNLABELED
JMPUNL LT,TMAR.U ;UNLABELED TAPES GO HERE
JRST TMAR.L ;LABELED TAPE GO HERE
; Common exit code for tape mark processing. Sets EOF and gets user
; out of Event Wait. All routines should PJRST to here.
TMAR.X: MOVX T1,LE.EOF ;CODE TO SAY EOF
STORE T1,G$TERM## ;SAVE AS TERMONATION CODE
MOVE P2,TCB.ST(B) ;GET STATUS
TXZ P2,TS.POS ;CLEAR POSITION INFO
TXO P2,TS.ATM ;FLAG AFTER TAPE MARK
STORE P2,TCB.ST(B) ;SAVE STATUS
PJRST CLOSIN ;DO INPUT CLOSE
; Here for labeled tapes
TMAR.L: PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF .RETF ;ERROR, RETURN
PUSHJ P,CHKEF1 ;CHECK FIRST 4 CHARS AS EOF1
JUMPF TMAL.1 ;THE'RE NOT, TRY AS EOV1
PUSHJ P,VEREOF ;VERIFY AS EOF LABELS
JUMPF .RETF ;THEY DON'T
PJRST TMAR.X ;RETURN EOF
; Here if EOV1 label seen -- must switch volumes
TMAL.1: PUSHJ P,VEREOV ;VERIFY AS EOV LABELS
JUMPF .RETF ;NOT, RETURN ERROR CODE
PUSHJ P,NXTVIN ;MOUNT NEXT INPUT VOLUME
JUMPF TMAL.2 ;ERROR SWITCHING VOLUMES
LOAD S1,TCB.SN(B) ;GET THE FILE SECTION NUMBER
AOS S1 ;INCREASE TO THE NEXT SECTION
STORE S1,TCB.SN(B) ;STORE AWAY
PJRST L$FINT ;ACT AS FIRST INPUT
TMAL.2: MOVX S1,<TI.LET> ;GET THE LEOT BIT
IORM S1,TCB.IO(B) ;LIGHT IT
PJRST TMAR.X ;GO RETURN EOF
; Here for NOLABELS tapes
TMAR.N: MOVX S1,TI.LTP ;GET LAST TAPE IN VOLUME-SET BIT
ANDCAB S1,TCB.IO(B) ;CLEAR IT
TXNE S1,TI.LET ;PREVENT POSSIBLE HUNG DEVICE BY NOT
PJRST TMAR.X ; READING PAST LEOT AND RETURNING EOF
JRST TMA.3B ;OK--GO TEST FOR LEOT NOW
; Here for unlabeled tapes
TMAR.U: MOVX S1,TS.IUD ;GET IN USER DATA FLAG
TDNE S1,TCB.ST(B) ;UNLABELED AND IN USER DATA?
PJRST TMAR.X ;RETURN EOF
TMA.3B: SKIPN TCB.IN(B) ;TAPE MARK? (CALLED BY L$CLIN)
JRST TMAR.9 ;NO
PUSHJ P,T$RDRC## ;READ NEXT RECORD
SKIPF ;TURN I/O ERRORS INTO EOF SO PROGRAMS
TDZA S1,S1 ; CAN READ PAST BAD SPOTS ON TAPE
MOVX S1,TI.EOF ; (IN PARTICULAR, DIRECT NEEDS THIS)
IORB S1,TCB.IO(B) ;GET I/O STATUS
TXNE S1,TI.EOF ;EOF AGAIN?
TXO S1,TI.LET ;YES--POSITIONED AT LEOT
MOVEM S1,TCB.IO(B) ;UPDATE I/O STATUS
TXNE S1,TI.LET ;AT LEOT NOW?
CAIE LT,LT.NL ;AND NOLABELS?
JRST TMAR.6 ;NO--JUST BACKUP 1 BLOCK AND RETURN EOF
JRST TMAR.5 ;TRY TO GET THE NEXT REEL IN VOLUME SET
TMAR.9: MOVEI S1,'BBL' ;MUST MOVE BACK
PUSHJ P,T$POS## ;TWO BLOCK IN ORDER
MOVEI S1,'BBL' ;TO CHECK FOR LOGICAL
PUSHJ P,T$POS## ;END OF TAPE
PUSHJ P,T$RDRC## ;READ A RECORD BEFORE THE EOF
JUMPF TMAR.4 ;ERROR NO EOF BEFORE THIS ONE
LOAD S1,TCB.IO(B),TI.EOF ;GET THE EOF BIT
JUMPN S1,TMAR.5 ;YES, LOGICAL EOT
;Here if the thing before the tape mark is not tape mark
;Position is before the 'current' tape mark
TMAR.4: MOVEI S1,'SBL' ;SKIP THE CURRENT EOF
PUSHJ P,T$POS## ;WE KNOW IT IS THERE
PUSHJ P,T$RDRC## ;READ THE NEXT RECORD
JUMPF TMAR.6 ;ERROR
LOAD S1,TCB.IO(B),TI.EOF ;GET THE EOF BIT
JUMPE S1,TMAR.6 ;NOT EOF THEREFORE NOT AT EOT
MOVEI S1,'BBL' ;POSITION INCASE NXTVOL FAILS
PUSHJ P,T$POS## ;AND THE USER READS AGAIN
;Here when we have seen 2 tape marks
;Position is between the tape marks
TMAR.5: CAIN LT,LT.NLV ;NO LABELS??
JRST TMAR.7 ;NO--JUST RETURN EOF
CAIE LT,LT.NL ;IS IT USER-EOT ???
PJRST TMAR.X ;YES,,RETURN EOF TO THE USER
PUSHJ P,NXTVIN ;DOUBLE EOF GET NEXT VOLUME
JUMPT L$FINP ;GO PROCESS FIRST INPUT REQUEST
MOVX S1,TI.LTP ;LAST TAPE IN VOLUME SET
IORM S1,TCB.IO(B) ;SAVE FOR POSITIONING CODE
TMAR.7: LOAD S1,TCB.IO(B) ;GET THE I/O STATUS WORD
TXNN S1,TI.LET ;WERE WE AT LEOT BEFORE THIS?
JRST TMAR.8 ;GO RETURN
MOVEI S1,'SBL' ;FORWARD SPACE OVER THE TAPE MARK
PUSHJ P,T$POS## ;DO IT
MOVX S1,TI.LET ;GET THE BIT THAT WE WERE HERE BEFORE
ANDCAM S1,TCB.IO(B) ;CLEAR IT
PJRST TMAR.X ;RETURN EOF
TMAR.8: TXO S1,TI.LET ;TURN ON THE BEEN HERE BIT
STORE S1,TCB.IO(B) ;TELL WE ARE NOW
JRST TMAR.X ;RETURN EOF
;Here when we don't have 2 tape marks in a row
TMAR.6: MOVEI S1,'BBL' ;BACKSPACE A BLOCK (MUST BE USER'S DATA)
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR
PJRST TMAR.X ;RETURN EOF
SUBTTL L$POSI - MTAPE and TAPOP. Positioning functions
L$POSI:: PUSHJ P,.SAVE1 ;SAVE P1
$TRACE (L$POSITION,2)
MOVNI P1,1 ;INIT FLAG
POS.0: PUSHJ P,T$OPEN## ;OPEN THE TAPE FOR IO
JUMPT POS.1 ;Got it, keep going
LOAD S1,TCB.IN(B) ;COULDN'T,Get request code
MOVE S2,G$TERM## ;Get the error reason
CAIE S1,POSREW ;WAS IT REWIND?
CAIN S2,LE.IOP ;TRYING TO UNDO ERROR?
SKIPA ;YES--LET HIM THROUGH
$RETF ;Neither, Too bad!
PUSHJ P,L$CLEF ;CLEAR ERROR
SETZM G$TERM## ;CLEAR TERMINATION CODE
AOJE P1,POS.0 ;AND TRY AGAIN IF THE FIRST TIME
MOVEI S1,LE.IOP ;OTHERWISE RETURN ILLEGAL POSITIONING
MOVEM S1,G$TERM## ; REQUESTED AND WE'RE DONE WITH THIS
$RETF ; MONITOR REQUEST
POS.1: MOVX S1,TS.ILC ;ZAP THE INHIBIT
ANDCAB S1,TCB.ST(B) ; LABEL CLEAR BIT
TXNE S1,TS.NTP ;Is there a tape?
PJRST PS.BAD ;No, forget it but release the user
MOVEI BUF,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
MOVE P1,TCB.IN(B) ;GET SAVED INFO FROM MESSAGE
CAIN P1,.TFWLE+40 ;WRITE LOGICAL EOT?
MOVX P1,-2 ;YES
CAIN P1,.TFDSE+40 ;DATA SECURITY ERASE?
MOVX P1,-1 ;YES
; We know that the monitor won't give is a negative function code
; so we won't check for it. Besides, MACRO can't handle the following
; instruction because of the forward references and I don't feel line
; moving the positioning dispatch table.
; CAML P1,[POSMIN] ;OFF THE LOWER END OF THE TABLE?
CAILE P1,POSLEN ;OR GREATER THAN MAX?
PJRST PS.ILF ;Yes,,return Illegal Operation
MOVX S1,TS.NFI!TS.NFO ;Get first in or out suppress bits
ANDCAM S1,TCB.ST(B) ;Clear out, since we're moving the tape
IFN FTTRACE,<
SKIPE G$DEBUG ;Debugging?
$TEXT (,<^I/@POSMSG(P1)/>) ;Yes, type a note
>;END IFN FTTRACE
CAXE P1,POSREW ;Was it rewind?
PUSHJ P,VERVOL ;No,,Validate the VOL labels
JUMPF .RETF ; Failed !!!!
SKIPGE POSREQ(P1) ;Do we want to intervene?
JRST POS.2 ;Yes, do the work
CAIN LT,LT.NL ;NOLABELS?
JRST POS.2 ;YES--IT'S KINDA LIKE A LABELED TAPE
JMPUNL LT,POS.3 ;May need help, but not if unlabeled
POS.2: PUSHJ P,@POSREQ(P1) ;FUNCTION IN RANGE, DISPATCH
MOVX S1,TS.ILC ;BIT TO TEST
TDNN S1,TCB.ST(B) ;INHIBIT LABEL PARAMETER CLEARING?
PUSHJ P,I$CLLP## ;CLEAR THE PARAMETER BLOCK
$RETT ;BYE
;Here for Unlabeled tapes
POS.3: MOVEI S1,LE.CON ;GET CODE TO ASK MONITOR TO DO IT
MOVEM S1,G$TERM## ;STORE IT AS TERMINATION CODE
POPJ P, ;RETURN
; WILL TELL MONITOR TO DO
; IT -- MONITOR WILL GIVE USER
; APPROPRIATE ERROR
;Sign bit is set for operations on unlabeled tapes
; which require some action on our part
POSMIN==.-POSREQ ;LOWER LIMIT
PS.WLE ;(-2) WRITE LOGICAL END OF TAPE
PS.DSE ;(-1) DATA SECURITY ERASE
POSREQ: PS.ILF ;0-ILLEGAL FUNCTION
POSREW==.-POSREQ ;Offset for rewind function
400000,,PS.REW ;1-REWIND
PS.ILF ;2-ILLEGAL FUNCTION
PS.WTM ;3-WRITE A TAPE MARK
PS.ILF ;4-ILLEGAL FUNCTION
PS.ILF ;5-ILLEGAL FUNCTION
PS.SKR ;6-SKIP A RECORD
PS.BSR ;7-BACKSPACE A RECORD
PS.SET ;10-SKIP TO LEOT
400000,,PS.UNL ;11-UNLOAD
PS.ILF ;12-ILLEGAL FUNCTION
POSWBT==.-POSREQ ;Code to write gap
PS.WBT ;13-WRITE BLANK TAPE
PS.ILF ;14-ILLEGAL FUNCTION
PS.ILF ;15-ILLEGAL FUNCTION
PS.SKF ;16-SKIP A FILE
PS.BSF ;17-BACKSPACE A FILE
POSLEN==.-POSREQ
IFN FTTRACE,<
[ITEXT (Write logical EOT)]
[ITEXT (Data security erase)]
POSMSG: @ILLMSG
[ITEXT (Rewind)]
@ILLMSG
[ITEXT (Write tape mark)]
@ILLMSG
@ILLMSG
[ITEXT (Skip a record)]
[ITEXT (Backspace a record)]
[ITEXT (Skip to LEOT)]
[ITEXT (Unload)]
@ILLMSG
[ITEXT (Write blank tape)]
@ILLMSG
@ILLMSG
[ITEXT (Skip a file)]
[ITEXT (Backspace a file)]
ILLMSG: [ITEXT (Illegal positioning request code ^O/T1/)]
>;END IFN FTTRACE
;Here for Illegal function
PS.ILF: MOVEI S1,LE.IOP ;GET CODE FOR ILLEGAL OPERATION
MOVEM S1,G$TERM## ;SAVE AS TERMINATION CODE
$RETF ;Return
;Here if Positioning failed
PS.BAD: MOVEI S1,LE.PSE ;GET CODE FOR POSITIONING ERROR
MOVEM S1,G$TERM## ;AND SAVE FOR RETURN
$RETF ;Return
; HERE TO STORE TERMINATION CODE AND INHIBIT LABEL PARAMETER CLEAR
PS.TRM: MOVEM S1,G$TERM## ;SAVE TERMINATION CODE
PS.ILC: MOVX S1,TS.ILC ;INHIBIT LABEL PARAMETER BLOCK CLEARING
IORM S1,TCB.ST(B) ;DURING POST-POSITIONING CLEANUP
POPJ P, ;RETURN
;Here to perform an UNLOAD function
PS.UNL: ;Fall into rewind, but DON'T unload anything!
;Here to perform a REWIND function
PS.REW: LOAD T1,TCB.ST(B) ;GET TAPE STATUS
TXNN T1,TS.OUT ;DOING OUTPUT?
JRST REW.1 ;NO, PROCEED
PUSHJ P,L$CLOU ;YES, DO A CLOSE FIRST
JUMPF .RETF ;ERROR, EXIT
REW.1: PUSHJ P,FIRVOL ;GET FIRST TAPE IN SET
JUMPF .RETF ;CAN'T GET FIRST VOLUME
MOVX S1,LE.BOT ;TERM CODE TO RETURN BOT AND SET FSTOP
MOVEM S1,G$TERM## ;SAVE FOR RETURN
MOVEI S1,'REW' ;GET CODE TO REQUEST REWIND
PUSHJ P,T$POS## ;DO THE REWIND
JUMPF .RETF ;ERROR ON REWIND?
MOVEI S1,1 ;FILE COUNT TO FIRST FILE
STORE S1,TCB.PS(B),TP.POS ;CLEAR THE FILE COUNT
MOVX S1,TS.FFF ;GET FIRST FILE FLAG
IORM S1,TCB.ST(B) ;INDICATE IN FIRST FILE ON TAPE
MOVX S1,TS.INP!TS.NFI!TS.OUT!TS.NFO!TS.VLV!TS.POS ;GET LOTS OF BITS
ANDCAM S1,TCB.ST(B) ; AND CLEAR THEM
$RETT ;RETURN
;Here to perform a WRITE TAPE MARK function
PS.WTM: MOVE P2,TCB.ST(B) ;GET STATUS
TXNN P2,TS.OUT ;DOING OUTPUT
JRST WTM.1 ;NO
TXNE P2,TS.IUD ;IN USERS DATA?
JRST WTM.2 ;YES--JUST SIMULATE CLOSE OUTPUT
WTM.1: PUSHJ P,L$FOUT ;DO FIRST OUTPUT PROCESSING
JUMPF .RETF ;CHECK FOR ERRORS
WTM.2: PUSHJ P,L$CLOU ;FIRST FINISH UP WITH CLOSE OUT
JUMPF .RETF ;DIDN'T MAKE IT
MOVEI S1,LE.EOF ;EOF CODE
STORE S1,G$TERM ;SET FOR LABEL RELEASE
$RETT ;ALL DONE
;Here to perform a SKIP RECORD function
PS.SKR: LOAD S1,TCB.IO(B) ;Get the I/O Flags
TXNE S1,<TI.LET> ;Are we aready at LEOT
$RETT ;Assume we're done
LOAD P2,TCB.ST(B) ;GET THE STATUS
TXNE P2,TS.OUT ;ARE WE DOING OUTPUT?
PJRST PS.IOP ;YES-CAN'T DO THIS
TXNN P2,TS.IUD ;ARE WE IN USER DATA?
JRST SKR.2 ;NO,DO THIS DIFFERENTLY
SKR.1: STORE P2,TCB.ST(B) ;STORE THE STATUS
MOVEI S1,'SBL' ;CODE TO SKIP A BLOCK
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR RETURN
LOAD P1,TCB.IO(B) ;GET THE STATUS
TXNN P1,TI.EOF ;DID SKIP HIT EOF?
$RETT ;NO, JUST RETURN
PJRST L$TMARK ;ACT LIKE TAPE MARK SEEN
SKR.2: TXNN P2,TS.VLV!TS.ATM!TS.IHL ;VOL LABELS VERIFIED, OR IN HEADER
; GROUP OR AFTER TAPE MARK
STOPCD (SSR,HALT,,<Strange skip record>)
PUSHJ P,L$FINP ;DO FIRST INPUT STUFF
JUMPF .RETF ;IT DIDN'T WORK
MOVX S1,TS.ATM ;GET BIT INDICATING LEOT
TDNE S1,TCB.ST(B) ;IF INPUT SAYS NO MORE TAPE,..
$RETT ; ... THEN SKIP REC IS A NOOP.
TXO P2,TS.NFI ;FLAG NO FIRST INPUT
JRST SKR.1 ;OK, NOW SKIP THE RECORD
;Here to perform a BACKSPACE RECORD function
PS.BSR: LOAD P2,TCB.ST(B) ;GET THE STATUS
TXNN P2,TS.VLV ;VOL LABELS VERIFIED?
$RETT ;RETURN TRUE
TXNN P2,TS.OUT ;DOING OUTPUT?
JRST BSR.1 ;NO, PROCEED
PUSHJ P,L$CLOU ;DO A CLOSE OUTPUT
JUMPF .RETF ;ERROR, RETURN
PUSHJ P,PS.BSF ;THEN A BACKSPACE FILE
JUMPF .RETF ;ERROR , RETURN
SETZM G$TERM## ;CLEAR G$TERM, SINCE BSF SETS EOF!
BSR.1: TXNE P2,TS.IUD ;IN THE USER DATA
JRST BSR.2 ;YES
TXNN P2,TS.VLV!TS.ATM!TS.IHL ;VOL LABELS VERIFIED, OR IN HEADER
STOPCD (BBR,HALT,,<Bad backspace record>)
PUSHJ P,L$FINP ;DO FIRST INPUT
JUMPF .RETF ;ERROR
MOVX P2,TS.NFI ;GET NOT FIRST INPUT
IORB P2,TCB.ST(B) ;SET IT ON
TXZ P2,TS.ATM ;CLEAR AFTER TAPE MARK
TXO P2,TS.IUD ;WILL BE IN USER DATA
MOVEM P2,TCB.ST(B) ;UPDATE
JMPUNL LT,BSR.2 ;ONWARD IF UNLABELED
MOVEI S1,'BFL' ;NEED TO BACKSPACE
PUSHJ P,T$POS## ; OVER THE EOF RECORDS
JUMPF .RETF ;CHECK FOR ERRORS
MOVEI S1,'BFL' ;AND BACKUP OVER
PUSHJ P,T$POS## ; THE TAPE MARK TOO
JUMPF .RETF ;CHECK FOR ERRORS
MOVEI S1,'SBL'
PUSHJ P,T$POS##
JUMPF .RETF
PUSHJ P,T$RDRC## ;READ EOF1 LABEL
JUMPF .RETF ;CAN'T
PUSHJ P,VEREOF ;VERRIFY EOF, GET FILE NAME, ETC.
JUMPF .RETF ;NO GOOD
LOAD S1,TCB.PS(B),TP.POS ;GET POSITION
SUBI S1,2 ;ACCOUNT FOR EOF CHECK AND FORWARD SKIP
STORE S1,TCB.PS(B),TP.POS ;UPDATE
PUSHJ P,I$STLP## ;SET LABEL PARAMETERS IN THE MONITOR
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE TAPE MARK
JUMPF .RETF ;CAN'T
MOVEI S1,'BFL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE EOF RECORDS
JUMPF .RETF ;CAN'T
MOVE S1,TCB.ST(B) ;GET STATUS WORD
TXZ S1,TS.ATM ;NO LONGER AFTER A TAPE MARK
TXO S1,TS.IUD ;POSITIONED IN USER DATA
MOVEM S1,TCB.ST(B) ;UPDATE
PUSHJ P,PS.ILC ;INHIBIT LABEL CLEAR
$RETT ;RETURN AND LET USER APPEND TO THE FILE
BSR.2: MOVEI S1,'BBL' ;JUST TRY TO BACK UP A BLOCK
PUSHJ P,T$POS## ;...
JUMPF .RETF ;ERROR DOING IT
LOAD P1,TCB.IO(B) ;GET IO STATUS
CAIN LT,LT.NL ;NOLABELS?
JRST BSR.5 ;MUST CHECK FOR REEL SWITCH DIFFERENTLY
; Here for labeled tapes
BSR.3: TXNN P1,TI.EOF ;BBL SAW EOF?
JRST [PUSHJ P,PS.ILC ;LIGHT INHIBIT LABEL CLEAR
$RETT] ;RETURN
MOVEI S1,'SBL' ;SKIP BACK OVER THE TAPE MARK
PUSHJ P,T$POS## ;CAUSE FNDHD1 EXPECTS TO BE AFTER IT
JUMPF .RETF ;CAN'T SKIP THE TAPE MARK???
PUSHJ P,FNDHD1 ;GO FIND THE HDR1 LABEL
JUMPF .RETF ;COULDN'T
PUSHJ P,@GETFSN(LT) ;NO GET THE FILE SECTION NUMBER
JUMPF .RETF ;THATS RATHER STRANGE?
CAIN S2,1 ;IS THIS THE FIRST FILE SECTION?
JRST BSR.4 ;YES, DO SPECIAL STUFF
PUSHJ P,LSTVOL ;;NO, FIND END OF PRECEDING VOL
; AND VER EOV LBLS.
JUMPF .RETF ;COULDN'T HACK IT
JRST BSR.1 ;NOW TRY TO BACKSPACE THE BLOCK
BSR.4: MOVEI S1,'SFL' ;SET UP TO SKIP REST OF LABEL GROUP
PUSHJ P,T$POS## ;PUTS US AT START OF USER FILE
JUMPF .RETF ;ONLY IF IT WORKED
PJRST PS.BSF ;DO LIKE BACKSPACE FILE
; Here for NOLABELS tapes
BSR.5: TXNN P1,TI.BOT ;AT BOT?
$RETT ;NO--DONE
PUSHJ P,LSTVOL ;GET PREVIOUS REEL
JUMPF .RETF ;CAN'T
MOVEI S1,'EOT' ;NOW POSITION TO
PUSHJ P,T$POS## ; PHYSICAL END OF TAPE
JUMPF .RETF ;CAN'T
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; A TAPE MARK
JUMPF .RETF ;CAN'T
JRST BSR.1 ;AND FINALLY BACKSPACE OVER THE RECORD
;Here to perform SKIP TO LEOT function
PS.SET: SETZM TCB.IN(B) ;CLEAR REQUEST CODE (CONFUSES L$TMAR)
LOAD P2,TCB.ST(B) ;GET TCB STATUS WORD
TXNE P2,TS.OUT ;DOING OUTPUT?
PJRST PS.IOP ;YES, ILLEGAL
MOVX S1,TI.LET ;GET LEOT BIT
TDNE S1,TCB.IO(B) ;ARE WE AT TAPE'S END?
JRST SET.3 ;YES, GO FINISH UP
TXNE P2,TS.IUD ;IN USER DATA?
JRST SET.2 ;YES,START BY SKIPPING IT
TXNN P2,TS.ATM!TS.IHL ;ARE WE AFTER A TAPE MARK??
PUSHJ P,PS.BAD ;BAD TAPE, GIVE STOPCD
SET.1: PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF .RETF ;CAN'T
LOAD P1,TCB.IO(B) ;GET IO STATUS
TXNE P1,TI.EOF ;SAW EOF??
JRST SET.3 ;YES, ALL DONE
PUSHJ P,VERHDR ;CHECK HDR LABELS
JUMPF .RETF ;COULDN'T, ERROR
SET.2: PUSHJ P,G$OJOB## ;GO CHECK SCHEDULER
MOVEI S1,'SFL' ;SET TO SKIP FILE
PUSHJ P,T$POS## ;SKIP OVER USERS DATA
JUMPF .RETF ;CAN'T
MOVX S1,TS.ATM ;NOW WE'RE POSITIONED
IORM S1,TCB.ST(B) ; AFTER A TAPE MARK
PUSHJ P,L$TMAR ;DO LIKE USER SAW TAPE MARK
JUMPF .RETF ;OOPS
MOVE S1,TCB.IO(B) ;GET I/O STATUS
MOVE S2,S1 ;COPY IT
TXZ S2,TI.LTP ;CLEAR LAST TAPE BIT
MOVEM S2,TCB.IO(B) ;UPDATE
TXNE S1,TI.LTP ;LAST TAPE IN VOLUME SET?
JRST SET.1 ;YES
MOVE P2,TCB.ST(B) ;GET THE STATUS
CAIE LT,LT.NL ;NOLABELS?
TXNE P2,TS.IUD ;IN USER DATA?
JRST SET.2 ;YES, SKIP REST OF USER'S FILE
JRST SET.1 ;NO, TRY FOR HDR LABELS
SET.3: MOVEI S1,LE.EOF ;RETURN EOF
MOVEM S1,G$TERM## ;ON THE RELEASE
MOVEI S1,'BFL' ;BACK UP OVER THE TAPE MARK
PJRST T$POS## ;AND RETURN WHEN DONE
;Here to perform a WRITE BLANK TAPE function
PS.WBT: LOAD P2,TCB.ST(B) ;GET DRIVE STATUS
TXNN P2,TS.OUT ;TAPE DOING OUTPUT?
JRST WBT.1 ;NO, TRY TO CHECK HDR LBLS
TXNE P2,TS.IUD ;IN USER'S DATA??
JRST WBT.3 ;YES, JUST LET MONITOR DO IT
WBT.1: CAIN LT,LT.NL ;NOLABELS?
JRST WBT.2 ;MEANS NO HEADER RECORDS
TXNN P2,TS.ATM!TS.IHL ;IN HEADERS OR AFTER TM?
JRST WBT.4 ;NO, ITS A STRANGE TAPE
WBT.2: PUSHJ P,L$FOUT ;DO LIKE FIRST OUTPUT
JUMPF .RETF ;ERROR
MOVX S1,TS.NFO ;REMEMBER THAT WE
IORM S1,TCB.ST(B) ; HAVE ALREADY DONE FIRST OUT
WBT.3: MOVEI S1,LE.CON ;LET THE MONITOR DO IT
PUSHJ P,PS.TRM ;SAVE AND INHIBIT LABEL CLEAR
$RETT ;GIVE GOOD RETURN
WBT.4: MOVEI S1,LE.PSE ;POSITIONING ERROR
PUSHJ P,PS.TRM ;SAVE AND INHIBIT LABEL CLEAR
$RETF
;Here to perform SKIP A FILE function
PS.SKF: LOAD S1,TCB.IO(B) ;GET THE I/O FLAGS
TXNE S1,TI.LET ;ARE WE AREADY AT LEOT
$RETT ;ASSUME WE'RE DONE
LOAD P2,TCB.ST(B) ;GET THE STATUS
TXNE P2,TS.OUT ;ARE WE DOING OUTPUT?
PJRST PS.IOP ;YES-CAN'T DO THIS
TXNE P2,TS.IUD ;IN USER'S DATA?
JRST SKF.2 ;YES, JUST SKIP TO END OF FILE
TXNN P2,TS.ATM!TS.IHL ;AFTER A TAPE MARK OR IN HEADER LABELS?
PUSHJ P,PS.BAD ;GIVE STOPCD FOR ILLEGAL TAPE POSITION
PUSHJ P,L$FINP ;DO FIRST INPUT PROCESSING
JUMPF .RETF ;FAILED
MOVX S1,TS.ATM ;GET BIT WHICH SAYS FINP SAW LEOT
TDNE S1,TCB.ST(B) ;IF INPUT SAW END OF TAPE, THEN
$RETT ; ... SKIP FILE IS A NOOP
MOVX P2,TS.NFI ;INDICATE FIRST INPUT
IORB P2,TCB.ST(B) ; PROCESSING NOT NEEDED NEXT TIME
JRST SKF.2 ;ONWARD
SKF.1: PUSHJ P,G$OJOB## ;GO CHECK SCHEDULER
SKF.2: MOVEI S1,'SFL' ;SET TO SKIP FILE
PUSHJ P,T$POS## ;SKIP TO END OF USER'S FILE
JUMPF .RETF ;COULDN'T
PUSHJ P,L$TMARK ;OK, NOW JUST ACT LIKE WE SAW EOF
JUMPF .RETF ;DIDN'T WORK
LOAD P2,TCB.ST(B) ;GET THE STATUS
TXNE P2,TS.IUD ;TAPE MARK CODE LEAVE US IN USER DATA?
JRST SKF.1 ;YES, MUST HAVE SWITCHED VOLUMES
$RETT ;NO,WE'RE ALL DONE
;Here to perform BACKSPACE A FILE function
PS.BSF: LOAD P2,TCB.ST(B) ;GET THE STATUS
TXNN P2,TS.VLV ;VOL LABELS VERIFIED?
JRST BSF.6 ;NO, JUST RETURN BOT
TXNN P2,TS.OUT ;DOING OUTPUT?
JRST BSF.1 ;NO, JUST PROCEED
PUSHJ P,L$CLOU ;YES, FORCE A CLOSE OUTPUT
JUMPF .RETF ;IT DIDN'T WORK
MOVEI S1,'BFL' ;SET TO BACKSPACE INTO EOF LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR BACKSPACING
MOVEI S1,'BFL' ;NOW BACK INTO USER'S DATA
PUSHJ P,T$POS## ;...
JUMPF .RETF ;CAN'T DO IT
TXZ P2,TS.POS ;CLEAR THE POSITIONING INFO
TXO P2,TS.IUD ;AND FLAG IN USER DATA
STORE P2,TCB.ST(B) ;MAKE SURE TCB IS RIGHT
BSF.1: CAIN LT,LT.NL ;NOLABELS?
JRST BSF.7 ;HANDLE DIFFERENTLY
TXNE P2,TS.IUD ;ARE WE IN USER DATA?
JRST BSF.2 ;YES, SIMPLE CASE
TXNN P2,TS.VLV!TS.ATM!TS.IHL ;VOL LABELS VERIFIED, OR IN HEADER
STOPCD (BBF,HALT,,<Bad backspace file>)
PUSHJ P,L$FINP ;DO FIRST INPUT
JUMPF .RETF ;ERROR
MOVX P2,TS.NFI ;GET NOT FIRST INPUT
IORB P2,TCB.ST(B) ;SET IT ON
TXNN P2,TS.ATM ;EOT
JRST BSF.2 ;NO IN THE USER DATA
MOVEI S1,'BFL' ;BACK INTO EOF LABELS
PUSHJ P,T$POS## ;...
JUMPF .RETF ;CAN'T
JRST BSF.3 ;NOW FINISH UP LIKE NORMAL CASE
BSF.2: PUSHJ P,FNDHD1 ;GO FIND THE HDR1 LABEL
JUMPF .RETF ;CAN'T--MUST NOT BE GOOD LABEL
PUSHJ P,@GETFSN(LT) ;GET THE FILE SECTION NUMBER
JUMPF .RETF ;CAN'T--MUST NOT BE GOOD LABEL
CAIE S2,1 ;FIRST FILE SECTION?
JRST BSF.5 ;NO, MUST SWITCH VOLUMES
MOVEI S1,'BFL' ;YES, WE WANT ONE FILE BACK
PUSHJ P,T$POS## ;GET TO ITS EOF LABELS
JUMPF .RETF ;CAN'T
LOAD P1,TCB.IO(B) ;GET IO STATUS
TXNN P1,TI.EOF ;BACKSPACE SAW TAPE MARK?
JRST BSF.6 ;NO, MUST BE AT BOT
BSF.3: MOVEI S1,'BFL' ;BACKSPACE OVER EOF LABELS
PUSHJ P,T$POS## ;NOW BEFORE TM AT EOND OF USER'S DATA
JUMPF .RETF ;DIDN'T MAKE IT
MOVEI S1,'SBL' ;SKIP BACK OVER TAPE MARK
PUSHJ P,T$POS## ;TO START OF END OF FILE LABEL GROUP
JUMPF .RETF ;CAN'T SKIP A TAPE MARK?
PUSHJ P,T$RDRC## ;READ THE RECORD
JUMPF .RETF ;CAN'T, GIVE UP
DECR TCB.PS(B),TP.POS ;BACK UP FILE POSITION ONE
STORE LT,TCB.LT(B) ;STORE BEST GUESS IN TCB
PUSHJ P,VEREOF ;BETTER BE EOF LABELS
JUMPF .RETF ;NOPE, ERROR
DECR TCB.PS(B),TP.POS ;BACK FILE COUNT UP AGAIN
; SINCE VEREOF COUNTED IT UP AGAIN
MOVEI S1,'BFL' ;BACK TO EOF LABELS
PUSHJ P,T$POS## ;SINCE VEREOF LEAVES US ATM
JUMPF .RETF ;CAN'T
MOVEI S1,'BFL' ;AND NOW BACK TO USER'S DATA
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;CAN'T
TXZ P2,TS.POS ;CLEAR POSITIONING INFO
TXO P2,TS.IUD!TS.NFI ;FLAG IN USER DATA AND NO FIRST INPUT
STORE P2,TCB.ST(B) ;SAVE IN TCB
$RETT ;GIVE GOOD RETURN
BSF.5: MOVEI S1,'BFL' ;BACK OVER HEADER LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;SIGH
LOAD P1,TCB.IO(B) ;PICK UP THE IO STATUS
TXNE P1,TI.EOF ;HIT EOF
PJRST PS.BAD ;FILE SECTION .GT. 1 NOT AT BOT IS BAD
PUSHJ P,LSTVOL ;BACK UP A VOLUME AND CHECK EOV LABELS
JUMPF .RETF ;SOMETHING DIDN'T WORK
JRST BSF.1 ;NOW START FROM SCRATCH
BSF.6: MOVX S1,LE.BOT ;TERMINATION CODE FOR BOT
MOVEM S1,G$TERM## ;TO STORE FOR USER
MOVEI S1,1 ;Mark file position number
STORE S1,TCB.PS(B),TP.POS ; as first.
ZERO TCB.ST(B) ;AND CLEAR STATUS
MOVX S1,TS.FFF ;GET FIRST FILE FLAG
IORM S1,TCB.ST(B) ;INDICATE IN FIRST FILE ON TAPE
$RETT ;GIVE GOOD RETURN
BSF.7: PUSHJ P,L$FINP ;DO FIRST INPUT PROCESSING
JUMPF .RETF ;ERRORS
MOVEI S1,'BFL' ;BACKSPACE TO
PUSHJ P,T$POS## ; BEGINING OF FILE
JUMPF .RETF ;ERRORS
MOVE S1,TCB.IO(B) ;GET I/O STATUS
TXNN S1,TI.BOT ;HIT BOT?
JRST BSF.9 ;NO
PUSHJ P,LSTVOL ;GET PREVIOUS REEL IN VOLUME-SE
JUMPF BSF.8 ;FAILED--MAYBE ON THE FIRST REEL
MOVEI S1,'EOT' ;NOW POSITION TO
PUSHJ P,T$POS## ; LOGICAL END OF TAPE
JUMPF .RETF ;ERRORS
JRST BSF.7 ;LOOP BACK AND TRY AGAIN
BSF.8: PUSHJ P,CKFIRV ;IS THIS THE FIRST REEL?
JUMPF .RETF ;NO--PROPAGATE ERRORS BACK
MOVEI S1,LE.BOT ;SET TERMINATION CODE
MOVEM S1,G$TERM## ; TO BEGINING OF TAPE
BSF.9: PJRST SETIUD ;SET IN USER DATA AND RETURN
; Here to write logical EOT
;
PS.WLE: PUSHJ P,L$FOUT ;DO FIRST OUTPUT LABEL CHECKING
JUMPF WLE.1 ;FAILED
PUSHJ P,L$CLOU ;CLOSE OUTPUT
JUMPF WLE.1 ;FAILED
MOVEI S1,'SBL' ;CODE TO SKIP A BLOCK
PUSHJ P,T$POS## ;SKIP OVER THE LABELS WE JUST WROTE
JUMPF WLE.2 ;CAN'T
MOVEI S1,LE.CON ;LET THE MONITOR DO THE ERASE
MOVEM S1,G$TERM## ; SINCE IT TAKES A LONG TIME
$RETT ;GIVE GOOD RETURN
WLE.1: SKIPA S1,[LE.VLE] ;VOLUME LABEL ERROR
WLE.2: MOVEI S1,LE.PSE ;POSITIONING ERROR
MOVEM S1,G$TERM## ;STORE TERMINATION CODE
$RETF ;RETURN
; Here to do a data security erase
; *** Note ***
; 1. This could tie up PULSAR for a long time.
; 2. Data security erase is really an output function because the tape
; is written. If we call NXTVOU to get the next volume for output,
; the operator will repeatedly be asked to mount a scratch tape.
; This is because QUASAR will very happily keep extending the volume
; set for the user. Instead, we will call NXTVIN to get the next reel.
; Conceptually, this is wrong, but it saves alot of chatter to and from
; QUASAR and lots of operator grief too.
PS.DSE: MOVNI P1,1 ;INIT FLAG
DSE.1: CAIN LT,LT.NL ;NOLABELS?
JRST DSE.4 ;HANDLE DIFFERENTLY
AOJN P1,DSE.3 ;JUMP IF BEYOND THE FIRST REEL
MOVE S1,TCB.ST(B) ;GET THE STATUS
TXNE S1,TS.VLV ;VOLUME LABELS VERIFIED?
TXNN S1,TS.OUT ;AND DOING OUTPUT?
JRST DSE.2 ;NO
TXNN S1,TS.IUD ;IN USER DATA?
JRST DSE.2 ;NO
TXZ S1,TS.FFF ;CLEAR FIRST FILE FLAG
MOVEM S1,TCB.ST(B) ;UPDATE STATUS
PUSHJ P,L$CLOU ;CLOSE OUTPUT
JUMPF DSE.E1 ;FAILED
MOVX S1,TS.FFF ;GET FIRST FILE ON REEL BIT
ANDCAM S1,TCB.ST(B) ;CLEAR SO WE DON'T WRITE VOL1 LABELS
JRST DSE.3 ;NOW WRITE A DUMMY FILE
DSE.2: PUSHJ P,L$FOUT ;MAKE SURE USER CAN WRITE THIS TAPE
JUMPF DSE.E1 ;CAN'T
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE TAPE MARK
JUMPF DSE.E2 ;POSITIONING ERROR
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE HDR2 RECORD
JUMPF DSE.E2 ;POSITIONING ERROR
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE HDR1 RECORD
JUMPF DSE.E2 ;POSITIONING ERROR
DSE.3: PUSHJ P,V$FILE## ;WRITE A DUMMY FILE
JUMPF DSE.E1 ;CHECK FOR ERRORS
JRST DSE.5 ;ALMOST DONE
DSE.4: MOVX S1,TS.ATM ;SEE IF POSITIONED
TDNN S1,TCB.ST(B) ; AFTER A TAPE MARK
PUSHJ P,T$WRTM## ;NO--WRITE EOF
JUMPF DSE.E1 ;VOLUME LABEL ERRORS
DSE.5: PUSHJ P,T$WRTM## ;WRITE A TAPE MARK TO END TAPE
JUMPF DSE.E1 ;VOLUME LABEL ERRORS
MOVEI S1,'DSE' ;CODE TO DO A DATA SECURITY ERASE
PUSHJ P,T$POS## ;ZAP TAPE (SOME DRIVES CAN'T DO IT)
PUSHJ P,NXTVIN ;GET NEXT VOLUME FOR INPUT
JUMPF DSE.6 ;CHECK FOR ERRORS
MOVX S1,TS.FFF ;GET FIRST FILE BIT
IORM S1,TCB.ST(B) ;SET IT
JRST DSE.1 ;GO BLANK ANOTHER TAPE
$RETT ;RETURN
DSE.6: MOVE S1,G$TERM## ;GET TERMINATION CODE
CAIN S1,LE.EOF ;NO MORE REELS IN VOLUME-SET?
$RETT ;DONE WITH DATA SECURITY ERASE
$RETF ;ELSE PROPAGATE ERROR BACK TO USER
DSE.E1: SKIPA S1,[LE.VLE] ;VOLUME LABEL ERROR
DSE.E2: MOVEI S1,LE.IOP ;POSITIONING ERROR
MOVEM S1,G$TERM## ;STORE TERMINATION CODE
$RETF ;RETURN
SUBTTL L$USRQ - Routine to Handle Label Request TAPOP.
L$USRQ:: $TRACE (L$USRQ,2)
LOAD S1,TCB.IN(B) ;GET THE EXTRA INFO FIELD
CAXN S1,TF.CLE ;CLEAR ERROR FUNCTION?
JRST USRQ.1 ;YES,
PUSHJ P,T$OPEN## ;GET TAPE SO WE'LL RELEASE USER
MOVX S1,LE.IOP ;NO, THIS IS ILLEGAL
MOVEM S1,G$TERM## ;SAVE ERROR CODE FOR USER
$RETF ;RETURN WITH ERROR
USRQ.1: PUSHJ P,L$CLEF ;Clear the error bits
PUSHJ P,T$OPEN## ;OPEN THE TAPE
JUMPF .RETF ;CAN'T
$RETT ;GOOD RETURN
SUBTTL L$CLEF - Clear error interlock
;This routine will clear the label error interlock for a given
;TCB. The tape need not be OPEN.
;Call with the TCB adr in B
L$CLEF::MOVX S1,TS.INI ;Get initialization bit
ANDM S1,TCB.ST(B) ;Clear all status bits - force restart
ZERO TCB.EC(B),TE.TRM ;Clear termination code
$RETT
SUBTTL L$ABOR - Monitor request to abort current labeling operation
; Here when the user types ^C while waiting for some tape labeler function
; to complete, or when the monitor feels malicious and wants to screw some
; unsuspecting user. The intent of this code is to gracefully unwind the
; TCB and get the user's job of event wait for the labeler. Under extreme
; circumstances, this might not work (hardware hangs, etc.). For each type
; of pending labeler request and TCB wait state, we'll attempt to unwind in
; a safe fashion.
L$ABOR::PUSHJ P,T$OPEN## ;SO WE CAN DO A LABEL RELEASE
JUMPF .RETF ;FAILED
MOVE S1,TCB.WS(B) ;GET WAIT STATE CODE
PUSHJ P,@ABOTAB(S1) ;DO SPECIAL PRE-ABORT PROCESSING FIRST
JUMPF .RETF ;HMMM
SETZM TCB.WS(B) ;MARK TCB IDLE
MOVX S1,TI.ABO ;GET ABORT FLAG
ANDCAM S1,TCB.IO(B) ;CLEAR IT
MOVEI S1,LE.LRA ;LABELER REQUEST ABORTED BY RESET UUO
MOVEM S1,G$TERM## ;STORE TERMINATION CODE
PJRST T$RELE## ;CLEAR LABELER WAIT AND RETURN
ABOSTP: STOPCD (AIC,HALT,,<Abort labeler request from illegal context>)
EXP .RETT ;WAITING TO RUN
ABOTAB: EXP .RETT ;IGNORE
EXP ABOMNT ;MOUNT WAIT
EXP ABOLBL ;LABEL FAILURE (OPR INTERVENTION) WAIT
EXP .RETT ;OFFLINE WAIT
EXP ABOSTP ;WAITING FOR ANOTHER TCB
EXP ABOSTP ;NEW TAPE WAIT OR OPR RESPONSE
ABOMAX==.-ABOTAB ;LENGTH OF TABLE
IFN <TW.MAX-ABOMAX>,<
PRINTX ? Missing abort code for labeler function(s)
PASS2
END
>
; TCB waiting for a mount
ABOMNT: PUSHJ P,CANMDA ;CANCEL PENDING REEL SWITCH REQUEST
$RETT ;RETURN
; TCB waiting for operator intervention on a label failure
ABOLBL: MOVX S1,TS.FSE ;GET A BIT
ANDCAM S1,TCB.S2(B) ;CLEAR FILE SEQUENCE ERROR PROCESSING
MOVEI S1,ABOTXT ;POINT TO REASON TEXT
PJRST O$KWTO## ;CANCEL WTOR AND RETURN
ABOTXT: ASCIZ |Labeler operation aborted by a RESET UUO|
SUBTTL Volume Label Verification
VERVOL: $TRACE (VERVOL,3)
MOVX T1,TS.VLV ;GET VOL LABELS VERIFIED BIT
TDNE T1,TCB.ST(B) ;HAVE THEY BEEN VERIFIED ALREADY?
$RETT ;YES, JUST GIVE GOOD RETURN
ZERO TCB.ST(B),TS.POS ;CLEAR POSITION INFO
MOVEI S1,'REW' ;SET UP TO REWIND THE TAPE
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;CAN'T, RETURN ERROR
PUSHJ P,T$WRCK## ;CHECK WRITE STATUS (RING)
LOAD T1,TCB.PT(B),TP.RWL ;GET REQUESTED STATUS
CAME T1,S2 ;REQUESTED = ACTUAL ?
SKIPE T1 ;NO, WANT WRITE LOCK
JRST VERV.1 ;MATCH, OF SOFT WRITE LOCK
MOVEI S1,LE.WLK ;CAN'T SOFTWARE WRITE-ENABLE
MOVEM S1,G$TERM ;STASH IN GLOBAL ERROR
$RETF ;AND GIVE FALSE BACK
;Here when the ring status is all set
VERV.1: PUSHJ P,I$GDEN## ;ASK THE MONITOR FOR DRIVE DENSITY
LOAD LT,TCB.LT(B) ;GET THE LABEL TYPE FROM THE TCB
PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF VERV.6 ;CAN'T,,CHECK LABEL TYPE
CAXN LT,LT.NSL ;NONSTANDARD LABELS?
JRST VERV.4 ;YES, LABEL TYPE ERROR
PUSHJ P,@VOLLBL(LT) ;VERIFY THAT LABEL IS 'VOL1'
JUMPF VERV.5 ;ITS NOT, GIVE ERROR
PUSHJ P,@VOLSER(LT) ;CHECK THE VOLUME SERIAL NUMBER
JUMPF VERV.5 ;DOESN'T CHECK, GIVE ERROR
PUSHJ P,I$PRIV## ;CHECK FOR [1,2] OR JACCT PRIVS
JUMPT VERV.2 ;GOT THEM - SKIP PROTECTION CHECK
PUSHJ P,@VOLACC(LT) ;CHECK ACCESSIBILITY
JUMPF .RETF ;CAN'T TOUCH TAPE
VERV.2: PUSHJ P,@VOLDEP(LT) ;NOW GO DO LABEL TYPE DEPENDENT CHECKS
JUMPF VERV.5 ;LABELS DIDN'T VERIFY
MOVX T1,TS.VLV!TS.IUD ; Assume unlabeled flags
JMPUNL LT,VERV.3 ;Jump if assumption correct
MOVX T1,TS.VLV!TS.IHL ;FLAG THAT THEY VERIFIED
VERV.3: IORM T1,TCB.ST(B) ;IN THE TCB
$RETT ;AND GIVE GOOD RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
VERV.4: MOVEI T1,LE.LTE ;CODE FOR LABEL TYPE ERROR
MOVEM T1,G$TERM## ;SAVE IN TERMINATION WORD
$RETF ;GIVE FALSE RETURN
VERV.5: MOVEI T1,LE.VLE ;GET CODE FOR VOLUME LABEL ERROR
MOVEM T1,G$TERM## ;SAVE IT IN TERMINATION CODE WORD
$RETF ;AND RETURN FALSE
;Here if we can't read the label record
VERV.6: JMPUNL LT,VERV.7 ;If we can't re-read unlabeled labels,
$RETF ;Continue. Return false if we're labeled
VERV.7: SETZM G$TERM## ;YES, CLEAR ANY ERRORS, IGNORE THE READ
MOVX T1,TS.VLV!TS.IUD ; Assume unlabeled flags
IORM T1,TCB.ST(B) ;IN THE TCB
MOVEI S1,'REW' ;REPOSITION TO BOT
PJRST T$POS## ;ALL IS WELL
VOLLBL: BLPDSP ;BYPASS LABELS-- SHOULD NEVER GET HERE
VLL.AS ;ANSI LABELS
VLL.AS ; "
VLL.IL ; IBM LABELS
VLL.IL ; "
VLL.LT ;LEADING TAPE MARK ????
.RETF ;NON-STANDARD LABELS
VLL.NL ;NO LABELS
.RETT ;FOR COBOL LABELS
.RETT ;FOR COBOL LABELS
VLL.NL ;NO LABELS
VLL.IL:
VLL.AS: MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT WHERE LABEL ID IS (CP 1-4)
MOVE T2,VL1PTR ;POINT AT STANDARD LABEL ID
MOVEI T3,4 ;LENGTH
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE IF ANY
PJRST STRCMP ;COMPARE THEM
VLL.LT: LOAD P1,TCB.IO(B) ;GET IO STATUS FROM TCB
TXNN P1,TI.EOF ;LAST OP SAW EOF?
$RETF ;YES, ERROR
$RETT ;ELSE ALL IS WELL
VLL.NL: MOVE T1,(BUF) ;GET FIRST 4 CHARS FROM TAPE
CAMN T1,VOL1WD ;ASCII "VOL1"?
$RETF ;YES, ERROR
CAMN T1,IBMVL1 ;IBM "VOL1"?
$RETF ;YES, ERROR
MOVEI S1,'REW' ;REPOSITION TO BOT
PJRST T$POS## ;ALL IS WELL
VOLSER: BLPDSP
VLS.AS
VLS.AS
VLS.IL
VLS.IL
.RETT
.RETF
.RETT
.RETT
.RETT
.RETT
VLS.IL:
VLS.AS: MOVE T1,[CPTRI ^D5,0(BUF)] ;POINT AT VOLID (CP 5-10)
MOVE T2,[POINT 8,TCB.VL(B)] ;POINT AT CURRENT VOLID IN TCB
HRRZI T3,6 ;LENGTH OF 6
HRL T3,CVTTAB(LT) ;ADDR OF CONVERSION ROUTINE IF ANY
PJRST STRCMP ;COMPARE THE VOLIDS
VOLACC: BLPDSP
VLA.AS
VLA.AS
VLA.IL
VLA.IL
.RETT
.RETF
.RETT
.RETT
.RETT
.RETT
VLA.IL: MOVX S1,TS.D1A ;NEVER DO DECSYSTEM10 ACCESSESS
ANDCAM S1,TCB.ST(B) ; CHECKING ON AN IBM LABELED TAPE
MOVE T2,[POINT 7,[ASCIZ/0/]] ;POINT AT ALL ACCESS ALLOWED CHAR
MOVE T1,[CPTRI ^D11,0(BUF)] ;AIM AT ACCESS CHARACTER (CP 11)
MOVEI T3,1 ;ONE CHARACTER LONG
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPT .RETT ;IT MUST BE A ZERO
MOVE T2,[POINT 7,[ASCIZ/ /]] ;POINT AT ACCESS ALLOWED CHAR
MOVE T1,[CPTRI ^D11,0(BUF)] ;AIM AT ACCESS CHARACTER (CP 11)
MOVEI T3,1 ;ONE CHARACTER LONG
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPT .RETT ;IT MUST BE A SPACE
PJRST VLA.1 ;COMPLAIN TO OPR, GET RESPONSE
VLA.AS: MOVE T2,BNKPTR ;POINT AT ALL ACCESS ALLOWED CHAR
MOVX S1,TS.D1A ;GET BIT TO CLEAR
ANDCAM S1,TCB.ST(B) ;CLEAR IT IN THE TCB
MOVE T1,[CPTRI ^D11,0(BUF)] ;Aim at access character (CP 11)
MOVEI T3,1 ;ONE CHARACTER LONG
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPT .RETT ;ALL ACCESS ALLOWED
MOVE T1,[CPTRI ^D38,0(BUF)] ;POINT AT OWNER ID (CP 38-40)
MOVE T2,D10PTR ;AND COMPARE OF PDP-10
HRRZI T3,3 ;3 CHARS, NO CONVRT
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;DO COMPARE
JUMPF .RETT ;Not a DEC-10 tape, let anyone in,
;since we don't know the access
;protection scheme of the writer
MOVE T1,[CPTRI ^D11,0(BUF)] ;Aim at access char for DEC-10 (CP 11)
MOVE T2,[POINT 7,[ASCIZ/1/]] ;RESTRICTED ACCESS CHAR FOR DEC-10
MOVEI T3,1 ;ONE CHARACTER LONG
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPF VLA.1 ;NOT SPECIAL CHAR, NO ACCESS
MOVX S1,TS.D1A ;FLAG DEC-10 ACCESS CHECKING
IORM S1,TCB.ST(B) ;TURN ON FLAG IN TCB
$RETT ;AND GIVE GOOD RETURN
VLA.1: MOVEI S1,[ITEXT (<Volume Accessibility Prohibits Access>)]
PJRST O$LERR## ;TELL OPR
;WAIT FOR ANSWER
VOLDEP: BLPDSP
VLD.AS
VLD.AS
VLD.IL
VLD.IL
.RETT
.RETF
.RETT
.RETT
.RETT
.RETT
VLD.IL:
VLD.AS:
IFE FTVPRO,< ;If we don't do volume protection
JRST VOLBYP ;Just skip to end of label group
>;End IFE FTVPRO
IFN FTVPRO,< ;If we do volume protection
$CALL .SAVE2 ;SAVE SOME REGS
LOAD S1,TCB.ST(B) ;GET STATUS
TXNN S1,TS.D1A ;DEC-10 ACCESS CHECKING?
JRST VOLBYP ;NO, JRST GET TO THE END OF THE VOLUME LABELS
PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF .RETF ;I/O ERROR
MOVE T1,[CPTRI ^D1,0(BUF)] ;Point to start of label record (CP 1-4)
MOVE T2,VL2PTR ;IS IT VOL2 ?
HRRZI T3,4 ;4 CHRS, NO CONVERT
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPT VLD.A1 ;VOL2, PROCEED
IFN FTUPRO,< ;If we do volume protection by UVL1,
;Then check for that flavor of label
MOVE T1,[CPTRI ^D1,0(BUF)] ;Point to start of label record (CP 1-4)
MOVE T2,UVLPTR ;IS IT UVL1 ?
HRRZI T3,4 ;4 CHRS, NO CONVERT
HRL T3,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STRCMP ;COMPARE
JUMPT VLD.A1 ;UVL1, PROCEED
>;End IFN FTUPRO
MOVEI S1,[ITEXT (<No DEC-10 protection label (VOL2/UVL1)>)]
PUSHJ P,O$LERR## ;TYPE DEVICE+MESSAGE
;WAIT FOR OPR
JUMPF .RETF ;HE SAID NO
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here when the volume protection label (either UVL1 or VOL2)
; for a DEC-10 tape has been read.
VLD.A1: MOVE T1,[CPTRI ^D5,0(BUF)] ;POINT AT PROT (CP 5-10)
HRRZI T2,6 ;6 CHARS, NO CONVERT
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;MAKE IT A NUMBER
JUMPF VLD.A4 ;OOPS, RETURN
MOVE P1,S2 ;SAVE PROT
LOAD S1,TCB.PT(B),TP.PRT ;Get protection from MOUNT
SKIPN S1 ;Was one specified?
STORE P1,TCB.PT(B),TP.PRT ;No, save it as a default
MOVE T1,[CPTRI ^D11,0(BUF)] ;POINT AT PROJ # (CP 11-16)
HRRZI T2,6 ;6 CHARS, NO CONVERT
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;GET A #
JUMPF VLD.A4 ;NOT A NUMBER?
MOVE P2,S2 ;SAVE PROJ # IN P2 FOR NOW
MOVE T1,[CPTRI ^D17,0(BUF)] ;POINT AT PROG # (CP 17-22)
HRRZI T2,6 ;6 CHARS, NO CONVERSION
HRL T2,CVTTAB(LT) ;CONVERSION IF NECESSARY
PUSHJ P,STROCT ;CHANGE STRING TO OCTAL NUMBER
JUMPF VLD.A4 ;NOT A NUMBER
MOVE T1,P1 ;GET PROT IN T1
HRRZ T2,S2 ;AND MAKE T2=PPN
HRL T2,P2 ;...
MOVEM T2,TCB.VO(B) ;STORE OWNER (PPN) FOR LATER REFERENCE
LOAD T3,TCB.OW(B) ;GET USER'S PPN FROM TCB
PUSHJ P,I$CKAC## ;CHECK ACCESS
JUMPL S2,VLD.A5 ;IF NO ACCESS AT ALL, TELL OPR NOW
MOVX S1,TS.NOW ;GET 'VOLUME WRITE PROTECTED' BIT
SKIPG S2 ;CAN USER WRITE?
IORM S1,TCB.ST(B) ;YES, SET THE BIT IN THE TCB
JRST VOLBYP
VLD.A4: MOVEI S1,[ITEXT (<Invalid character in volume PPN or protection>)]
PUSHJ P,O$LERR## ;TYPE DRIVE NAME AND ERROR
;AND WAIT FOR OPR RESPONSE
JUMPF .RETF ;IF ERROR, RETURN NOW
JRST VOLBYP ;IF PROCEED, FINISH UP VOL LBL STUFF
VLD.A5: PUSHJ P,VPCCHK ;TELL OPR ABOUT VOL PROT FAILURE
JUMPF .RETF ;RESPONSE WAS ABORT
JRST VOLBYP ;ELSE CHARGE ONWARD
>;End IFN FTVPRO
SUBTTL VOLBYP - Bypass VOL2-VOLn, UVLn
VOLBYP: PUSHJ P,T$RDRC## ;GO READ A RECORD
JUMPF .RETF ;COULDN'T, LOSE
LOAD T1,TCB.IO(B),TI.EOF ;LAST OP SAW EOF?
JUMPN T1,VOLB.3 ;BACKSPACE AND QUIT NOW IF TRUE
MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT LABEL ID FIELD (CP 1-3)
MOVE T2,VL1PTR ;COMPARE AGAINST VOL(n)
HRRZI T3,3 ;NO CONVERSION, 3 CHARACTERS
HRL T3,CVTTAB(LT) ;GET RIGHT CONVERSION ROUTINE ADDRESS
PUSHJ P,STRCMP ;COMPARE IT
JUMPT VOLBYP ;IF IT WAS, GO READ NEXT RECORD
JRST UVLB.1 ;Jump into the UVL bypass loop
;Here to skip over UVL records
UVLBYP: PUSHJ P,T$RDRC## ;GO READ A RECORD
JUMPF .RETF ;COULDN'T, LOSE
LOAD T1,TCB.IO(B),TI.EOF ;LAST OP SAW EOF?
JUMPN T1,VOLB.3 ;BACKSPACE AND QUIT NOW IF TRUE
UVLB.1: MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT LABEL ID FIELD (CP 1-3)
MOVE T2,UVLPTR ;COMPARE AGAINST UVL(n)
HRRZI T3,3 ;NO CONVERSION, 3 CHARACTERS
HRL T3,CVTTAB(LT) ;GET RIGHT CONVERSION ROUTINE ADDRESS
PUSHJ P,STRCMP ;COMPARE IT
JUMPT UVLBYP ;IF IT WAS, GO READ NEXT RECORD
;Otherwise, just back up over it
VOLB.3: MOVEI S1,'BBL' ;Code for Backspace Block
PJRST T$POS## ;Back over EOF, and return
SUBTTL Header Label Verification
VERHDR: CAIN LT,LT.NL ;NOLABELS?
JRST VERH.1 ;YES--NO HEADERS TO CHECK
PUSHJ P,@HDRLBL(LT) ;GO CHECK FOR HDR1
JUMPF VERH.2 ;NOT THERE, ERROR
PUSHJ P,@HDRSEQ(LT) ;NOW PROCESS SEQUENCE NUMBER
JUMPF VERH.2 ;ITS WRONG
; PUSHJ P,@HDRSEC(LT) ;MAKE SURE WE HAVE THE RIGHT PIECE
; JUMPF VERH.2 ; OF FILE SECTION NUMBER
PUSHJ P,@HDREXP(LT) ;CHECK EXPIRADION DATE IF OUTPUT
JUMPF VERH.2 ;NOT PAST, ERROR
PUSHJ P,@HDRACC(LT) ;CHECK ACCESSIBILITY
JUMPF VERH.2 ;NO ACCESS ALLOWED
PUSHJ P,@HDRDEP(LT) ;AND GO DO LABEL TYPE DEPENDENT CODE
JUMPF VERH.2 ;DIDN'T WORK
VERH.1: MOVX P2,TS.POS ;GET STATUS POSITION FIELS
ANDCAB P2,TCB.ST(B) ;CLEAR IN TCB AND GET STATUS IN P2
TXNN P2,TS.OUT ;THIS FILE DOING OUTPUT?
TXZ P2,TS.FFF ;NO, TURN OFF FIRST FILE FLAG
TXO P2,TS.IUD ;GET FLAG FOR IN USER DATA
MOVEM P2,TCB.ST(B) ;IN BOTH AC AND TCB
$RETT ;GIVE GOOD RETURN
;HERE TO RETURN HEADER LABEL ERROR
VERH.2: MOVEI S1,LE.HDE ;GET CODE FOR HEADER LABEL ERROR
MOVEM S1,G$TERM## ;AND STORE IN TERMINATION CODE WORD
$RETF ;AND RETURN ERROR
SUBTTL L$HDEX - Check for expiration during intialization
;This routine is used when initializing a tape to make
; sure that the operator is not trying to initialize an un-expired
; tape.
;Call -
; LT/ label type of this tape.
;Returns -
; T/ OK to write on this tape
; F/ Tape is 'unexpired'
L$HDEX::
JMPUNL LT,.RETT ;If unlabeled, no expiration checking
PUSHJ P,FNDHD1 ;Get to the HDR1 label
JUMPF .POPJ ;No HDR1, say unexpired
PUSHJ P,@HDREXP(LT) ;Check expiration
MOVX S1,TS.EXP ;Get the un-expired bit
TDNN S1,TCB.ST(B) ;Is file unexpired?
$RETT ;No
$RETF ;Yes, say so
HDRLBL: BLPDSP
HLB.AS
HLB.AS
HLB.IL
HLB.IL
.RETF
.RETF
.RETF
HLB.CA
HLB.CA
.RETF
HLB.CA:
HLB.IL:
HLB.AS: MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT HDR1 IN LABEL (CP 1-4)
HLB.A1: MOVE T2,HD1PTR ;AND AT CANONICAL FORM
HRRZI T3,4 ;4 CHARS
HRL T3,CVTTAB(LT) ;GET POINTER TO CONVERT ROUTINE
PUSHJ P,STRCMP ;COMPARE THEM
JUMPF HLB.1 ;NOT HDR1
MOVX S1,TS.OUT ;GET OUTPUT FLAG
TDNE S1,TCB.ST(B) ;DON'T COPY FILE NAME ON OUTPUT
$RETT ;EXIT ON OUTPUT
MOVE T1,[CPTRI ^D5,0(BUF)] ;POINTER TO THE FILE NAME (CP 5-21)
MOVE T2,[POINT 7,TCB.FN(B)] ;WHERE TO STORE THE FILE NAME
MOVEI T3,^D17 ;SEVENTEEN CHARACTERS
HRL T3,CVTTAB(LT) ;CONVERSION TYPE
PUSHJ P,STGSTR ;COPY THE STRING
JUMPT .RETT ;OK RETURN
HLB.0: MOVEI S1,[ITEXT (<Illegal character(s) in the file name>)]
PJRST O$LERR## ;TELL THE OPERATOR
;WAIT FOR THE RESPONSE
HLB.1: MOVEI S1,[ITEXT (<Expected HDR1 label is not HDR1>)]
PJRST O$LERR## ;TYPE DRIVE+ERROR
;WAIT FOR OPR RESPONSE
HDRACC: BLPDSP
HDA.AS
HDA.AS
HDA.IL
HDA.IL
.RETF
.RETF
.RETF
.RETT
.RETT
.RETF
HDA.IL: SKIPA T2,[POINT 7,[ASCIZ/0/]] ;POINT AT A ZERO
HDA.AS: MOVE T2,BNKPTR ;OR AT A BLANK
MOVE T1,[CPTRI ^D54,0(BUF)] ;POINT AT CHAR IN LABEL (CP 54)
MOVEI T3,1 ;CHARS TO COMPARE
HRL T3,CVTTAB(LT) ;GET CONVERSION ROUTINE ADDR
MOVX S1,TS.D1A ;GET BIT TO CLEAR
ANDCAM S1,TCB.ST(B) ;CLEAR IT IN THE TCB
PUSHJ P,STRCMP ;COMPARE THE CHARACTERS
JUMPT .RETT ;RETURN NOW IF OK
MOVE T1,[CPTRI ^D61,0(BUF)] ;POINT AT SYSTEM CODE (CP 61-73)
MOVE T2,S10PTR ;POINTER TO 'DECSYSTEM10'
MOVEI T3,^D13 ;LENGTH TO CHECK
HRL T3,CVTTAB(LT) ;CONVERSION IF ANY
PUSHJ P,STRCMP ;IS THIS A DEC-10 TAPE?
JUMPF HDA.1 ;NO, TELL OPR OF FAILURE NOW
MOVE T1,[CPTRI ^D54,0(BUF)] ;POINT AT ACCESS CHAR AGAIN (CP 54)
MOVE T2,[POINT 7,[ASCIZ/1/]] ;AND AT SPECIAL CHAR USED BY 10
MOVEI T3,1 ;ONE CHAR
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE ADDR
PUSHJ P,STRCMP ;IS IT SPECIAL DEC-10 CHAR?
JUMPF HDA.1 ;IF NOT, TELL OPR ABOUT ACC FAILURE
MOVX S1,TS.D1A ;ELSE GET BIT TO FLAG DEC-10 ACCESS CHECKING
IORM S1,TCB.ST(B) ;AND FLAG IT IN TCB
$RETT ;AND RETURN GOOD FOR NOW
HDA.1: MOVEI S1,[ITEXT (<File Accessibility Prohibits Access>)]
PJRST O$LERR## ;TELL OPR DRIVE AND FAILURE
;WAIT FOR HIS ANSWER
SUBTTL HDRSEQ - Verify file sequence number
HDRSEQ: BLPDSP
HDS.AS
HDS.AS
HDS.IL
HDS.IL
.RETF
.RETF
.RETF
HDS.CA
HDS.CS
.RETF
HDS.CA: MOVE T1,[POINT 7,6(BUF),6] ;POINT AT SEQUENCE NUMBER IN LABEL
JRST HDS.A1 ;AND DO REST LIKE ASCII
HDS.CS: MOVE T1,[POINT 6,5(BUF),5] ;POINT AT SEQUENCE NUMBER IN LABEL
JRST HDS.A1 ;AND DO REST LIKE ASCII
HDS.IL: ;IBM ARE JUST LIKE ASCII
HDS.AS: MOVE T1,[CPTRI ^D32,0(BUF)] ;POINT AT THE SEQUENCE NUMBER (CP 32-35)
HDS.A1: HRRZI T2,4 ;IT IS 4 CHARS LONG
HRL T2,CVTTAB(LT) ;GET CONVERSION ROUTINE ADDR
PUSHJ P,STRNUM ;GET IT AS A NUMBER
JUMPF HDS.3 ;NOT A NUMBER?
LOAD T2,TCB.PS(B),TP.POS ;NOW PICK UP CURRENT POSITION
SKIPN T2 ;IS IT ZERO?
MOVEI T2,1 ;YES, USE START OF 1
LOAD S1,TCB.ST(B) ;GET UNIT STATUS
TXC S1,TS.FFF!TS.OUT ;COMPLEMENT FIRST FILE+DOING OUTPUT
TXNN S1,TS.FFF!TS.OUT ;WERE BOTH ON ?
JRST HDS.1 ;YES, JUST SAVE POSITION FROM TCB
CAIN T2,1 ;ARE WE EXPECTING FIRST SECTION?
MOVE T2,S2 ;YES, EXPECT ANYTHING
CAMN T2,S2 ;DO LABEL AND TCB AGREE?
JRST HDS.1 ;ALL IS WELL
SKIPE G$SEQC## ;HAVE WE ASKED THE OPERATOR?
$WTO (<HDR file sequence warning>,<Label says ^D/S2/ when looking for ^D/T2/>,TCB.OB(B),$WTFLG(WT.SJI))
HDS.1: STORE T2,TCB.PS(B),TP.POS ;GOOD NUMBER, STORE IT (MAKES 0 INTO 1)
$RETT ;AND GIVE GOOD RETURN
HDS.3: MOVEI S1,[ITEXT (<Invalid numeric field for File Sequence Number>)]
PJRST O$LERR## ;TELL OPR DRIVE+ERROR
;WAIT FOR HIS RESPONSE
SUBTTL HDRSEC - Verify file section number
HDRSEC: BLPDSP
HDN.AS
HDN.AS
HDN.IL
HDN.IL
.RETF
.RETF
.RETF
.RETT ;None for COBOL labels
.RETT ;None for COBOL labels
.RETF
HDN.IL: ;IBM ARE JUST LIKE ASCII
HDN.AS: MOVE T1,[CPTRI ^D28,0(BUF)] ;POINT AT THE SECTION NUMBER (CP 28-31)
HRRZI T2,4 ;IT IS 4 CHARS LONG
HRL T2,CVTTAB(LT) ;GET CONVERSION ROUTINE ADDR
PUSHJ P,STRNUM ;GET IT AS A NUMBER
JUMPF HDN.3 ;NOT A NUMBER?
LOAD T2,TCB.SN(B) ;NOW PICK UP CURRENT SECTION #
LOAD S1,TCB.ST(B) ;GET UNIT STATUS
TXC S1,TS.FFF!TS.OUT ;COMPLEMENT FIRST FILE+DOING OUTPUT
CAME T2,S2 ;DO LABEL AND TCB AGREE?
TXNN S1,TS.FFF!TS.OUT ;NO, WRITING FIRST FILE?
$RETT ;YES, MATCH, OR IGNORE ON OVERWRITE
MOVEI S1,[ITEXT (<Incorrect File Section Number>)]
SKIPA ;AFTER MESSAGE, LIKE OTHER ERROR
HDN.3: MOVEI S1,[ITEXT (<Invalid numeric field for File Section Number>)]
PJRST O$LERR## ;TELL OPR DRIVE+ERROR
;WAIT FOR HIS RESPONSE
SUBTTL HDREXP - Get and check creation and expiration dates
; This routine also reads the generation and version numbers
; Call -
; BUF/ Addr of HDR1 buffer
HDREXP: BLPDSP
HDE.AS
HDE.AS
HDE.IL
HDE.IL
.RETF
.RETF
.RETF
.RETT
.RETT
.RETF
HDE.IL: ;JUST LIKE ANSI
HDE.AS: MOVE T1,[CPTRI ^D43,0(BUF)] ;AIM AT THE CREATION DATE (CP 43-47)
MOVEI T2,5 ;NUMBER OF CHARS TO CONVERT
HRL T2,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRNUM ;READ A DECIMAL NUMBER
SKIPT ;WINS?
SETZ S2, ;NO, FLAG NO KNOWN DATE
MOVE S1,S2 ;COPY THE DATE FROM THE HDR1
PUSHJ P,I$DT15## ;CONVERT TO 15-BIT FORMAT
STORE S1,TCB.EX(B),TE.CRE ;SAVE IN TCB
MOVE T1,[CPTRI ^D49,0(BUF)] ;POINT AT THE EXP DATE FIELD (CP 49-53)
MOVEI T2,5 ;NUMBER OF CHARS TO GET
HRL T2,CVTTAB(LT) ;CONVERSION IF ANY
PUSHJ P,STRNUM ;GET IT AS A DECIMAL NUMBER
JUMPF HDE.1 ;BAD NUMBER, COMPLAIN TO OPR
PUSH P,S2 ;SAVE DATE FROM LABEL
MOVE S1,S2 ;COPY IT TO S1
PUSHJ P,I$DT15## ;MAKE DATE FROM LABEL IN 15 BIT FORM
LOAD T1,TCB.ST(B) ;Get status
TXNN T1,TS.OUT ;Don't save exp date on output
STORE S1,TCB.EX(B),TE.EXP ;SAVE IT IN THE TCB
PUSHJ P,I$DATE## ;GET TODAY'S DATE
MOVE T1,S2 ;COPY BYTE POINTER TO TODAY INTO T1
IBP T1 ;SKIP THE LEADING BLANK
MOVEI T2,5 ;LENGTH OF A DATE
PUSHJ P,STRNUM ;MAKE IT A NUMBER
SKIPT ;VALID NUMBER?
STOPCD (IDM,HALT,,<Invalid date from monitor>)
POP P,S1 ;GET BACK DATE FROM LABEL
MOVX T1,TS.EXP ;BIT WHICH FLAGS UNEXPIRED FILE
ANDCAM T1,TCB.ST(B) ;CLEAR IT IN CASE EXPIRED
CAMGE S2,S1 ;IS FILE EXPIRED?
IORM T1,TCB.ST(B) ;NO, FLAG IT AS SO
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Now, get the generation and version numbers for this file
MOVE T1,[CPTRI ^D36,0(BUF)] ;AIM AT THE GENERATION NUMBER (CP 36-39)
MOVEI T2,4 ;4 CHAR FIELD
HRL T2,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRNUM ;READ THE GENERATION NUMBER
SKIPT ;LOOKS OK?
SETZ S2, ;NO, SUPPLY A DEFAULT
STORE S2,TCB.GV(B),TG.GEN ;SAVE IN TCB
MOVE T1,[CPTRI ^D40,0(BUF)] ;AIM AT THE VERSION NUMBER FIELD (CP 40-41)
MOVEI T2,2 ;2 CHAR FIELD
HRL T2,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRNUM ;CONVERT IT
SKIPT ;LOOKS OK?
SETZ S2, ;NO, SUPPLY A DEFAULT
STORE S2,TCB.GV(B),TG.VER ;SAVE IN TCB
$RETT ;AND GIVE GOOD RETURN
HDE.1: MOVEI S1,[ITEXT (<Invalid Expiration Date Field>)]
PJRST O$LERR## ;TELL OPR
;WAIT FOR HIS RESPONSE
SUBTTL HDRDEP - Label type dependent checks
; Call -
; BUF/ Addr of buffer containing HDR1
; Returns -
; BUF/ Addr of buffer with HDR2 (unless there isn't a HDR2)
HDRDEP: BLPDSP
HDD.AS
HDD.AS
HDD.IL
HDD.IL
.RETF
.RETF
.RETF
.RETT
.RETT
.RETF
HDD.IL:
HDD.AS: $CALL .SAVE3 ;SAVE SOME AC'S
ZERO TCB.PR(B) ;CLEAR PROTECTION
ZERO TCB.RF(B),TF.RFM!TF.FCT ;CLEAR RECORD FORMAT AND FORM CONTROL
ZERO TCB.LN(B) ;CLEAR RECORD AND BLOCK LENGTHS
MOVX S1,TS.WLK ;Get file write protect bit
ANDCAM S1,TCB.ST(B) ;Clear it (assume write is allowed)
PUSHJ P,T$RDRC## ;READ NEXT RECORD
JUMPF .POPJ ;ERROR
LOAD P1,TCB.IO(B) ;GET IO STATUS
TXNE P1,TI.EOF ;EOF SEEN??
$RETT ;Yes, No more HDRs, quit
MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT LABEL ID IN BUFFER (CP 1-4)
MOVE T2,HD2PTR ;AND AT 'HDR2'
HRRZI T3,4 ;LENGTH OF 4
HRL T3,CVTTAB(LT) ;GET ADDR OF CONVERT ROUTINE
PUSHJ P,STRCMP ;COMPARE THEM
JUMPF HDD.A6 ;NOT HDR2, TELL OPR
LOAD S1,TCB.ST(B) ;PICK UP STATUS
TXNN S1,TS.D1A ;WANT DEC-10 ACCESS CHECKING?
JRST HDD.A1 ;NO, EXIT NOW
MOVE T1,[CPTRI ^D22,0(BUF)] ;POINT AT PROJECT NUMBER (CP 22-27)
HRRZI T2,6 ;6 CHARS
HRL T2,CVTTAB(LT) ;GET ADDR OF CONVERT ROUTINE
PUSHJ P,STROCT ;MAKE IT AN OCTAL NUMBER
JUMPF HDD.A4 ;COULDN'T
MOVE P1,S2 ;SAVE FOR LATER
MOVE T1,[CPTRI ^D28,0(BUF)] ;POINT AT PROGRAMMER NUMBER (CP 28-33)
HRRZI T2,6 ;6 CHARACTER
HRL T2,CVTTAB(LT) ;GET ADDR OF CONVERT ROUTINE
PUSHJ P,STROCT ;GET IT IN OCTAL
JUMPF HDD.A4 ;COULDN'T
MOVE P2,S2 ;SAVE FOR LATER
MOVE T1,[CPTRI ^D16,0(BUF)] ;POINT AT PROTECTION (CP 16-21)
HRRZI T2,6 ;GET 6 CHARACTERS
HRL T2,CVTTAB(LT) ;GET ADDR OF CONVERT ROUTINE
PUSHJ P,STROCT ;MAKE THEM AN OCTAL NUMBER
JUMPF HDD.A4 ;COULDN'T
STORE S2,TCB.PR(B) ;SAVE IN TCB
MOVE T1,S2 ;MAKE T1 BE PROTECTION
HRRZ T2,P2 ;GET PROGRAMMER NUMBER
HRL T2,P1 ;MAKE PPN
LOAD T3,TCB.OW(B) ;GET THE USER'S PPN
PUSHJ P,I$CKAC## ;DO THE ACCESS CHECK
JUMPG S2,HDD.A1 ;IF ALL ACCESS ALLOWED, RETURN
JUMPL S2,HDD.A5 ;IF NO ACCESS, TELL OPR NOW
MOVX S1,TS.WLK ;ELSE GET FILE WRITE LOCKED BIT
IORM S1,TCB.ST(B) ;SET IT IN TCB AND GO ON
HDD.A1: MOVE T1,[CPTRI ^D5,0(BUF)] ;POINT AT REC FORMAT FIELD (CP 5)
MOVE T2,[POINT 7,P3] ;GET IT INTO P3
MOVEI T3,1 ;1 CHARACTER
HRL T3,CVTTAB(LT) ;CONVERT IF NEEDED
PUSHJ P,STGSTR ;GET THE REC FMT
JUMPF HDD.A2 ;NO GOOD
LDB T1,[POINT 7,P3,6] ;COPY CHARACTER TO T1
MOVE T2,[XWD -.TRFMX,1] ;MAKE T2 AN AOBJN POINTER TO REC FMTS
CAME T1,RECFMT(T2) ;DOES THIS ENTRY MATCH?
AOBJN T2,.-1 ;NO, TRY TILL DONE
SKIPLE T2 ;Find a match??
HDD.A2: MOVX T2,.TRFUN ;No, Assume Undefined format
STORE T2,TCB.RF(B),TF.RFM ;STORE REC FORMAT IN TCB
MOVE T1,[CPTRI ^D11,0(BUF)] ;NOW POINT AT REC LEN FIELD (CP 11-15)
MOVEI T2,5 ;5 CHARACTER FIELD
HRL T2,CVTTAB(LT) ;CONVERT
PUSHJ P,STRNUM ;DECIMAL NUMBER
JUMPF .POPJ ;OOPS
STORE S2,TCB.LN(B),TL.REC ;SAVE IN TCB
MOVE T1,[CPTRI ^D6,0(BUF)] ;NOW POINT AT BLOCK LEN FIELD (CP 6-10)
MOVEI T2,5 ;5 CHARACTER FIELD
HRL T2,CVTTAB(LT) ;CONVERT
PUSHJ P,STRNUM ;DECIMAL NUMBER
JUMPF .RETF ;OOPS
STORE S2,TCB.LN(B),TL.BLK ;SAVE IN TCB
MOVE T1,[CPTRI ^D37,0(BUF)] ;AIM AT FORM CONTROL CHAR (CP37)
MOVE T2,[POINT 7,P3] ;STORE CONVERTED CHAR IN P3
MOVEI T3,1 ;ONLY 1 CHAR
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STGSTR ;READ AND CONVERT FORM CONTROL CHAR
JUMPF HDD.A3 ;BAD CHAR, ASSUME NONE
LDB T1,[POINT 7,P3,6] ;GET BACK THE CHAR
MOVE T2,[XWD -.TFCMX,1] ;MAKE POINTER TO TABLE
CAME T1,RECFRM(T2) ;IS THIS THE ONE
AOBJN T2,.-1 ;NO, TRY THE NEXT
SKIPL T2 ;FIND ONE?
HDD.A3: MOVX T2,.TFCNO ;NO, SAY NO FORM CONTROL
STORE T2,TCB.RF(B),TF.FCT ;SAVE INDEX
MOVEI S1,'SFL' ;SET TO SKIP THE REST OF THE LABEL GROUP
PJRST T$POS## ;DO IT AND RETURN
HDD.A4: MOVEI S1,[ITEXT (<Invalid PPN or Protection in HDR1 Label>)]
PUSHJ P,O$LERR## ;TELL OPR DRIVE+MESSAGE
;WAIT FOR OPR RESPONSE
JUMPF .RETF ;ABORT IF HE SAY'S SO
JRST HDD.A1 ;OTHERWISE, FINISH UP
HDD.A5: MOVEI S1,[ITEXT (<File Protection Prohibits Access>)]
PUSHJ P,O$LERR## ;TELL OPR,,WAIT FOR RESPONSE
JUMPF .RETF ;ABORT IF HE SAY'S SO
JRST HDD.A1 ;OTHERWISE, FINISH UP
HDD.A6: MOVEI S1,[ITEXT (<HDR2 expected but not found>)]
PUSHJ P,O$LERR## ;TELL OPR DRIVE+MESSAGE
;WAIT FOR OPR RESPONSE
JUMPF .RETF ;ABORT IF HE SAY'S SO
JRST HDD.A1 ;OTHERWISE, FINISH UP
SUBTTL EOF Label Verification
VEREOF: $TRACE (VEREOF,3)
PUSHJ P,@EOFLBL(LT) ;CHECK FOR 'EOF1'
JUMPF VEOF.1 ;NOT THERE
PUSHJ P,@EOFSEQ(LT) ;CHECK FILE SEQUENCE NUMBER
JUMPF VEOF.1 ;DOESN'T CHECK
; PUSHJ P,@EOFSEC(LT) ;Check the file section number
; JUMPF VEOF.1 ;Doesn't match!
INCR TCB.PS(B),TP.POS ;COUNT UP THE FILE NOW
PUSHJ P,@EOFEXP(LT) ;CHECK EXPIRATION DATE
JUMPF VEOF.1 ;IF NO GOOD, QUIT NOW
PUSHJ P,I$BCNT## ;GET BLOCK COUNT SO FAR
MOVEM S1,TCB.BC(B) ;SAVE
PUSHJ P,@EOFBLK(LT) ;CHECK BLOCK COUNT
JUMPF VEOF.1 ;DOESN'T CHECK
PUSHJ P,@EOFDEP(LT) ;GO DO LABEL TYPE DEPENDENT
; STUFF
JUMPF VEOF.1 ;DIDN'T WORK
MOVX S1,TS.POS ;GET POSITION STATUS BITS
ANDCAM S1,TCB.ST(B) ;CLEAR THEM IN THE TCB
MOVX S1,TS.ATM ;AND GET BIT FOR AFTER TAPE MARK
IORM S1,TCB.ST(B) ;TURN IT ON IN TCB
$RETT ;AND GIVE GOOD RETURN
VEOF.1: MOVEI S1,LE.TRE ;GET CODE FOR TRAILER LABEL ERROR
MOVEM S1,G$TERM## ;SAVE AS TERMINATION CODE
$RETF ;AND RETURN
SUBTTL EOV Label Verification
VEREOV: $TRACE (VEREOV,3)
PUSHJ P,@EOVLBL(LT) ;CHECK FOR 'EOV1'
JUMPF VEOV.1 ;NOT THERE
PUSHJ P,@EOVSEQ(LT) ;CHECK FILE SEQUENCE NUMBER
JUMPF VEOV.1 ;DOESN'T CHECK
; PUSHJ P,@EOVSEC(LT) ;Check the file section number
; JUMPF VEOV.1 ;Doesn't look good!
PUSHJ P,@EOVBLK(LT) ;CHECK BLOCK COUNT
JUMPF VEOV.1 ;DOESN'T CHECK
PJRST @EOVDEP(LT) ;GO DO LABEL TYPE DEPENDENT STUFF
VEOV.1: MOVEI S1,LE.TRE ;GET CODE FOR TRAILER LABEL ERROR
MOVEM S1,G$TERM## ;SAVE IN TERMINATION WORD
$RETF ;RETURN ERROR
EOFLBL: BLPDSP
EFL.AS
EFL.AS
EFL.IL
EFL.IL
.RETF
.RETF
.RETF
EFL.CA
EFL.CS
.RETF
EOVLBL: BLPDSP
EVL.AS
EVL.AS
EVL.IL
EVL.IL
.RETF
.RETF
.RETF
EVL.CA
EVL.CS
.RETF
EVL.CA: SKIPA T2,EV1PTR ;GET POINTER TO 'EOV1'
EFL.CA: MOVE T2,EF1PTR ;GET POINTER TO 'EOF1'
MOVE T1,[POINT 7,(BUF)] ;AND POINT INTO THE LABEL
JRST EFL.A1 ;NOW LIKE ALL OTHER LABELS
EVL.CS: SKIPA T2,EV1PTR ;GET POINTER TO 'EOV1'
EFL.CS: MOVE T2,EF1PTR ;GET POINTER TO 'EOF1'
MOVE T1,[POINT 6,(BUF)] ;POINT AT THE LABEL
JRST EFL.A1 ;NOW LIKE ALL OTHER TYPES
EVL.IL: ;DO IBM LIKE ANSI
EVL.AS: SKIPA T2,EV1PTR ;POINT AT 'EOV1'
EFL.IL: ;IBM IS LIKE ANSI
EFL.AS: MOVE T2,EF1PTR ;POINT AT 'EOF1'
MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT AT WHAT WE READ (CP 1-4)
EFL.A1: HRRZI T3,4 ;LENGTH TO COMPARE
HRL T3,CVTTAB(LT) ;GET ADDR OF CORRECT CONVERT
; ROUTINE
PUSHJ P,STRCMP ;DO THE COMPARE
JUMPF EFL.0 ;ERROR
MOVX S1,TS.OUT ;GET OUTPUT FLAG
TDNE S1,TCB.ST(B) ;DON'T COPY FILE NAME ON OUTPUT
$RETT ;EXIT ON OUTPUT
MOVE T1,[CPTRI ^D5,0(BUF)] ;POINTER TO THE FILE NAME (CP 5-21)
MOVE T2,[POINT 7,TCB.FN(B)] ;WHERE TO STORE THE FILE NAME
MOVEI T3,^D17 ;SEVENTEEN CHARACTERS
HRL T3,CVTTAB(LT) ;CONVERSION TYPE
PUSHJ P,STGSTR ;COPY THE STRING
JUMPT .RETT ;OK RETURN
EFL.0: MOVEI S1,[ITEXT (<Invalid EOF1 Record>)] ;ASSUME EOF1 LABEL
HRRZ T1,EF1PTR
TLZ T2,-1
CAIE T1,(T2) ;IS IT AN EOF1 LABEL?
MOVEI S1,[ITEXT (<Invalid EOV1 Record>)] ;NO, IT WAS EOV1
PJRST O$LERR## ;TELL OPR DRIVE AND ERROR
;AND WAIT FOR HIS ANSWER
SUBTTL EOFSEQ/EOVSEQ - Verify file sequence number for trailers
EOFSEQ: BLPDSP
EFS.AS
EFS.AS
EFS.IL
EFS.IL
.RETF
.RETF
.RETF
EFS.CA
EFS.CS
.RETF
EOVSEQ: BLPDSP
EVS.AS
EVS.AS
EVS.IL
EVS.IL
.RETF
.RETF
.RETF
EVS.CA
EVS.CS
.RETF
EVS.CA: ;SAME AS EOF SEQ CHECK
EFS.CA: MOVE T1,[POINT 7,6(BUF),6] ;POINT AT SEQUENCE NUMBER IN BUFFER
JRST EFS.A1 ;AND FINISH WITH COMMON CODE
EVS.CS: ;SAME AS EOF SEQ CHECK
EFS.CS: MOVE T1,[POINT 6,5(BUF),5] ;POINT AT SEQUENCE NUMBER IN LABEL
JRST EFS.A1 ;AND FINISH WITH COMMON CODE
EVS.IL: ;IBM-EOV LIKE ANSI-EOF
EFS.IL: ;IBM IS LIKE ANSI
EVS.AS: ;EOV IS LIKE EOF
EFS.AS: MOVE T1,[CPTRI ^D32,0(BUF)] ;POINT AT SEQ NUM IN LABEL (CP 32-35)
EFS.A1: HRRZI T2,4 ;FIELD IS 4 LONG
HRL T2,CVTTAB(LT) ;GET CONVERSION ROUTINE
PUSHJ P,STRNUM ;GET IT AS A NUMBER
JUMPF EFS.1 ;IF NOT A NUMBER, GIVE ERROR
LOAD T2,TCB.PS(B),TP.POS ;GET THE SAVED POSITION
CAME T2,S2 ;IS IT THE SAME?
JRST EFS.2 ;NO, ERROR
$RETT ;ALL'S WELL
EFS.1: MOVEI S1,[ITEXT (<Illegal File Sequence Number>)]
PJRST O$LERR## ;TELL THE OPR AND WAIT FOR HIS ANSWER
EFS.2: SKIPE G$SEQC## ;HAVE WE ASKED THE OPERATOR?
$WTO (<EOF file sequence warning>,<Label says ^D/S2/ when looking for ^D/T2/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETT ;RETURN AND IGNORE THE ERROR
SUBTTL EOFSEC/EOVSEC - Verify file section number for trailers
EOFSEC: BLPDSP
EFN.AS
EFN.AS
EFN.IL
EFN.IL
.RETF
.RETF
.RETF
.RETT ;COBOL labels don't have 'em
.RETT ;COBOL labels don't have 'em
.RETF
EOVSEC: BLPDSP
EVN.AS
EVN.AS
EVN.IL
EVN.IL
.RETF
.RETF
.RETF
.RETT ;COBOL labels don't have 'em
.RETT ;COBOL labels don't have 'em
.RETF
EVN.IL: ;IBM-EOV LIKE ANSI-EOF
EFN.IL: ;IBM IS LIKE ANSI
EVN.AS: ;EOV IS LIKE EOF
EFN.AS: MOVE T1,[CPTRI ^D28,0(BUF)] ;AIM AT FILE SECTION NUMBER (CP 28-31)
HRRZI T2,4 ;FIELD IS 4 LONG
HRL T2,CVTTAB(LT) ;GET CONVERSION ROUTINE
PUSHJ P,STRNUM ;GET IT AS A NUMBER
JUMPF ENS.1 ;IF NOT A NUMBER, GIVE ERROR
LOAD T2,TCB.SN(B) ;GET THE CURRENT SECTION NUMBER
CAME T2,S2 ;IS IT THE SAME?
JRST ENS.2 ;NO, ERROR
$RETT ;ALL'S WELL
ENS.1: MOVEI S1,[ITEXT (<Illegal File Section Number>)]
SKIPA
ENS.2: MOVEI S1,[ITEXT (<Incorrect File Section Number>)]
PJRST O$LERR## ;TELL THE OPR
;WAIT FOR HIS ANSWER
EOFBLK:
EOVBLK: BLPDSP
.RETT
.RETT
.RETT
.RETT
.RETT
.RETT
.RETT
.RETT
.RETT
.RETT
EOFEXP: BLPDSP
EFE.AS
EFE.AS
EFE.IL
EFE.IL
.RETF
.RETF
.RETF
.RETT
.RETT
.RETF
EFE.IL: ;LIKE ANSI
EFE.AS: MOVE T1,[CPTRI ^D49,0(BUF)] ;POINT AT EXP DATE IN LABEL (CP 49-53)
MOVEI T2,5 ;NUMBER OF CHARS TO GET
HRL T2,CVTTAB(LT) ;CONVERSION IF ANY
PUSHJ P,STRNUM ;GET IT AS A DECIMAL NUMBER
JUMPF EFE.1 ;BAD NUMBER, COMPLAIN TO OPR
PUSH P,S2 ;SAVE DATE FROM LABEL
PUSHJ P,I$DATE## ;GET BP TO TODAY'S DATE
MOVE T1,S2 ;COPY THE BYTE POINTER
IBP T1 ;SKIP OVER THE LEADING BLANK
MOVEI T2,5 ;NUMBER OF CHARACTERS TO CONVERT
PUSHJ P,STRNUM ;CONVERT TO BINARY (IN S2)
JUMPF EFE.1 ;ILLEGAL SYSTEM ERROR
POP P,S1 ;GET BACK DATE FROM LABEL
MOVX T1,TS.EXP ;BIT WHICH FLAGS UNEXPIRED FILE
CAMGE S2,S1 ;IS FILE EXPIRED?
IORM T1,TCB.ST(B) ;YES, FLAG IT AS SO
$RETT ;AND GIVE GOOD RETURN
EFE.1: MOVEI S1,[ITEXT (<Invalid Expiration Date Field>)]
PJRST O$LERR## ;TELL OPR
;WAIT FOR HIS RESPONSE
EOFDEP: BLPDSP
EFD.AS
EFD.AS
EFD.IL
EFD.IL
.RETF
.RETF
.RETF
EXD.CB
EXD.CB
.RETF
EOVDEP: BLPDSP
EVD.AS
EVD.AS
EVD.IL
EVD.IL
.RETT
.RETF
.RETT
EXD.CB
EXD.CB
.RETT
EXD.CB: MOVEI S1,'SFL' ;HAVE TO SKIP REST OF LABELS
PJRST T$POS## ;BUT NO SPECIAL PROCESSING
EVD.IL:
EVD.AS: MOVE T1,[CPTRI ^D61,0(BUF)] ;SYSTEM CODE IN LABEL (CP 61-73)
MOVE T2,S10PTR ;POINT AT SYSTEM CODE
HRRZI T3,^D13 ;ITS LENGTH
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRCMP ;SEE IF LOCAL LABELS
JUMPF EXD.A1 ;NO, JUST SKIP REST
PUSHJ P,T$RDRC## ;GO READ NEXT RECORD
JUMPF .RETF ;COULDN'T, GIVE BAD RETURN
LOAD T1,TCB.IO(B) ;GET THE IO STATUS
TXNE T1,TI.EOF ;EOF?
JRST EXD.A2 ;YES, EXPECTED EOV2 NOT FOUND
MOVE T2,EV2PTR ;GET POINTER TO 'EOV2'
JRST EXD.AS ;AND PROCEED AS IN EOF LABELS
EFD.IL:
EFD.AS: MOVE T1,[CPTRI ^D61,0(BUF)] ;SYSTEM CODE IN LABEL (CP 61-73)
MOVE T2,S10PTR ;POINT AT SYSTEM CODE
HRRZI T3,^D13 ;ITS LENGTH
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRCMP ;SEE IF LOCAL LABELS
JUMPF EXD.A1 ;NO, JUST SKIP REST
PUSHJ P,T$RDRC## ;GO READ NEXT RECORD
JUMPF .RETF ;GIVE BAD RETURN IF ERROR
LOAD T1,TCB.IO(B) ;GET THE IO STATUS
TXNE T1,TI.EOF ;EOF?
JRST EXD.A2 ;YES, EXPECTED EOF2 NOT FOUND
MOVE T2,EF2PTR ;GET POINTER TO 'EOF2'
EXD.AS: MOVE T1,[CPTRI ^D1,0(BUF)] ;POINT TO WHAT WE READ (CP 1-4)
HRRZI T3,4 ;COMPARE 4 CHARS, NO CONVERSION
HRL T3,CVTTAB(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STRCMP ;DO COMPARE
JUMPF EXD.A2 ;GIVE ERROR ON FAILING COMPARE
EXD.A1: MOVEI S1,'SFL' ;ELSE SET TO SKIP FILE
PJRST T$POS## ;DO IT AND RETURN
EXD.A2: MOVEI S1,[ITEXT (<Expected EOF2/EOV2 Label not Found>)]
PJRST O$LERR## ;TELL THE OPR
;AND WAIT FOR RESPONSE
SUBTTL Label Output - 'VOL1' and 'UVL1'
;This routine will write VOL1 and UVL1 labels on the tape at the current
; (assumedly rewound) position. It is useful only during intialization,
; to setup a new tape for some user.
; As a historical note, it used to be called every time a user
; wrote the first file on a tape. This action had the side
; effect of causing the last writer of the tape to be the owner.
; Now, when writing the first file, all the volume labels are just
; bypassed, and any owner or protection fields are left intact.
L$WVOL::
$TRACE (L$WVOL,3)
PUSHJ P,@WRTVL1(LT) ;WRITE THE 'VOL1' LABEL
JUMPF .RETF ;ERROR WRITING 'VOL1' LABEL
PUSHJ P,@WRTUV1(LT) ;WRITE THE 'UVL1' LABEL
JUMPF .RETF ;CAN'T
MOVX P2,TS.VLV!TS.IHL ;GET VOL LABELS VERIFIED + IN HEADER LABELS
IORM P2,TCB.ST(B) ;FLAG THAT IN TCB
$RETT ;AND RETURN
WRTVL1: BLPDSP
WV1.AS
WV1.AS
WV1.IL
WV1.IL
WV1.LT
.RETF
.RETT
.RETF
.RETF
.RETT
WRTUV1: BLPDSP
WUV.AS
WUV.AS
WUV.IL
WUV.IL
.RETT
.RETF
.RETT
.RETF
.RETF
.RETT
SUBTTL Label Output - ANSI 'VOL1' Subroutines
; !-------------------------------------------------------!
; ! WRITE 'VOL1' !
; !-------------------------------------------------------!
WV1.LT: PJRST T$WRTM## ;JUST WRITE A TAPE MARK
WV1.AS: MOVE T1,VL1PTR ;GET POINTER TO STRING TO STORE
MOVE T2,[CPTRI ^D1,0(BUF)] ;WHERE TO STORE IT (CP 1-4)
MOVEI T3,4 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,STGSTR ;STORE THE LABEL ID
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! SIXBIT VOLID !
; !-------------------------------------------------------!
MOVE T1,[POINT 8,TCB.VL(B)] ;POINT AT CURRENT VOLID
MOVEI T3,6 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;STORE THE VOLID
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! ACCESSIBILITY CODE !
; !-------------------------------------------------------!
MOVE T1,BNKPTR ;POINT AT A BLANK
LOAD S1,TCB.PT(B),TP.PRT ;GET PROTECTION FIELD
SKIPE S1 ;PROTECTION = 0?
MOVE T1,[POINT 7,[ASCII/1/]] ;NO, ACC CHAR = 1
MOVEI T3,1 ;GET LENGTH
HRL T3,CVTTB1(LT) ;AND CONVERSION ROUTINE
PUSHJ P,STGSTR ;STORE THE ACCESSIBILITY
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D26 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,BNKSTR ;STORE SOME BLANKS
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! OWNER IDENTIFIER !
; !-------------------------------------------------------!
MOVE T1,D10PTR ;D%A FOR OWNER ID
MOVEI T3,3 ;# CHARS
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;STORE IN LABEL
JUMPF .RETF ;...
MOVE T1,[POINT 7,[ASCII/T10 /]] ;POINT AT OP SYS CODE
MOVEI T3,5 ;# CHARS
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;PUT IT IN LABEL
JUMPF .RETF ;....
; !-------------------------------------------------------!
; ! SYSTEM SERIAL NUMBER !
; !-------------------------------------------------------!
PUSHJ P,I$CPSN## ;GO GET SYSTEM SERIAL NUMBER
MOVE T1,S1 ;COPY IT TO T1
MOVEI T3,5 ;5 CHARS
HRL T3,CVTTB1(LT) ;WITH~ CONVERSION
PUSHJ P,DECSTR ;AS A DECIMAL NUMBER
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! DEC STANDARD VERSION '1' !
; !-------------------------------------------------------!
MOVEI T1,1 ;DEC STD VERSION
MOVEI T3,1 ;ONE CHAR
HRL T3,CVTTB1(LT) ;CONVERT IT
PUSHJ P,OCTSTR ;STORE IT AS A NUMBER
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D28 ;MORE SPACES
HRL T3,CVTTB1(LT) ;CONVERT THEM ALSO
PUSHJ P,BNKSTR ;INTO LABEL
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! LABEL STANDARD VERSION '3' !
; !-------------------------------------------------------!
MOVEI T1,3 ;ANSI STD VERSION
MOVEI T3,1 ;# CHARS
HRL T3,CVTTB1(LT) ;CONVERT IT
PUSHJ P,OCTSTR ;STORE INTO LABEL
JUMPF .RETF ;...
PJRST T$WRRC## ;WRITE OUT THIS LABEL
SUBTTL Label Output - IBM 'VOL1' Subroutines
; !-------------------------------------------------------!
; ! WRITE 'VOL1' !
; !-------------------------------------------------------!
WV1.IL: MOVE T1,VL1PTR ;GET POINTER TO STRING TO STORE
MOVE T2,[CPTRI ^D1,0(BUF)] ;WHERE TO STORE IT (CP 1-4)
MOVEI T3,4 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,STGSTR ;STORE THE LABEL ID
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! SIXBIT VOLID !
; !-------------------------------------------------------!
MOVE T1,[POINT 8,TCB.VL(B)] ;POINT AT CURRENT VOLID
MOVEI T3,6 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;STORE THE VOLID
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVE T1,[POINT 7,[ASCIZ /0/]];MUST BE A ZERO
MOVEI T3,1 ;GET LENGTH
HRL T3,CVTTB1(LT) ;AND CONVERSION ROUTINE
PUSHJ P,STGSTR ;STORE A ZERO
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! VTOC POINTER !
; !-------------------------------------------------------!
MOVEI T3,^D10 ;GET LENGTH
HRL T3,CVTTB1(LT) ;AND CONVERSION ROUTINE
PUSHJ P,BNKSTR ;STORE BLANKS
JUMPF .RETF ;CHECK FAILURE
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D10 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,BNKSTR ;STORE SOME BLANKS
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D10 ;COUNT
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,BNKSTR ;STORE SOME BLANKS
JUMPF .RETF ;...
; !-------------------------------------------------------!
; ! OWNER IDENTIFIER !
; !-------------------------------------------------------!
MOVE T1,D10PTR ;D%A FOR OWNER ID
MOVEI T3,3 ;# CHARS
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;STORE IN LABEL
JUMPF .RETF ;...
MOVE T1,[POINT 7,[ASCII/T10 /]] ;POINT AT OP SYS CODE
MOVEI T3,7 ;# CHARS
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;PUT IT IN LABEL
JUMPF .RETF ;....
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D29 ;MORE SPACES
HRL T3,CVTTB1(LT) ;CONVERT THEM ALSO
PUSHJ P,BNKSTR ;INTO LABEL
JUMPF .RETF ;...
PJRST T$WRRC## ;WRITE OUT THIS LABEL
SUBTTL Label Output - 'UVL1' Subroutines
WUV.IL: $RETT ;IBM DOESN'T HAVE UVL/VOL2
WUV.AS:
IFN FTVPRO,< ;If we do any protection at all...
IFN FTUPRO,< ;If we do it via UVL1 label
MOVE T1,UVLPTR ;POINT AT 'UVL1'
>;End IFN FTUPRO
IFE FTUPRO,< ;If we do it via VOL2 label
MOVE T1,VL2PTR ;POINT AT 'VOL2'
>;End IFE FTUPRO
MOVE T2,[CPTRI ^D1,0(BUF)] ;WHERE TO SAVE CHARACTERS (CP 1-4)
MOVEI T3,4 ;LENGTH
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;PUT CHARS IN LABEL
JUMPF .RETF ;...
LOAD T1,TCB.PT(B),TP.PRT ;GET PROTECTION
MOVEI T3,6 ;NUMBER OF CHARACTERS TO STORE
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,OCTSTR ;STORE IN LABEL
JUMPF .RETF ;...
MOVE T1,TCB.OW(B) ;GET PPN
CAMN T1,G$FFAP## ;[OPR] PPN ?
MOVE T1,TCB.VO(B) ;YES - USE VOLUME OWNER PPN INSTEAD
HLRZS T1 ;GET PROJECT NUMBER
MOVEI T3,6 ;NUMBER OF CHARACTERS TO STORE
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,OCTSTR ;STORE IN LABEL
JUMPF .RETF ;...
MOVE T1,TCB.OW(B) ;GET PPN
CAMN T1,G$FFAP## ;[OPR] PPN ?
MOVE T1,TCB.VO(B) ;YES - USE VOLUME OWNER PPN INSTEAD
HRRZS T1 ;GET PROGRAMMER NUMBER
MOVEI T3,6 ;NUMBER OF CHARACTERS TO STORE
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,OCTSTR ;STORE IN LABEL
JUMPF .RETF ;...
HRRI T1,TCB.UN(B) ;Aim at user name
HRLI T1,(POINT 7,) ;With a 7-bit pointer
MOVEI T3,14 ;LENGTH TO STORE
HRL T3,CVTTB1(LT) ;CONVERSION
PUSHJ P,STGSTR ;STORE NAME IN LABEL
JUMPF .RETF ;...
MOVEI T3,56 ;REST OF LABELS GETS
HRL T3,CVTTB1(LT) ; FILLED WITH BLANKS
PUSHJ P,BNKSTR ;...
JUMPF .RETF ;...
PUSHJ P,T$WRRC## ;WRITE OUT THIS LABEL
JUMPF .POPJ ;ANOTHER BAD DAY!
>;End IFN FTVPRO
$RETT
SUBTTL Label Output - 'EOF1'
L$WEOF::
WRTEOF: $TRACE (WRTEOF,3)
MOVE T1,EF1PTR ;POINT AT 'EOF1'
PUSHJ P,@WHDR1(LT) ;MAKE AN EOF1 LABEL AND WRITE IT
JUMPF .RETF ;OOPS, COULDN'T
MOVE T1,EF2PTR ;POINT AT 'EOF2'
PUSHJ P,@WHDR2(LT) ;MAKE THAT AND WRITE IT
JUMPF .RETF ;COULDN'T DO IT
MOVX S1,TS.POS ;GET STATUS FOR POSITION
ANDCAM S1,TCB.ST(B) ;CLEAR IT
MOVX S1,TS.ATM ;AND FLAG AFTER TAPE MARK
IORM S1,TCB.ST(B) ;IN THE TCB
PJRST T$CLOS## ;DO AN OUTPUT CLOSE
SUBTTL Label Output - 'EOV1'
L$WEOV::
WRTEOV: $TRACE (WRTEOV,3)
MOVE T1,EV1PTR ;AND A POINTER TO 'EOV1'
PUSHJ P,@WHDR1(LT) ;WRITE THE EOV1 LABEL
JUMPF .RETF ;CAN'T
MOVE T1,EV2PTR ;POINT AT EOV2
PUSHJ P,@WHDR2(LT) ;AND WRITE IT
JUMPF .RETF ;WHAT?
MOVX S1,TS.POS ;GET POSITION BITS
ANDCAM S1,TCB.ST(B) ;CLEAR THEM
MOVX S1,TS.ATM ;GET AFTER TAPE MARK BIT
IORM S1,TCB.ST(B) ;LIGHT IT IN TCB
PJRST T$CLOS## ;CLOSE OUTPUT AND RETURN
SUBTTL Label Output - 'HDR1' and 'HDR2'
L$WHDR::
WRTHDR: $TRACE (WRTHDR,3)
MOVE T1,HD1PTR ;POINT AT 'HDR1'
PUSHJ P,@WHDR1(LT) ;WRITE IT OUT
JUMPF .RETF ;ERROR
MOVE T1,HD2PTR ;POINT AT 'HDR2'
PUSHJ P,@WHDR2(LT) ;WRITE THAT OUT
JUMPF .RETF ;ERROR
MOVX S1,TS.POS ;GET POSITION BITS
ANDCAM S1,TCB.ST(B) ;CLEAR THEM
MOVX S1,TS.IUD ;GET IN USER DATA BIT
IORM S1,TCB.ST(B) ;LIGHT IT IN TCB
PJRST T$CLOS## ;CLOSE OUTPUT AND RETURN
WHDR1: BLPDSP
WH1.AS
WH1.AS
WH1.IL
WH1.IL
.RETT
.RETF
.RETT
.RETF
.RETF
.RETT
WHDR2: BLPDSP
WH2.AS
WH2.AS
WH2.IL
WH2.IL
.RETT
.RETF
.RETT
.RETT
.RETT
.RETT
SUBTTL Label Output - ANSI and IBM HDR1 Subroutines
; !-------------------------------------------------------!
; ! WRITE 'HDR1' !
; !-------------------------------------------------------!
WH1.IL: ;LIKE ANSI, BUT DIFF CONVERSION
WH1.AS: MOVE T2,[CPTRI ^D1,0(BUF)] ;POINT AT WHERE TO START STORING (CP 1-4)
HRRZI T3,4 ;HOW MUCH TO STORE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;SAVE AS STRING
JUMPF .RETF ;BAD CHARS?
; !-------------------------------------------------------!
; ! 17-CHARACTER FILE IDENTIFIER !
; ! (From TCB) or - !
; ! 'FILE.nnnBBBBBBBBB' !
; ! (where nnn is the file position) !
; !-------------------------------------------------------!
MOVE S1,[ASCII / /] ;GET FIVE BLANKS
CAMN S1,TCB.FN(B) ;WAS A FILE NAME SPECIFIED
JRST WH1.A0 ;NO, USE THE DEFAULT
MOVE T1,[POINT 7,TCB.FN(B)] ;POINTER TO THE FILE NAME
HRRZI T3,^D17 ;SEVENTEEN CHARACTER MAX
HRL T3,CVTTB1(LT) ;CONVERSION TYPE
PUSHJ P,STGSTR ;COPY THE FILE NAME
JUMPF .RETF ;BAD FILE NAME
JRST WH1.B ;CONTINUE
WH1.A0:
MOVE T1,FILPTR ;POINT AT 'FILE'
HRRZI T3,5 ;SAVE 5 CHARS
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;AS CHARACTERS
JUMPF .RETF ;BAD CHARACTER?????
LOAD T1,TCB.PS(B),TP.POS ;GET CURRENT POSITION
JUMPN T1,WH1.A1 ;PROCEED IF NON ZERO
MOVEI T1,1 ;ELSE MAKE IT 1
STORE T1,TCB.PS(B),TP.POS ;AND SAVE IT IN THE TCB
CAILE T1,^D999 ;MAX EXTENSION
MOVEI T1,^D999 ;SET TO MAX
WH1.A1: HRRZI T3,3 ;3 CHARACTERS LONG
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;AS A DECIMAL NUMBER
JUMPF .RETF ;BAD NUMBER
HRRZI T3,11 ;ELEVEN MORE BLANKS
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,BNKSTR ;ALL BLANKS
JUMPF .RETF ;THATS AWFULLY STRANGE
; !-------------------------------------------------------!
; ! VOLUME ID OF FIRST VOLUME IN VOLUME SET !
; !-------------------------------------------------------!
WH1.B: MOVE T1,[POINT 8,TCB.FV(B)] ;POINT AT THE VOLID
HRRZI T3,6 ;IT'S SIX CHARS LONG
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;SAVE IT AS A STRING
JUMPF .RETF ;OOPS
; !-------------------------------------------------------!
; ! FILE SECTION NUMBER !
; !-------------------------------------------------------!
LOAD T1,TCB.SN(B) ;GET FILE SECTION NUMBER
HRRZI T3,4 ;4 WIDE FILED
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;SAVE AS DECIMAL NUMBER
JUMPF .RETF ;COULDN'T???
; !-------------------------------------------------------!
; ! FILE SEQUENCE NUMBER !
; !-------------------------------------------------------!
LOAD T1,TCB.PS(B),TP.POS ;GET CURRENT POSITION
HRRZI T3,4 ;4 WIDE FIELD
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;AS DECIMAL NUMBER
JUMPF .RETF ;WHAT??
; !-------------------------------------------------------!
; ! GENERATION NUMBER !
; !-------------------------------------------------------!
LOAD T1,TCB.GV(B),TG.GEN ;GET THE GENERATION NUMBER
SKIPE T1 ;WAS ANYTHING SPECIFIED
CAILE T1,^D9999 ;OR TOO BIG?
MOVEI T1,1 ;OUT OF RANGE, SAY 1
HRRZI T3,4 ;4 WIDE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;USE DECIMAL CONVERISON
JUMPF .RETF ;SOMETIMES NOTHING WINS!!!
; !-------------------------------------------------------!
; ! VERSION NUMBER !
; !-------------------------------------------------------!
LOAD T1,TCB.GV(B),TG.VER ;GET THE VERSION NUMBER
CAILE T1,^D99 ;OR TOO BIG?
SETZ T1, ;OUT OF RANGE, SAY 0
HRRZI T3,2 ;2 CHARS WIDE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;USE DECIMAL CONVERSION
JUMPF .RETF ;SOMETIMES NOTHING WINS!!!
; !-------------------------------------------------------!
; ! CREATION DATE (JULIAN) ' YYDDD' OR ' 00000' !
; !-------------------------------------------------------!
PUSHJ P,I$DATE## ;GET THE DATE
MOVE T1,S2 ;INTO T1
HRRZI T3,6 ;ITS SIX CHARACTERS LONG
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;AND AN STRING
JUMPF .RETF ;OOPS
; !-------------------------------------------------------!
; ! EXPIRATION DATE (JULIAN) ' YYDDD' !
; !-------------------------------------------------------!
MOVEI T3,1 ;NOW 1 BLANK
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,BNKSTR ;...
JUMPF .RETF ;WE ALL HAVE OUR BAD DAYS
LOAD S1,TCB.EX(B),TE.EXP ;GET EXPIRATION DATE FROM TAPOP.
JUMPE S1,WH1.A2 ;NONE SET
PUSHJ P,I$DATI## ;MAKE 15 BIT DATE INTO ASCII
JRST WH1.A3 ;AND PROCEED
WH1.A2: LOAD T1,TCB.DT(B) ;GET THE DEFAULT EXPIRATION DATE
HRRZI T3,5 ;ITS 5 WIDE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;AND IN DECIMAL
LOAD T1,TCB.DT(B) ;GET THE EXPIRATION DATE AGAIN
JUMPN T1,WH1.A4 ;IF NON-ZERO, WE'RE OK
PUSHJ P,I$DATE## ;ELSE GET TODAY AGAIN
WH1.A3: MOVE T1,S2 ;MOVE PTR TO T1
MOVE T2,[CPTRI ^D48,0(BUF)] ;POINT AT FIELD IN LABEL AGAIN (CP 48-53)
HRRZI T3,6 ;6 WIDE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;AS A STRING
JUMPF .RETF ;OH WELL
; !-------------------------------------------------------!
; ! ACCESSIBILITY CHARACTER !
; !-------------------------------------------------------!
WH1.A4: MOVE T1,BNKPTR ;POINT TO A BLANK
SKIPN S1,TCB.PR(B) ;GET PROT FROM TAPOP IF SET
LOAD S1,TCB.PT(B),TP.PRT ;GET PROTECTION FIELD
SKIPE S1 ;PROTECTION = 0?
MOVE T1,[POINT 7,[ASCIZ/1/]] ;POINT AT '1'
CAIE LT,LT.IL ;ARE LABELS IBM?
CAIN LT,LT.IUL ;OR IBM WITH USER?
MOVE T1,[POINT 7,[ASCIZ/0/]] ;YES, FREE ACCESS CHAR IS 0
HRRZI T3,1 ;1 BLANK
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;...
JUMPF .RETF ;BAD DAY
; !-------------------------------------------------------!
; ! BLOCK COUNT '000000' !
; !-------------------------------------------------------!
MOVE T1,TCB.BC(B) ;GET BLOCK COUNT FROM TCB
HRRZI T3,6 ;TO FILL A SIX WIDE FIELD
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,DECSTR ;...
JUMPF .RETF ;SIGH
; !-------------------------------------------------------!
; ! SYSTEM CODE 'DECSYSTEM10' !
; !-------------------------------------------------------!
MOVE T1,S10PTR ;POINT AT 'DECSYSTEM10'
MOVEI T3,^D13+^D7 ;CODE FIELD OF 13 PLUS 7 BLANKS
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR ;WITH THAT STRING
JUMPF .RETF ;AFTER ALL THAT LUCK
PJRST T$WRRC## ;AND WRITE THE RECORD
SUBTTL Label Output - ANSI HDR2 Subroutines
; !-------------------------------------------------------!
; ! WRITE 'HDR2' !
; !-------------------------------------------------------!
WH2.AS: $CALL .SAVE1 ;SAVE A SCRATCH REGISTER
MOVE T2,[CPTRI ^D1,0(BUF)] ; (CP 1-4)
HRRZI T3,4
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! RECORD FORMAT !
; !-------------------------------------------------------!
LOAD P1,TCB.RF(B),TF.RFM ;PICK UP RECORD FORMAT
MOVE T1,[POINT 7,RECFMT(P1),35-7] ;POINT AT LIST OF CHARACTERS
MOVEI T3,1
HRL T3,CVTTB1(LT)
PUSHJ P,STGSTR ;STORE REC FMT IN LABEL
JUMPF .RETF ;OOPS
; !-------------------------------------------------------!
; ! BLOCK LENGTH !
; !-------------------------------------------------------!
LOAD T1,TCB.LN(B),TL.BLK ;GET BLOCK LENGTH
MOVEI T3,5
HRL T3,CVTTB1(LT)
PUSHJ P,DECSTR ;SAVE BLOCK LEN IN LABEL
JUMPF .RETF
; !-------------------------------------------------------!
; ! RECORD LENGTH !
; !-------------------------------------------------------!
LOAD T1,TCB.LN(B),TL.REC ;GET RECORD LENGTH
MOVEI T3,5
HRL T3,CVTTB1(LT)
PUSHJ P,DECSTR ;SAVE REC LEN IN LABEL
JUMPF .RETF
; !-------------------------------------------------------!
; ! FILE ACCESS CODE !
; !-------------------------------------------------------!
SKIPN T1,TCB.PR(B) ;GET USER-SET PROTECTION
LOAD T1,TCB.PT(B),TP.PRT ;OR MOUNTED ONE IF NONE SET
HRRZI T3,6 ;SIX CHARACTERS
HRL T3,CVTTB1(LT) ;CONVERT IF NEEDED
PUSHJ P,OCTSTR ;ITS AN OCTAL NUMBER
JUMPF .RETF ;OOOPS
; !-------------------------------------------------------!
; ! OWNER'S DIRECTORY !
; !-------------------------------------------------------!
HLRZ T1,TCB.OW(B)
HRRZI T3,6
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,OCTSTR
JUMPF .RETF
HRRZ T1,TCB.OW(B)
HRRZI T3,6
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,OCTSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! SYSTEM DEPENDENT !
; !-------------------------------------------------------!
MOVEI T3,^D3
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,BNKSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! FORM CONTROL CHARACTER !
; !-------------------------------------------------------!
LOAD P1,TCB.RF(B),TF.FCT ;Get form control index
MOVE T1,[POINT 7,RECFRM(P1),35-7] ;Aim at appropriate character
MOVEI T3,1 ;ONE BYTE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D43
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,BNKSTR
JUMPF .RETF
PJRST T$WRRC##
SUBTTL Label Output - IBM HDR2 Subroutines
; !-------------------------------------------------------!
; ! WRITE 'HDR2' !
; !-------------------------------------------------------!
WH2.IL: $CALL .SAVE1 ;SAVE A SCRATCH REGISTER
MOVE T2,[CPTRI ^D1,0(BUF)] ; (CP 1-4)
HRRZI T3,4
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! RECORD FORMAT !
; !-------------------------------------------------------!
LOAD P1,TCB.RF(B),TF.RFM ;PICK UP RECORD FORMAT
MOVE T1,[POINT 7,RECFMT(P1),35-7] ;POINT AT LIST OF CHARACTERS
MOVEI T3,1
HRL T3,CVTTB1(LT)
PUSHJ P,STGSTR ;STORE REC FMT IN LABEL
JUMPF .RETF ;OOPS
; !-------------------------------------------------------!
; ! BLOCK LENGTH !
; !-------------------------------------------------------!
LOAD T1,TCB.LN(B),TL.BLK ;GET BLOCK LENGTH
CAILE T1,^D32760 ;CAN'T BE GREATER THAN THIS
MOVEI T1,^D32760 ;ADJUST TO CONFROM TO IBM SPEC
MOVEI T3,5
HRL T3,CVTTB1(LT)
PUSHJ P,DECSTR ;SAVE BLOCK LEN IN LABEL
JUMPF .RETF
; !-------------------------------------------------------!
; ! RECORD LENGTH !
; !-------------------------------------------------------!
LOAD T1,TCB.LN(B),TL.REC ;GET RECORD LENGTH
MOVEI T3,5
HRL T3,CVTTB1(LT)
PUSHJ P,DECSTR ;SAVE REC LEN IN LABEL
JUMPF .RETF
; !-------------------------------------------------------!
; ! TAPE DENSITY !
; !-------------------------------------------------------!
PUSH P,T2 ;SAVE FROM DESTRUCTION
PUSHJ P,I$GDEN## ;MAKE SURE WE HAVE THE DENSITY
POP P,T2 ;RESTORE BYTE POINTER TO LABEL BUFFER
LOAD T1,TCB.PS(B),TP.DEN ;GET KNOWN DENSITY
SUBI T1,1 ;ADJUST TO MATCH IBM CODES
MOVEI T3,1 ;1 CHARACTER
HRL T3,CVTTB1(LT) ;GET CONVERSION ROUTINE
PUSHJ P,OCTSTR ;WRITE OUT THE DENSITY CODE
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! DATA SET POSITION !
; !-------------------------------------------------------!
PUSH P,T2 ;SAVE FROM DESTRUCTION
MOVE T1,[POINT 8,TCB.FV(B)] ;POINT TO THE FIRST REELID
MOVE T2,[POINT 8,TCB.VL(B)] ;POINT TO THE CURRENT REELID
MOVEI T4,6 ;6 CHARACTERS
HRL T3,CVTTAB(LT) ;CONVERSION ROUTINE
PUSHJ P,STRCMP ;COMPARE
POP P,T2 ;RESTORE BYTE POINTER TO BUFFER
MOVE T1,[POINT 7,[ASCIZ /0/]];ASSUME FIRST REEL IN VOLUME SET
SKIPT ;IS IT?
MOVE T1,[POINT 7,[ASCIZ /1/]];NO--A CONTINUATION REEL
MOVEI T3,1 ;1 CHARACTER
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,STGSTR ;WRITE DIGIT OUT
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! JOB/JOB STEP IDENTIFICATION !
; !-------------------------------------------------------!
MOVEI T3,^D17 ;17 CHARACTERS
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,BNKSTR ;WRITE BLANKS
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! TAPE RECORDING TECHNIQUE !
; !-------------------------------------------------------!
MOVEI T3,2 ;2 CHARACTERS
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,BNKSTR ;WRITE BLANKS
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! CONTROL CHARACTERS !
; !-------------------------------------------------------!
LOAD P1,TCB.RF(B),TF.FCT ;GET FORM CONTROL INDEX
MOVE T1,[POINT 7,RECFRM(P1),35-7] ;AIM AT APPROPRIATE CHARACTER
MOVEI T3,1 ;ONE BYTE
HRL T3,CVTTB1(LT) ;GET ADDR OF CONVERSION ROUTINE
PUSHJ P,STGSTR
JUMPF .RETF
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,1 ;LENGTH
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,BNKSTR ;WRITE BLANKS
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! BLOCK ATTRIBUTE !
; !-------------------------------------------------------!
MOVEI T3,1 ;LENGTH
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,BNKSTR ;WRITE A BLANK
JUMPF .RETF ;CHECK FOR ERRORS
; !-------------------------------------------------------!
; ! RESERVED !
; !-------------------------------------------------------!
MOVEI T3,^D41 ;LENGTH
HRL T3,CVTTB1(LT) ;CONVERSION ROUTINE
PUSHJ P,BNKSTR ;WRITE BLANKS
JUMPF .RETF ;CHECK FOR ERRORS
PJRST T$WRRC## ;WRITE RECORD AND RETURN
SUBTTL Routines to Return File Sequence Number
GETFSN: BLPDSP ;ERROR IF HERE ON BLP
GTF.AS ;ANSI LABELS
GTF.AS ;...
GTF.IL ;IBM LABELS
GTF.IL ;IBM LABELS
GTF.LT ;LEADING TAPE MARK
GTF.NS ;NON STANDARD
GTF.NL ;NO LABELS
GTF.NL ;COBOL ASCII
GTF.NL ;COBOL SIXBIT
GTF.NL ;NO LABELS
GTF.NL:
GTF.LT:
GTF.NS: HALT .
GTF.IL:
GTF.AS: MOVE T1,[CPTRI ^D28,0(BUF)] ;POINT AT FILE SECTION NUMBER (CP 28-31)
GTF.1: HRRZI T2,4 ;LENGTH OF 4
HRL T2,CVTTAB(LT) ;GET CONVERSION ROUTINE
PJRST STRNUM ;MAKE IT A NUMBER
GTF.CA: SKIPA T1,[POINT 7,5(BUF),13] ;POINT AT FSN
GTF.CS: MOVE T1,[POINT 6,4(BUF),17] ;POINT AT FSN
$RETT
SUBTTL Routine to Determine if This is an EOF1 Label
CHKEV1: SKIPA T2,EV1PTR ;POINT TO 'EOV1'
CHKEF1: MOVE T2,EF1PTR ;GET POINTER TO CANONICAL 'EOF1'
MOVE T1,CHKE.A(LT) ;GET BYTE POINTER TO LABEL ID FIELD
MOVEI T3,4 ;COUNT
HRL T3,CVTTAB(LT) ;CONVERSION
PJRST STRCMP ;DO THE COMPARE
CHKE.A: Z ;NO PTR FOR BLP
CPTRI ^D1,0(BUF) ;FOR SL
CPTRI ^D1,0(BUF) ;AND SUL
CPTRI ^D1,0(BUF) ;FOR IL
CPTRI ^D1,0(BUF) ;AND IUL
Z ;FOR LTM
Z ;FOR NS
Z ;FOR NL
Z ;FOR COBOL ASCII
Z ;FOR COBOL SIXBIT
Z ;FOR NL
SUBTTL Routine to Do Input Checking
;THIS ROUTINE CHECKS IF AN INPUT TYPE OPERATION IS LEGAL TO
;THIS TAPE. AN INPUT TYPE OPERATION IS ANY OPERATION EXCEPT
;REWIND, OUTPUT, CLOSE OUTPUT, OR FEOV.
INPCHK: MOVX S1,TS.OUT ;GET ONLY OUPUT LEGAL BIT
TDNN S1,TCB.ST(B) ;IS IT SET?
$RETT ;NO, ALL IS WELL
PS.IOP: MOVX S1,LE.IOP ;GET ERROR CODE
MOVEM S1,G$TERM## ;STORE IT FOR RETURN
$RETF
SUBTTL SETIUD - Routine to set TS.IUD in TCB status word
SETIUD: MOVE S1,TCB.ST(B) ;GET STATUS WORD
TXO S1,TS.IUD ;SET IN USER DATA
TXZ S1,TS.ATM ;CLEAR AFTER TAPE MARK
MOVEM S1,TCB.ST(B) ;UPDATE
$RETT ;RETURN
SUBTTL Routine to Find HDR1 Label
;THIS ROUTINE FINDS THE HDR1 LABEL IN THE PRECEDING BEGINNING OF FILE
;OR BEGINNING OF VOLUME LABEL GROUP. IT MUST BE CALLED WITH THE TAPE
;POSITIONED IN USER DATA.
FNDHD1: $TRACE (FNDHD1,3)
MOVEI S1,'BFL' ;SET TO BACKSPACE TO LABEL GROUP
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;CAN'T?
MOVEI S1,'BFL' ;NOW BACK OVER LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;THIS SHOULDN'T HAPPEN
FNDH.1: LOAD S1,TCB.IO(B) ;GET IO STATUS
TXNN S1,TI.EOF ;LAST OP HIT EOF?
JRST FNDH.2 ;NO, MUST BE AT START OF VOLUME
MOVEI S1,'SFL' ;SKIP BACK TO START OF HDR LABELS
PUSHJ P,T$POS## ;GO
JUMPF .RETF ;BUT WE JUST WENT THE OTHER WAY
FNDH.2: PUSHJ P,T$RDRC## ;READ NEXT RECORD
JUMPF .RETF ;ERROR READING RECORD
MOVX S1,TI.EOF ;CHECK FOR EOF
TDNE S1,TCB.IO(B) ;IN TCB
$RETF ;NO HDR1?????
MOVE T1,CHKE.A(LT) ;GET BYTE POINTER TO LABEL
MOVE T2,HD1PTR ;AND TO 'HDR1'
MOVEI T3,4 ;HOW MANY CHARS TO COMPARE
HRL T3,CVTTAB(LT) ;WHAT CONVERSION TO USE
PUSHJ P,STRCMP ;COMPARE
JUMPF FNDH.2 ;NOPE, TRY NEXT RECORD
MOVX S1,TS.IUD ;GET IN USER DATA
ANDCAM S1,TCB.ST(B) ;CLEAR IT
MOVX S1,TS.IHL ;GET IN HEADER LABELS
IORM S1,TCB.ST(B) ;SET IT
$RETT ;RETURN TRUE
SUBTTL Utility Routines -- Volume protection check
; This routine is called whenever a volume protection error occurs.
; The first time, the operator will be asked to abort or proceed
; with the operation. The operator's response will be memorized
; in the TCB so succeding errors can be handled without operator
; intervention.
VPCCHK: LOAD S1,TCB.S2(B),TS.VPC ;GET VOLUME PROTECTION CHECK STATUS
JRST @.+1(S1) ;DISPATCH
EXP VPCCH0 ;ASK
EXP VPCCH1 ;ABORT
EXP VPCCH2 ;PROCEED
VPCCH0: MOVEI S1,[ITEXT (<Volume protection failure>)]
PUSHJ P,O$LERR## ;TELL OPR OF PROTECTION FAILURE
JUMPT VPCCH2 ;RESPONSE AS PROCEED
VPCCH1: MOVEI S1,.TSABO ;GET ABORT CODE
STORE S1,TCB.S2(B),TS.VPC ;STORE
MOVEI S1,LE.VPF ;VOLUME PROTECTION FAILURE
MOVEM S1,G$TERM## ;SET TERMINATION CODE
$RETF ;AND RETURN
VPCCH2: MOVEI S1,.TSPRO ;PROCEED
STORE S1,TCB.S2(B),TS.VPC ;STORE
SETZM G$TERM## ;GIVE USER THE GREEN LIGHT
$RETT ;AND PROCEED
SUBTTL Utility Routines -- Routine To Mount Previous Volume
;THIS ROUTINE IS CALLED TO MOUNT THE N-1ST VOLUME OF A VOLUME SET ON
;A BACKSPACE RECORD/FILE WHICH WENT INTO THE BEGINNING-OF-VOLUME LABEL
;GROUP ON THE NTH VOLUME.
;IT SPACES TO THE END OF THE VOLUME AND THEN VERIFIES THE EOV LABELS.
;THE TAPE IS LEFT POSITIONED BEFORE THE TAPE MARK PRECEDING THE END-OF-
;FILE-SECTION LABEL GROUP AT THE END OF THE VOLUME. TS.IUD WILL ALWAYS
;BE ON IN TCB.ST.
;TRUE/FALSE IS RETURNED. IF THE FIRST VOLUME OF THE SET IS ALREADY
;MOUNTED, BOT WILL BE STORED IN G$TERM AND FALSE WILL BE RETURNED.
LSTVOL: $TRACE (LSTVOL,3)
PUSHJ P,CKFIRV ;Are we on the first volume?
JUMPT LSTV.3 ;Yes, can't back up from here!
MOVX S1,%RLPRV ;Get code for previous volume
SETZ S2, ;Clear the I/O flag
PUSHJ P,MNTVOL ;Get that one mounted
JUMPF .RETF ;THAT DIDN'T WORK
PUSHJ P,VERVOL ;CHECK ITS VOLUME LABELS
JUMPF .RETF ;THEY ARE WRONG
CAIN LT,LT.NL ;NOLABELS?
$RETT ;YES--ALL DONE
LSTV.1: PUSHJ P,T$RDRC## ;READ THE HDR1 LABEL
JUMPF .RETF ;ERROR
LOAD S1,TCB.IO(B) ;GET THE IO STATUS
TXNE S1,TI.EOF ;READ SAW EOF??
JRST LSTV.2 ;YES, MUST BE END OF VOLUME
PUSHJ P,@HDRLBL(LT) ;IS THIS A PROPER HDR1?
JUMPF .RETF ;NO, ERROR
MOVEI S1,'SFL' ;SKIP THE HEADER LABELS
PUSHJ P,T$POS## ;TO GET TO USER'S DATA
JUMPF .RETF ;ERROR
MOVEI S1,'SFL' ;SKIP THE USER'S DATA
PUSHJ P,T$POS## ;TO GET TO EOF LABELS
JUMPF .RETF ;ERROR
MOVEI S1,'SFL' ;SKIP THE EOF LABELS ALSO
PUSHJ P,T$POS## ;TO GET TO NEXT FILE'S HDR LABELS
JUMPF .RETF ;COULDN'T
JRST LSTV.1 ;AND TRY TO CHECK THEM
LSTV.2: MOVEI S1,'BFL' ;BACK UP OVER SECOND TAPE MARK OF LEOT
PUSHJ P,T$POS## ;...
JUMPF .RETF ;OOPS
MOVEI S1,'BFL' ;BACK UP INTO EOV LABELS
PUSHJ P,T$POS## ;LEAVES US AT END OF LABEL GROUP
JUMPF .RETF ;EXCEPT WHEN IT DOESN'T WORK
MOVEI S1,'BFL' ;NOW BACK OVER LABEL GROUP
PUSHJ P,T$POS## ;LEAVES US BEFORE TAPE MARK BEFORE LABEL GROUP
JUMPF .RETF ;OOPS
MOVEI S1,'SBL' ;NOW SKIP THAT TAPE MARK
PUSHJ P,T$POS## ;TO BE AT START OF EOV LABELS
JUMPF .RETF ;ON GOOD DAYS
PUSHJ P,T$RDRC## ;READ THE EOV1
JUMPF .RETF ;CAN'T
PUSHJ P,VEREOV ;CHECK THE EOV LABELS
JUMPF .RETF ;THEY'RE WRONG
MOVEI S1,'BFL' ;BACK UP INTO EOV LABELS
PUSHJ P,T$POS## ;LEAVES US AT END OF LABEL GROUP
JUMPF .RETF ;EXCEPT WHEN IT DOESN'T WORK
MOVEI S1,'BFL' ;NOW BACK OVER LABEL GROUP
PUSHJ P,T$POS## ;LEAVES US BEFORE TAPE MARK BEFORE LABEL GROUP
JUMPF .RETF ;OOPS
MOVX S1,TS.POS ;GET TCB POSITION INFORMATION
ANDCAM S1,TCB.ST(B) ;CLEAR IT IN THE TCB
MOVX S1,TS.IUD ;FLAG THAT WE'RE IN USER DATA
IORM S1,TCB.ST(B) ;SET IT IN THE TCB
$RETT ;AND GIVE GOOD RETURN
LSTV.3: MOVX S1,LE.BOT ;GET CODE FOR BOT
MOVEM S1,G$TERM## ;SAVE IT IN TERMINATION WORD
$RETF ;AND RETURN FALSE
SUBTTL Routine to get the next volume of a set mounted
;There are two entry points to this routine.
;NXTVIN and NXTVOU. Both will ask MDA for the next volume of a set,
; however, one asks for the next volume for input and
; the other asks for the next volume for output.
;Call with the TCB adr in B
;Returns TRUE if the tape was mounted (volume labels NOT verified)
NXTVIN: TDZA S2,S2 ;Clear the flags
NXTVOU: MOVX S2,%VWRT ;Mark that we want to write next volume
$TRACE (NXTVOL,4)
MOVX S1,%RLNXT ;Code to get next volume
PUSHJ P,MNTVOL ;Get it mounted
JUMPF .RETF ;Couldn't, so quit
MOVEI S1,'REW' ;REWIND THIS TAPE
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR ON REWIND! QUIT
ZERO TCB.ST(B) ;CLEAR THE STATUS
$RETT ;RETURN TRUE
SUBTTL FIRVOL - Get the first volume of a set mounted
;This routine will as MDA to mount the first volume of
;a volume set. (this is only neccessary on REWIND)
;Call with the TCB addr in B
FIRVOL:
PUSHJ P,CKFIRV ;Are we on the first volume already?
JUMPT .RETT ;Yes, use it!
MOVX S1,%RLFIR ;Get code for first volume in set
SETZ S2, ;And clear the IN/OUT flags
PJRST MNTVOL ;Get that one mounted
SUBTTL CKFIRV - See if current vol is first vol
;Call with TCB of mounted (L$MOUNT) volume in B.
;Returns TRUE is current vol is first vol.
; FALSE if not on first vol
CKFIRV:
MOVE S1,TCB.VL(B) ;Get first part of volid
MOVE S2,TCB.VL+1(B) ;And second part
CAMN S1,TCB.FV(B) ;First part match?
CAME S2,TCB.FV+1(B) ;Yes, does second?
$RETF ;One of 'em doesn't
$RETT ;Both do, win
SUBTTL MNTVOL - Get an arbitrary volume of a set mounted
;Call -
; S1/ Relative volume code %RLxxx
; S2/ Input/Ouput flag (0 or %VWRT)
; B/ TCB addr
;Returns -
; TRUE, volume is up, perhaps on a switched unit,
; (the switch has been taken care of!)
; FALSE, OPR refused to comply, or end of volume set
MNTVOL: $TRACE (MNTVOL,4)
PUSHJ P,REQMDA ;Post the request to MDA
MOVX S1,TW.MNT ;CODE FOR MOUNT WAIT
STORE S1,TCB.WS(B) ;Set the wait state
PUSHJ P,G$NJOB## ;WAIT FOR OPR RESPONSE
JUMPT MNTV.2 ;Jump if OPR put tape up
MOVX S2,LE.VLE ;Default to label error
CAXN S1,PLR%ES ;Was it End of Volume set?
MOVX S2,LE.EOF ;Yes, return EOF to user
CAXN S1,PLR%CN ;Were we cancelled ?
MOVX S2,LE.CAN ;Yes, tell the user
CAXN S1,PLR%TM ;Exceeded volume limit ?
MOVX S2,LE.TMV ;Yes, tell the user
MOVEM S2,G$TERM## ;Save the error code
CAXE S2,LE.TMV ;If too many volumes
CAXN S2,LE.EOF ; or end of file then
$RETF ; return now
SETZM TCB.WS(B) ;Else set TCB idle
MOVX S1,TS.NTP ;Get no tape bit
MOVEM S1,TCB.ST(B) ;That's all we know about the TCB
$RETF ;Return
MNTV.2: MOVX S1,TS.NTP+TS.VLV ;Get not tape+volume verified bits
ANDCAM S1,TCB.ST(B) ; and clear them
MOVEI S1,TCB.VL(B) ;GET ADDRESS OF VOLID
PJRST I$RLID## ;SET AS SYSTEM REELID AND RETURN
SUBTTL REQMDA - Ask MDA to get a different volume mounted
;This routine is called to post a volume switch requet to MDA.
;The routine does not wait for the request to be answered.
;Enter at CANMDA to cancel pending volume switch request.
;Call -
; S1/ Relative volume code %RLxxx
; S2/ Input/Output flag (0 or %VWRT)
; B/ TCB addr
CANMDA: MOVEI S1,%RLABO ;ABORT PENDING REEL SWITCH
MOVEI S2,0 ;NO JUNK PLEASE
REQMDA: MOVEM S2,RLVOL+.RLVCD ;Save the I/O flag
STORE S1,RLVOL+.RLVCD,RLV.CD ;Store the relative volume code
LOAD S1,TCB.DV(B) ;Get the real MT device name
STORE S1,RECDV+.RECDN ;Set the device name
DMOVE S1,[EXP REQLN,REQMSG] ;Aim at the message
PJRST G$SMDA## ;Send it to MDA
REQMSG: $BUILD (.OHDRS)
$SET (.MSTYP,MS.TYP,.QOVSR) ;Type - Volume Switch Request
$SET (.MSTYP,MS.CNT,REQLN) ;Length
$SET (.OARGC,,2) ;2 argument blocks
$EOB
;The first argument block
$BUILD (ARG.DA)
$SET (ARG.HD,AR.LEN,ARG.DA+.RECSZ) ;Length of the block
$SET (ARG.HD,AR.TYP,.RECDV) ;Block type
$EOB
RECDV: BLOCK .RECSZ ;Space for the device name
;The second argument block
$BUILD (ARG.DA)
$SET (ARG.HD,AR.LEN,ARG.DA+.RLVSZ) ;Length of the block
$SET (ARG.HD,AR.TYP,.RLVOL) ;Block type
$EOB
RLVOL: BLOCK .RLVSZ ;Space for the relative volume argument
REQLN==.-REQMSG ;Length of the request message
SUBTTL Routine to Position Tape To Correct File
POSTAP: $TRACE (POSTAP,2)
MOVX S1,TS.PSN ;GET FLAG FOR POSITIONING NEEDED
TDNN S1,TCB.ST(B) ;IS IT ON?
PJRST POSFIL ;CHECK ON FILE POSITION ONLY
MOVX S1,TS.IHL!TS.ATM ;POTENTIALLY IN HEADERS?
TDNN S1,TCB.ST(B) ;???
STOPCD (BCP,HALT,,<Bad call to POSTAP>)
PUSHJ P,T$RDRC## ;GO READ A RECORD
JUMPF .RETF ;CAN'T READ A RECORD
LOAD S1,TCB.IO(B),TI.EOF ;GET BIT TO SEE IF WE HIT EOF
JUMPE S1,POST.0 ;NO, NOT AT EOT
MOVEI S1,'BFL' ;YES, SKIP BACK OVER END OF FILE
PUSHJ P,T$POS## ;MOVE THE TAPE
JUMPF .RETF ;POSITIONING ERROR
LOAD T1,TCB.RP(B),TP.RQP ;GET THE REQUEST POSITION
LOAD S2,TCB.PS(B),TP.POS ;GET THE ACTUAL POSITION
CAME T1,S2 ;REQUESTING THE LAST FILE +1 (EOT)
CAIN T1,^D99999 ;LOOKING FOR EOT
JRST POST.2 ;YES, WE FOUND IT
PUSHJ P,POSZER ;TELL OPR ABOUT SEQ NUM MISMATCH
JUMPF .POPJ ;OPR SAID ABORT
CAIN S1,PLR%PR ;PROCEED AND IGNORE SEQUENCE ERRORS?
JRST POST.2 ;PRETEND AT RIGHT POSITION
CAMG T1,S2 ;CHECK FOR GOING BACKWARD AT EOT
JRST POST.3 ;YES, SPACE BACKWARD
MOVEI S1,LE.PSE ;NO, GET FLAG FOR POSITIONING ERROR
MOVEM S1,G$TERM## ;SET AS TERMINATION WORD
$RETF ;GIVE FALSE RETURN
POST.0: MOVE T1,[CPTRI ^D32,0(BUF)] ;POINT AT HDRSEQ (CP 32-35)
HRL T2,CVTTAB(LT) ;SET UP TO CONVERT IF NECESSARY
HRRI T2,4 ;LENGTH OF STRING
PUSHJ P,STRNUM ;MAKE STRING INTO NUMBER
JUMPF .RETF ;NOT A NUMBER
STORE S2,TCB.PS(B),TP.POS ;SAVE THE FILE POSITION NUMBER
LOAD T1,TCB.RP(B),TP.RQP ;GET REQUESTED FILE POSITION
CAMN T1,S2 ;COMPARE IT TO CURRENT FILE POSITION
JRST POST.1 ;WE'RE THERE, FINISH UP
PUSHJ P,POSZER ;TELL OPR ABOUT SEQ NUM MISMATCH
JUMPF .POPJ ;OPR SAID ABORT
CAIN S1,PLR%PR ;PROCEED AND IGNORE SEQUENCE ERRORS?
JRST POST.1 ;PRETEND AT RIGHT POSITION
CAMG T1,S2 ;ARE WE BEFORE THE FILE?
JRST POST.3 ;NO, GO BACKWARDS
MOVEI S1,'SFL' ;GET CODE TO SKIP FILE
PUSHJ P,T$POS## ;MOVE THE TAPE
JUMPF .RETF ;OOPS, THAT LOST
ZERO TCB.ST(B),TS.POS ;CLEAR POSITIONING BITS
MOVX S1,TS.IUD ;GET IN USER DATA BIT
IORM S1,TCB.ST(B) ;LIGHT THAT IN TCB
PUSHJ P,NXTFIL ;SKIP TO NEXT FILE
JUMPF .RETF ;COULDN'T SKIP TO NEXT FILE
JRST POSTAP ;WE HAVE NOW SKIPPED TO NEXT SET
; OF HDR LABELS, SEE IF THIS IS IT
POST.1: MOVEI S1,'BBL' ;CODE TO BACK UP BLOCK
PUSHJ P,T$POS## ;BACK UP OVER HDR LABEL WE JUST READ
JUMPF .RETF ;COUDN'T DO IT
LOAD S1,TCB.RP(B),TP.RQP ;GET THE REQUESTED POSITION
STORE S1,TCB.PS(B),TP.POS ;SAVE AS THE CURRENT POSITION
POST.2: MOVX T1,TS.PSN!TS.FFF ;GET BIT THAT SAYS WE NEEDED TO POSITION
ANDCAM T1,TCB.ST(B) ;CLEAR IT
MOVEI S1,1 ;GET A 1
STORE S1,TCB.SN(B) ;SET THE FILE SECTION NUMBER NOW!!
SETZM G$TERM## ;CLEAR TERMINATION WORD
MOVX T1,TS.PSF ;GET FILE POSITION FLAG
TDNN T1,TCB.ST(B) ;IS IT ON
$RETT ;NO, EXIT POSITION IS DONE
ANDCAB T1,TCB.ST(B) ;CLEAR THE POSITION FLAG
TXNE T1,TS.OUT ;DOING OUTPUT
$RETT ;YES, THEN ANY NAME OK
MOVE T1,[CPTRI ^D5,0(BUF)] ;POINTER TO HDR1 FILE NAME (CP 5-21)
MOVE T2,[POINT 7,TCB.FN(B)] ;POINTER TO USER's FILE NAME
MOVEI T3,^D17 ;COMPARE ALL 17 CHARACTERS
HRL T3,CVTTAB(LT) ;GET THE CONVERSION TYPE
PUSHJ P,STRCMP ;FILE NAME COMPARE
JUMPT .RETT ;YES, GOOD RETURN
MOVEI T1,LE.FNF ;GET FILE NOT FOUND RETURN
MOVEM T1,G$TERM## ;STORE AS TERMINATION FLAG
$RETF ;ERROR RETURN
POST.3: MOVEI S1,'BFL' ;BACK UP OVER HEADER LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR
MOVEI S1,'BFL' ;BACK UP OVER END OF FILE LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR
ZERO TCB.ST(B),TS.POS ;CLEAR THE POSITION BITS
MOVX S1,TS.IUD ;NOW IN THE USER DATA
IORM S1,TCB.ST(B) ;SET ON
DECR TCB.PS(B),TP.POS ;BACKUP THE FILE COUNT
POST.4: PUSHJ P,FNDHD1 ;FIND THE HEADER RECORDS
JUMPF .RETF ;ERROR
PUSHJ P,@GETFSN(LT) ;GET THE FILE SECTION NUMBER
JUMPF .RETF ;CAN'T BAD TAPE HEADER
CAIN S2,1 ;FIRST FILE SECTION
JRST POST.0 ;YES, TRY AGAIN
MOVEI S1,'BFL' ;BACK UP OVER FILE LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR
LOAD S1,TCB.IO(B) ;GET THE IO FLAGS
TXNE S1,TI.EOF ;END OF FILE
JUMPF .RETF ;YES, BAD TAPE
PUSHJ P,LSTVOL ;GET THE PREVIOUS VOLUME
JUMPT POST.4 ;TRY AGAIN
MOVEI S1,LE.PSE ;POSITIONING ERROR
MOVEM S1,G$TERM## ;STORE
$RETF ;RETURN
; Routine to notify the operator about a sequence number mismatch.
POSZER: MOVE S1,G$SEQC## ;GET CODE TO PROCESS SEQUENCE ERRORS
CAIN S1,PLR%AB ;ABORT USER JOB?
JRST PS.BAD ;YES
CAIE S1,PLR%PR ;PROCEED AND IGNORE SEQUENCE ERRORS?
CAIN S1,PLR%RT ;RETRY SEARCH FOR CORRECT SEQ NUM?
JRST POSZ.2 ;YES
POSZ.1: MOVX S1,TS.FSE ;GET A BIT
IORM S1,TCB.S2(B) ;FLAG FILE SEQUENCE ERROR PROCESSING
MOVEI S1,POSTX1 ;POINT TO INTRODUCTORY TEXT
MOVEI S2,POSTX2 ;POINT TO MAIN TEXT
PUSHJ P,O$LERT## ;ASK THE OPERATOR WHAT TO DO
MOVX S2,TS.FSE ;GET BIT AGAIN
ANDCAM S2,TCB.S2(B) ;CLEAR IT
CAIN S1,PLR%TY ;WANT TO RETYPE THE MESSAGE?
JRST POSZER ;STUPID OPR DOESN'T KNOW HOW TO RESPOND
JUMPF PS.BAD ;OPR SAID ABORT
POSZ.2: LOAD S2,TCB.PS(B),TP.POS ;RELOAD CURRENT POSITION
LOAD T1,TCB.RP(B),TP.RQP ;RELOAD REQUESTED POSITION
CAIE S1,PLR%PR ;OPR TYPE PROCEED?
$RETT ;NO--RETURN WITH PLR%RT IN S1
CAML T1,S2 ;WHICH ONE IS SMALLER
MOVE T1,S2 ;S2 IS
CAIL T1,0 ;OUT OF RANGE?
CAILE T1,^D999 ;MUST BE A LEGAL SEQUENCE NUMBER
MOVEI T1,1 ;MAKE IT REASONABLE
STORE T1,TCB.PS(B),TP.POS ;RESET TO CREATE FILE.001
STORE T1,TCB.RP(B),TP.RQP ;SET REQUESTED POSITION TO MATCH
$RETT ;RETURN WITH PLR%PR IN S1
POSTX1: ITEXT (<File sequence number error; label says ^D/TCB.PS(B),TP.POS/ when looking for ^D/TCB.RP(B),TP.RQP/>)
POSTX2: ITEXT (<Type 'RESPOND ^I/number/ ABORT' to terminate this operation
Type 'RESPOND ^I/number/ PROCEED' to ignore the error and continue
Type 'RESPOND ^I/number/ RETRY' to search again for correct file>)
POSFIL: $TRACE (POSFIL,2)
MOVX S1,TS.PSF ;GET FILE POS BIT
TDNN S1,TCB.ST(B) ;IS IT ON
$RETT ;NO, EXIT
ANDCAM S1,TCB.ST(B) ;YES, CLEAR IT
$CALL .SAVE1 ;NEED AN AC
MOVE P1,TCB.ST(B) ;GET THE STATUS BIT
AND P1,[TS.INP!TS.OUT] ;SAVE FIRST IN/OUT
ANDCAM P1,TCB.ST(B) ;CLEAR IN THE STATUS WORD
PUSHJ P,PS.REW ;GO TO THE FIRST FILE OF THE FIRST VOLUME
IORM P1,TCB.ST(B) ;RESTORE THE FLAGS
JUMPF .RETF ;ERROR ON LOGICAL REWIND
PUSHJ P,VERVOL ;MAKE SURE THE VOLUME IS OK
JUMPF .POPJ ;ITS NOT, SO GIVE UP
POSF.1: PUSHJ P,T$RDRC ;READ A RECORD
JUMPF .RETF ;ERROR IN READING HDR1
LOAD S1,TCB.IO(B),TI.EOF ;GET THE END OF FILE BIT
JUMPN S1,POSF.7 ;YES AT END OF LOGICAL TAPE
MOVE T1,[CPTRI ^D5,0(BUF)] ;FILE NAME IN THE HDR1 LABEL (CP 5-21)
MOVE T2,[POINT 7,TCB.FN(B)] ;GET THE USER'S FILE NAME
MOVEI T3,^D17 ;COMPARE ALL 17 CHARACTERS
HRL T3,CVTTAB(LT) ;CONVERSION TYPE
PUSHJ P,STRCMP ;IS THIS THE FILE
JUMPT POSF.2 ;YES, FOUND THE FILE
MOVEI S1,'SFL' ;SKIP THE FILE LABELS
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;LOST
ZERO TCB.ST(B),TS.POS ;CLEAR THE POSITIONING BIT
MOVX S1,TS.IUD ;GET IN THE USER's DATA
IORM S1,TCB.ST(B) ;SET IT
PUSHJ P,NXTFIL ;GO TO THE NEXT FILE
JUMPF .RETF ;ERRORS
IORM P1,TCB.ST(B) ;RESET THE IN/OUT FLAG RESET ON REEL SWITCH
JRST POSF.1 ;TRY AGAIN
POSF.2: MOVEI S1,'BBL' ;BACK TO THE HEADER 1 RECORD
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;ERROR
PJRST POST.2 ;COMMON EXIT
POSF.7: ;HERE ON LOGICAL END OF TAPE
MOVEI S1,'BFL' ;SKIP BACK OVER END OF FILE
PUSHJ P,T$POS## ;DO IT
JUMPF .RETF ;CAN'T
TXNE P1,TS.OUT ;DOING OUTPUT
PJRST POST.2 ;WIN
MOVEI T1,LE.FNF ;GET FILE NOT FOUND
MOVEM T1,G$TERM## ;STORE AS USER'S TERMINATION
$RETF ;RETURN
SUBTTL NXTFIL -- Routine to Skip to Next Data File
;CALLED WHEN IN USER DATA TO SKIP TO NEXT FILE'S HDR1 LABEL
NXTFIL: $TRACE (NXTFIL,4)
LOAD S1,TCB.ST(B) ;GET TAPE STATUS
TXNN S1,TS.IUD ;IN USER DATA?
STOPCD (BCN,HALT,,<Bad call to NXTFIL>)
MOVEI S1,'SFL' ;CODE TO SKIP A FILE
PUSHJ P,T$POS## ;SKIP THE FILE
JUMPF .RETF ;THAT LOST
MOVX S1,TS.IUD ;GET IN USER DATA BIT
ANDCAM S1,TCB.ST(B) ;CLEAR IT
PUSHJ P,T$RDRC## ;READ A RECORD
JUMPF .RETF ;LOSING MAGTAPES
PUSHJ P,CHKEF1 ;CHECK IF 'EOF1'
JUMPF NXTF.1 ;NO, HOPE IT'S 'EOV1'
MOVEI S1,'SFL' ;CODE TO SKIP FILE
PUSHJ P,T$POS## ;SKIP THE FILE
JUMPF .RETF ;THAT LOST
INCR TCB.PS(B),TP.POS ;INDICATE NEXT FILE
MOVX S1,TS.ATM ;GET AFTER TAPE MARK BIT
IORM S1,TCB.ST(B) ;SET IN TCB
$RETT ;GIVE WINNING RETURN
;HERE IF NOT EOF1 LABEL AFTER USER DATA
NXTF.1: $CALL .SAVE1 ;SAVE A REGISTER
PUSHJ P,CHKEV1 ;TRY FOR 'EOV1'
JUMPF NXTF.2 ;BAD LABELS
LOAD P1,TCB.ST(B),TS.PSN ;GET POSITIONING NEEDED FLAG
PUSHJ P,NXTVIN ;GET THE NEXT VOLUME
JUMPF .RETF ;COULDN'T
IORM P1,TCB.ST(B) ;AND TURN IT ON IF NECESSARY
PUSHJ P,VERVOL ;CHECK ITS VOLUME LABELS
JUMPF .RETF ;THEY LOST
MOVEI S1,'SFL' ;SKIP THE REST OF THE LABEL GROUP
PUSHJ P,T$POS## ;...
JUMPF .RETF ;OOPS
ZERO TCB.ST(B),TS.POS ;CLEAR TAPE POSITION BITS
MOVX S1,TS.IUD ;GET IN USER DATA BIT
IORM S1,TCB.ST(B) ;SET AS POSITION
JRST NXTFIL ;AND GO BACK TO START
;HERE IF NEITHER EOF1 OR EOV1 AFTER DATA
NXTF.2: MOVX S1,LE.TRE ;TRAILER LABEL ERROR
STORE S1,G$TERM## ;SAVE IN TERMINATION CODE WORD
$RETF ;AND GIVE BAD RETURN
;SUBTTL Routine to Find a TCB from a Volid
;
;
;;CALLED WITH:
;; S1 = SIXBIT VOLID
;;RETURNS TRUE/FALSE, B POINTING TO THE TCB WITH MATCHING VOLID IF TRUE
;
;
;L$FVOL:: $TRACE (L$FVOL,1)
; $CALL .SAVET ;SAVE THE T REGS
; MOVEM S1,FVOL.A ;SAVE VOLID IN LOCAL STORAGE
; MOVE S1,G$LIST## ;Get list handle
; $CALL L%FIRST ;Start at the top
;FVOL.1: JUMPF .RETF ;NO MORE, RETURN FALSE
; MOVE B,S2 ;Save pointer to this TCB
; MOVE T1,[POINT 6,FVOL.A] ;GET A BYTE POINTER TO THE SOUGHT VOLID
; MOVE T2,[POINT 8,TCB.VL(B)] ;GET A BYTE POINTER TO VOLID IN THIS TCB
; MOVE T3,[SIXCVT,,6] ;CONVERSION ROUTINE,,LENGTH
; PUSHJ P,STRCMP ;DO THEY MATCH?
; JUMPT .RETT ;YES, THIS IS THE ONE
; MOVE S1,G$LIST## ;Get back list handle
; $CALL L%NEXT ;Try for next entry
; JRST FVOL.1 ;NO, TRY NEXT TCB
;
;FVOL.A: BLOCK 1 ;LOCAL STORAGE
SUBTTL String Manipulation Routines
;ROUTINE TO COMPARE TO CHARACTER STRINGS
;CALLED WITH
; T1 = BYTE POINTER TO STRING 1
; T2 = BYTE POINTER TO STRING 1
; T3 = ADDR OF CONVERSION ROUTINE FOR STRING 2,,LENGTH OF STRINGS
;
;RETURNS TRUE/FALSE
STRCMP: HLRZ T4,T3 ;GET ADDR OF CONVERSION ROUTINE INTO T4
HRRZS T3 ;MAKE T3 ONLY COUNT
STRC.1: ILDB S2,T1 ;GET A CHARACTER FROM STRING 1
JUMPE T4,STRC.2 ;CONTINUE IF NO CONVERSION DESIRED
MOVE S1,S2 ;GET CHARACTER INTO S1
PUSHJ P,(T4) ;CALL CONVERSION ROUTINE
JUMPF .RETF ;ILLEGAL CHARACTER, RETURN
STRC.2: ILDB S1,T2 ;GET A CHARACTER FROM STRING 2
CAME S1,S2 ;COMPARE
$RETF ;RETURN FALSE
SOJG T3,STRC.1 ;LOOP FOR NEXT CHARACTER
$RETT ;ALL DONE, RETURN TRUE
;ROUTINE TO CONVERT A CHARACTER STRING TO A NUMBER
;ENTER AT STRNUM FOR DECIMAL, AT STROCT FOR OCTAL
;CALLED WITH:
; T1 = BYTE POINTER TO STRING
; T2 = ADDR OF CONVERSION ROUTINE,,LENGTH OF STRING
;
;RETURNS TRUE/FALSE, NUMBER IN S2
STROCT: SKIPA T4,[EXP 10] ;GET RADIX
STRNUM: MOVEI T4,^D10 ;GET RADIX
$CALL .SAVE1 ;AND SAVE AN AC
HLRZ T3,T2 ;GET ADDR OF CONVERSION ROUTINE
HRRZS T2 ;AND MAKE T2 JUST COUNT
SETZ P1, ;CLEAR AN AC AS AN ACCUMULATOR
STRN.1: ILDB S2,T1 ;GET A CHARACTER
JUMPE T3,STRN.2 ;CONTINUE IF NO CONVERSION DESIRED
MOVE S1,S2 ;GET CHAR INTO S1 FOR CONVERT
PUSHJ P,(T3) ;CALL CONVERSION ROUTINE
JUMPF .RETF ;ILLEGAL CHARACTER, RETURN FALSE
STRN.2: CAIG S2,"0"-1(T4) ;IS CHAR BIGGER THAN 9
CAIGE S2,"0" ;OR LESS THAN 0
$RETF ;YES, ITS NOT A DIGIT, RETURN FALSE
SUBI S2,"0" ;CONVERT TO A NUMBER
IMULI P1,(T4) ;SHIFT THE ACCUMULATOR ONE DIGIT
ADD P1,S2 ;AND ADD IN THIS DIGIT
SOJG T2,STRN.1 ;LOOP FOR MORE
MOVE S2,P1 ;GET RESULT IN S2 FOR RETURN
$RETT ;AND GIVE GOOD RETURN
;ROUTINES TO CONVERT NUMBER INTO STRING
;ENTER AT OCTSTR IF NUMBER IS TO BE INTERPRETED AS OCTAL
;ENTER AT DECSTR IF NUMBER IS TO BE INTERPRETED AS DECIMAL
;CALLED WITH:
; T1 = NUMBER
; T2 = DESTINATION BYTE POINTER
; T3 = ADDR OF CONVERT ROUTINE,,LENGTH OF STRING TO STORE INTO
;RETURNS WITH:
; T2 = UPDATED DESTINATION BYTE POINTER
; TRUE/FALSE - FALSE ONLY IF NUMBER WON'T FIT INTO STRING
; OF LENGTH (T3)
;STRING STORE IS RIGHT JUSTIFIED, ZERO FILLED
OCTSTR: SKIPA T4,[EXP 10] ;SET RADIX TO 8
DECSTR: MOVEI T4,^D10 ;SET RADIX TO 10
$CALL .SAVE1 ;SAVE A REGISTER
HLRZ P1,T3 ;GET ADDR OF CONVERSION ROUTINE INTO P1
HRRZS T3 ;MAKE T3 JUST COUNT
MOVE S2,T1 ;COPY NUMBER INTO S2
NUMS.1: IDIVI S2,(T4) ;GET A DIGIT
HRLM T1,(P) ;SAVE A DIGIT ON THE STACK
SOJG T3,NUMS.2 ;HAS COUNT EXPIRED
JUMPE S2,NUMS.3 ;YES, IF NO MORE NUMBER, OK
$RETF ;NUMBER TOO LONG
NUMS.2: PUSHJ P,NUMS.1 ;RECURSE FOR NEXT DIGIT
JUMPF .RETF ;PROPAGATE FALSE RETURN
NUMS.3: HLRZ S2,(P) ;GET A DIGIT OFF THE STACK
ADDI S2,"0" ;ADD IN ASCII ZERO
JUMPE P1,NUMS.4 ;DON'T CALL CONVERT ROUTINE IF THERE ISN'T ONE
MOVE S1,S2 ;COPY CHARACTER TO S1 FOR CONVERT ROUTINE
PUSHJ P,(P1) ;CALL CONVERSION ROUTINE
JUMPF .RETF ;OOPS, BAD CHARACTER
NUMS.4: IDPB S2,T2 ;STORE A CHARACTER
$RETT ;RETURN TRUE
;ROUTINE TO STORE A STRING, WITH CONVERSION IF NECESSARY
;CALLED WITH:
; T1 = BYTE POINTER TO SOURCE STRING
; T2 = BYTE POINTER TO DESTINATION STRING
; T3 = ADDR OF CONVERSION ROUTINE,,LENGTH OF STRINGS
;
;RETURNS FALSE IF ANY ILLEGAL CHARACTERS
;RETURNS UPDATED DESTINATION BYTE POINTER IN T2
;LH OF T3 = 0 IMPLIES NO CONVERSION
L$STST::
STGSTR: HLRZ T4,T3 ;GET CONVERSION ROUTINE ADDR IN T4
HRRZS T3 ;MAKE T3 JUST COUNT
STGS.1: ILDB S1,T1 ;GET A CHARACTER
JUMPE T4,STGS.2 ;PROCEED IF NO CONVERSION
PUSHJ P,(T4) ;CALL CONVERSION ROUTINE
JUMPF .RETF ;ILLEGAL CHARACTER
MOVE S1,S2 ;COPY CONVERSION RESULT INTO S1
STGS.2: IDPB S1,T2 ;STORE A CHARACTER
SOJG T3,STGS.1 ;LOOP FOR MORE
$RETT ;RETURN TRUE
;ROUTINE TO STORE BLANKS
;CALLED WITH:
; T2 = DESTINATION BYTE POINTER
; T3 = ADDR OF CONVERSION ROUTINE,,NUMBER OF BLANKS TO STORE
;
;RETURNS UPDATED DESTINATION BYTE POINTER IN T2
;LH OF T3 = 0 ON CALL IMPLIES NO CONVERSION
BNKSTR: MOVE S1,BNKPTR ;POINT TO WORD OF BLANKS
ILDB S2,S1 ;GET AN ASCII BLANK
HLRZ T4,T3 ;GET ADDR OF CONVERT ROUTINE
HRRZS T3 ;MAKE T3 JUST COUNT
JUMPE T4,BNKS.1 ;SKIP IF NO CONVERT
MOVE S1,S2 ;COPY TO S1 FOR CONVERSION ROUTINE
PUSHJ P,(T4) ;CALL CONVERT ROUTINE
BNKS.1: IDPB S2,T2 ;STORE A CHARACTER
SOJG T3,BNKS.1 ;LOOP FOR NEXT
$RETT ;GIVE GOOD RETURN
SUBTTL String Conversion
;THE FIRST SET CONVERT TO ASCII FROM OTHER CHARACRTER SETS
L$CVTT::
CVTTAB: BLPDSP ;ERROR
Z ;NO CONVERSION FOR ANSI
Z ;...
EBCCVT ;EBCDIC TO ASCII
EBCCVT ;...
Z
Z
Z
Z ;NO CONVERSION FOR COBOL ASCII
SIXCVT ;SIXBIT TO ASCII
Z
SIXCVT: MOVEI S2,40(S1) ;CONVERT CHAR IN S1
TRNE S2,777600 ;LEGAL ASCII?
$RETF ;NO, GIVE ERROR
$RETT ;RETURN OK
EBCCVT: IDIVI S1,4 ;MAKE S1 INDEX TO TABLE,
; S2 INDEX TO BYTE POINTER
ADDI S1,E.ATBL ;MAKE S1 WORD TO GET CHAR FROM
LDB S2,PTRS(S2) ;GET THE CORRECT BYTE
TRNN S2,200 ;IS IT A LEGAL CHAR?
$RETT ;YES, GOOD RETURN
$RETF ;NO, LOSE
;THESE CONVERT FROM ASCII TO ANOTHER CHARACTER SET
CVTTB1: BLPDSP ;THIS IS VERY WRONG
Z ;NO CONVERSION FOR ASCII
Z ;DITTO
ASCEBC ;ASCII TO EBCDIC
ASCEBC ; "
Z
Z
Z
Z
Z
Z
ASCEBC: IDIVI S1,4 ;MAKE S1 INDEX TO TABLE
; S2 INDEX TO BYTE POINTER
ADDI S1,A.ETBL ;POINT AT CORRECT LOC IN TABLE
LDB S2,PTRS(S2) ;GET THE CHARACTER
TRNN S2,400 ;IS IT LEGAL?
$RETT ;YES, GOOD RETURN
$RETF ;NO, ERROR
SUBTTL Character Conversion Tables
;FIRST DEFINE SOME MACROS TO SET UP THESE TABLES
.XCREF
DEFINE WORD(A,B,C,D),< ;DEFINE A MACRO TO GENERATE A WORD
;OF NINE BIT BYTES
XLIST
BYT(A,1)
BYT(B,2)
BYT(C,3)
BYT(D,4)
BYTE(9)%1,%2,%3,%4
LIST
>
ZZ==0
DEFINE BYT(A,B),< ;DEFINE THE BYTES AS THE ASCII TO EBCDIC
;VALUES
IFG AE%'A-400000,<%'B==400+AE%'A-400000>
IFLE AE%'A-400000,<%'B==AE%'A>
PURGE AE%'A
>
A.ETBL: ;NOW DEFINE THE TABLE
REPEAT 40,<
WORD(\ZZ,\<ZZ+1>,\<ZZ+2>,\<ZZ+3>)
ZZ==ZZ+4
>
;NOW REDEFINE THE BYT MACRO TO GENERATE THE EBCDIC TO ASCII TABLE
ZZ==0
DEFINE BYT(A,B),< ;DEFINE THE BYTES AS THE EBCDIC TO ASCII
;VALUES
IFGE EA%'A-400000,<%'B==400+EA%'A-400000>
IFL EA%'A-400000,<%'B==EA%'A>
PURGE EA%'A
>
E.ATBL: ;NOW DEFINE THE TABLE
REPEAT 100,<
WORD(\ZZ,\<ZZ+1>,\<ZZ+2>,\<ZZ+3>)
ZZ==ZZ+4
>
.CREF
;SET UP BYTE POINTERS TO THE TABLES
;THESE ASSUME S1 IS POINTING TO THE CORREC WORD IN THE TABLE
PTRS: POINT 9,(S1),8
POINT 9,(S1),17
POINT 9,(S1),26
POINT 9,(S1),35
BLPDSP: JRST .RETF
END