Trailing-Edge
-
PDP-10 Archives
-
tops10_703a_sys_atpch16_bb-fr67f-bb
-
plrini.x16
There are 2 other files named plrini.x16 in the archive. Click here to see a list.
TITLE PLRINI - Initialization Module
SUBTTL Author: Dave Cornelius/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
SEARCH ORNMAC ;For the WTO definitions
SEARCH PLRMAC
SEARCH QSRMAC
PROLOG (PLRINI)
GLOB <G$REEL>
; This module contains all of the code to support the SET TAPE INITIALIZE
; OPR command. This code is the replacement for the VOLINI program. It
; allows the operator to generate labeled tapes ; without running any special
; program. The operator may label one tape, or a batch of tapes with
; incremental volume identifiers.
; The entry point symbols in this module are of the form V$xxxx, to signify
; that the routine is resposible for writing of VOLUME labels.
SUBTTL External references
;This is an incomplete list of external references
; which are made only from within $TEXTs or $WTOs
EXTERN G$DENS ;Table of density strings
EXTERN G$LTYP ;Table of label type strings
SUBTTL V$IMSG - Decode and dispatch the initialize message
;This routine is called from the operator dispatch code
; when a SET TAPE INITIALIZE command is given
;The only argument is the message, whose addrs is passed in M
;The routine has no T/F value, but the operator
; may get bitched at if the message is internally bad
; or there are problems with the tapes.
; The routine sets up the TCB runnable at the labeler loop code
V$IMSG::
$SAVE <P1,P2>
SETZM P2 ;Indicate normal initialization
MOVX S1,.DVINI ;Make sure the set tap msg is
PUSHJ P,O$FNDB## ; an INITIALIZE msg
SKIPT ;Ie, does it contain a .DVINI block?
JSP S1,O$CERR## ;It doesn't, give up
MOVX S1,.TAPDV ;Block type to find
PUSHJ P,O$FNDB## ;Search the message for it
SKIPT ;Wins?
JSP S1,O$CERR## ;No, quit
HRLI S1,(POINT 7,) ;Aim at the ASCII
$CALL S%SIXB ;Convert to SIXBIT
DEVNAM S2, ;Expand the drive name
JSP S1,O$CERR## ;Can't, so give up
MOVE P1,S2 ;Save it permanently
MOVX S1,.SIABO ;Get /ABORT block type
PUSHJ P,O$FNDB## ;Is this /ABORT ???
JUMPT ABOINI ;Yes,,abort it !!!!
MOVE S1,P1 ;Get device name in S1
PUSHJ P,G$FTCB## ;Find the tape's data block
JUMPF IMSG.0 ;Not there,,skip this
MOVE S1,TCB.WS(B) ;Get its wait state
CAXE S1,TW.OFL ;Is it offline ???
CAXN S1,TW.IGN ;Is it idle ???
JRST IMSG.3 ;Yes,,forge ahead !!
CAXE S1,TW.MNT ;Switching reels ???
JRST IMSG.1 ;No,,thats an error
MOVE P2,B ;Save the current TCB address
MOVE T1,TCB.DV(B) ;Get the device name
SETZB T2,T3 ;No job or ppn
MOVEM P2,TCB.DV(P2) ;Make sure we don't use the old TCB
PUSHJ P,G$MTCB## ;Create a new TCB to do the work
MOVE S1,TCB.IO(P2) ;Get the DDB file status bits
MOVEM S1,TCB.IO(B) ;Save them in the new TCB
HRLI S1,TCB.FB(P2) ;Get the FILOP. block address
HRRI S1,TCB.FB(B) ;Where to put it...
BLT S1,TCB.FB+FLPLEN-1(B) ;Copy to the new TCB
MOVEI S1,TCB.IB(B) ;Get input buffer address
ADD S1,[IOWD BFRSIZ+1,0] ;Gen an input CCW
MOVEM S1,TCB.IC(B) ;Gen in input command list
MOVEI S1,TCB.WB(B) ;Get output buffer address
ADD S1,[IOWD BFRSIZ+1,0] ;Gen an output CCW
MOVEM S1,TCB.OC(B) ;Gen an output command list
JRST IMSG.3 ;Continue onward
IMSG.0: MOVE S1,P1 ;Get back the device name
PUSHJ P,T$CKAV## ;Is it in use?
JUMPT IMSG.2 ;No, use it!
IMSG.1: MOVEM P1,ABOOBJ+OBJ.UN ;KLUDGE
$ACK (<Unavailable for initialization>,,ABOOBJ,.MSCOD(M))
MOVE S1,P1 ;Get the drive name again
PJRST V$MDFN ;Tell MDA we're all done!
IMSG.2: MOVE T1,P1 ;Get back device name
SETZB T2,T3 ;No job number or owner
PUSHJ P,G$MTCB## ;Make one up
MOVX S1,TW.IGN ;Make wait state ignore
MOVEM S1,TCB.WS(B) ; before we get started
;Here when the useable TCB is set up.
IMSG.3: MOVX S1,.SILBT ;Get the desired label type
PUSHJ P,O$FNDB## ;Find that block
SKIPF ;Find it?
SKIPA S1,0(S1) ;Yes--Get the label type code
MOVEI S1,DEFLBT ;No--Set use the system default
STORE S1,TCB.IL(B),TV.LBT ;Save desired label type
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Get the density
MOVX S1,.SIDEN ;Block type - density code
PUSHJ P,O$FNDB## ;Find it
SKIPT ;Got it?
TDZA S1,S1 ;No, Use default for this drive
MOVE S1,0(S1) ;Yes, get it
STORE S1,TCB.IL(B),TV.DEN ;Save it
;Clean up any garbage
MOVX S1,TV.OVR ;Get bits to clear
ANDCAM S1,TCB.IL(B) ;Zap everything
SETZM TCB.IR(B) ;CLEAR REQUEST-ID
SETZM TCB.II(B) ;CLEAR INCREMENT
SETZM TCB.OI(B) ;No PPN of owner yet
SETZM TCB.IP(B) ;No initial protection
SETZM TCB.IV(B) ;No volid
MOVX S1,TV.HLD ;Get the 'hold when done' bit
IORM S1,TCB.IL(B) ;Default to /TAPE-DISPOSITION:KEEP
MOVEI S1,1 ;Get a count of 1
STORE S1,TCB.IL(B),TV.CNT ;Save it
LOAD S1,TCB.IL(B),TV.LBT ;GET LABEL TYPE
CAIE S1,LT.SL ;ANSI?
CAIN S1,LT.SUL ;ANSI WITH USER LABELS?
SETOM TCB.IP(B) ;YES--PROTECTION MIGHT NEED FIXUP LATER
;Now look at each block in the message
LOAD T1,.OARGC(M) ;Get the number of blocks
MOVEI T2,.OHDRS(M) ;Aim at the first block
INILOP: LOAD S1,ARG.HD(T2),AR.TYP ;Get this block type
MOVE S2,[XWD -INITLN,INITAB] ;Get the transalation table pointer
INIL.1: HLRZ TF,0(S2) ;Get next known arg type
CAIE TF,0(S1) ;Is this it?
AOBJN S2,INIL.1 ;No, try the next
SKIPL S2 ;Found one?
JSP S1,O$CERR## ;No, we're messed up!
MOVEI S1,ARG.DA(T2) ;Aim at the data
HRRZ S2,0(S2) ;Get the dispatch adrs
PUSHJ P,0(S2) ;Process this block
SKIPT ;Good?
JSP S1,O$CERR## ;No, quit
LOAD S1,ARG.HD(T2),AR.LEN ;Get block length
ADDI T2,0(S1) ;Aim at next block
SOJG T1,INILOP ;Try 'em all
;Fix up any inconsistencies
MOVX S1,TV.NEW ;GET /NEW-VOLUME BIT
TDNN S1,TCB.IL(B) ;REINITIALIZING AN OLD TAPE?
SKIPE TCB.IV(B) ;NO--WAS A REELID SPECIFIED?
JRST INIL.2 ;SKIP LABEL AND REELID CHECK
LOAD S1,TCB.IL(B),TV.LBT ;GET LABEL TYPE
CAIE S1,.TFLNL ;NOLABELS?
CAIN S1,.TFLNV ;USER-EOT?
JRST INIL.2 ;YES--REELID NOT NECESSARY
$ACK (<Volume Id required for labeled tapes>,,TCB.OB(B),.MSCOD(M))
PJRST V$MDFI ;INFORM QUASAR WE'RE DONE
INIL.2: MOVEI S2,1 ;ASSUME A DEFAULT INCREMENT
SKIPN S1,TCB.II(B) ;GET THE INCREMENT IF THERE IS ONE
MOVEM S2,TCB.II(B) ;SET DEFAULT
MOVE S2,TCB.IL(B) ;GET FLAGS, ETC.
LOAD S1,S2,TV.CNT ;GET VOLUME COUNT
TXNE S2,TV.NEW ;RE-INITIALIZING OLD TAPES?
HLRZ S1,TCB.VP(B) ;GET NUMBER OF REELS TO PROCESS
STORE S1,S2,TV.CNT ;RESET COUNT
TXNE S2,TV.NEW ;/NEW-VOLUME PROCESSING?
TXO S2,TV.HLD ;YES--ALWAYS TURN ON HOLD
CAILE S1,1 ;UNLESS MORE THAN ONE TAPE
TXZ S2,TV.HLD ;THEN ZAP HOLD BIT
MOVEM S2,TCB.IL(B) ;UPDATE FLAGS, ETC.
SKIPN TCB.OI(B) ;HAVE AN OWNER PPN?
SETZM TCB.IP(B) ;NO--CLEAR PROTECTION
SKIPGE S1,TCB.IP(B) ;GET PROTECTION CODE
TXNE S2,TV.NEW ;/NEW-VOLUME PROCESSING?
SKIPA ;YES--USE PROTECTION (MIGHT BE -1)
MOVE S1,G$PSTP## ;USE STANDARD FILE PROTECTION CODE
MOVEM S1,TCB.IP(B) ;SET IT
INIL.3: LOAD S2,TCB.CH(B),TC.TYP ;Get the device type
CAIN S2,%DTAP ;DECtape?
SKIPA S1,[D$IDTA##] ;Yes
MOVEI S1,V$LABEL ;Start address for TCB
JUMPE P2,G$NPRC## ;Normal initialization,,start'er up !!
MOVE S1,P2 ;Vol switch,,setup new TCB with
PUSHJ P,G$NPRC## ; old TCB address first on the stack
EXCH P,TCB.AC+P(B) ;Get process stack
PUSH P,[V$VSWR] ;Routine to run when done
PUSH P,[V$LABEL] ;Routine to run to start
EXCH P,TCB.AC+P(B) ;Reset stack pointers
$RETT ;Return
V$VSWR: POP P,S1 ;Get the address of the real TCB
MOVE P1,B ;Save the old TCB address
PUSHJ P,G$FTCB## ;I know we have it,,but check anyway
SKIPT ;Must be there !!!
PUSHJ P,S..WNF## ;No,,deep trouble !!!
MOVE S1,TCB.DV(P1) ;Get the device name back
MOVEM S1,TCB.DV(B) ;Make the real TCB the new one
MOVE P,TCB.AC+P(B) ;Get the real TCB stack pointer
MOVE S1,P1 ;Get the old TCB address
PUSHJ P,G$DTCB## ;Delete the worker !!!
MOVE S1,G$LIST## ;Get the TCB list id
MOVE S2,B ;Get the real TCB address
PUSHJ P,L%APOS ;Position to the real entry
PUSHJ P,L%RENT ;Remember where it is
MOVSI TF,TCB.AC(B) ;Swap TCB contexts
BLT TF,P ; to the new TCB
MOVE TF,TCB.AC(B) ;Restore TF
PJRST G$NJOB## ;Back to the scheduler !!!
SUBTTL V$TABLE - Tables for block decoding in the message
;These tables tell what to do for each particular block type
; in the incoming message
INITAB: XWD .TAPDV,ININOP ;Skip the drive name block
XWD .DVINI,ININOP ;Bypass .DVINI block
XWD .SILBT,ININOP ;Already got label type
XWD .SIDEN,ININOP ;Already have (or defaulted) density
XWD .VOLID,V$VOLID ;Volume identifier
XWD .SISVI,V$SVOLID ;Starting volume id
XWD .SIOWN,V$OWN ;Owner identifier
XWD .SIPRO,V$PROT ;Protection
XWD .SIUNL,V$UNL ;Unload when done
XWD .SIHLD,V$HOLD ;Keep tape up when done
XWD .SIOVR,V$OVR ;Override protection/expiration
XWD .SINOV,V$NOV ;Check expiration
XWD .SIINC,V$INCR ;Increment for multiple initializations
XWD .SICTR,V$CNT ;# of tapes to do
XWD .SIERA,V$ERA ;ERASE THE TAPE
XWD .SINEW,V$NEW ;NEW VOLUME (RE-INITIALIZE OLD TAPE)
XWD .SILST,V$LST ;LIST OF REELIDS
XWD .ORREQ,V$REQ ;REQUEST-ID (/NEW ONLY)
INITLN==.-INITAB
SUBTTL V$BLOCK - Block processing routines
ININOP: $RETT ;Win, but do nothing
V$INCR: MOVE S2,(S1) ;GET INCREMENT
MOVEM S2,TCB.II(B) ;SAVE IT
$RETT ;RETURN
V$CNT: MOVE S2,[POINTR TCB.IL(B),TV.CNT] ;Where to store the # vols to do
MOVE S1,0(S1) ;GET VOLUME COUNT
V$STOR: DPB S1,S2 ;Stash the data
$RETT
V$OWN: LOAD S2,TCB.IL(B),TV.LBT ;GET LABEL TYPE
CAIE S2,LT.SL ;ANSI?
CAIN S2,LT.SUL ;ANSI WITH USER LABELS?
SKIPA S1,(S1) ;YES--GET OWNER PPN
MOVEI S1,0 ;OTHERWISE SET TO ZERO (IGNORE IT)
MOVEM S1,TCB.OI(B) ;SAVE IT AWAY
$RETT ;AND RETURN
V$PROT: LOAD S2,TCB.IL(B),TV.LBT ;GET LABEL TYPE
CAIE S2,LT.SL ;ANSI?
CAIN S2,LT.SUL ;ANSI WITH USER LABELS?
SKIPA S1,(S1) ;YES--GET PROTECTION CODE
MOVEI S1,0 ;OTHERWISE SET TO ZERO (IGNORE IT)
CAILE S1,777 ;MAKE SURE IT'S LEGAL
MOVNI S1,1 ;DEFAULT CUZ OPERATOR IS STUPID
MOVEM S1,TCB.IP(B) ;STORE IT AWAY
$RETT ;AND RETURN
V$NOV: SKIPA S2,[POINTR TCB.IL(B),TV.OVR] ;Clear the override bit
V$UNL: MOVE S2,[POINTR TCB.IL(B),TV.HLD] ;Bit to clear
V$ZERO: SETZ S1, ;Store a 0
PJRST V$STOR
V$ERA: SKIPA S2,[POINTR TCB.IL(B),TV.ERA] ;ERASE BIT
V$NEW: MOVE S2,[POINTR TCB.IL(B),TV.NEW] ;NEW BIT
JRST V$ONE ;GO STORE A 1
V$OVR: SKIPA S2,[POINTR TCB.IL(B),TV.OVR] ;Set the override bit
V$HOLD: MOVE S2,[POINTR TCB.IL(B),TV.HLD] ;Bit to set
V$ONE: MOVEI S1,1 ;Get a one
PJRST V$STOR ;Store it
V$VOLID:
HRLI S1,(POINT 7,) ;Point to the ASCII text
$CALL S%SIXB ;Convert volid to sixbit
STORE S2,TCB.IV(B) ;Save the volid
$RETT
V$SVOLID:
MOVE S2,0(S1) ;Get the starting number
CAXLE S2,^D999999 ;Will it fit?
JSP S1,O$CERR## ;No, too bad
$TEXT (<-1,,G$BLOK>,<^D/S2/>) ;Convert to ASCII
MOVEI S1,G$BLOK## ;Aim at the ASCII
PJRST V$VOLID ;And make that our volid
V$LST: LOAD S1,ARG.HD(T2),AR.LEN ;GET BLOCK LENGTH
SUBI S1,ARG.DA ;MINUS NUMBER OF OVERHEAD WORDS
$CALL M%GMEM ;GET THIS MUCH CORE
HRL S2,S1 ;MAKE IT LEN,,ADDR
MOVEM S2,TCB.VP(B) ;SAVE FOR LATER
MOVNS S1 ;GET -WORD COUNT
HRL S2,S1 ;MAKE AN AOBJN POINTER TO LIST
MOVEM S2,TCB.VC(B) ;SAVE AS POINTER TO CURRENT REELID
MOVSI S1,ARG.DA(T2) ;POINT TO THE FIRST DATA WORD
HRR S1,TCB.VP(B) ;MAKE A BLT POINTER
HLRZ S2,TCB.VP(B) ;GET NUMBER OF WORDS TO BLT
ADD S2,TCB.VP(B) ;COMPUTE END OF BLOCK
TLZ S2,-1 ;NO JUNK
BLT S1,-1(S2) ;COPY LIST OF REELIDS
$RETT ;AND RETURN
V$REQ: MOVE S1,(S1) ;GET REQUEST-ID
MOVEM S1,TCB.IR(B) ;SAVE FOR ACK TO QUASAR
$RETT ;RETURN
SUBTTL ABOINI - Routine to abort the tape initialization
;CALL: P1/ The sixbit drive name
;
;RET: True always
ABOINI: MOVEM P1,ABOOBJ+OBJ.UN ;Save the device name
MOVE S1,P1 ;Get device name in S1
PUSHJ P,G$FTCB## ;Find the tape's data block
JUMPF ABOI.2 ;Not there,,just return
MOVX S1,TS.INI ;Get the initialization bit
TDNN S1,TCB.ST(B) ;Initializing this tape ???
JRST ABOI.2 ;No,,nak the operator
ANDCAM S1,TCB.ST(B) ;Yes,,clear initializing state
MOVE P1,TCB.AC+P(B) ;Get the process stack
ABOI.1: POP P1,S1 ;Pop off an entry
CAIE S1,T$RELE## ; at a time till we get
CAIN S1,V$VSWR ; where we want to be
SKIPA ; so that we can continue
JRST ABOI.1 ; the process as if it completed
PUSH P1,S1 ;Put the completion address back
MOVEM P1,TCB.AC+P(B) ;And reset the process stack pointer
PUSHJ P,G$STRN## ;Mark the process as runnable
$ACK (Tape initialization aborted,,ABOOBJ,.MSCOD(M))
$RETT ;Tell the operator and return
ABOI.2: $ACK (Tape not being initialized,,ABOOBJ,.MSCOD(M))
$RETT ;Nak the operator and return
ABOOBJ: $BUILD OBJ.SZ
$SET (OBJ.TY,,.OTMNT)
$EOB
SUBTTL V$MDFI - Tell MDA initialization is done
;This routine sends a message to MDA indicating that initialization
; is complete on a certain drive, and that such a drive may be used
; for normal operation.
;Call -
; B/ TCB adrs (for V$MDFI entry)
; S1/ SIXBIT drive name (for V$MDFN entry)
;Returns
; A message to MDA, and TRUE (always)
V$MDFI: MOVE S1,TCB.DV(B) ;Get the drive name
MOVE S2,TCB.IR(B) ;GET THE REQUEST-ID (IF ANY)
V$MDFN: MOVEM S1,DEVNAM+ARG.DA ;STORE DRIVE NAME
MOVE S1,MDFMSG+.MSFLG ;GET MESSAGE FLAG WORD
TLZE S2,400000 ;ERROR SOMEWHERE?
TXOA S1,AK.NAK ;LITE THE NAK BIT
TXZ S1,AK.NAK ;ELSE CLEAR IT
MOVEM S1,MDFMSG+.MSFLG ;UPDATE FLAGS
MOVEM S2,REQID+ARG.DA ;STORE REQUEST-ID
DMOVE S1,[EXP MDFLEN,MDFMSG] ;AIM AT THE MESSAGE
PJRST G$SMDA## ;SEND ANSWER TO MDA
MDFMSG: $BUILD .OHDRS ;Build the header
$SET (.MSTYP,MS.TYP,.QOIDN) ;Message type - Initialize done
$SET (.MSTYP,MS.CNT,MDFLEN) ;Length of the message
$SET (.OARGC,,2) ;NUMBER OF ARGUMENTS
$EOB
DEVNAM: XWD 2,.RECDV ;LEN,,BLOCK TYPE
EXP 0 ;DEVICE NAME
REQID: XWD 2,.ORREQ ;LEN,,BLOCK TYPE
EXP 0 ;REQUEST-ID
MDFLEN==.-MDFMSG ;LENGTH OF MESSAGE
SUBTTL V$LABEL - TCB level routine to write labels
;This routine does the actual work of initializing
; the labels on one or more tapes.
;The TCB is set up with all the requisite information in the
; initialization portion of the TCB
;For each tape, Any existing labels are checked for expiration,
; and perhaps overwritten, unless the operator has
; specified no expiration checking. If this is the case, the
; tape is never read. This allows the operator to initialize
; a 'virgin' tape, ie one which has a very long record
; on it, which the DX10/20 can't handle.
V$LABEL:
$SAVE <P1>
LOAD P1,TCB.IL(B),TV.CNT ;Get # of tapes to do
PUSHJ P,L$CLEF## ;Clear out all errors (start fresh)
PUSHJ P,T$OPEN## ;Set up the drive for I/O
JUMPF VLAB.3 ;Can't, so quit
MOVX S1,TS.INI ;Get the initialization bit
IORM S1,TCB.ST(B) ;Lite so the world knows
MOVX S1,TI.OAV ;Get AVR open bit
IORM S1,TCB.IO(B) ;Lite so we flush label DDB when done
MOVX S1,TV.NEW ;GET /NEW-VOLUME BIT
TDNN S1,TCB.IL(B) ;SPECIAL INITIALIZATION?
JRST VLAB.1 ;NO
PUSHJ P,V$NEWV ;GET FIRST /NEW-VOLUME IF NECESSARY
VLAB.1: PUSHJ P,T$CLRS## ;Clear any I/O errors as well
MOVX S1,TS.FFF ;GOING TO WRITE FIRST FILE ON REEL
IORM S1,TCB.ST(B) ;SET BIT
PUSHJ P,LABEL1 ;Do this tape
JUMPF VLAB.2 ;Real trouble, quit
PUSHJ P,V$TOPR ;Tell OPR about this volume
SOJLE P1,VLAB.2 ;Any more tapes to do?
PUSHJ P,V$NEXT ;Get the next tape up
JUMPT VLAB.1 ;If OPR put up another...go init it
;Here to send ack to MDA saying all done with initialize
VLAB.2: MOVEI S1,'UNL' ;Get unload command
LOAD S2,TCB.IL(B),TV.HLD ;Want to keep tape up when done?
SKIPN S2 ;Should we unload?
PUSHJ P,T$POS## ;Yes, throw it off
VLAB.3: MOVX S2,TV.NEW ;GET /NEW-VOLUME BIT
TDNN S2,TCB.IL(B) ;SPECIAL TYPE OF INITIALIZATION?
JRST VLAB.4 ;NO
SKIPL TCB.IR(B) ;DID AN ERROR OCCUR?
PUSHJ P,V$FIRS ;NO--GET FIRST REEL BACK ON THE DRIVE
HLRZ S1,TCB.VP(B) ;GET WORD COUNT
HRRZ S2,TCB.VP(B) ;GET ADDR
$CALL M%RMEM ;RELEASE CORE
SETZM TCB.VP(B) ;CLEAR POINTER
VLAB.4: MOVX S1,TS.INI ;Get the initialization bit
ANDCAM S1,TCB.ST(B) ;Finished with initialization
PJRST V$MDFI ;Inform MDA of completion
SUBTTL LABEL1 - Initialize the labels on one tape
;This routine will write the labels on one reel, after
; perhaps checking for expiration.
LABEL1:
LABE.1: MOVEI S1,'REW' ;Rewind command
PUSHJ P,T$POS## ;Get to BOT
PUSHJ P,T$WRCK## ;Is there a write ring?
JUMPE S2,LABE.3 ;Yes, continue
DMOVE S1,[EXP RNGTYP,RNGTXT] ;Aim at type, text fields
LABE.2: PUSHJ P,V$TAPE ;Get a new tape
JUMPF .POPJ ;Don't want to continue, so quit
JRST LABE.1 ;Try this tape!
LABE.3: MOVE S1,TCB.IL(B) ;GET INITALIZATION FLAGS
TXNN S1,TV.NEW ;USER WANTS TO RE-INIT AN OLD TAPE?
TXNN S1,TV.OVR ;OPR WANTS TO OVERRIDE EXPIRATION DATE?
SKIPA
JRST LABE.6 ;GO WRITE LABELS
PUSHJ P,L$RVOL## ;READ VOL RECORDS
JUMPF [DMOVE S1,[EXP CCETYP,NTPTXT]
JRST LABE.2 ] ;Try again
MOVX S1,TV.NEW ;GET /NEW-VOLUME BIT
TDNN S1,TCB.IL(B) ;USER WANTS TO RE-INIT AN OLD TAPE?
JRST LABE.4 ;NO
JMPUNL LT,LAB3A ;NO REELID STUFF IF UNLABELED
MOVE T1,[CPTRI ^D5,0(BUF)] ;VOLID STORE IN CP 5-10
MOVE T2,[POINT 8,TCB.VL(B)] ;COPY TO HERE
HRRZI T3,6 ;SIX CHARACTERS
HRL T3,L$CVTT##(LT) ;GET CONVERSION ROUTINE ADDR
PUSHJ P,L$STST## ;COPY TEXT
CAIE LT,LT.SL ;ANSI?
CAIN LT,LT.SUL ;ANSI WITH USER LABELS?
SKIPA S1,TCB.OI(B) ;GET OWNER PPN
LAB3A: MOVEI S1,0 ;CLEAR OUT OWNER PPN
MOVEM S1,TCB.VO(B) ;DEFAULT THE ONE ON THE TAPE
PUSHJ P,L$RUVL## ;READ UVL1 RECORD FOR PROT AND PPN
PUSHJ P,NEWCHK ;PERFORM NEW-VOLUME CHECKS
JUMPF LABE.2 ;GIVE UP ON FAILURE AND TRY ANOTHER
LABE.4: MOVX S1,TV.OVR ;GET /OVERRIDE BIT
TDNE S1,TCB.IL(B) ;OPR WANTS TO OVERRIDE EXPIRATION DATE?
JRST LABE.5 ;YES
PUSHJ P,L$HDEX## ;ELSE CHECK THE DATE
JUMPF [DMOVE S1,[EXP FNETYP,NTPTXT]
JRST LABE.2 ] ;Throw out tape, try again
LABE.5: MOVEI S1,'REW' ;Get the rewind command
PUSHJ P,T$POS## ;Back to load point
MOVX S1,TV.ERA ;GET ERASE BIT
TDNN S1,TCB.IL(B) ;WANT TO ZAP THE TAPE?
JRST LABE.6 ;NO
MOVEI S1,'DSE' ;GET CODE
PUSHJ P,T$POS## ;DO DATA SECURITY ERASE
SKIPT ;DID IT WORK?
PUSHJ P,ERACHK ;MAYBE WE HAVE TO TELL THE OPERATOR
MOVEI S1,'REW' ;NOW REWIND THE TAPE
PUSHJ P,T$POS## ; BACK TO THE LOAD POINT
LABE.6: MOVEI BUF,TCB.WB(B) ;GET OUTPUT BUFFER ADDRESS
LOAD LT,TCB.IL(B),TV.LBT ;Get the desired label type back
LOAD S1,TCB.IL(B),TV.DEN ;Get requested density
STORE S1,TCB.PS(B),TP.DEN ;Save it where it counts
PUSHJ P,I$SDEN## ;Set it
JUMPF ILLDEN ;Can't, complain
MOVX S1,TS.FFF ;FLAG FIRST FILE ON TAPE
IORM S1,TCB.ST(B) ;TO FAKE OUT WRTLBL
PUSHJ P,@LBLINI(LT) ;Initialize these particular labels
SKIPT ;Did it work?
PUSHJ P,ERRINI ;No, complain to OPR
PUSHJ P,I$GDEN## ;READ THE REAL DENSITY BACK
$RETT ;And then win
;CONTINUED ON THE NEXT PAGE
NEWCHK: JMPUNL LT,.RETT ;NOTHING TO CHECK IF UNLABELED
MOVEI S1,TCB.VL(B) ;POINT TO REELID STORAGE
PUSHJ P,O$CN86## ;CONVERT TO SIXBIT
CAME S2,TCB.IV(B) ;THE SAME?
JRST NEWCE1 ;NO--TRY ANOTHER TAPE
CAIE LT,LT.SL ;ANSI?
CAIN LT,LT.SUL ;ANSI WITH USER LABELS?
SKIPA S1,TCB.VO(B) ;YES--GET VOLUME OWNER (FROM TAPE)
$RETT ;NOTHING ELSE TO CHECK
MOVE S2,TCB.OI(B) ;GET PROSPECTIVE NEW OWNER
PUSHJ P,I$OWN## ;SEE IF THEY'RE THE SAME
JUMPF NEWCE2 ;NO--GET ANOTHER TAPE
$RETT ;LOOKS LIKE A GOOD TAPE
NEWCE1: MOVEM S2,G$REEL## ;SAVE IN A SAFE PLACE
DMOVE S1,[EXP VIDTYP,VIDTXT] ;POINT TO TYPE AND TEXT BLOCKS
$RETF ;TRY ANOTHER TAPE
NEWCE2: DMOVE S1,[EXP PPNTYP,PPNTXT] ;POINT TO TYPE AND TEXT BLOCKS
$RETF ;TRY ANOTHER TAPE
VIDTYP: ASCIZ |Volume-id mismatch during tape reinitialization|
VIDTXT: ITEXT (<Tape ^W/G$REEL/ mounted when expecting ^W/TCB.IV(B)/
Please try another tape>)
PPNTYP: ASCIZ |PPN mismatch during tape reinitialization|
PPNTXT: ITEXT (<Tape owned by ^U/TCB.VO(B)/ when expecting ^U/TCB.OI(B)/
Please try another tape>)
; Check erase failures
ERACHK: MOVE S1,TCB.IL(B) ;GET INITIALIZATION FLAGS
TXZN S1,TV.NOE ;DOES OPR ALREADY KNOW THIS?
POPJ P, ;YES--JUST RETURN
MOVEM S1,TCB.IL(B) ;UPDATE FLAGS
MOVX S1,TV.NEW ;GET /NEW-VOLUME
TDNN S1,TCB.IL(B) ;WHO REQUESTED THIS?
SKIPA S1,[ERATX2] ;THE OPERATOR ON SET TAPE INIT COMMAND
MOVEI S1,ERATX3 ;THE USER ON MOUNT COMMAND
$WTO (<^T/ERATX1/>,<^T/(S1)/>,TCB.OB(B),$WTFLG(WT.SJI))
POPJ P, ;RETURN
ERATX1: ASCIZ |Hardware does not support data security erase|
ERATX2: ASCIZ |Function requested by the operator|
ERATX3: ASCIZ |Function requested by user|
;CONTINUED FROM THE PREVIOUS PAGE
RNGTYP: ASCIZ /Write ring required for Initialization/
RNGTXT: ITEXT (<Please add a write-ring and re-mount this tape>)
CCETYP: ASCIZ /Can't check existing labels for expiration/
NEWTYP: ASCIZ /Wrong tape for reinitialization/
FNETYP: ASCIZ /File has not yet expired/
NTPTXT: ITEXT (<Please try another tape>)
SUBTTL V$FILE - Write a dummy file on the tape
; Called by PLRLBP when performing a data security erase
V$FILE::MOVX S1,TS.INI ;GET TAPE INITIALIZING BIT
ANDCAM S1,TCB.ST(B) ;MAKE SURE IT'S OFF
PJRST @LBLINI(LT) ;DISPATCH AND RETURN (S1 := ADDR
;OF ERROR TEXT ON FALSE RETURN)
;These routines return adrs of string S1 if FALSE
LBLINI: ILLLBL ;BYPASS is illegal
WRTLBL ;ANSI
WRTLBL ;ANSI
WRTLBL ;IBM
WRTLBL ;IBM
UNLABL ;LTM
UNLABL ;NON-STANDARD
UNLABL ;NO LABELS
ILLLBL ;COBOL ASCII
ILLLBL ;COBOL SIXBIT
UNLABL ;NO-LABELS, USER EOV
MAXLBL==.-LBLINI
SUBTTL UNLABL - Initialize an 'unlabeled' tape
;This routine will write the 'labels' on an unlabeled tape.
;All this amounts to is writing some garbage piece of data
; at the required density, and writing a couple of tape marks
UNLABL: MOVE T1,BNKWD## ;GET A WORD OF BLANKS
MOVEM T1,(BUF) ;STORE IT
MOVSI T1,(BUF) ;START OF BUFFER
HRRI T1,1(BUF) ;MAKE A BLT POINTER
BLT T1,BFRSIZ-1(BUF) ;INIT BUFFER TO ALL SPACES
MOVE T1,UNLPTR ;Aim at unlabeled text
MOVE T2,[POINT 8,0(BUF)] ;Aim at the output buffer
MOVEI T3,UNLLEN ;Length of string
PUSHJ P,L$STST## ;Store that string
PUSHJ P,T$WRRC## ;Write the data
PUSHJ P,T$WRTM## ;Write one tape mark
PUSHJ P,T$WRTM## ;Write a second one
MOVEI S1,'BBL' ;BACKSPACE OVER
PUSHJ P,T$POS## ; THE TAPE MARK
$RETT ;All done!
UNLPTR: POINT 7,[ASCIZ/Unlabeled Tape/] ;The text itself
UNLLEN==^D14 ;# of chars
SUBTTL WRTLBL - Initialize ANSI and EBCDIC labels
;This routine is responsible for writing ANSI VOL1, UVL1, HDR1, HDR2
; <TM>, <TM>, EOF1, EOF2, <TM>, <TM>
; on the tape.
;Returns T/F,
; F/ S1/ adrs of error text
WRTLBL: MOVX S1,TS.INI ;GET INITIALIZING BIT
TDNN S1,TCB.ST(B) ;CALLED BY PLRINI OR PLRLBP?
JRST WRTL.1 ;PLRLBP
;Set up the VOL1 and UVL1 paramters
LOAD S1,TCB.OI(B) ;Get initial owner ID
STORE S1,TCB.OW(B) ;Save in real area of TCB
LOAD S1,TCB.IP(B) ;Get initial protection
STORE S1,TCB.PT(B),TP.PRT ;Save as real protection code
MOVE S1,TCB.IV(B) ;Get this volume id
MOVEI S2,TCB.VL(B) ;Where to put the result
PUSHJ P,O$CN68## ;Convert to 8-bit ASCII
MOVE S1,TCB.IV(B) ;Get the volid again
MOVEI S2,TCB.FV(B) ;Aim at 'first' volid space
PUSHJ P,O$CN68## ;Setup first volid in set name
; Write VOL1 labels
WRTL.1: MOVE S1,TCB.ST(B) ;GET STATUS WORD
MOVE S2,S1 ;COPY IT
TXZ S1,TS.FFF ;CLEAR FIRST FILE ON REEL FLAG
MOVEM S1,TCB.ST(B) ;UPDATE
TXNN S2,TS.FFF ;FIRST FILE?
JRST WRTL.2 ;NO
PUSHJ P,L$WVOL## ;Write the VOL1, UVL1
JUMPF [MOVEI S1,[ASCIZ/Error writing VOL1 label group/]
$RETF] ;Can't, so tell the bad news
;Set up the HDR1 parameters
WRTL.2: DMOVE S1,[ASCII/DUMMY.FILE/] ;Get the funny file name
DMOVEM S1,TCB.FN(B) ;Set the first part
DMOVE S1,[ASCII/ /] ;Seven spaces
DMOVEM S1,TCB.FN+2(B) ;Save second part of filename
MOVX S1,TS.INI ;GET INITIALIZING BIT
TDNN S1,TCB.ST(B) ;WHO WERE WE CALLED BY?
JRST WRTL.3 ;PLRLBP
MOVEI S1,1 ;Get a one
STORE S1,TCB.SN(B) ;Save as first section of file
STORE S1,TCB.PS(B),TP.POS ;And indicate first file on tape
STORE S1,TCB.GV(B),TG.GEN ;Generation is 1
WRTL.3: ZERO TCB.EX(B),TE.CRE!TE.EXP ;NO CREATION OR EXPIRATION DATE
MOVEI S2,0 ;GET A ZERO
STORE S2,TCB.GV(B),TG.VER ;Version is 0
STORE S2,TCB.BC(B) ;Block count is 0
;Set up the HDR2 parameters
MOVX TF,.TRFUN ;Undefined record format
STORE TF,TCB.RF(B),TF.RFM ;Save for output
STORE S1,TCB.LN(B),TL.REC ;Set 1 as record length
STORE S1,TCB.LN(B),TL.BLK ;And as block length, too
ZERO TCB.PR(B) ;No protection for this dummy file
ZERO TCB.PT(B),TP.PRT ;Clear volume protection, too
PUSHJ P,L$WHDR## ;Write the headers (HDR1 & HDR2)
JUMPF [MOVEI S1,[ASCIZ/Error writing dummy file HDR labels/]
$RETF] ;Can't, so complain
MOVE T1,BNKWD## ;GET A WORD OF BLANKS
MOVEM T1,(BUF) ;STORE IT
MOVSI T1,(BUF) ;START OF BUFFER
HRRI T1,1(BUF) ;MAKE A BLT POINTER
BLT T1,BFRSIZ-1(BUF) ;INIT BUFFER TO ALL SPACES
MOVE T1,LBLPTR ;POINT TO "LABELED TAPE"
MOVE T2,[POINT 8,0(BUF)] ;AIM AT THE OUTPUT BUFFER
MOVEI T3,LBLLEN ;GET LENGTH OF STRIGN
PUSHJ P,L$STST## ;STORE THE STRING
PUSHJ P,T$WRRC## ;WRITE THE RECORD OUT
PUSHJ P,T$CLOS## ;CLOSE THE FILE (WRITING 2 TAPE MARKS)
PUSHJ P,L$WEOF## ;WRITE EOF LABELS
MOVEI S1,[ASCIZ/Can't write dummy file trailer labels/]
$RET ;Return T/F from that
LBLPTR: POINT 7,[ASCIZ |Labeled tape|]
LBLLEN==^D12
SUBTTL Error dropouts for label initialization
;These routines inform the operator that something has gone
; wrong in the label init code, and return false
ILLLBL: MOVEI S1,[ASCIZ/Illegal label type/]
$RETF
ILLDEN: MOVEI S1,[ASCIZ/Illegal density specified/]
ERRINI: $WTO (<Error during volume initialization>,<^T/0(S1)/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF
SUBTTL V$NEWV - Routine to get the next "new" volume
; This routine is used only for /NEW-VOLUME processing. In this
; case, QUASAR generates the SET TAPE INITIALIZE message and
; provides a list of reelids. This list comes from the user's
; MOUNT /REELID:(reel1,reel2,...)/NEW-VOLUME command. This mechanism
; is used to tell MDA to re-initialize existing tapes already
; owned by the user.
V$NEWV: SETZM TCB.IV(B) ;ASSUME NO MORE
SKIPL S1,TCB.VC(B) ;GET AOBJN POINTER TO CURRENT REELID
$RETF ;ALL DONE!
MOVE S2,(S1) ;GET A REELID
MOVEM S2,TCB.IV(B) ;SET IT UP FOR LBLINI
AOBJN S1,.+1 ;ADVANCE POINTER
MOVEM S1,TCB.VC(B) ;UPDATE FOR NEXT TIME
$RETT ;RETURN
SUBTTL V$FIRST - Routine to get the first volume mounted again
; This routine is required for /NEW-VOLUME processing. Before telling
; QUASAR we're done, we have to get the first reel mounted again so the
; world doesn't fall apart.
; Call: MOVE B, TCB address
; PUSHJ P,V$NEXT
;
; TRUE return: First volume back on the drive
; FALSE return: The operator is very unsocialble
;
V$FIRS: LOAD S1,TCB.IL(B),TV.CNT ;GET COUNT OF REELS INITIALIZED
SOJLE S1,.POPJ ;RETURN IF MORE THAN ONE
SKIPN S1,TCB.VP(B) ;HAVE A LIST OF REELIDS?
STOPCD (NFR,HALT,,<No first reel for reinitialization>)
MOVE S1,(S1) ;GET FIRST REELID
MOVEM S1,TCB.IV(B) ;SAVE IT AWAY
MOVEI S1,FIRTX1 ;POINT TO TYPE TEXT
MOVEI S2,FIRTX2 ;POINT TO MAIN TEXT
PUSHJ P,V$TAPE ;GET THE TAPE MOUNTED
JUMPT .POPJ ;RETURN IF ALL IS WELL
POPJ P, ;RETURN
FIRTX1: ASCIZ |Please load first tape again|
FIRTX2: ITEXT (<The reelid is ^W/TCB.IV(B)/; it will be identified with request-id ^D/TCB.IR(B)/>)
SUBTTL V$NEXT - Routine to get next volume mounted
;This routine will generate the next volume identifier to be initialized
; and ask the operator to put the next scratch tape up.
;Call -
; B/ Adrs of OPEN TCB
;Returns -
; T/ Next volume is up
; F/ OPR decided to quit
V$NEXT: MOVX S2,TV.NEW ;GET /NEW-VOLUME BIT
TDNE S2,TCB.IL(B) ;SPECIAL TYPE OF INITIALIZATION?
JRST NEXT.1 ;YES
PUSHJ P,V$NVID ;GENERATE A NEW REELID
JUMPF .POPJ ;CAN'T
MOVEI S1,NXTTXT ;GET TYPE TEXT
HLRZ S2,LBLITX(LT) ;GET ADDR OF NORMAL-INIT ITEXT BLOCK
PJRST V$TAPE ;GET THE NEXT TAPE
NEXT.1: PUSHJ P,V$NEWV ;GET NEXT REELID REQUESTED BY USER
JUMPF .POPJ ;NO MORE TO DO
MOVEI S1,NXTTXT ;GET TYPE TEXT
HRRZ S2,LBLITX(LT) ;GET ADDR OF RE-INIT ITEXT BLOCK
PJRST V$TAPE ;GET THE NEXT TAPE
NXTTXT: ASCIZ |Please load the next tape|
; Normal-initialization ANSI tape message
NXTNI1:
; Normal-initialization Non-ANSI tape message
NXTNI2: ITEXT (<It will be initialized as ^T/@LBLTAB(LT)/ tape. The
volume-id will be ^W/TCB.IV(B)/.>)
; Normal-initialization unlabeled tape message
NXTNI3: ITEXT (<It will be initialized as ^T/@LBLTAB(LT)/ tape.>)
; New-volume ANSI tape message
NXTNV1: ITEXT (<It will be reinitialized as ^T/@LBLTAB(LT)/ tape. The
volume-id will be ^W/TCB.IV(B)/.>)
; New-volume non-ANSI tape message
NXTNV2: ITEXT (<It will be reinitialized as ^T/@LBLTAB(LT)/ tape. Make
sure volume ^W/TCB.IV(B)/ is mounted. It is impossible for the
tape labeler to verrify owner information using these type
of labels.>)
; New-volume unlabeled tape message
NXTNV3: ITEXT (<It will be reinitialized as ^T/@LBLTAB(LT)/ tape. Make
sure volume ^W/TCB.IV(B)/ is mounted. It is impossible for the
tape labeler to verrify volume-id or owner information using
these type of labels.>)
LBLTAB: [ASCIZ |an unlabeled|]
[ASCIZ |an ANSI|]
[ASCIZ |an ANSI|]
[ASCIZ |an IBM|]
[ASCIZ |an IBM|]
[ASCIZ |an unlabeled|]
[ASCIZ |an unlabeled|]
[ASCIZ |an unlabeled|]
[ASCIZ |an ASCII-COBOL|]
[ASCIZ |a sixbit-COBOL|]
[ASCIZ |an unlabeled|]
LBLITX: NXTNI3,,NXTNV3
NXTNI1,,NXTNV1
NXTNI1,,NXTNV1
NXTNI2,,NXTNV2
NXTNI2,,NXTNV2
NXTNI3,,NXTNV3
NXTNI3,,NXTNV3
NXTNI3,,NXTNV3
NXTNI2,,NXTNV2
NXTNI2,,NXTNV2
NXTNI3,,NXTNV3
SUBTTL V$TAPE - Get a new tape mounted
;This routine is run if for some reason, the current tape
; is no longer useful. For example: Volume initialized, write protected, etc
; This routine will arrange with the operator to get the next tape mounted
;Call -
; S1/ Adrs of ASCIZ type field of WTO
; S1/ Adrs of ITEXT for text field of WTO
; The ITEXT must not use the Ts as arguments
; The Ps should be used, instead
V$TAPE: PUSH P,S1 ;Save type
PUSH P,S2 ;Save text
MOVEI S1,'UNL' ;Get unload command
PUSHJ P,T$POS## ;Done with this tape
POP P,S2 ;Get back type
POP P,S1 ;Get back text
PUSHJ P,O$NTAP## ;GET A NEW TAPE
JUMPT .POPJ ;RETURN IF ALL IS WELL
MOVSI S1,400000 ;MUST FLAG THE ERROR
IORM S1,TCB.IR(B) ;SO QUASAR WON'T SELF DESTRUCT
POPJ P, ;AND RETURN
SUBTTL V$NVID - Generate next incremental volume id
;This routine will generate the volume id of the next volume
; in the incremental sequence
; Basically, it adds the increment to the trailing number
; on the volume id.
;If the trailing number on the volume id overflows,
; this routine returns false.
V$NVID:
JMPUNL LT,.RETT ;If unlabeled, no problem
$SAVE <P1,P2,P3> ;Save some regs
STKVAR <PRFIXN,NUMN,FSTDIG> ;PRFXIN - # of chars in prefix
;NUMN - # of chars in the trailing number
;FSTDIG - byte ptr to first digit
SETZM PRFIXN ;No chars in prefix
SETZM NUMN ;No chars in number
MOVE P1,[POINT 6,TCB.IV(B)] ;Aim at the exsisting volid
MOVEI P2,6 ;Examine at most 6 chars
SETZ P3, ;Clear number accumulator
NVID.1: ILDB S1,P1 ;Get next char of volid
CAIL S1,'0' ;Is it a decimal digit?
CAILE S1,'9' ;Is it?
JRST NVID.2 ;No, check it out
SKIPN NUMN ;Is this the first digit in the number?
MOVEM P1,FSTDIG ;Yes, save byte pointer to this digit
AOS NUMN ;Count this digit
IMULI P3,^D10 ;Shift old stuff over
ADDI P3,-'0'(S1) ;Add in this digit
SOJG P2,NVID.1 ;Try the next one
JRST NVID.3 ;Looked at all six, quit
NVID.2: JUMPE S1,[SKIPN NUMN ;If end of volid, have we seen a number?
JRST NVID.E ;No, that's an error
JRST NVID.3] ;Yes, do the increment
AOS S2,NUMN ;A non-numeric, Count it, include old length
ADDM S2,PRFIXN ;All those chars are now part of prefix
SETZB P3,NUMN ;No chars in number, no number
SOJG P2,NVID.1 ;Do the next
JRST NVID.E ;Last char in volid, error
NVID.3: MOVE S1,TCB.II(B) ;GET THE AMOUNT TO MOVE
ADD S1,P3 ;Step to next volid
MOVE P2,[XWD -6,-5] ;Aim at range checker
CAML S1,MAXNXT+6(P2) ;Is this one in range?
AOBJN P2,.-1 ;No, try the next
JUMPGE P2,NVID.E ;Way too big, quit
MOVEI P2,6(P2) ;Make neg counter into # digits
CAMGE P2,NUMN ;Is this number longer?
MOVE P2,NUMN ;Shorter, use the old length
MOVE S2,P2 ;Copy it for a sec
ADD S2,PRFIXN ;Include the prefix length
CAILE S2,6 ;Still legal volid?
JRST NVID.E ;No, quit
NVID.4: IDIV S1,MAXNXT-1(P2) ;Get leftmost digit
ADDI S1,'0' ;Make it SIXBIT
DPB S1,FSTDIG ;Stash it
IBP FSTDIG ;Aim at next
MOVE S1,S2 ;Use remainder for next calculation
SOJG P2,NVID.4 ;Do 'em all
$RETT
NVID.E: $WTO (<Incremental volume id overflow>,<Initialization aborted, last volume id is ^W6/TCB.IV(B)/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF
MAXNXT: ^D1
^D10
^D100
^D1000
^D10000
^D100000
^D1000000
SUBTTL V$TOPR - Tell OPR about volume just initialized
; This routine will inform the OPR whenever a volume has been intialized.
; All it does is a WTO which contains alot of demographic information about
; the volume, for instance, its volid, density, label type, owner, etc.
;
; Call -
; B/ TCB adrs
;
; Returns -
; (a message to the OPR)
; TRUE (always)
V$TOPR: PUSHJ P,G$TXTI## ;INIT THE TEXT BUFFER
LOAD S1,TCB.PS(B),TP.DEN ;GET DENSITY INDEX
MOVEI S2,UNLTXT ;ASSUME AN UNLABELED TAPE
JMPUNL LT,TOPR.1 ;JUMP IF UNLABELED
MOVEI S2,LBLTXT ;MUST BE LABELED
TOPR.1: $TEXT (G$TYPE##,<^I/(S2)/^A>) ;WRITE FIRST LINE OUT
LOAD S1,TCB.PS(B),TP.DEN ;GET DENSITY INDEX
$TEXT (G$TYPE##,<^I/DENTXT/>) ;TYPE DENSITY
SKIPE TCB.OI(B) ;HAVE AN OWNER?
$TEXT (G$TYPE##,<^I/OWNTXT/>) ;YES--TYPE OWNER AND PROTECTION INFO
MOVX S1,TV.NEW ;GET /NEW-VOLUME BIT
TDNE S1,TCB.IL(B) ;RE-INITIALIZING AN OLD TAPE?
SKIPA S1,[[ASCIZ |reinitialized|]]
MOVEI S1,[ASCIZ |initialized|]
MOVEI S2,G$TXTB## ;POINT TO TEXT BUFFER
$WTO (<Volume ^T/(S1)/>,<^T/(S2)/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETT
UNLTXT: ITEXT (<Unlabeled tape>)
LBLTXT: ITEXT (<Volume Id:^W/TCB.IV(B)/, Label type:^T/@G$LTYP(LT)/>)
OWNTXT: ITEXT (<Owner:^U/TCB.OI(B)/, Protection:^O3R0/TCB.IP(B)/>)
DENTXT: ITEXT (<, Density:^T/@G$DENS(S1)/>)
END