Trailing-Edge
-
PDP-10 Archives
-
tops10_703a_sys_atpch16_bb-fr67f-bb
-
plrdsk.x16
There are 2 other files named plrdsk.x16 in the archive. Click here to see a list.
TITLE PLRDSK - Disk Processing Module
SUBTTL Author: Dave Cornelius/DC/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
SEARCH UFDPRM ;GET UFDSET SYMBOLS
PROLOG (PLRDSK) ;SEARCH OTHER NEEDED FILES
%%UFDS==%%UFDS ;RECORD UFDSET VERSION
;This module is responsible for all of the disk handling done
;by the tape labeller for the MDA system.
;It is responsible for reading home blocks, creating file structures,
;and removing file structures from the system lists
GLOB <G$TXTB,NUMBER>
SUBTTL Directory for PLRDSK
;Until we find a better home for these symbols...
;Byte definitions for the SPT pointers which hang off the UPBs
; on a .FSDEF STRUUO
;TALSIZ==^D13
;TALPOS==^D12
;CLASIZ==^D23
;CLAPOS==^D35
SPTTAL==777740,,0 ;# of free clusters described by SPT entry
SPTCLA==000037,,-1 ;Cluster addr of this group
UNVRSF==^D500 ;Saftey factor hide 1 out of
;every UNVRSF blocks for safe keeping
DSKTRY==^D10 ;# times monitor should retry on error
;Should agree with definition in COMMOD
RIBFIR==0
RIBNAM==2
RIBEXT==3
SAFFIR==0
;Define the fields and macros for dealing with PDP-11 packed ASCII
E11B1==377B17 ;PDP-11 byte 1
E11B2==377B9 ;PDP-11 byte 2
E11B3==377B35 ;PDP-11 byte 3
E11B4==377B27 ;PDP-11 byte 4
DEFINE ASC11(A,B,C,D),<INSVL.("A",E11B1)!INSVL.("B",E11B2)!INSVL.("C",E11B3)!INSVL.("D",E11B4)>
SUBTTL D$HOM - Home block reader
;This routine is analagous to L$MDC, in that it reads
; the 'volume labels' from a drive on a particular unit.
D$HOM:: PUSHJ P,D$WLK ;Get hardware write locked status
STORE S1,TCB.PT(B),TP.RWL ;Save in TCB so O$STAT will send it
PUSHJ P,D$IHOM ;Read 'em
JUMPF HOM.1 ;Can't tell the sad story
HRRZ BUF,TCB.HO(B) ;Get Addr-1 of hom block
AOS BUF ;Point at home block itself
$SAVE <T1,T2,T3,T4> ;Save the T acs
MOVE S1,TCB.DV(B) ;Get the structure name
PUSHJ P,GETDCH ;Do a DSKCHR
JUMPF .RETF ;Couldn't?... Oh well
LSH S1,-3 ;Shift to get at the unit type
ANDI S1,7 ;Isolate it
MOVE S2,HOMUTP(BUF) ;And the type it belongs on
CAMN S1,S2 ;Are they the same?
JRST HOM.2 ;Yes, continue
$WTO (<Volume ^W/HOMHID(BUF)/>,<Volume type does not match drive type.^M^JRemount structure on correct drive type.>,TCB.OB(B),$WTFLG(WT.SJI))
JRST HOM.1 ;Return false
HOM.2: MOVE T1,HOMHID(BUF) ;Get the HOMe ID (volid)
MOVE T2,HOMNXT(BUF) ;Get volid of next volume in str
MOVE T3,HOMLUN(BUF) ;Get logical unit # of this pack
MOVE T4,HOMSNM(BUF) ;And get structure name
MOVE S1,HOMOPP(BUF) ;Get owner PPN
MOVEM S1,TCB.OW(B) ;Save it
; $WTO (<Volume ^W/HOMHID(BUF)/ mounted>,<Unit ^D/HOMLUN(BUF)/ of file structure ^W/HOMSNM(BUF)/
;Previous volume in file structure:^W/HOMPRV(BUF)/
; Next volume in file structure:^W/HOMNXT(BUF)/>,,$WTFLG(WT.SJI))
PUSHJ P,O$STAT## ;Send the status to MDA
PUSHJ P,D$RELE ;Close the device
$RETT
;Here if we can't read the HOMe blocks
HOM.1: MOVX S1,TS.NTP ;Get fake offline bit
IORM S1,TCB.ST(B) ;Save in TCB
PUSHJ P,O$STAT## ;Tell MDA the bad news
PUSHJ P,D$RELE ;Can't, give back the space
$RETF
SUBTTL D$IHOM - Internal home block reader
;This routine does the same thing an on-line request to read
; home blocks does, except that it does not report the results
; to MDA
D$IHOM::
PUSHJ P,D$UPEN ;Get the Unit tied to a channel
JUMPF .RETF ;Can't, that's too bad
MOVX S1,HOMEB1 ;Code for first home block
PUSHJ P,D$RHOM ;Read that home block
JUMPT .RETT ;Got it, so use it
MOVX S1,HOMEB2 ;Can't, try the other guy
PUSHJ P,D$RHOM ;Read that home block
JUMPT RHOM.1 ;Got that one!
MOVE S1,TCB.DV(B) ;Get the unit name
PUSHJ P,GETDCH ;Get disk characteristics
SKIPF ;Strange
SKIPN S1,G$BLOK##+.DCSNM ;Get structure name (if any)
SKIPA S2,[[ITEXT (<>)]] ;Not part of a structure
MOVEI S2,HOMITX ;Point to a long story
$WTO (<Can't read either HOM block>,<^I/(S2)/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF
HOMITX: ITEXT (<
Unit ^W/TCB.DV(B)/ belongs to structure ^W/S1/ which is currently mounted.
The structure may still be usable for reading files. Should ^W/S1/
be dismounted or the system crash, it probably cannot be mounted
again due to the state of the HOM blocks.>)
;Here if only the second block can be read
RHOM.1: $WTO (<Error reading first HOM block>,,TCB.OB(B),$WTFLG(WT.SJI))
$RETT
SUBTTL D$RHOM - Read a particular home block
;This routine will read a particular home block from a unit
;Call with the drive open, its data block adr in B.
;S1/ Code specifying which home block to read
;Returns true if the specified block can be read without errors,
; and is indeed a home block
;Otherwise, it returns FALSE
D$RHOM:
MOVE S2,TCB.HO(B) ;Get the IOWD to do the read
PUSHJ P,D$GUNB ;Read the particular block from the unit
JUMPF .RETF ;Can't... too bad
HRRZ BUF,TCB.HO(B) ;Get the buffer addr
AOS BUF ;Adjust for IOWD
MOVE S2,HOMNAM(BUF) ;Get this block's name
MOVE S1,HOMCOD(BUF) ;Get unlikely code word
CAXN S2,<SIXBIT/HOM/> ;Is this a HOM block?
CAXE S1,CODHOM ;Does it match XXX?
JRST RHM.1 ;No, complain
MOVE S1,[ASC11(T,O,P,S)] ;PDP11 ASCII for TOPS
MOVE S2,[ASC11(-,1,0, )] ;PDP11 ASCII for -10
CAMN S1,HOMVSY(BUF) ;Is this a real TOPS-10
CAME S2,HOMVSY+1(BUF) ; pack?
JRST RHM.2 ;No, go complain
SKIPN HOMREF(BUF) ;Looks like HOM block, need refreshing?
$RETT ;No, its a winner!
$WTO (<Volume ^W/HOMHID(BUF)/>,<Structure ^W/HOMSNM(BUF)/ needs refreshing>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF ;Needs refreshing!
;Here if the HOM block doesn't say HOM, and XXX
RHM.1: $WTO (<HOM block consistency failure>,,TCB.OB(B),$WTFLG(WT.SJI))
$RETF
;Here if the pack is not a TOPS-10 pack
RHM.2: $WTO (<Not a TOPS-10 pack>,<HOM block system type is ^7/HOMVSY(BUF),E11B1/^7/HOMVSY(BUF),E11B2/^7/HOMVSY(BUF),E11B3/^7/HOMVSY(BUF),E11B4/^7/HOMVSY+1(BUF),E11B1/^7/HOMVSY+1(BUF),E11B2/^7/HOMVSY+1(BUF),E11B3/^7/HOMVSY+1(BUF),E11B4/^7/HOMVSY+2(BUF),E11B1/^7/HOMVSY+2(BUF),E11B2/^7/HOMVSY+2(BUF),E11B3/^7/HOMVSY+2(BUF),E11B4/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF
SUBTTL D$GUNB - Get a particular block from a unit
;This routine will read a certain logical block from an open unit
; Call with drive data block in B, desired logical block # in S1.
; S2/ IOWD to do the input
D$GUNB:
$SAVE <P1>
STKVAR <<CMDLST,2>> ;1 command, 0 termination word
MOVE P1,S1 ;Preserve the desired block
MOVEM S2,CMDLST ;Save the command
SETZM 1+CMDLST ;Terminate the list
PUSHJ P,D$UPEN ;Make sure the unit is open
JUMPF .RETF ;Can't get it!
MOVEI S2,CMDLST ;Get addr of command list
STORE S2,TCB.FI(B),RHMASK ;Save IOWD ptr in the 2nd word (IO status)
LOAD S1,TCB.FU(B),TF.DVH ;Get the channel number
STORE S1,P1,SU.SCH ;Save in correct place in SUSET wd
SUSET. P1, ;Position to the desired block
$RETF ;Can't
MOVX S1,.FOINP ;Code to do an input
PUSHJ P,D$FILS ;Read the block
JUMPF .RETF ;Can't!
$RETT
SUBTTL D$WUNB - Read a particular block from a unit
; This routine will write a block on a unit
; Call: MOVE S1, block number
; MOVE S2, IOWD to do output
; PUSHJ P,D$WUNB
;
; TRUE return: block written
; FALSE return: failed, TS.HWP set in TCB if hardware write protected
;
D$WUNB: $SAVE <P1> ;Save P1
STKVAR <<CMDLST,2>> ;1 command, 0 termination word
MOVE P1,S1 ;Preserve the desired block
MOVEM S2,CMDLST ;Save the command
SETZM 1+CMDLST ;Terminate the list
PUSHJ P,D$UPEN ;Make sure the unit is open
JUMPF .RETF ;Can't get it!
MOVEI S2,CMDLST ;Get addr of command list
STORE S2,TCB.FI(B),RHMASK ;Save IOWD pointer
LOAD S1,TCB.FU(B),TF.DVH ;Get the channel number
STORE S1,P1,SU.SCH ;Save in correct place in SUSET wd
TXO P1,SU.SOT ;Lite the 'position for output' bit
SUSET. P1, ;Position to the desired block
$RETF ;Can't
MOVX S1,.FOOUT ;Code to do an input
PUSHJ P,D$FILS ;Write the block
JUMPF .RETF ;Can't!
$RETT
SUBTTL D$GFSB - Read a particular logical block from a file structure
;Call -
; S1/ Desired structure block #
; B/ Structure TCB adrs
;Return-
; TRUE -
; With the required block of the file structure in
; the HOMe block area for this structure TCB
; FALSE - I/O errors
D$GFSB:
$SAVE <P1,P2,P3>
MOVE P3,B ;Preserve TCB adr
MOVE P1,S1 ;Copy the input to a safe place
PUSHJ P,D$MBLK ;Get some space to read into
IDIV P1,TCB.BU(B) ;Convert to unit #, relative block #
CAML P1,TCB.NV(B) ;Is it in range 0 to #units-1?
$RETF ;No, Cant read from non-ex unit!
ADDI P1,TCB.DU(B) ;Look into list of unit names
MOVE S1,0(P1) ;Get this (new) unit name
PUSHJ P,G$FTCB## ;Get the data block for this unit
JUMPT GFSB.1 ;Got it, so use it
MOVE T1,0(P1) ;Can't find it, so make one
SETZB T2,T3 ;Clear job #, ppn
PUSHJ P,G$MTCB## ;Make it up
GFSB.1: MOVEM P2,TCB.AC+S1(B) ;Save arg 1 - block number
MOVE S1,TCB.HO(P3) ;Read into OUR (structure) home block
MOVEM S1,TCB.AC+S2(B) ;Save as arg 2 - IOWD
MOVEI S1,D$GUNB ;Routine to run
MOVE S2,B ;In this unit TCB
MOVE B,P3 ;Get back to our TCB
PUSHJ P,G$PREQ## ;Get the work done
JUMPF .RETF ;Couldn't hack it
$RETT
SUBTTL RDSAT - Read a (SAT) block from a unit
;This routine will read any logical block from a particular unit
;The block will be read into the caller's TCB.SA area
;Call -
; S1/ SIXBIT unit name
; S2/ block # to read
; B/ TCB setup
;Returns -
; S1/ addrs of block (TCB.SA)
RDSAT:
$SAVE <P1,P2,P3>
DMOVE P1,S1 ;Preserve unit, block #
MOVE P3,B ;And caller's TCB, too
PUSHJ P,G$FTCB## ;Find the desired unit
JUMPT RDSA.1 ;Got it
MOVE T1,P1 ;Can't find it,
SETZB T2,T3 ;Make a new one
PUSHJ P,G$MTCB## ;Set it up
RDSA.1: MOVEM P2,TCB.AC+S1(B) ;Set arg 1 - block number
MOVE S1,TCB.SA(P3) ;Set arg 2 - IOWD to destination
MOVEM S1,TCB.AC+S2(B) ;Put in unit TCB
MOVEI S1,D$GUNB ;Routine to run - Get Unit Block
MOVE S2,B ;TCB to run - unit TCB
MOVE B,P3 ;Get back to caller's TCB
PUSHJ P,G$PREQ## ;Wait for the work to be done
JUMPF .RETF ;Can't do it. quit now.
HRRZ S1,TCB.SA(B) ;Wins, set ptr to data
AOJA S1,.RETT ;And leave
SUBTTL D$ROHM - Read the HOM block for a different unit
;This routine will request that the HOM blocks of a unit other
; than the current TCB be read.
;Call -
; S1/ Unit name whose HOMe blocks are to be read
;Returns T/F
D$ROHM:
$SAVE <P1,P2>
MOVE P1,B ;Save our TCB
MOVE P2,S1 ;Save the unit name
PUSHJ P,G$FTCB## ;Find the unit's TCB
JUMPT ROHM.1 ;Got it... keep going
MOVE T1,P2 ;Not there, make one
SETZB T2,T3 ;No job #, or owner
PUSHJ P,G$MTCB## ;Make it up
ROHM.1: MOVEI S1,D$IHOM ;Routine to run - home block reader
MOVE S2,B ;Aim at this (new) unit TCB
EXCH B,P1 ;Get back to our (str) TCB
PUSHJ P,G$PREQ## ;Wait for the read to finish
JUMPF .RETF ;Couldn't hack it
MOVE S1,TCB.HO(P1) ;Aim at the block just read
AOJA S1,.RETT ;Undo IOWD, give true to caller
SUBTTL D$UPEN - Open a disk unit
;This routine will set up a channel upon which we can do disk I/O
;Call -
; B/ TCB adrs
;Returns FALSE if we can't open a channel for this unit
D$UPEN: LOAD TF,TCB.IO(B),TI.OPN ;Is it already open?
JUMPN TF,.RETT ;Yes, that's all we have to do!
MOVE S1,TCB.DV(B) ;Get the unit name
PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
MOVE S1,TCB.DV(B) ;GET THE UNIT NAME AGAIN
DEVNAM S1, ;PRIMARY PORT?
MOVE S1,G$BLOK##+.DCALT ;IT WAS AN ALTERNATE PORT
MOVEM S1,TCB.DN(B) ;Put it in the FILOP. block
MOVX S1,FO.ASC ;Get the ext chan bit
MOVEM S1,TCB.FU(B) ;That's all we know, now.
MOVX S1,.IODMP ;Dump mode I/O
STORE S1,TCB.FI(B),RHMASK ;Save in FILOP. block
MOVX S1,.FOSIO ;Read the file in super I/O
PUSHJ P,D$FILS ;Get the device
JUMPF .RETF ;Can't get it, so quit
ZERO TCB.FU(B),FO.ASC ;Don't ask for a channel again
PUSHJ P,D$MBLK ;Setup up the I/O blocks
MOVX S1,TI.OPN ;Get the open bit
IORM S1,TCB.IO(B) ;Lite in satus word
MOVEI S1,PS.RDO!PS.RDH ;Trap off-line and hung device
PUSHJ P,I$PICD## ;Connect device to PSI system
$RETIF ;FALSE?
$RETT ;Return
SUBTTL D$MBLK - Make up the I/O blocks for disks
;This routine will get space for the dump mode
; I/O blocks required to read/write the HOME blocks, SAT blocks, RIBs
; If the blocks already exists, then this routine just $RETTs
;Call -
; B/ TCB adrs
;Returns -
; TRUE, always
D$MBLK:
SKIPN S1,TCB.HO(B) ;Already exists?
PUSHJ P,MBLOCK ;Get one block
MOVEM S1,TCB.HO(B) ;Save as home block
SKIPN S1,TCB.SA(B) ;Already exists?
PUSHJ P,MBLOCK ;Get another
MOVEM S1,TCB.SA(B) ;Save as SAT block
SKIPN S1,TCB.RI(B) ;Already exists?
PUSHJ P,MBLOCK ;Get another
MOVEM S1,TCB.RI(B) ;Save RIB block
$RETT
MBLOCK: MOVEI S1,BLKLEN ;One block's worth of data
$CALL M%GMEM ;The a block of data
MOVEI S1,-1(S2) ;Aim at the buffer, IOWD style
HRLI S1,-BLKLEN ;Make counter for IOWD
$RETT
SUBTTL D$SDEF - Structure definition
;This routine will take a request from MDA and define
; a structure to the Monitor
;The required inputs (from the TCB) are:
; TCB.NV # of units in the structure
; TCB.FS Structure name to be defined (might not agree
; with HOM block definition) in SIXBIT
; TCB.DU Contains the SIXBIT unit names
; TCB.OW Contains PPN of owner of structure
D$SDEF::
$SAVE <P1,P2>
PUSHJ P,D$MSTR ;Get the STRUUO blocks set up
PUSHJ P,FILSTP ;Fill in the structure param block
;And get a retrieval AOBJN ptr for SAT
JUMPF SDEF.3 ;Can't... too bad
MOVN P1,TCB.NV(B) ;Get - # of units
MOVSS P1 ;To LH for AOBJN
HRRI P1,TCB.DU(B) ;Aim at list of unit names
SETZ P2, ;Set unit counter to 0
SDEF.1: ;Note - S1 is (still) setup with
;AOBJN ptr to SAT RIB
MOVE S2,0(P1) ;Get the next unit id
MOVE T1,P2 ;Copy the unit number
PUSHJ P,FILUNP ;Fill the unit param block for that one
JUMPF SDEF.3 ;Can't... too bad
AOS P2 ;Bump the unit number
AOBJN P1,SDEF.1 ;Do each of the units
PUSHJ P,CHKEOF ;Make sure RIB ptr in S1 points to EOF
JUMPF SDEF.3 ;It doesn't
PUSHJ P,ADJTAL ;Adjust the structure totals
JUMPF SDEF.3 ;Can't... too bad
MOVE S1,TCB.SP(B) ;Aim at the work
STRUUO S1, ;Define this structure
JRST SDEF.2 ;Can't... give up
PUSHJ P,RELUNI ;Clean up the TCBs
SETZ S1, ;Assume not write-locked
MOVX S2,TS.HWP ;Get write-locked bit
TDNE S2,TCB.SF(B) ;Is it?
MOVX S1,.MTWLK ;Yes
HRRI S1,%MOUNT ;Ack type - MOUNT
MOVX S2,TS.BOP ;Get bad owner PPN flag
TDNE S2,TCB.SF(B) ;Is it set?
HRRI S1,%MNTNO ;Yes
MOVE S2,TCB.DV(B) ;Get file structure name
PUSHJ P,O$ACK## ;Tell MDA str is up!
$RETT
SDEF.2: MOVE S2,[XWD -STRELN,STRETB] ;Aim at the error conversion table
PUSHJ P,D$MAPE ;Map the number into readable text
$WTO (<Structure ^W/TCB.DV(B)/ cannot be mounted>,<STRUUO (.FSDEF) failed. ^I/0(S2)/>,,$WTFLG(WT.SJI))
SDEF.3: PUSHJ P,RELUNI ;Clean up the TCBs
MOVX S1,%MOUNT ;Ack type - MOUNT
MOVE S2,TCB.DV(B) ;Get file structure name
PUSHJ P,O$NAK## ;Tell MDA tough breakee!
$RETF
SUBTTL RELUNI - Release the units used to build a FS
;This routine will release each drive used to mount a structure.
;It will also give back the storage for each of the unit TCBs
;Call with Str TCB in B.
RELUNI: $SAVE <P1,P2>
MOVN P1,TCB.NV(B) ;Get neg # of drives
MOVSS P1 ;To LH
HRRI P1,TCB.DU(B) ;Aim at drive name list
MOVE P2,B ;Save the str TCB adr
RELU.1: MOVE S1,0(P1) ;Get next drive name
PUSHJ P,G$FTCB## ;Get that unit TCB
JUMPF RELU.2 ;Can't!! very strange
MOVEI S1,D$RELE ;Routine to run on that TCB
MOVE S2,B ;Run on unit TCB
PUSH P,B ;Save Unit TCB adr
MOVE B,P2 ;Call on str TCB
PUSHJ P,G$PREQ## ;Release the unit
POP P,S1 ;Get unit TCB adr
PUSHJ P,G$DTCB## ;And give back that unit's storage
RELU.2: AOBJN P1,RELU.1 ;Do 'em all
$RETT
SUBTTL FILSTP - Fill in structure parameter block
;This routine will set up some of the arguments to
; the STRUUO .FSDEF structure paramter block
;This routine will also read in the SAT.
; the SAT data space for the structure TCB.
; It will return an AOBJN pointer to those retrieval
; pointers in S1.
;If the RIB for SAT.SYS can't be found... FILSTP returns FALSE
;Call with the TCB addr for the structure in B
;Returns TRUE if the stuff was setup. FALSE if there were I/O errors, etc
FILSTP: $SAVE <P1,P2,P3>
MOVE S1,TCB.SP(B) ;Aim at the STRUUO ptr block
HRRZ P1,.FSNST(S1) ;And at the str parameter block
;Fill in some of the easy things in the str parameter block
MOVE S1,TCB.DV(B) ;Get the desired structure name
MOVEM S1,.FSSNM(P1) ;Put that in the str param block
MOVE S1,TCB.NV(B) ;Get the number of units
MOVEM S1,.FSSNU(P1) ;Mark in the str param block
MOVEI S1,DSKTRY ;Get # times to recal on error
MOVEM S1,.FSSTR(P1) ;Tell monitor to try that many times
MOVE S1,TCB.OW(B) ;Get the structure owner's PPN
MOVEM S1,.FSPPN(P1) ;Save in str param block
;Compute STRHGH, STRBPU, STRSIZ, etc
SETZB P2,P3 ;Clear total # of blocks
;And biggest unit
MOVN T1,TCB.NV(B) ;Get - # of units
MOVSS T1 ;Build AOBJN ptr
HRRI T1,TCB.DU(B) ;Aim at the unit list
FILS.1: MOVE S1,0(T1) ;Get this unit name
PUSHJ P,GETSIZ ;Find out how many block on this unit
JUMPF .RETF ;Can't find out, quit!
ADD P2,S1 ;Accumulate this unit's contribution
CAMGE P3,S1 ;Is this a new maximum blocks/unit?
MOVE P3,S1 ;Yes, save it!
AOBJN T1,FILS.1 ;Account for each unit in the str
MOVEM P2,.FSSSZ(P1) ;Save # of blocks on this str
MOVEM P3,.FSSBU(P1) ;Save size of largest unit in str
MOVEM P3,TCB.BU(B) ;Save # blocks/unit for Get FSB
IMUL P3,TCB.NV(B) ;Compute highest (referenceable) block
SOS P3 ;(They start at 0!)
MOVEM P3,.FSSHL(P1) ;Save in Str par block
; PJRST STRHOM ;Get the rest of the stuff from the HOM block
SUBTTL STRHOM - Read in the HOM block for structure info
;This routine will read the HOM block from one of the units in
; the structure being built, and extract any structure-specific
; info from the HOM block. This info will be stored
; in the str parm block off the caller's TCB
;This routine will also read in the RIB for SAT.SYS, and
; store the entire RIB in TCB.RI(B). An AOBJN ptr to
; the retrieval pointers is returned in S1.
;Enter with addr of structure parameter block in P1
;(Fall into STRHOM from FILSTP)
STRHOM:
MOVE S1,TCB.DU(B) ;Get the first unit's name
PUSHJ P,D$ROHM ;Read that unit's home block
JUMPF .RETF ;Couldn't
MOVE T1,S1 ;Aim at this HOM block
SKIPN G$SETS## ;Monitor support disk sets feature?
JRST STHM.2 ;No
LDB S1,[POINT HOSSET,HOMSET(T1),HONSET] ;Get set number
JUMPE S1,STHM.2 ;Jump if part of the "ALL" set
CAILE S1,^D36 ;Part of a numbered set?
JRST STHM.1 ;No, must be part of the "NO" set
MOVNI S2,-1(S1) ;Get the set number, zero based
MOVX S1,1B0 ;Get bit zero
LSH S1,(S2) ;Position to the appropriate bit
TDNE S1,G$SETN## ;Should this structure be mounted?
JRST STHM.2 ;Yes
STHM.1: MOVX S1,TS.OSN ;Did operator say /OVERRIDE-SET-NUMBER?
TDNN S1,TCB.SF(B) ;...
JRST STRH.5 ;No, straight out error
$WTO (<Structure ^W/TCB.DV(B)/>,<Overriding disk set number>,,$WTFLG(WT.SJI))
STHM.2: MOVE T2,TCB.SP(B) ;Aim at the STRUUO arg block
MOVE T2,.FSNST(T2) ;And now at the str parm block
MOVE T3,[XWD -FSTLEN,FSTABL] ;Aim at the conversion table
PUSHJ P,MOVALU ;Move the stuff from the HOM to
; the str parm block
MOVE S1,HOMOPP(T1) ;Get owner PPN from HOM block
MOVE S2,.FSPPN(P1) ;Get owner PPN from QUASAR
PUSHJ P,PPNCHK ;Check for PPN mismatch
SKIPT ;Was there a mismatch?
SETZM .FSPPN(P1) ;Yes - clear owner PPN
MOVE S1,HOMMFD(T1) ;Get str blk # of MFD rib
PUSHJ P,D$GFSB ;Get that block of the file str
JUMPF STRH.1 ;Can't
MOVE S1,TCB.HO(B) ;Aim at our HOM block
AOS S1 ;Undo IOWD
MOVE S2,RIBNAM(S1) ;Get the file name
HLRZ TF,RIBEXT(S1) ;And the extension
CAMN S2,G$MFDP## ;Is the name [1,1]?
CAIE TF,(SIXBIT/UFD/) ;Yes, is the extension UFD?
JRST STHR.2 ;No to either, bad RIB
ADD S1,RIBFIR(S1) ;Point at first retr ptr
SETOM .FSSML(P1) ;Assume multiple retrieval ptr
SKIPE 2(S1) ;If 2nd ptr is empty, only 1 ptr
SETZM .FSSML(P1) ;No multilple retr ptr for MFD
MOVE S1,HOMSAT(T1) ;Get str blk # of SAT rib
PUSHJ P,D$GFSB ;Read in the RIB for SAT.SYS
JUMPF STRH.3 ;Can't
HRL S2,TCB.HO(B) ;Get addr of our HOM blk
HRR S2,TCB.RI(B) ;And addr of RIB blk
AOBJP S2,.+1 ;Bump to undo IOWD
HRRZ S1,S2 ;Make another copy of destination
BLT S2,BLKLEN-1(S1) ;Move the SAT RIB into our RIB space
MOVS S2,RIBNAM(S1) ;Get file name
HLRZ TF,RIBEXT(S1) ;And get extension
CAIN S2,(SIXBIT/SAT/) ;Is this file SAT.
CAIE TF,(SIXBIT/SYS/) ; SYS?
JRST STRH.4 ;Can't?!?!
ADD S1,RIBFIR(S1) ;Aim at the first ret ptr
MOVE S2,0(S1) ;Get Unit change pointer to first SAT
MOVEM S2,1(S1) ;Fudge so we don't see first RIB pointer
$RETT
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SUBTTL STRHOM error routines
;This code handles any errors which might be encountered trying
; to read the HOM blocks to get to SAT.SYS
;Here if the HOMMFD points to the boonies,
; or we can't read RIB for the MFD
STRH.1: MOVEI S1,[ASCIZ/Can't find RIB for MFD/]
PJRST STRH.9 ;Complain
;Here if [1,1].MFD (according to HOMMFD) is not RIB for the MFD
STHR.2: MOVEI S1,[ASCIZ/HOMMFD does not point to RIB for MFD/]
PJRST STRH.9 ;Complain
;Here if HOMSAT points to the boonies,
; or we can't read the RIB for SAT.SYS
STRH.3: MOVEI S1,[ASCIZ/Can't find RIB for SAT.SYS/]
PJRST STRH.9 ;Complain
;Here if SAT.SYS (according to the RIB) is not SAT.SYS
STRH.4: MOVEI S1,[ASCIZ/HOMSAT does not point to RIB for SAT.SYS/]
PJRST STRH.9 ;Complain
;Here if structure belongs to a disk set not mounted to this system
STRH.5: MOVEI S1,[ASCIZ /Structure belongs to a disk set not mounted to this system/]
; PJRST STRH.9 ;Fall thru
STRH.9: $WTO (<Structure ^W/TCB.DV(B)/ cannot be mounted>,<^T/0(S1)/>,,$WTFLG(WT.SJI))
$RETF
SUBTTL Check for owner PPN mismatch
; Check for an owner PPN mismatch
; Call: MOVE S1, HOM block PPN
; MOVE S2, STRUUO block PPN
; PUSHJ P,PPNCHK
;
; TRUE return: PPNs OK
; FALSE return: PPN mismatch, TCB.OB(B) set, operator notified
;
PPNCHK: MOVX TF,TS.BOP ;GET BAD OWNER PPN FLAG
ANDCAM TF,TCB.SF(B) ;CLEAR IT
SKIPE S1 ;ALLOW ZERO FOR COMPATIBILITY WITH OLD
CAMN S1,S2 ; DISKS. PPN WHAT QUASAR THINKS IT IS?
$RETT ;YES - THEN ALL IS WELL
$SAVE <P1,P2,P3,P4> ;SAVE SOME ACS
PUSH P,[-1] ;SO WE KNOW WHEN TO STOP
PUSH P,S1 ;SAVE PPN FROM HOM BLOCKS
PUSH P,[[ASCIZ |The HOM blocks indicate|]]
PUSH P,S2 ;SAVE PPN FROM STRUUO BLOCK
PUSH P,[[ASCIZ |QUASAR claims|]]
PUSHJ P,G$TXTI## ;INITIALIZE THE TEXT BUFFER
PPNC.1: POP P,P1 ;GET TEXT
JUMPL P1,PPNC.3 ;DONE?
POP P,P2 ;GET PPN
MOVEI S1,[ITEXT (<there is no owner PPN>)] ;INCASE NO PPN
JUMPE P2,PPNC.2 ;IS THERE A PPN?
MOVEI S1,[ITEXT (<the owner is [^I/(P3)/,^I/(P4)/]>)] ;ITEXT BLOCK
MOVEI P3,[ITEXT (<^O/P2,LHMASK/>)] ;ASSUME OCTAL PROJECT #
HLRE S2,P2 ;GET THE PROJECT NUMBER
CAMN S2,[-1] ;IS IT WILD?
MOVEI P3,[ITEXT (<*>)] ;YES
MOVEI P4,[ITEXT (<^O/P2,RHMASK/>)] ;ASSUME OCTAL PROGRAMMER #
HRRE S2,P2 ;GET THE PROGRAMMER NUMBER
CAMN S2,[-1] ;IS IT WILD?
MOVEI P4,[ITEXT (<*>)] ;YES
PPNC.2: $TEXT (G$TYPE##,<^T/(P1)/ ^I/(S1)/>) ;DISPLAY A LINE OF TEXT
JRST PPNC.1 ;LOOP
PPNC.3: $TEXT (G$TYPE##,<Clearing owner PPN^M^J^0>)
$WTO (<Structure ^W/TCB.DV(B)/ - owner PPN mismatch>,<^T/G$TXTB/>,,$WTFLG(WT.SJI))
MOVX S1,TS.BOP ;GET BAD OWNER PPN FLAG
IORM S1,TCB.SF(B) ;SET IT
$RETF ;RETURN
SUBTTL HOM- to Structure transfer table
;Conversion table for HOM block offsets to str parm block offsets
FSTABL:
XWD HOMGAR,.FSSRQ ;Guaranteed quota
XWD HOMOVR,.FSSOD ;Overdraw blocks
XWD HOMPT1,.FSSMP ;1st retrieval ptr for MFD
XWD HOMUN1,.FSSUN ;Logical unit number for MFD
XWD HOMBSC,.FSSBC ;Blocks/supercluster
XWD HOMSCU,.FSSSU ;Superclusters/unit
XWD HOMCNP,.FSSCC ;Byte ptr to retrieval cluster count fld
XWD HOMCKP,.FSSCK ;Byte ptr to retrieval checksum fld
XWD HOMCLP,.FSSCA ;Byte ptr to retrieval cluster adrs fld
XWD HOMPVS,.FSPVT ;Private structure flag
XWD HOMCRS,.FSSCR ;Block # in str for CRASH.EXE
XWD HOMK4C,.FSK4C ;K FOR CRASH.EXE
XWD 400000+SETPTR,.FSSET ;Disk set number
FSTLEN==.-FSTABL
MSTROF==.FSSET ;Maximum offset used in block
;Byte pointers
SETPTR: POINT HOSSET,HOMSET(T1),HONSET
SUBTTL FILUNP - Fill in unit parameter blocks
;This routine will fill in the unit parameter blocks for a particular
; unit in a structure.
;Call -
; S1/ AOBJN ptr to retrieval pointers for the SAT blocks
; on this structure.
; S2/ SIXBIT Unit name eg RPA3
; T1/ Logical unit # in str
;Returns -
; TRUE -
; S1/ Updated AOBJN ptr to retrieval ptrs.
; FALSE - I/O errors
FILUNP:
$SAVE <P1,P2,P3,P4>
;UNIT - logical unit number (arg T1)
;PCLADR - Pointer to cluster adrs in a retrieval pointer
;PCLNUM - Pointer to cluster count in a retrieval pointer
STKVAR <UNIT,PCLADR,PCLNUM>
DMOVE P3,S1 ;Preserve the ptr to the retrv ptrs
MOVEM T1,UNIT ;Save logical unit number
;Build the str- dependent pointers to cluster count and adrs in a
; retrieval pointer. Note: Use of these pointers assumes a
; valid retrieval pointer in S1!!
MOVE S1,TCB.SP(B) ;Get the STRUUO pointer
HRRZ S1,.FSNST(S1) ;Get to the str param block
MOVEI S2,S1 ;Aim the pointers at S1
HLL S2,.FSSCC(S1) ;Make cluster count pointer
MOVEM S2,PCLNUM ;Save for extracting count from ret ptr
HLL S2,.FSSCA(S1) ;Make cluster adrs pointer
MOVEM S2,PCLADR ;Save..to get adr from ptr in S1
;Fill in some of the easy pieces of the UPB
MOVE P1,T1 ;Get the unit # again
ADD P1,TCB.SP(B) ;Aim part way down the STRUUO block
HRRZ P1,.FSNUN(P1) ;And get the adrs of the desired UPB
MOVEM P4,.FSUNM(P1) ;This unit parm blk for this unit
MOVE S1,TCB.DV(B) ;Get the str name we're making
MOVE S2,UNIT ;For this unit number
PUSHJ P,LOGUNI ;Make a logical unit name
MOVEM S1,.FSULN(P1) ;Save the FS log unit name
;Then use the HOM block to fill in some more
MOVE S1,P4 ;Get SIXBIT unit name
PUSHJ P,D$ROHM ;Read that guy's home block (again)
JUMPF .RETF ;Can't, so quit
MOVE P2,S1 ;Save pointer to HOM block
MOVE S2,UNIT ;Get logical unit number
PUSHJ P,CHKHOM ;Make sure we're on the right pack
JUMPF .POPJ ;Things don't look good
MOVE T1,P2 ;Aim at the source block
MOVE T2,P1 ;Aim at the destination block (UPB)
MOVE T3,[XWD -UNILEN,UNITAB] ;Aim at the conversion table
PUSHJ P,MOVALU ;Transfer stuff from HOM to UPB
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVX S1,TS.HWP ;Get HWP bit
MOVX S2,FS.UWL ;Get universal write-lock bit
TDNE S1,TCB.SF(B) ;Is unit hardware-write-protected?
MOVEM S2,.FSUDS(P1) ;Yes - set software-write-locked in UPB
MOVE S1,P4 ;Get the unit name
PUSHJ P,GETSIZ ;Get # of block on this unit
JUMPF .RETF ;Can't. quit
IDIV S1,HOMBPC(P2) ;Convert to # of clusters
SOS S1 ;Down by one
IDIV S1,HOMSPU(P2) ;Get # of clusters in this SAT
MOVEM S1,.FSUCS(P1) ;Save clusters/SAT
AOS .FSUCS(P1) ;Bump it
IDIVI S1,^D36 ;Figure words/SAT
AOS S1 ;bump that
MOVEM S1,.FSUWS(P1) ;Save wds/SAT in UPB
MOVE S1,TCB.SL(B) ;Get list handle for SPT tables
$CALL L%LAST ;Get to end of list
JUMPT FILU.1 ;Wins, tack ours on
CAXE S1,EREOL$ ;No, lost because list empty?
SATR.E: STOPCD (CAS,HALT,,<Can't Append to SPT list>)
FILU.1: MOVE S1,TCB.SL(B) ;Get back the list handle
MOVE S2,HOMSPU(P2) ;Get # SATs on this unit
$CALL L%CENT ;Tack this SPT onto the list
SKIPT ;Win?
PUSHJ P,SATR.E ;No, die
HRL S2,HOMSPU(P2) ;Make a counted pointer
MOVEM S2,.FSUSP(P1) ;Make the UPB point to the SPT
MOVN P4,HOMSPU(P2) ;Get - SATs on this unit
MOVSS P4 ;To LH
HRRI P4,0(S2) ;Make AOBJN ptr to SPT
;At this point, things look like:
;P1/ adr of Unit Parameter Block
;P2/ HOM block for this unit
;P3/ AOBJN for SAT retrieval ptrs (in str TCB's TCB.RI)
;P4/ AOBJN for SPT table for this UPB
AOBJP P3,SATERR ;Get next retrieval pointer
SKIPN S1,0(P3) ;Get it
JRST SATERR ;Better not be EOF!
LDB S2,PCLNUM ;Extract # of clusters from S1
JUMPN S2,SATERR ;We expect a unit change pointer
ANDI S1,77 ;Mask to new unit number
CAME S1,UNIT ;SAT block on this unit?
JRST SATERR ;No, funny SAT-RIB
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;Now loop over each SAT retrieval pointer, accumulating total free space
; described by that SAT. Each SAT retrieval pointer points to a cluster
; of which only the first block is used. This (SAT) block is a bit map
; for free clusters on part of this unit. We read each SAT, and
; count the number of unused clusters.
SATRET: AOBJP P3,SATERR ;Get next retrieval pointer
MOVE S1,0(P3) ;Get it
LDB S2,PCLNUM ;Get # of clusters in this group
JUMPE S2,SATERR ;Better not be unit change pointer
LDB S2,PCLADR ;Get addrs of that group (SAT block)
STORE S2,0(P4),SPTCLA ;Aim the SPT ptr at the SAT
IMUL S2,.FSUBC(P1) ;Convert to block addrs
MOVE S1,.FSUNM(P1) ;Get this unit name
PUSHJ P,RDSAT ;Read in this SAT block
JUMPF .RETF ;Can't, too bad
MOVN S2,.FSUWS(P1) ;Get # words used in a SAT
HRLI S1,(S2) ;Make AOBJN ptr to bit map
HRRI S1,SAFFIR(S1) ;Point at first word
PUSHJ P,ZBITS ;Count the unused clusters
STORE S1,0(P4),SPTTAL ;Make SPT see this many
IMUL S1,.FSUBC(P1) ;Convert free clusters to free blocks
ADDM S1,.FSUTL(P1) ;Add that to total free on unit
AOBJN P4,SATRET ;Do all the SATs on this unit
MOVE S1,P3 ;Get updated AOBJN to SAT retr ptrs
$RETT ;Return that to caller
;Here if things look bad while decoding the SAT-RIB or SAT itself
SATERR: SKIPA S1,UNIT ;GET UNIT FROM STKVAR'ED LOC
SATBAD: MOVE S1,P2 ;GET UNIT FROM P2 (CHKEOF ENTRY POINT)
$WTO (<Volume ^W/.FSUID(P1)/>,<Logical unit ^O/S1/ of file structure ^W/TCB.DV(B)/
SAT-RIB or SAT on this pack has bad format>,,$WTFLG(WT.SJI))
$RETF
;Transfer table for moving things from HOM block to Unit Paramter Block
UNITAB:
XWD HOMHID,.FSUID ;Pack (unit, volume) ID
XWD HOMLUN,.FSULU ;Logical unit number in FS
XWD HOMGRP,.FSUGP ;# consecutive block to try on out
XWD HOMBPC,.FSUBC ;Blocks per cluster
XWD HOMSIC,.FSUSC ;# of SATs in core
XWD HOMSPU,.FSUSU ;# of SATs on this unit
XWD HOMSLB,.FSUSB ;1st block to swap on
XWD HOMK4S,.FSUKS ;#K for Swap
UNILEN==.-UNITAB
MUNIOF==.FSUKS ;Biggest offset used in unit param block
SUBTTL ADJTAL - Adjust free space totals
;This routine is used after most of the structure and unit
; parameter blocks have been set up. It calculates the total
; free blocks on the structure, and adjusts this total by
; the safety factor.
;Call -
; Str TCB in B, with UPB lists set up.
ADJTAL:
$SAVE <P1,P2,P3>
SETZ P1, ;Clear structure total
MOVE P2,TCB.NV(B) ;Get the number of units
MOVE S1,TCB.UL(B) ;Get the Unit parm blk list handle
$CALL L%FIRST ;Start at the first unit
ADJT.1: SKIPT ;Don't hit end of list!
STOPCD (ULS,HALT,,<Unit parameter list is short>)
MOVE P3,S2 ;Save UPB adr
MOVE S1,.FSUNM(P3) ;Get the unit name
PUSHJ P,GETSIZ ;Find out how many blocks on this unit
MOVE S2,.FSUKS(P3) ;Get # K for swap on this pack
LSH S2,3 ;Convert K (1024.) to Blocks (128.)
SUB S1,S2 ;Don't use swapping blocks for safety
IDIVI S1,UNVRSF ;Hide one out of every UNVRSF blocks
CAILE S1,^D500 ;But not more than 500
MOVEI S1,^D500 ;per pack
MOVNS S1 ;Get ready for subtract
ADDB S1,.FSUTL(P3) ;Remove the saftey blocks
ADD P1,S1 ;Accumulate total free on structure
SOJLE P2,ADJT.2 ;Get out after all units done
MOVE S1,TCB.UL(B) ;Get the Unit parm blk list handle
$CALL L%NEXT ;Get the next UPB
JRST ADJT.1 ;Account for this one's contribution
ADJT.2: MOVE S1,TCB.SP(B) ;Get pointer to STRUUO block
MOVE S1,.FSNST(S1) ;Get pointer to str parm block
MOVEM P1,.FSSTL(S1) ;Save total free on structure
$RETT
SUBTTL CHKHOM - Check HOMe block for structure paramters
;This routine makes sure that the anticipated pack is on
; the units suggested by MDA.
; If they're not, a message is given to the operator, and
; the caller gets FALSE
;Call -
; S1/ Addrs of HOM block for this unit
; S2/ Logical unit number
; B/ Structure TCB addrs
;Return -
; TRUE - Things look good in the HOM block
; FALSE - There are some inconsistencies (OPR notified)
CHKHOM: MOVE TF,S2 ;Copy logical unit number
ADDI TF,TCB.VL(B) ;Aim at the volume ID (HOM ID) list
MOVE TF,@TF ;Get the current HOM block name
;First, make sure the volume ID has not changed
CAMN TF,HOMHID(S1) ;Does it match?
JRST CHKH.1 ;Yes, keep going
$WTO (<Structure ^W/TCB.DV(B)/ cannot be mounted>,<^W/TCB.DV(B)/^O/S2/ HOM block ID is ^W/HOMHID(S1)/, should be ^W/TF/>,,$WTFLG(WT.SJI))
$RETF
;Next, check the logical unit number in the HOM block
CHKH.1: CAMN S2,HOMLUN(S1) ;Does HOM logical unit match ours?
JRST CHKH.2 ;Yes, keep going!
MOVE TF,S2 ;Get expected logical unit number
ADDI TF,TCB.DU(B) ;Aim at current unit name
MOVE TF,@TF ;Get the current unit name
$WTO (<Structure ^W/TCB.DV(B)/ cannot be mounted>,<Unit ^W/TF/ (^W/TCB.DV(B)/^O/S2/)
HOM block logical unit number is ^O/HOMLUN(S1)/>,,$WTFLG(WT.SJI))
$RETF
CHKH.2: $RETT
SUBTTL CHKEOF - Make sure RIB retrieval ptrs finished
;Call with (exhausted) AOBJN to SAT retrieval ptrs.
;Returns FALSE if ptr isn't aimed at EOF
;True otherwise
CHKEOF:
AOBJP S1,SATBAD ;Bypass redundant RIB pointer
AOBJP S1,SATBAD ;And get to termination word
SKIPE 0(S1) ;Are we at EOF?
JRST SATBAD ;No, bad format
$RETT ;Yes, say true!
SUBTTL LOGUNI - Make a logical unit name
;This routine takes the structure name in S1, and the
; logical unit number in S2. It returns the logical unit name in S1
; Taken from OMOUNT
LOGUNI:
TRNE S1,77 ;Make sure that the loop stops!
$RETT ;Let the monitor handle any problems
$SAVE <P1> ;Save a reg
MOVE P1,[POINT 6,S1] ;Get a pointer to the FS name
LOGU.1: ILDB TF,P1 ;Get next char of str name
JUMPN TF,LOGU.1 ;Valid char... try next
ADDI S2,'0' ;Convert log unit # to SIXBIT
DPB S2,P1 ;Change trailing space to unit #
$RETT
SUBTTL MOVALU - Data transfer routines
;MOVALU - Move values from places in one block to
; different places in another block
;Call with T1/source block addrs, T2/destination block addrs
; T3/AOBJN ptr to table of XWD srcoff,dstoff
;Preserves T1,T2, Clobbers T3
;Taken from OMOUNT
MOVALU: HLRZ S1,0(T3) ;Get offset for fetch
TRZE S1,400000 ;A byte to load?
JRST MOVAL1 ;Yes
ADDI S1,0(T1) ;Relocate from fetch addrs
HRRZ S2,0(T3) ;Get offset for store
ADDI S2,0(T2) ;Relocate to store
MOVE S1,0(S1) ;Get the data
MOVEM S1,0(S2) ;Store it
AOBJN T3,MOVALU ;Do all the data
$RETT
;Here to move a byte - address of byte pointer in S1, already
;indexed by T1.
MOVAL1: HRRZ S2,0(T3) ;Get offset for store
ADDI S2,0(T2) ;Relocate to store
LDB S1,0(S1) ;Get the data
MOVEM S1,0(S2) ;Store it
AOBJN T3,MOVALU ;Do all the data
$RETT
SUBTTL ZBITS - Count Number of 0 bits in a block of words
;CALL S1=AOBJ PTR TO WORDS WHOSE BITS TO COUNT
;RET+0 ALWAYS--S1=NO. OF 0 BITS
;Taken from OMOUNT
ZBITS: $SAVE <P1,P2>
MOVE S2,S1 ;Copy the AOBJN ptr
TDZA S1,S1 ;COUNT BITS IN S1
ZBITS1: AOBJP S2,.RETT ;BUMP WD PTR
SETCM P1,(S2) ;GET COMP. OF WORD
JUMPE P1,ZBITS1 ;SKIP WDS WITH ALL 1'S
ZBITS2: SETCA P1, ;COUNT LEADING 0'S
JFFO P1,ZBITS3
ADDI S1,^D36 ;MUST HAVE BEEN ALL 0'S
JRST ZBITS1
ZBITS3: SETCA P1,
ADDI S1,(P2) ;ADD COUNT TO S1
LSH P1,(P2) ;SHIFT OFF 1'S
JFFO P1,ZBITS4
JRST ZBITS1 ;FINISHED WITH THIS WORD
ZBITS4: LSH P1,(P2)
JRST ZBITS2
SUBTTL Get disk characteristics
; Here to get disk characteristics from the monitor
; Call: MOVE S1, sixbit unit or str name
; PUSHJ P,GETDCH
;
; TRUE return: S1:= DSKCHR AC, G$BLOK:= DSKCHR block
; FALSE return: You lose
;
CHKLN (BLOKLN,.DCMAX) ;Req'd length of the block
GETDCH: MOVEM S1,G$BLOK##+.DCNAM ;STORE ARGUMENT
MOVE S1,[.DCMAX,,G$BLOK##] ;SET UP UUO
DSKCHR S1, ;GET DISK CHARACTERISTICS
SKIPA ;CAN'T
$RETT ;RETURN
$WTO (<PULSAR error>,<DSKCHR UUO for ^W/G$BLOK+.DCNAM/ failed>,,$WTFLG(WT.SJI))
$RETF ;RETURN
SUBTTL GETSIZ - Find out size of a unit in 128 wd blocks
;This routine will ask the monitor how many blocks can be written
; on a particular unit.
;Call -
; S1/ SIXBIT unit name
;Return - T/F, Size in blocks in S1
GETSIZ: PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
$RETIF ;RETURN IF DSKCHR FAILED
MOVE S1,G$BLOK##+.DCUSZ ;GET SIZE
$RETT ;RETURN
SUBTTL D$MSTR - Co-routine to make structure definition blocks
;This routine will allocate the space required for the
; structure parameter blocks and the
; unit parameter block(s) for the .FSDEF (define structure)
; STRUUO.
;It is a co-routine, so that the caller may be careless
; about exit procedures: all the blocks will be returned
; when the caller returns.
;Call with the number of units, structure name, and
; drive name(s) in the TCB.
;Returns with the TCB pointing to the STRUUO arg block,
; the structure parameter block, and the
; list handle of the unit parameter blocks,
; and the list handle of the unit SAT list in the TCB
;Always returns TRUE
D$MSTR:
LOAD S1,TCB.NV(B) ;Get the number of units
ADDI S1,.FSNUN ;Get enuf for code, ptr to str blk
HRLZ T1,S1 ;Save length of block
$CALL M%GMEM ;Get the space for the pointer block
HRR T1,S2 ;Count the block
MOVEM T1,TCB.SP(B) ;Save STRUUO pointer
MOVX S1,.FSDEF ;Function code to define a structure
MOVEM S1,.FSFCN(T1) ;Identify this UUO block
;Make a structure parameter block
MOVX S1,MSTROF+1 ;Length of block - (biggest offset +1)
$CALL M%GMEM ;Get the space
HRLI S2,MSTROF+1 ;Count the block
MOVEM S2,.FSNST(T1) ;Aim the UUO pointer block at this block
;Make the lists for the UPBs and SPTs
$CALL L%CLST ;Make a list
MOVEM S1,TCB.UL(B) ;Save its handle (Unit param blk list)
$CALL L%CLST ;Make another list for SAT ptr tables
MOVEM S1,TCB.SL(B) ;Save that guy, too!
;Make the Unit parameter blocks
MOVN S1,TCB.NV(B) ;Get the number of units again
HRL T1,S1 ;Count for the AOBJN
ADDI T1,.FSNUN ;And aim at the first pointer slot
MSTR.1: MOVE S1,TCB.UL(B) ;Get the list handle again
MOVEI S2,MUNIOF+1 ;Size of the block
$CALL L%CENT ;Add this UPB to the list
HRLI S2,MUNIOF+1 ;Size of the block
MOVEM S2,0(T1) ;Aim the pointer block at this UPB
AOBJN T1,MSTR.1 ;Make as many as we need
POP P,S1 ;Get return addrs off stack
PUSHJ P,0(S1) ;Call the caller
;When caller returns.. fall thru
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;Here after caller (of D$MSTR) has 'returned'
PUSH P,TF ;Save T/F so we can return it on up
MOVE T1,TCB.SP(B) ;Get the ptr to the STRUUO block
HLRZ S1,.FSNST(T1) ;Get the length of the block
HRRZ S2,.FSNST(T1) ;Get the addr of that block
$CALL M%RMEM ;Give back the space
MOVE S1,TCB.UL(B) ;Get the list handle for the UPB list
$CALL L%DLST ;Give back all those blocks
MOVE S1,TCB.SL(B) ;Get the list handle for the SPT list
$CALL L%DLST ;Give any of those back, too
SETZM TCB.UL(B) ;No list handle
SETZM TCB.SL(B) ;None for SPTs, either
POP P,TF ;Get back the caller's T/F
$RET
SUBTTL D$RELE - Release and clean up after use of a disk
;This routine will return bufferspace and close the channel
;associated with a disk unit
D$RELE: PUSHJ P,I$PIRD## ;Remove device from PSI system
MOVEI S1,BLKLEN ;Size of the I/O block
HRRZ S2,TCB.HO(B) ;Aim at the home block
SKIPE S2 ;If none, don't bother
PUSHJ P,RELE.2 ;Give back the space
MOVEI S1,BLKLEN ;Size of the I/O block
HRRZ S2,TCB.SA(B) ;Aim at the SAT block
SKIPE S2 ;If none, don't bother
PUSHJ P,RELE.2 ;Give back the space
MOVEI S1,BLKLEN ;Size of the I/O block
HRRZ S2,TCB.RI(B) ;Aim at the RIB block
SKIPE S2 ;If none, don't bother
PUSHJ P,RELE.2 ;Give back the space
LOAD S1,TCB.IO(B),TI.OPN ;Is the drive open on a channel?
JUMPE S1,RELE.1 ;No, skipe the release
LOAD S1,TCB.FU(B),TF.DVH ;Get channel #
RESDV. S1, ;RELEASE, But don't write anything!
JFCL ;Oh well!
ZERO TCB.IO(B),TI.OPN ;No longer open!
RELE.1: SETZM TCB.FU(B) ;Clean out any junk
SETZM TCB.HO(B) ;Be neat
SETZM TCB.SA(B) ;Be neat
SETZM TCB.RI(B) ;Be neat
$RETT
;Here to de-fudge an IOWD, and give back some space
RELE.2: AOS S2 ;Undo the IOWD
$CALL M%RMEM ;Give it away
$RET
SUBTTL D$WLK - See if a disk unit is write enabled/locked
; This routine will tell whether a given disk unit is hardware write
; protected. Beleive it or not, there is at least one disk controller
; that won't tell the monitor the write locked/enabled status of the
; drive. If you guessed the RP20 controller, you're right! So we've
; dreamed up this kludge to program around the hardware's ignorance.
; We'll read and write back out one block on the unit we're checking.
; If the write fails (not due to hard disk errors, etc.) then it must
; be write locked. Block 3 has been chosen since it is an unused block
; on standard DECsystem-10 disks.
; Call: MOVE B, TCB address
; PUSHJ P,D$WLK
;
; On return, S1:= 1 if the drive is locked, 0 of it is enabled
;
; In the event of hard read/write errors, etc. we'll assume write enabled.
;
D$WLK: PUSHJ P,D$UPEN ;OPEN A CHANNEL
JUMPF WLK.1 ;CAN'T
MOVEI S1,3 ;BLOCK 3
MOVE S2,TCB.HO(B) ;USE HOM BLOCK BUFFER
PUSHJ P,D$GUNB ;READ THE BLOCK
JUMPF WLK.1 ;CAN'T
MOVE S1,TCB.SF(B) ;GET STR FLAGS
TXO S1,TS.HWC ;LITE HWP CHECKING BIT
TXZ S1,TS.HWP ;AND CLEAR UNIT WRITE PROTECTED BIT
MOVEM S1,TCB.SF(B) ;UPDATE FLAGS
MOVEI S1,3 ;BLOCK 3
MOVE S2,TCB.HO(B) ;USE THE HOM BLOCK BUFFER
PUSHJ P,D$WUNB ;TRY TO WRITE THE BLOCK BACK OUT
JUMPF WLK.1 ;CAN'T
WLK.1: MOVX S1,TS.HWC ;GET HWP CHECK FLAG
ANDCAM S1,TCB.SF(B) ;CLEAR IT IN THE STR FLAG WORD
MOVX S1,TS.HWP ;GET HWP BIT
TDNN S1,TCB.SF(B) ;IS STR HARDWARE WRITE PROTECTED?
TDZA S1,S1 ;WRITE-ENABLED
MOVEI S1,1 ;WRITE-LOCKED
POPJ P, ;RETURN
SUBTTL Process search list changes -- JSL entry
; This routine will handle all job search list changes for a user
; Call: MOVE M, message address
; PUSHJ P,D$SLCH
;
D$SLCH::$SAVE <P1,P2> ;SAVE P1 AND P2
MOVEI P1,UFDBLK ;GET .UFDOP ARGUMENT BLOCK ADDRESS
PUSHJ P,UFDJSL ;SET UP BLOCK FOR JSL CHANGE
JUMPF SLCH.F ;CAN'T
MOVEI S1,(P1) ;POINT TO THE BLOCK
SETZ P2, ;INDICATE ALL'S WELL SO FAR
PUSHJ P,.UFD## ;PERFORM UFD OPERATIONS
SLCH.F: SETO P2, ;FAILED SOMEWHERE
MOVEI S1,.CHNUL ;GET A NULL
PUSHJ P,G$TYPE## ;TERMINATE THE TEXT
MOVX S1,%ADSTR ;ASSUME ADD STR ACK CODE
LOAD S2,.UFFLG(P1),UF.FNC ;GET FUNCTION CODE
CAIN S2,.UFDMO ;DISMOUNTING?
MOVX S1,%RMSTR ;YES - GET A DIFFERENT ACK CODE
MOVE S2,.UFSTR(P1) ;GET STR NAME
JUMPN P2,SLCH.E ;ANY ERRORS?
PUSHJ P,O$ACKU## ;NO - ACK THE USER
$RETT ;RETURN
SLCH.E: PUSHJ P,O$NCKU## ;SEND NAK
$RETF ;RETURN
UFDBLK: BLOCK .UFSIZ ;ARGUMENT BLOCK FOR UFDSET
SUBTTL Process search list changes -- SSL entry
; These routines will handle all system search list changes
; Call: MOVE S1, structure name
; PUSHJ P,D$ASSL ;To add str to SSL
; PUSHJ P,D$RSSL ;To remove str from SSL
;
D$ASSL::SKIPA S2,[FL.ADD] ;GET ADD TO SSL FLAG
D$RSSL::MOVEI S2,FL.REM ;GET REMOVE FROM SSL FLAG
$SAVE <P1,P2,P3,P4> ;SAVE SOME ACS
MOVE P1,S1 ;COPY STR NAME
MOVEI P2,SL.SSL ;IT'S THE SYSTEM SEARCH LIST
MOVE P3,S2 ;GET ADD/REMOVE FLAG
PUSHJ P,CHKSSL ;ALREADY IN OR OUT OF SSL?
CAIN P3,FL.ADD ;ADDING?
JUMPT D$NOTS ;IT IS, DUMB OPR
CAIN P3,FL.REM ;REMOVING?
JUMPF D$NOTS ;ITS NOT, DUMB OPR
MOVE S1,P1 ;GET STR NAME
MOVE S2,P3 ;GET FLAG
PUSHJ P,UFDSSL ;SET UP UFDSET CALL FOR SSL CHANGE
MOVEI S1,UFDBLK ;POINT TO ARGUMENT BLOCK
PUSHJ P,.UFD## ;PERFORM SEARCH LIST CHANGES
JFCL ;IGNORE ERRORS
JUMPF .RETT ;CAN'T, MESSAGE PRINTED
PJRST D$DONE ;FINISH UP
SUBTTL Process search list changes -- Set up JSL argument block
UFDJSL: SETZM (P1) ;CLEAR THE FIRST WORD
MOVSI S1,(P1) ;GET STARTING ADDRESS
HRRI S1,1(P1) ;MAKE A BLT POINTER
BLT S1,.UFSIZ-1(P1) ;CLEAR THE ARGUMENT BLOCK
UFDJ.1: MOVE S2,.OFLAG(M) ;GET MESSAGE FLAG WORD
MOVX S1,INSVL.(.UFMNT,UF.FNC) ;ASSUME MOUNT FUNCTION
TXNE S2,ASL.RM ;REMOVE BIT ON?
MOVX S1,INSVL.(.UFDMO,UF.FNC) ;YES - GET DISMOUNT FUNCTION
TXNE S2,ASL.AR ;WANT ALWAYS RECOMPUTE DISK USAGE?
TXO S1,UF.ARD ;YES
TXNE S2,ASL.NR ;WANT NEVER RECOMPUTE DISK USAGE?
TXO S1,UF.NRD ;YES
TXNE S2,ASL.PS ;WANT PASSIVE SEARCH LIST?
TXO S1,UF.PSL ;YES
TXNE S2,ASL.SA ;WANT SINGLE ACCESS?
TXO S1,UF.SIN ;YES
TXNE S2,ASL.NQ ;NO QUOTA ENFORCEMENT?
TXO S1,UF.NOQ ;YES
MOVEM S1,.UFFLG(P1) ;SAVE FLAGS AND FUNCTION CODE
SETZ S1, ;CLEAR FILE STRUCTURE STATUS BITS
TXNE S2,ASL.WL ;WANT NOWRITE?
TXO S1,DF.SWL ;YES
TXNE S2,ASL.NC ;WANT NOCREATE?
TXO S1,DF.SNC ;YES
MOVEM S1,.UFSTS(P1) ;SAVE STATUS WORD
UFDJ.2: MOVEI S1,.BLDSN ;GET A BLOCK TYPE
PUSHJ P,O$FNDBL## ;FIND IT
$RETIF ;CAN'T
MOVE S2,.BLDNM(S1) ;GET STR NAME
MOVEM S2,.UFSTR(P1) ;SAVE IT
MOVE S2,.BLDOW(S1) ;GET PPN
MOVEM S2,.UFPPN(P1) ;SAVE IT
LOAD S1,.OFLAG(M),ASL.JB ;GET THE JOB NUMBER
MOVEM S1,.UFJOB(P1) ;SAVE IT
SETOM .UFPRO(P1) ;DEFAULT PROTECTION CODE
SETOM .UFDED(P1) ;DEFAULT DIRECTORY EXPIRATION DATE
SETOM .UFQTF(P1) ;DEFAULT FCFS QUOTA
SETOM .UFQTO(P1) ;DEFAULT LOGGED-OUT QUOTA
SETOM .UFQTR(P1) ;DEFAULT RESERVED QUOTA
MOVE S1,.UFSTR(P1) ;GET STR NAME
MOVE S2,UFDBLK+.UFPPN ;GET PPN
PUSHJ P,Q$QOTA## ;TRY TO READ QUOTAS
JUMPF UFDJ.4 ;NO QUOTAS IN AUXACC.SYS OR QUOTA.SYS
MOVEM S1,.UFQTR(P1) ;SAVE RESERVED QUOTA
MOVEM S2,.UFQTF(P1) ;SAVE FCFS QUOTA
MOVEM T1,.UFQTO(P1) ;SAVE LOGGED-OUT QUOTA
UFDJ.3: PUSHJ P,G$TXTI## ;INITIALIZE THE ACK/NAK TEXT BUFFER
MOVEI S1,UFDTYO ;GET TYPEOUT ROUTINE ADDRESS
MOVEM S1,.UFTYO(P1) ;SAVE IT
$RETT ;RETURN
;Here when the user had no quotas
UFDJ.4: MOVE S1,.UFPPN(P1) ;WHO ARE WE DOING THIS FOR
CAMN S1,G$FFAP## ;THE OPR?
JRST UFDJ.3 ;YES, LET IT PASS
MOVE S1,.UFSTR(P1) ;GET THE STRUCTURE NAME
PUSHJ P,GETDCH ;GET DSKCHR INFORMATION FOR STRUCTURE
$RETIF ;ERROR, DON'T ALLOW MOUNTING
TXNN S1,DC.PRV ;PRIVATE STRUCTURE?
JRST UFDJ.3 ;NO, LET THEM HAVE IT
MOVE S1,G$BLOK##+.DCOWN ;GET OWNER PPN
HLRE S2,S1 ;GET PROJECT, EXTEND SIGN
CAMN S2,[-1] ;WILD PROJECT?
HLL S1,.UFPPN(P1) ;YES, PLUG IN REQUESTOR'S PROJECT
HRRE S2,S1 ;GET PROGRAMMER, EXTEND SIGN
CAMN S2,[-1] ;WILD PROGRAMMER?
HRR S1,.UFPPN(P1) ;YES, PLUG IN REQUESTOR'S PROGRAMMER
CAMN S1,.UFPPN(P1) ;IS THIS GUY THE STRUCTURE OWNER?
JRST UFDJ.3 ;YES, ALLOW HIM TO MOUNT IT
PUSHJ P,G$TXTI## ;INITIALIZE ACK/NAK BUFFER
$TEXT (G$TYPE##,<[No quotas for ^W/.UFSTR(P1)/:^P/.UFPPN(P1)/]>)
$RETF ;PUNT THEM
SUBTTL Process search list changes -- Set up SSL argument block
UFDSSL: PUSH P,S1 ;SAVE STR NAME
MOVE S1,[UFDBLK,,UFDBLK+1] ;SET UP BLT
SETZM UFDBLK ;CLEAR FIRST WORD
BLT S1,UFDBLK+.UFSIZ-1 ;CLEAR UFDSET ARGUMENT BLOCK
MOVX S1,INSVL.(.UFASL,UF.FNC) ;ASSUME ADD TO SSL FUNCTION
CAIN S2,FL.REM ;REMOVE?
MOVX S1,INSVL.(.UFRSL,UF.FNC) ;YES - GET REMOVE FROM SSL FUNCTION
MOVEM S1,UFDBLK+.UFFLG ;SAVE IN FLAG/FUNCTION WORD
POP P,UFDBLK+.UFSTR ;SAVE STR NAME
PUSHJ P,G$TXTI## ;INITIALIZE THE ACK/NAK TEXT BUFFER
MOVEI S1,UFDTYO ;GET TYPEOUT ROUTINE ADDRESS
MOVEM S1,UFDBLK+.UFTYO ;SAVE IT
$RETT ;RETURN
SUBTTL Process search list changes -- Text routines
UFDTYO: PUSHJ P,UFDCHK ;CHECK FOR ERROR THE OPR SHOULD SEE
HRRZ S1,UFDBLK+.UFPFX ;GET THE PREFIX
CAIE S1,'MNT' ;IS THIS THE FINAL MOUNT MESSAEG
CAIN S1,'DMO' ;OR THE DISMOUNT MESSAGE?
POPJ P, ;IGNORE IT
CAIN S1,'RDU' ;RECOMPUTING MESSAGE?
POPJ P, ;IGNORE IT
UFDT.1: MOVE S1,UFDBLK+.UFTXT ;POINT TO TEXT BUFFER
HRLI S1,(POINT 7,) ;MAKE A BYTE POINTER
PUSH P,S1 ;SAVE IT
HLRZ S1,UFDBLK+.UFPFX ;GET SEVERITY CHARACTER
SKIPA ;SKIP FIRST TIME THROUGH
UFDT.2: ILDB S1,(P) ;GET A CHARACTER
JUMPE S1,UFDT.3 ;DONE?
PUSHJ P,G$TYPE## ;STORE IT AWAY
JRST UFDT.2 ;LOOP
UFDT.3: POP P,(P) ;PHASE STACK
MOVEI S1,"]" ;ASSUME AN INFORMATIONAL MESSAGE
HLRZ S2,UFDBLK+.UFPFX ;GET SEVERITY CHARACTER AGAIN
CAIN S2,"[" ;WAS IT?
PUSHJ P,G$TYPE## ;YES - TERMINATE MESSAGE PROPERLY
MOVEI S1,.CHCRT ;GET A <CR>
PUSHJ P,G$TYPE## ;TYPE IT
MOVEI S1,.CHLFD ;GET A <LF>
PJRST G$TYPE## ;TYPE IT AND RETURN
SUBTTL Process job search list changes -- Special error checking
; Check to see if the error returned might be of some interest to
; the operator. If so, WTO the message to him.
;
UFDCHK: SKIPN S1,UFDBLK+.UFERR ;GET THE ERROR CODE (IF ANY)
POPJ P, ;RETURN
MOVE S2,[-UFDELN,,UFDETB] ;SET UP AOBJN POINTER
CAME S1,(S2) ;A MATCH?
AOBJN S2,.-1 ;SEARCH THE TABLE
SKIPL S2 ;FOUND ONE?
POPJ P, ;NOPE
MOVEI S1,UFDTXJ ;ASSUME A JOB REQUEST
SKIPN UFDBLK+.UFJOB ;CHECK IT
MOVEI S1,UFDTXS ;SSL REQUEST
$WTO (<PULSAR error>,<^I/UFDTXT/>,,$WTFLG(WT.SJI))
POPJ P, ;RETURN
UFDTXJ: ITEXT (<job ^D/UFDBLK+.UFJOB/ ^P/UFDBLK+.UFPPN/>)
UFDTXS: ITEXT (<a system search list change>)
UFDTXT: ITEXT (<Fatal return from UFDSET %^V/[%%UFDS]/
Processing a request for ^I/(S1)/
Structure = ^W/UFDBLK+.UFSTR/
Flags = ^O12R0/UFDBLK+.UFFLG/, Function = ^O/UFDBLK+.UFFLG,UF.FNC/
Error code = ^O/UFDBLK+.UFERR/; ^T/@UFDBLK+.UFTXT/>)
; Table of UFDSET error codes that might interest the operator
;
UFDETB: EXP UFIDV%, UFISN%, UFIOE%, UFCAD%, UFLFU%, UFRFU%
EXP UFCRS%, UFIFC%, UFEFU%, UFCCS%, UFCSO%, UFCSS%
UFDELN==.-UFDETB
SUBTTL Read a search list
; Read a search list
; Call: MOVE S1, job number for job S/L or zero for system S/L
; PUSHJ P,D$RDSL
;
; TRUE return: S1:= S/L block address
; FALSE return: Error message sent to OPR
;
GETSL::
D$RDSL::MOVEI S2,.FSDSL ;GET FUNCTION CODE
MOVEM S2,G$OSL##+.FSFCN ;SAVE IT
MOVEM S1,G$OSL##+.FSDJN ;SAVE JOB NUMBER
SETZM G$OSL##+.FSDPP ;CLEAR PPN WORD
SETZM G$OSL##+.FSDFL ;CLEAR FLAG WORD
MOVEI S2,G$OSL##+.FSDSO ;POINT TO FIRST STR BLOCK
MOVEM S1,G$BLOK##+.DFGJN ;SAVE JOB NUMBER
SETZM G$BLOK##+.DFGPP ;NO PPN
SETOM G$BLOK##+.DFGNM ;START WITH THE FIRST STRUCTURE
RDSL.1: MOVE S1,[.DFGST+1,,G$BLOK##] ;SET UP UUO
GOBSTR S1, ;GET THE NEXT STRUCTURE IN S/L
JRST RDSL.E ;FAILED
MOVSI S1,G$BLOK##+.DFGNM ;POINT TO ARGUMENTS RETURNED
HRRI S1,(S2) ;BUILD BLT POINTER
BLT S1,.DFJBL-1(S2) ;COPY THEM
ADDI S2,.DFJBL ;POINT TO NEXT STR BLOCK
MOVE S1,G$BLOK##+.DFGNM ;GET LAST STR RETURNED
AOJN S1,RDSL.1 ;LOOP IF NOT END OF S/L
MOVEI S1,G$OSL## ;GET S/L BLOCK ADDRESS
POPJ P, ;RETURN
RDSL.E: MOVE S2,[XWD -GOBELN,GOBETB] ;POINT AT THE ERROR CODE MAPPING TABLE
PUSHJ P,D$MAPE ;CONVERT IT
$WTO (<Error reading search list for job ^D/G$BLOK+.DFGJN/>,<GOBSTR UUO failed. ^I/0(S2)/>,,$WTFLG(WT.SJI))
$RETF
SUBTTL D$UNLC - Unload a disk unit
;This routine will unload a given disk drive. Generally,
; it could be called at any time, but specifically, it
; is used only at the request of MDA.
;Call -
; B/ Disk TCB adrs
D$UNLC::
SETOM G$UNL## ;Set the 'unloading' flag for T$OFLN
LOAD S2,TCB.DV(B) ;Get the device name
MOVE S1,[XWD .DUUNL,S2] ;Aim at the argument block
DISK. S1, ;Unload the unit
SKIPA ;Can't,, see why
JRST [SETZM G$UNL## ;Done!, Clear the unloading flag
$RETT]
SETZM G$UNL## ;Clear our flag
CAXN S1,DUUNU% ;Lost because 'no can unload'?
$RETT ;Yes, keep moving
MOVE S2,[XWD -DUUNLN,DUUNTB] ;Aim at conversion table
PUSHJ P,D$MAPE ;Convert the error number
$WTO (<Can't unload>,<DISK. (.DUUNL) failed. ^I/0(S2)/>,TCB.OB(B),$WTFLG(WT.SJI))
$RETF ;Bye!
SUBTTL D$SREM - Remove a file structure from the system
;This routine is called in TCB context to remove
; a file structure from the monitor's tables
; If there is anything that should be called to the operator's attention,
; then the TCB will block, asking the operator for confirmation
;Call -
; B/ TCB addrs, TCB set up from MDA message (ie drive names, etc)
;Returns -
; A message to MDA indicating success/failure of the dismount
D$SREM::
PUSHJ P,REMCHK ;Check for safe structure removal
JUMPF SREM.4 ;Problems with that, quit
PUSHJ P,REMUNI ;Do any unit specific actions first
JUMPF SREM.4 ;Problems there, tell bad news
SREM.1: MOVEI S1,.FSREM ;Code to remove structure
MOVE S2,TCB.DV(B) ;Get the file structure name
MOVE TF,[XWD 2,S1] ;Aim at the argument block
STRUUO TF, ;Get rid of it
JRST SREM.2 ;Can't, see why
MOVX S1,%DSMNT ;Ack code - dismount
; MOVE S2,S2 ;Structure name
PUSHJ P,O$ACK## ;Tell MDA the good news
$RETT
;Here if we're having trouble dismounting the structure
SREM.2: CAXE TF,FSUNA% ;Lost because units not idle?
JRST SREM.3 ;No, complain a little
PUSHJ P,G$OJOB## ;See if anyone else would like to run
JRST SREM.1 ;And try again
;Here If we just can't get rid of it
SREM.3: MOVE S1,TF ;Copy the error code
MOVE S2,[XWD -STRELN,STRETB] ;Aim at the conversion table
PUSHJ P,D$MAPE ;Convert to error text
$WTO (<Structure ^W/TCB.DV(B)/ cannot be dismounted>,<STRUUO (.FSREM) failed. ^I/0(S2)/>,,$WTFLG(WT.SJI))
SREM.4: MOVX S1,%DSMNT ;Ack code - dismount
MOVE S2,TCB.DV(B) ;Structure name
PUSHJ P,O$NAK## ;Tell MDA the bad news!
$RETT
SUBTTL REMCHK - Check for safe structure removal
;This routine will check properties of a file structure about
; to be removed for properties which may cause problems on
; a dismount. The operator is asked for confirmation.
;The following properties are checked:
; 1) In system search list
; 2) Queueing structure
; 3) STRLST.SYS
; 4) In crash dump list
; 5) 0 Mount count
;Call -
; B/ Structure TCB addrs
;Returns -
; TRUE if FS is OK to go!
; FALSE if not (OPR said no, perhaps)
REMCHK: $SAVE <P1,P2,P3> ;Preserve some regs
PUSHJ P,G$TXTI## ;Initialize text buffer
MOVE S1,[BYTE (7) 15,15,15,15,12] ;Magic to make
MOVEM S1,G$TXTB## ;The WTO/WTOR buffer
AOS G$TXTP## ;Look pretty
MOVE P1,[XWD -CHKFLN,CHKFTB] ;Aim at the table
SETZ P2, ;No flags yet
LOAD S1,TCB.SF(B),TS.NCK ;OPR said /NOCHECK?
SKIPE S1 ;Did s/he?
MOVX P2,CHKF.N ;Yes, note it
CHKFL: MOVE S1,TCB.DV(B) ;Get the file structure name
HLRZ S2,0(P1) ;Get next check routine pointer
MOVE S2,0(S2) ;Get flags,, routine adrs
TDNE S2,P2 ;OPR want /NOCHECK and this attribute
JRST CHKF.2 ; would touch str? Yes, skip attr check
PUSHJ P,0(S2) ;Check the next parameter
JUMPF CHKF.2 ;No problem, keep going
CHKF.1: HRRZ S2,(P1) ;Get ITEXT pointer
$TEXT (G$TYPE##,<^I/(S2)/>) ;Store some text
CHKF.2: AOBJN P1,CHKFL ;Do each parameter
MOVN P1,TCB.NV(B) ;Get negative number of units
MOVSS P1 ;To LH
HRRI P1,TCB.DU(B) ;Aim at the unit list
CHKF.3: MOVE P3,[XWD -CHKULN,CHKUTB] ;Set up AOBJN pointer to unit checks
CHKF.4: MOVE S1,(P1) ;Get a unit name
HLRZ S2,0(P3) ;Get next check routine pointer
MOVE S2,0(S2) ;Get flags,, routine adrs
TDNE S2,P2 ;OPR want /NOCHECK and this attribute
JRST CHKF.5 ; would touch str? Yes, skip attr check
PUSHJ P,0(S2) ;Check the next parameter
JUMPF CHKF.5 ;No problem, keep going
HRRZ S2,(P3) ;Get ITEXT address
$TEXT (G$TYPE##,<^W/(P1)/ ^I/(S2)/>) ;Store some text
CHKF.5: AOBJN P3,CHKF.4 ;Loop for each check
CHKF.6: AOBJN P1,CHKF.3 ;Loop for each unit
SKIPN G$TXTB##+1 ;We put anything in the buffer ?
$RETT ;No - return quietly
MOVX S1,TS.NCK ;Get the /NOCHECK bit
TDNE S1,TCB.SF(B) ;Operator request it ?
JRST CHKF.7 ;Yes
MOVEI S1,[ITEXT (<^T/G$TXTB/>)] ;Point to the text buffer
MOVEI S2,[ITEXT (<Type 'RESPOND ^I/number/ ABORT' to not dismount structure ^W/TCB.DV(B)/
Type 'RESPOND ^I/number/ PROCEED' to remove structure ^W/TCB.DV(B)/ anyway>)]
PUSHJ P,O$SERT## ;See if OK to procceed
$RET ;Return T/F to caller
CHKF.7: $WTO (<Removing structure ^W/TCB.DV(B)/ may cause problems>,<^T/G$TXTB/^M^JProceeding...>,TCB.OB(B),$WTFLG(WT.SJI))
$RETT ;Keep on going
; A table of check routine addresses and their corresponding error messages
; Each routine will be called with the structure name in S1
DEFINE X(ROUT,TEXT,FLAG),<XWD [FLAG+ROUT],[ITEXT(TEXT)]>
CHKF.N==1B0 ;Flag for attributes which would touch str
CHKFTB: X CHKSSL,<In system search list>
X CHKQUE,<Contains queues>
X CHKCAT,<Contains a system catalog (STRLST.SYS)>,CHKF.N
X CHKCDL,<In crash dump list>
X CHKKLF,<Contains a KL10 front-end file system>,CHKF.N
X CHKKSF,<Contains a KS10 front-end file system>,CHKF.N
X CHKMNC,<Mount count = ^D/S1/>
X CHKNRQ,<Number of queue requests = ^D/S1/>
CHKFLN==.-CHKFTB ;Table length
;A table of unit check routine addrs and the corresponding error messages.
; Each routine will be called with SIXBIT unit name in S1.
CHKUTB: X INASL ,<is in active swapping list>
CHKULN==.-CHKUTB ;Length of table
SUBTTL REMUNI - Remove all units from the active swapping list
;This routine will remove ALL units in a structure from the
; active swapping list. It does so regardless of whether those
; units are in the list or not. The caller should have
; checked for and dealt with this possiblity.
;Call -
; B/ Structure TCB addrs
;Returns -
; TRUE - All units removed
; FALSE - something went wrong
REMUNI:
$SAVE <P1>
MOVX S1,TS.NCK ;Get OPR /NOCHECK bit
TDNE S1,TCB.SF(B) ;OPR doesn't want to touch disk?
$RETT ;Yes, assume all units out!
MOVN P1,TCB.NV(B) ;Get neg # of units in str
MOVSS P1 ;To LH
HRRI P1,TCB.DU(B) ;Aim at the list of unit names
REMU.1: MOVE S1,0(P1) ;Get next unit name
PUSHJ P,REMSWP ;Move the swap space off!
JUMPF REMU.E ;Can't, go complain
AOBJN P1,REMU.1 ;Do 'em all
$RETT
;Here if we can't move swap away from some unit
REMU.E: MOVE S2,[XWD -ERRSLN,ERRSWP] ;Aim at the conversion table
PUSHJ P,D$MAPE ;Map into text
$WTO (<Can't remove unit ^W/0(P1)/ from active swapping list>,<DISK. UUO (.DUSWP) ^I/0(S2)/>,,$WTFLG(WT.SJI))
$RETF
SUBTTL INASL - See if a unit is in the active swapping list
;This routine will tell if a given unit is in the active swapping list
;Call -
; S1/ SIXBIT unit name
;Returns -
; TRUE -
; S1/ Position of the unit in the active swap list
; FALSE - it's not in the ASL
;
D$PASL::
INASL: PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
$RETIF ;RETURN IF DSKCHR FAILED
LOAD S2,S1,DC.TYP ;GET UNIT TYPE
CAIE S2,.DCTPU ;PHYSICAL UNIT?
$RETF ;NOPE
SKIPGE S1,G$BLOK##+.DCPAS ;GET POSITION IN THE ASL
$RETF ;NOT IN THE ASL
$RETT ;IN THE ASL
SUBTTL CHKKLF - See if unit is SY0: to RSX20F
;This routine will ask the monitor if a unit is in use
; as the system pack by RSX20F, the KL10 front end.
;Call -
; S1/ SIXBIT unit name
;Returns -
; TRUE - In use by -20F
; FALSE - Not in use as system pack by KL10 FE
CHKKLF: SETZM G$BLOK##+.DCXSF ;JUST IN CASE OLD MONITOR
MOVEI S2,%KL10 ;GET A PROCESSOR TYPE
CAME S2,G$CPU## ;SAME AS THE ONE WE'RE RUNNING ON?
$RETF ;NO
PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
$RETIF ;CAN'T - ASSUME NO FE
LOAD S1,G$BLOK##+.DCXSF,DC.FES ;GET FRONT-END STATUS FOR THIS UNIT
JUMPN S1,CHKKL1 ;IF STATUS IS KNOWN, USE THAT INSTEAD
SKIPE G$BLOK##+.DCALT ;DUAL PORTED DISK?
$RETF ;YES - THAN THE FE CAN'T HAVE A PORT
MOVE S1,G$BLOK##+.DCNAM ;GET STR NAME BACK
MOVSI S2,'FE ' ;KL10 FRONT-END FILE SYSTEM FILE NAME
PUSHJ P,OPNSYS ;TRY TO READ THAT FILE
$RET ;If that wins say true (catalog exists)
;If it loses, there's no catalog!
;Don't do PJRST here, or we'll carry
; the buffers around for a while
CHKKL1: LOAD S1,S1,DC.FES ;GET FE STATUS FLAGS
CAXN S1,.DCFEN ;DEFINITELY NOT AN FE PACK?
$RETF ;ROGER, NO SWEAT HERE
CAXE S1,.DCFEB ;THE UNIT -20F WAS BOOTED FROM?
$RETF ;NO, GUESS THIS IS OK, ALTHO WE MIGHT
; WANT A WARNING IN THIS CASE
$RETT ;PROBABLY SHOULDN'T PLAY WITH THIS
SUBTTL CHKKSF - See if unit is part of a KS10 front-end file system
;This routine will ask the monitor if a unit is in use
; as the system pack by the KS10 front-end file system.
;Call -
; S1/ SIXBIT unit name
;Returns -
; TRUE - In use by KS10 front-end
; FALSE - Not in use as system pack by KS10 FE
;
CHKKSF: SETZM G$BLOK##+.DCXSF ;JUST IN CASE OLD MONITOR
MOVEI S2,%KS10 ;GET A PROCESSOR TYPE
CAME S2,G$CPU## ;SAME AS THE ONE WE'RE RUNNING ON?
$RETF ;NO
PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
$RETIF ;CAN'T - ASSUME NO FE
LOAD S1,G$BLOK##+.DCXSF,DC.FES ;GET FRONT-END STATUS FOR THIS UNIT
JUMPN S1,CHKKS1 ;IF STATUS IS KNOWN, USE THAT INSTEAD
$SAVE <P1,P2> ;Save some ACs
MOVEI P1,G$BLOK ;Put the FOB here
MOVEI P2,G$BLOK+FOB.MZ ;Put the FD here
MOVEM S1,.FDSTR(P2) ;Store the structure name
MOVEI S1,^D36 ;Byte size - full word
MOVEM S1,FOB.CW(P1) ;Save in FOB
MOVEI S1,FOB.MZ(P1) ;Aim at the FD space
MOVEM S1,FOB.FD(P1) ;Point the FOB at the FD
MOVE S1,[FDMSIZ,,0] ;Get length of this FD
MOVEM S1,.FDLEN(P2) ;Count this FD
MOVE S1,['KS10FE'] ;File name
MOVEM S1,.FDNAM(P2) ;Store it
MOVX S1,'BIN ' ;Extension
MOVEM S1,.FDEXT(P2) ;Store it
MOVE S1,[6,,2020] ;Get the funny UFD
MOVEM S1,.FDPPN(P2) ;Save that...
MOVEI S1,FOB.MZ ;Length of the FOB
MOVE S2,P1 ;Point to FOB
$CALL F%IOPN ;Open it up
$RETIF ;Return if can't find file
$CALL F%REL ;Give back the file handle
$RETT ;Return
CHKKS1: LOAD S1,S1,DC.FES ;GET FE STATUS FLAGS
CAXN S1,.DCFEN ;DEFINITELY NOT AN FE PACK?
$RETF ;ROGER, NO SWEAT HERE
CAXE S1,.DCFEB ;THE UNIT SYSTEM WAS BOOTED FROM?
$RETF ;NO
$RETT ;PROBABLY SHOULDN'T PLAY WITH THIS
SUBTTL CHKCAT - See if a structure is has a catalog
;This routine will look for the exsitence of a system catalog
; on a structure about to be removed.
; Today, since the definition of a system catalog is fuzzy,
; it just checks for STR:STRLST.SYS[1,4], as the catalog
;Call -
; S1/ Structure name
;Returns -
; TRUE - there is a catalog
; FALSE - there is no catalog
CHKCAT:
$SAVE <P1>
MOVE P1,S1 ;Save the structure name
PUSHJ P,CHKSSL ;Is the str in the system search list?
JUMPF .POPJ ;No, any catalog would be useless
MOVE S1,P1 ;Yes, get back structure name
MOVE S2,[SIXBIT/STRLST/] ;Catalog name is STRLST
PUSHJ P,OPNSYS ;Try to read that file
$RET ;If that wins say true (catalog exists)
;If it loses, there's no catalog!
;Don't do PJRST here, or we'll carry
; the buffers around for a while
SUBTTL OPNSYS - Coroutine to Open/Close a system file
;This routine will set things up to read the quota file from a particular
; structure. It is a coroutine, so the caller can be sloppy about
; exit procedures.
;Call -
; S1/ SIXBIT structure name
; S2/ SIXBIT file name
; (Extension is .SYS, UFD is [1,4])
;Returns - T/F
; TRUE - IFN for reading file in S1
OPNSYS:
PUSH P,S1 ;Save str name
PUSH P,S2 ;Save file name
MOVEI S1,FDMSIZ+FOB.MZ ;Space for an FD and a FOB
$CALL M%GMEM ;Get that room
MOVEI S1,^D36 ;Byte size - full word
STORE S1,FOB.CW(S2),FB.BSZ ;Save in FOB
MOVEI S1,FOB.MZ(S2) ;Aim at the FD space
STORE S1,FOB.FD(S2) ;Point the FOB at the FD
POP P,.FDNAM(S1) ;Put in the file name
POP P,.FDSTR(S1) ;Put in the file structure name
EXCH S2,0(P) ;Get Caller's addr, save FOB, FD
PUSH P,S2 ;Save return adr again
MOVE S2,S1 ;Aim at the FD
MOVEI S1,FDMSIZ ;Get length of this FD
STORE S1,.FDLEN(S2),FD.LEN ;Count this FD
MOVX S1,<SIXBIT/SYS/> ;Get extension
MOVEM S1,.FDEXT(S2) ;And save that
MOVE S1,G$SYSP## ;Get system UFD
MOVEM S1,.FDPPN(S2) ;Save that...
MOVEI S1,FOB.MZ ;Length of the FOB
MOVE S2,-1(P) ;Get addr, but leave it on stack
$CALL F%IOPN ;Open it up
JUMPF OPNS.E ;Can't, go clean up
POP P,S2 ;Get callers adrs
PUSH P,S1 ;Save the IFN
PUSHJ P,0(S2) ;Call the caller (with TRUE in TF)
EXCH S1,0(P) ;Save Return S1, Get back IFN
PUSH P,TF ;Save TF
PUSH P,S2 ;And S2
$CALL F%REL ;Give back the file handle
MOVEI S1,FOB.MZ+FDMSIZ ;Size of the space
MOVE S2,-3(P) ;Addr of space obtained
$CALL M%RMEM ;Give it back
POP P,S2 ;Get back S2
POP P,TF ;And T/F
POP P,S1 ;And S1
POP P,0(P) ;Throw away the old space adrs
$RET ;Return
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;Here if we can't open the file. 2 elements on stack:
; 0(P)/ caller's addrs
; -1(P) Addr of FOB, FD space
OPNS.E:
POP P,S2 ;Get back caller's addr
EXCH S2,0(P) ;Save it, get addr of FOB, FD
MOVEI S1,FOB.MZ+FDMSIZ ;Get size of space obtained
$CALL M%RMEM ;Give back the space
$RETF
SUBTTL CHKMNC - Check for other users of a file structure
;This routine is used to make sure there are no users of a
; file structure about to be removed from the system.
;Call -
; S1/ Structure name
;Returns -
; S1:= mount count and
; TRUE - There are other users of the structure
; FALSE - No other users (mount count is 0)
;
CHKMNC: PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
SKIPF ;CAN'T - ASSUME NO OTHER USERS
SKIPN S1,G$BLOK##+.DCSMT ;ARE THERE OTHER USERS?
$RETF ;NO
$RETT ;YES
SUBTTL CHKNRQ - See if queue requests require this structure
; This routine will complain to the operator if the number of queue requests
; (supplied to us by QUASAR) is non-zero. It indicates the how many requests
; will be needing the structure that the operator is trying to remove.
; Call: MOVE S1, structure name
;
; Returns:
; S1:= number of requests and
; TRUE - There is at least one request
; FALSE - There are no requests
;
CHKNRQ: LOAD S1,TCB.SF(B),TS.NRQ ;GET NUMBER OF REQUESTS
SKIPE S1 ;NON-ZERO?
$RETT ;YES - COMPLAIN
$RETF ;RETURN
SUBTTL CHKQUE - See if file structure is Queue structure
;This routine checks to see if a file structure about to be
; removed contains queues
;Call -
; S1/ Structure name
;Returns -
; TRUE - There are queues on that structure
; FALSE - No queues on str
CHKQUE: MOVX S2,%LDQUS ;Ask each time we need it
GETTAB S2, ; Since it might be changed by QUASAR
$RETT ;Error, be safe and assume its QUESTR
CAME S1,S2 ;Is this the queueing str?
$RETF ;No, say so
$RETT ;Yes, say that instead
SUBTTL CHKCDL - See if a structure is in the crash dump list
;This routine will tell whether a file structure is in the
; crash dump list.
;Call -
; S1/ Structure name in SIXBIT
;Returns -
; TRUE -
; S1/ Position of this str in the crash dump list
; FALSE - Str in not in CDL
;
D$PCDL::
CHKCDL: PUSHJ P,GETDCH ;GET DISK CHARACTERISTICS
$RETIF ;CAN'T - ASSUME NOT IN CRASH DUMP LIST
LOAD S2,S1,DC.TYP ;Get the argument type
CAXE S2,.DCTFS ;Was it a file str name?
$RETF ;No, .DCPSD won't be valid
SKIPGE S1,G$BLOK##+.DCPSD ;Yes, is this str in the SDL
$RETF ; .LT. 0, Not in SDL
$RETT ;Yes, Give back the position number
SUBTTL CHKSSL - See if a structure is in the system search list
;This routine tells whether a file structure about to be removed is
; in the system search list.
;Call -
; S1/ Structure name
;Returns -
; TRUE - Structure is in SSL
; FALSE - Str is not in SSL
CHKLN (BLOKLN,<.DFGST+1>) ;Req'd length of the block
CHKSSL:
SETZM G$BLOK##+.DFGJN ;0 job number -- look at SSL
SETZM G$BLOK##+.DFGPP ;And no PPN, either
MOVEM S1,G$BLOK##+.DFGNM ;Put structure name in GOBSTR block
MOVSI S1,.DFGST+1 ;Length of the block
HRRI S1,G$BLOK## ;Addr of block
GOBSTR S1, ;Lookup str in SSL
CAXE S1,DFGIF% ;Lost because bad str name?
$RETT ;In there! tell caller
$RETF ;Not there, tell caller
SUBTTL D$DILS - Do a short FILOP on a TCB
;Call -
; S1/ Function code
;Returns -
; True- function wins
; False - function lost
D$FILS: STORE S1,TCB.FU(B),RHMASK ;Save desired function
MOVE S2,S1 ;Save it here also
HRRI S1,TCB.FB(B) ;Aim at the FILOP block in the TCB
HRLI S1,FLPLEN ;And setup the (short) length
CAIE S2,.FOINP ;Are we doing I/O?
CAIN S2,.FOOUT ; . . .
HRLI S1,2 ;Yes, shoren the arg block to lenght
FILOP. S1, ;Do the desired function
SKIPA ;Can't - investigate
$RETT ;Wins, tell the caller
MOVEI TF,PS.RDO!PS.RDH ;Device off-line or hung?
TDZN TF,TCB.PI(B) ;Is that what happened?
$RETF ;Must be a real I/O error
MOVEI TF,PS.RDH ;Get hung device bit
TDNE TF,TCB.PI(B) ;Was it a hung device?
JRST DSKHNG ;Complain about hung device
MOVX TF,TS.HWP ;Get HWP bit
TDNE TF,TCB.SF(B) ;Unit set to HWP at interrupt level?
$RETF ;Yes
MOVX S1,TS.NTP ;Get no disk present bit
IORM S1,TCB.ST(B) ;Set it so we know the disk isn't there
PUSHJ P,O$STAT## ;Tell the operator
JRST DSKKIL ;Kill off the TCB
DSKHNG: $WTO (<Hung device>,,TCB.OB(B),$WTFLG(WT.SJI))
DSKKIL: PUSHJ P,D$RELE ;Clean up
MOVX S1,TS.KIL ;Get kill bit
IORM S1,TCB.ST(B) ;Lite so we flush this TCB
PUSHJ P,G$NJOB## ;Go away
STOPCD (RKD,HALT,,<Running a killed disk TDB>)
SUBTTL REMSUN - REMOVE A UNIT FROM THE ACTIVE SWAPPING LIST
;This routine will remove a specified unit from the active
; swapping list, and inform the operator that it was done
;Call -
; S1/ SIXBIT unit name
; M Incoming message adrs (with ack code)
;Returns -
; TRUE
D$RSUN::
$SAVE <P1,P2,P3,P4> ;Some work space
MOVE P1,S1 ;Protect the unit name
DMOVE P2,[EXP SL.ASL,FL.REM] ;List is ASL, Removing
PUSHJ P,INASL ;Is unit in the list now?
JUMPF D$NOTS ;Not in there, complain
MOVE S1,P1 ;Get back unit name
PUSHJ P,REMSWP ;Get it out
SKIPF ;Can't, see why
PJRST D$DONE ;Ack the OPR
MOVE S2,[XWD -ERRSLN,ERRSWP] ;Aim at the table
PJRST D$ERRP ;Try to say what happened
SUBTTL REMSWP - GET A UNIT OUT OF THE ASL
;Call -
; S1/ SIXBIT unit name
;Returns -
; TRUE - swap space moved
; FALSE - DISK. error code in S1
REMSWP: MOVE S2,S1 ;Move the input arg over
MOVE S1,[XWD .DUSWP,S2] ;Aim at the arguments
DISK. S1, ;Move it off
$RETF ;Cant
$RETT ;Done
SUBTTL D$ASUN - Add a unit to active swap list and tell OPR
;Call -
; S1/ SIXBIT unit name
;Returns -
; TRUE, ALWAYS
D$ASUN::
$SAVE <P1,P2,P3,P4> ;Some space
MOVE P1,S1 ;Preserve the input
DMOVE P2,[EXP SL.ASL,FL.ADD] ;List is ASL, Adding
PUSHJ P,INASL ;See if its in already
JUMPT D$NOTS ;It is, Dumb OPR
MOVE S1,P1 ;Get back the input arg
PUSHJ P,ADDSWP ;Add it to the ASL
SKIPF ;Can't, see why
PJRST D$DONE ;Finish up
MOVE S2,[XWD -ERASLN,ERASWP] ;Aim at the table
PJRST D$ERRP ;Try to say what happened
SUBTTL ADDSWP - Add one unit to the active swap list
;This routine takes a unit name in S1 and tries to add that unit
; to the active swap list.
;If it can, then it returns TRUE.
;If it can't, it returns FALSE, with the DISK. UUO error code in S1
ADDSWP:
MOVE S2,S1 ;Move the input arg
MOVE S1,[XWD .DUASW,S2] ;Add unit in S1 to active swap
DISK. S1, ;Put it in
$RETF ;Cant
$RETT ;Wins
SUBTTL D$ACDL - ADD A STR TO THE CRASH DUMP LIST
;CALL -
; S1/ SIXBIT STR NAME
;RETURNS -
; ACK TO THE OPR WHO DID IT
D$ACDL::
$SAVE <P1,P2,P3,P4>
MOVE P1,S1 ;Save the str name
DMOVE P2,[EXP SL.CDL,FL.ADD] ;List is CDL, Removing
PUSHJ P,CHKCDL ;Is it in already?
JUMPT D$NOTS ;Yes, complain
MOVE S1,[XWD .DUASD,P1] ;Aim at the argument
DISK. S1, ;Add it
SKIPA ;Can't, see why
PJRST D$DONE ;Finish up
MOVE S2,[XWD -ERACLN,ERACDL] ;Aim at the error table
PJRST D$ERRP ;Tell what happened
SUBTTL D$RCDL - REMOVE A STR FROM THE CRASH DUMP LIST
;CALL -
; S1/ SIXBIT STR NAME
;RETURNS -
; ACK TO THE OPR WHO DID IT
D$RCDL::
$SAVE <P1,P2,P3,P4>
MOVE P1,S1 ;Save the str name
DMOVE P2,[EXP SL.CDL,FL.REM] ;List is CDL, removing
PUSHJ P,CHKCDL ;Is it in now?
JUMPF D$NOTS ;No, dumb OPR
MOVE S1,[XWD .DURSD,P1] ;Aim at the argument
DISK. S1, ;Take it out
SKIPA ;Can't, see why
PJRST D$DONE ;Finish up
MOVE S2,[XWD -ERRCLN,ERRCDL] ;Aim at the table
PJRST D$ERRP ;Say what happened
SUBTTL EXIT routines for the system list manipulators
;these routines assume many accumulators setup:
; S2/ Addr of error ITEXT
; P1/ SIXBIT structure or unit name
; P2/ List handle, SL.xxx
; P3/ 0 for Adding, 1 for Removing
; P4/ Addr of ITEXT for message
; M/ Adrs of incoming message
;Here if there is an error
; S1/ UUO error code
; S2/ -length of translation table,,addr of table
; table has form: XWD code,[ASCIZ/explanation/]
D$ERRP:
PUSHJ P,D$MAPE ;Get the descriptive ITEXT
MOVEI P4,[ITEXT(<Could not be ^T/@ADRMTB(P3)/>)] ;Aim at the problem
PJRST D$ACK ;Go type that
;Here if the str/uni is already in during an add, or not in
; during a remove
D$NOTS: MOVEI P4,[ITEXT(<Is ^T/@NOTTAB(P3)/ in>)]
JRST D$NOER ;And don't add an error text
D$DONE: MOVEI P4,[ITEXT(<^T/@ADRMTB(P3)/>)] ;Say that it's done
D$NOER: MOVEI S2,[ITEXT(<>)] ;No error suffix text
D$ACK: MOVEM P1,OBJBLK+OBJ.UN ;Save object unit name
$ACK (<^I/0(P4)/ ^T/@LSTAB-SL.TMN(P2)/>,<^I/0(S2)/>,OBJBLK,.MSCOD(M))
$RETT
LSTAB: [ASCIZ/System Search List/]
[ASCIZ/Crash Dump List/]
[ASCIZ/Active Swapping List/]
NOTTAB: [ASCIZ/already/]
[ASCIZ/not/]
ADRMTB: FL.ADD==.-ADRMTB ;Offset for adding things
[ASCIZ/Added to/]
FL.REM==.-ADRMTB ;Offset for removing things
[ASCIZ/Removed from/]
OBJBLK: $BUILD (OBJ.SZ) ;An object block
$SET (OBJ.TY,,.OTMNT) ;A mount object
; $SET (OBJ.UN,,0) ;Filled in at runtime
$SET (OBJ.ND,,0) ;No node
$EOB
SUBTTL D$MAPE - Map an error code
;This routine will map the error code for any UUO failure into
; an ITEXT describing the error.
;Call -
; S1/ UUO error code
; S2/ -Length,,adrs of error table
; Table has the form:
; error code,,[ASCIZ/explanation/]
;Returns -
; ITEXT in S2 describing the error
; NB, this ITEXT may use S1 to hold values, etc!!
; Thus, the ITEXT must be used as is, and not DMOVEd to
; the Ps, or such.
D$MAPE: JUMPGE S2,ERRP.2 ;Quit if we have no explaination
MAPE.1: HLRE TF,0(S2) ;Get this entry's error code
CAME TF,S1 ;Is this the one?
AOBJN S2,MAPE.1 ;No, try the next
JUMPL S2,ERRP.2 ;Go if we found a match
MOVEI S2,[ITEXT(<Reason: (Unknown) error code ^O/S1/>)]
$RETT ;All set
;Here if there is a match
ERRP.2: HRRZ S1,0(S2) ;Pick up the explanation
MOVEI S2,[ITEXT(<Reason: ^T/0(S1)/>)] ;Point to the error
$RETT ;Got it
SUBTTL Error code mapping tables
;These tables all map specific UUO or specific UUO function error
; codes into meaningful text. They are set up for use by D$MAPErr
;Table for mapping errors on DISK. .DUSWP function (remove unit from ASL)
ERRSWP: XWD DUOIP%,[ASCIZ!Channel or controller off-line in progress!]
XWD DUOSK%,[ASCIZ!No such controller!]
XWD DUOSS%,[ASCIZ!Not enough swapping space if this pack removed!]
XWD DUOIS%,[ASCIZ!Unit in a file structure cannot be put off-line!]
XWD DUOES%,[ASCIZ!Not enough space for IOWDs!]
XWD DUOPI%,[ASCIZ!Unit contains IPCF pages!]
ERRSLN==.-ERRSWP ;Length of remove from swap error table
;Table for mapping errors from DISK. .DUASW (Add a swapping unit)
ERASWP: XWD DUANU%,[ASCIZ!No such unit!]
XWD DUAAI%,[ASCIZ!Unit already in Active Swapping List!]
XWD DUASF%,[ASCIZ!Monitor swap table is full!]
XWD DUAN4%,[ASCIZ!Blocks/cylinder not mulitple of 4!]
XWD DUANS%,[ASCIZ!No swapping space (file SWAP.SYS) on pack!]
ERASLN==.-ERASWP ;Table length
;Table for mapping errors from DISK. .DUACD (Add a crash structure)
ERACDL: XWD DUDND%,[ASCIZ!No such structure!]
XWD DUDNC%,[ASCIZ!No crash space on structure!]
XWD DUDAD%,[ASCIZ!Structure already in the crash dump list!]
XWD DUDDF%,[ASCIZ!Crash dump list is full!]
ERACLN==.-ERACDL ;Table length
;Table for errors from DISK. .DURCD (remove from crash dump list)
ERRCDL: XWD DUDNS%,[ASCIZ!Structure not in Crash Dump List!]
ERRCLN==.-ERRCDL ;Table length
;Table for errors from DISK. .DUUNL (Unload a disk unit)
DUUNTB: XWD DUUIU%,[ASCIZ!Illegal Unit name!]
XWD DUUNI%,[ASCIZ!File structure not idle!]
XWD DUUNU%,[ASCIZ!Device cannot be unloaded!]
DUUNLN==.-DUUNTB ;Table length
;Table for errors from the GOBSTR UUO
GOBETB: XWD DFGIF%,[ASCIZ!Illegal file structure name!]
XWD DFGPP%,[ASCIZ!Job number and PPN do not match!]
XWD DFGNP%,[ASCIZ!Insufficient privileges!]
XWD DFGLN%,[ASCIZ!Incorrect argument block length!]
GOBELN==.-GOBETB ;Table length
;Table for errors from the STRUUO
STRETB: XWD FSILF%,[ASCIZ!Illegal function code!]
XWD FSSNF%,[ASCIZ!One or more of the file structures not found!]
XWD FSSSA%,[ASCIZ!One or more of the file structures in single access!]
XWD FSILE%,[ASCIZ!Illegal entries in the argument block!]
XWD FSTME%,[ASCIZ!Too many entries in the search list!]
XWD FSUNA%,[ASCIZ!One or more of the units is not available!]
XWD FSPPN%,[ASCIZ!Job number and PPN do not match!]
XWD FSMCN%,[ASCIZ!Mount count is greater than 1!]
XWD FSNPV%,[ASCIZ!Insufficient privileges!]
XWD FSFSA%,[ASCIZ!File structure already exists!]
XWD FSILL%,[ASCIZ!Illegal argument block length!]
XWD FSNFS%,[ASCIZ!System file structure space full!]
XWD FSNCS%,[ASCIZ!No free core for data blocks!]
XWD FSUNF%,[ASCIZ!Unknown unit specified!]
XWD FSRSL%,[ASCIZ!File structure repeated in search list definition!]
XWD FSASL%,[ASCIZ!File structure contains units in Active Swapping List!]
XWD FSISN%,[ASCIZ!Illegal file structure name; more than 4 characters!]
STRELN==.-STRETB ;Table length
;Table for generic errors from file operations
FILETB:
FILELN==.-FILETB ;Table length
SUBTTL LOKUFD - Lock the UFD
;This routine, actually a co-routine, gets the UFD interlock
; for a particular STR:[p,pn], and unlocks the UFD when the caller
; returns
;If the interlock cannot be obtained, the OPR gets an error message,
; and the caller proceeds.
;Call -
; S1/ SIXBIT file structure name
; S2/ [p,pn]
;Returns -
; TRUE always
; Stack modified so caller's return will unlock the UFD
LOKCNT==^D10 ;Seconds to wait for interlock to clear
LOKUFD:
PUSHJ P,LOKU.1 ;Get the interlock
EXCH S1,0(P) ;Save the str name, Get return addr
PUSH P,S2 ;Save the ppn
PUSHJ P,0(S1) ;Call the caller
EXCH S2,0(P) ;Save return S2, get ppn
EXCH S1,-1(P) ;Save return s1, get str name
PUSH P,TF ;Save return T/F
PUSHJ P,LOKU.3 ;Clear the interlock
POP P,TF ;Get back TF
POP P,S2 ;Get back S2
POP P,S1 ;Get back S1
$RET ;Return from caller
;Here to get the UFD interlock
LOKU.1: $SAVE <P1> ;Save a reg
MOVEI P1,LOKCNT ;Get the retry counter
LOKU.2: MOVX TF,.FSULK ;Get the function code-UFD interlock
PUSHJ P,LOKU.4 ;Do the work
JUMPT .POPJ ;Got it, return
SOJLE P1,LOKU.E ;Quit when counter expires
PUSH P,P1 ;Save the count
MOVEI P1,1 ;1 second
SLEEP P1, ;Wait a sec
POP P,P1 ;Get back count
JRST LOKU.2 ;And try again
;Here to clear the UFD interlock
LOKU.3: MOVX TF,.FSUCL ;Function to clear interlock
PUSHJ P,LOKU.4 ;Do the work
JUMPT .POPJ ;Wins
JRST LOKE.1 ;Complain
;Here to pull the STRUUO
LOKU.4: $SAVE <P1> ;Save a reg
MOVX P1,<XWD 3,TF> ;Aim at the input args
STRUUO P1, ;Do it
$RETF ;Can't
$RETT ;Can
;Here if there are problems doing the work
LOKU.E: MOVEI TF,[ASCIZ/set/] ;Say what we can't do
SKIPA ;Enter the output code
LOKE.1: MOVEI TF,[ASCIZ/clear/]
EXCH S1,TF ;Swap str name, error text
$WTO (<Error on structure ^W/TF/>,<Can't ^T/@S1/ UFD interlock for ^U/S2/>,,$WTFLG(WT.SJI))
EXCH S1,TF ;GET BACK STR NAME
$RETF ;Can't
SUBTTL End
END