mirror of
https://github.com/PDP-10/stacken.git
synced 2026-04-19 16:40:09 +00:00
1027 lines
36 KiB
Plaintext
1027 lines
36 KiB
Plaintext
TITLE PLROPR - Operator Interface Module
|
||
SUBTTL Author: Dave Cornelius 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 GALAXY library conventions
|
||
SEARCH ORNMAC ;For keyword descriptions
|
||
SEARCH PLRMAC
|
||
SEARCH QSRMAC
|
||
PROLOG (PLROPR)
|
||
|
||
GLOB NUMBER
|
||
|
||
NUMBER: ITEXT (<^7/[.CHLAB]/number^7/[.CHRAB]/>)
|
||
SUBTTL COMERR - Error handler for messages
|
||
|
||
;This routine will complain to the operator if anything in the
|
||
; dialogs between PULSAR and any other component is screwed up.
|
||
; In all probablity, something is going to be messed up
|
||
; and perhaps beyond repair, but we should try to keep going.
|
||
; Call -
|
||
; JSP S1,COMERR
|
||
;Returns -
|
||
; $RETT, always
|
||
|
||
O$CERR::
|
||
COMERR::
|
||
MOVEM S1,G$COMR## ;Save the PC of the last mistake
|
||
LOAD S1,.MSTYP(M),MS.TYP ;Get the type of message code
|
||
LOAD S2,.MSFLG(M),MF.SUF ;And SIXBIT suffix
|
||
CAIN S1,.OMTXT ;Is it just text?
|
||
CAIE S2,'ODE' ;And sent to gone operator
|
||
$WTO (PULSAR Internal Error,<Message type ^O/.MSTYP(M),MS.TYP/ is unknown or unrecognizable>,,$WTFLG(WT.SJI))
|
||
$RETT ;Try to continue
|
||
SUBTTL UNLOAD command processing
|
||
O$CUNL::
|
||
$SAVE <P1> ;Save a reg
|
||
MOVX S1,.RECDV ;Look for a tape recognize block
|
||
PUSHJ P,FNDBLK ;Find that in the message
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;Noper, complain
|
||
MOVE S1,.RECDN(S1) ;Get the device name
|
||
MOVE P1,S1 ;Save the real dev name
|
||
PUSHJ P,G$FTCB## ;Find the TCB for that drive
|
||
JUMPF [MOVE T1,P1 ;Get device name
|
||
SETZB T2,T3 ;Clear job number and owner
|
||
PUSHJ P,G$MTCB## ;Make up a new TCB
|
||
JUMPT OACU.0 ;Get one?, start the recognizer
|
||
STOPCD (CMV,HALT,,<Can't make TCB>)]
|
||
OACU.0: LOAD S1,TCB.WS(B) ;Get the wait state
|
||
CAXN S1,TW.MNT ;Waiting for mount?
|
||
JRST OACU.M ;Yes, do a special unload
|
||
CAXN S1,TW.LBL ;No, Waiting for RESPONSE?
|
||
JRST OACM.R ;Yes, indicate that to OPR
|
||
JUMPN S1,[MOVX S2,TS.KIL ;Get the rundown in progress bit
|
||
TDNN S2,TCB.ST(B) ;Are we killing this TCB
|
||
JRST OACM.U ;Anything but idle, don't touch
|
||
$RETF ] ;Killing TCB, let it die down
|
||
MOVEI S1,1 ;Wait for the Monitor to catch up
|
||
SLEEP S1, ;ZZZZ
|
||
LOAD S1,TCB.DV(B) ;Get dev name requested
|
||
PUSHJ P,T$CKAV## ;Can we use it?
|
||
JUMPF OACM.U ;No, complain to OPR again
|
||
MOVX S1,TI.OAV ;Get open for AVR only bit
|
||
IORM S1,TCB.IO(B) ;Set so we clean up later
|
||
SETZM TCB.LT(B) ;Clear the label type
|
||
SETZM TCB.OW(B) ;Clear the owner ppn
|
||
SETZM TCB.JB(B) ;And the owner's job number
|
||
SETZM TCB.ST(B) ;Clear all status bits
|
||
MOVEI S1,D$UNLC## ;Assume a disk
|
||
LOAD S2,TCB.CH(B),TC.TYP ;Get the device type
|
||
CAIN S2,%TAPE ;Magtape?
|
||
MOVEI S1,O$UNLC ;Yes
|
||
CAIN S2,%DTAP ;DECtape?
|
||
MOVEI S1,D$UDTA## ;Yes
|
||
PJRST G$NPRC## ;Go to it!
|
||
|
||
OACU.M: MOVEI S1,O$UNLC ;Get addr of routine to do on-the-side
|
||
PJRST CALSUB ;And do that on the side
|
||
|
||
;HERE FOR PART TWO OF THE COMMAND ON A SCHEDULE CYCLE
|
||
O$UNLC: $TRACE (O$UNLC,6) ;TRACE IT
|
||
PUSHJ P,L$CLEF## ;Clear out any errors
|
||
PUSHJ P,T$OPEN## ;OPEN THE TAPE
|
||
JUMPF .RETT ;ERROR, Oh well
|
||
MOVEI S1,'UNL' ;GET THE UNLOAD COMMAND
|
||
PUSHJ P,T$POS## ;DO IT
|
||
JUMPF .RETT ;ERROR, Oh well
|
||
ZERO TCB.VL(B) ;And first part of volid
|
||
ZERO TCB.VL+1(B) ;And second part, too
|
||
MOVEI S1,BNKWD## ;Aim at 8 blanks
|
||
PJRST I$RLID## ;SET THE REELID AND RRETURN
|
||
SUBTTL OACREW - Rewind a volume
|
||
|
||
;This directive is given by MDA when a volume
|
||
; switch request can't be satisfied on this volume.
|
||
; The idea is to overlap the rewinding with the operator's
|
||
; searching for the next tape.
|
||
|
||
O$CREW::
|
||
$SAVE <P1> ;Save a reg
|
||
MOVX S1,.RECDV ;Look for a tape recognize block
|
||
PUSHJ P,FNDBLK ;Find that in the message
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE S1,.RECDN(S1) ;Get the device name
|
||
MOVE P1,S1 ;Save the real dev name
|
||
PUSHJ P,G$FTCB## ;Find the TCB for that drive
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
LOAD S1,TCB.WS(B) ;Get this guy's wait state
|
||
CAIE S1,TW.MNT ;Waiting for a volume switch?
|
||
$RETT ;Nope, race conditions with abort stuff
|
||
MOVEI S1,O$REWC ;Addr of routine to run
|
||
PJRST CALSUB ;Run the TCB, and come back
|
||
|
||
;Here in the TCB's context (In case we fall into offline device trap!)
|
||
O$REWC:
|
||
$TRACE (O$REWC,6)
|
||
MOVEI S1,'REW' ;Get the command
|
||
PUSHJ P,T$POS## ;Do it
|
||
$RETT ;Ignore the error
|
||
|
||
SUBTTL MOUNT tape recognize command
|
||
O$CREC::
|
||
$SAVE <P1> ;Save a reg
|
||
MOVX S1,.RECDV ;Look for a tape recognize block
|
||
PUSHJ P,FNDBLK ;Go find it...
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE S1,.RECDN(S1) ;Get the device name
|
||
MOVE P1,S1 ;Save the real dev name
|
||
PUSHJ P,G$FTCB## ;Find the TCB for that drive
|
||
JUMPF OACM.2 ;No TCB, go make one
|
||
ZERO TCB.ST(B),TS.NTP ;Clear the 'no-tape' bit
|
||
LOAD S1,TCB.WS(B) ;Get wait state for the TCB
|
||
CAIN S1,TW.MNT ;Is the TCB waiting for this?
|
||
JRST OACM.4 ;Yes, get the recognizer running
|
||
CAIN S1,TW.OFL ;Or is it offline?
|
||
PJRST G$STRN## ;Off line, pick up where we left off
|
||
CAIN S1,TW.LBL ;Is it waiting for RESPONSE?
|
||
JRST OACM.R ;Yes, say that
|
||
CAIN S1,TW.INM ;Waiting for initialization mount?
|
||
JRST OACM.5 ;Yes, go can the ack, and use the tape
|
||
CAIE S1,TW.IGN ;Is it idle
|
||
JRST OACM.U ;No, don't touch the tape
|
||
LOAD S1,TCB.DV(B) ;Get dev name requested
|
||
PUSHJ P,T$CKAV## ;Can we use it?
|
||
JUMPF OACM.U ;No, tell OPR someone has it
|
||
|
||
;CONTINUED ON THE NEXT PAGE
|
||
;CONTINUED FROM THE PREVIOUS PAGE
|
||
|
||
;Here to fire up a volume recognition for the drive
|
||
|
||
OACM.1: SETZM TCB.ST(B) ;Clear all status bits
|
||
PUSHJ P,L$CLEF## ;Clear out the error status
|
||
MOVEI S1,L$MDC## ;Assume a magtape
|
||
LOAD S2,TCB.CH(B),TC.TYP ;Get device type code
|
||
CAIN S2,%DISK ;A disk?
|
||
MOVEI S1,D$HOM## ;Yes
|
||
CAIN S2,%DTAP ;DECtape?
|
||
MOVEI S1,D$RDTA## ;Yes
|
||
PJRST G$NPRC## ;Create a new context in TCB (B)
|
||
|
||
OACM.2: MOVE S1,P1 ;Get device name
|
||
PUSHJ P,T$CKAV## ;Make sure we don't
|
||
;rewind some user's tape!
|
||
JUMPF OACM.Z ;In use, tell OPR
|
||
MOVE T1,P1 ;Get device name
|
||
SETZB T2,T3 ;Clear job number and owner
|
||
PUSHJ P,G$MTCB## ;Make up a new TCB
|
||
SKIPT ;Get one?, start the recognizer
|
||
STOPCD (CMU,HALT,,<Can't make TCB>)
|
||
MOVX S1,TI.OAV ;Get 'Open for VR' bit
|
||
IORM S1,TCB.IO(B) ;Lite that so we'll delete label DDB
|
||
JRST OACM.1 ;And start the recognizer
|
||
|
||
OACM.4: MOVEI S1,L$MDC## ;Addr of routine to run on-the-side
|
||
PJRST CALSUB ;Do it, and get out
|
||
|
||
;Here if the drive is intializing, and was waiting for a new tape
|
||
|
||
OACM.5: PUSHJ P,CANWTO ;Cancel outstanding WTOR's
|
||
PJRST G$STRN## ;Return true to process
|
||
|
||
OACM.Z: STKVAR <<OBJ,OBJ.SZ>> ;It sure is hard being pretty
|
||
MOVEI S2,OBJ ;Get the object block address
|
||
MOVX S1,.OTMNT ;Get the tape object type
|
||
MOVEM S1,OBJ.TY(S2) ;Save it
|
||
MOVEM P1,OBJ.UN(S2) ;Save the device name
|
||
SETZM OBJ.ND(S2) ;There is no node name
|
||
SKIPA ;Skip over general entry point
|
||
|
||
OACM.U: MOVEI S2,TCB.OB(B) ;Get the object block address
|
||
MOVE S1,OBJ.UN(S2) ;Get the device name
|
||
DEVTYP S1, ;Get the owners job number
|
||
SETZM S1 ;Failed,,zero
|
||
LOAD S1,S1,TY.JOB ;Get the job number in S1
|
||
$WTO (<Invalid request - drive is assigned by job ^D/S1/>,,0(S2),$WTFLG(WT.SJI))
|
||
$RETT
|
||
|
||
;Here if there is a message outstanding
|
||
|
||
OACM.R: $WTO (<Please RESPOND to outstanding MESSAGE>,,TCB.OB(B),$WTFLG(WT.SJI))
|
||
$RETT
|
||
SUBTTL CALSUB - Call a subroutine for a TCB
|
||
|
||
;This routine will take an existing TCB and call an other
|
||
; routine in that TCB's context
|
||
|
||
;Call -
|
||
; S1/ Addr of the routine to be called
|
||
; B/ TCB to be run
|
||
|
||
CALSUB: EXCH P,TCB.AC+P(B) ;Get Process PDL
|
||
LOAD S2,TCB.WS(B) ;Save the wait state
|
||
PUSH P,S2 ;Save the current wait state
|
||
PUSH P,[EXP CALDON] ;Where to go when done
|
||
PUSH P,S1 ;Routine to call
|
||
EXCH P,TCB.AC+P(B) ;Restore both stacks
|
||
PJRST G$STTR## ;Start the TCB
|
||
|
||
CALDON: POP P,S1 ;Get back the wait state
|
||
STORE S1,TCB.WS(B) ;Put the TCB in that state
|
||
PJRST G$NJOB## ;And continue scheduling
|
||
SUBTTL Mount message from MDA
|
||
|
||
;Enter with M pointing to the message.
|
||
;This routine will build the required data base to
|
||
; service this user's labelled tape processing
|
||
|
||
O$CVMN::
|
||
$SAVE <P1>
|
||
MOVX S1,.RECDV ;Block type for device name block
|
||
PUSHJ P,FNDBLK ;Get that block from the message
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE S1,.RECDN(S1) ;Get the drive name
|
||
MOVE P1,S1 ;Save across FTCB call
|
||
PUSHJ P,G$FTCB## ;Find that guy's data block
|
||
JUMPF MOUN.1 ;Not found, go make a block
|
||
|
||
;Here if a TCB already exists
|
||
|
||
PUSHJ P,CANWTO ;Cancel outstanding WTOR's
|
||
MOVX S1,TI.OPN ;Get the open bit
|
||
TDNN S1,TCB.IO(B) ;Channel opened?
|
||
JRST MOUN.2 ;No
|
||
MOVX S1,TS.SLR ;Get skip label release bit
|
||
IORM S1,TCB.ST(B) ;Memorize it
|
||
PUSHJ P,T$RELE## ;Zap open channel and clean up
|
||
JRST MOUN.2 ;Keep going
|
||
|
||
;Here to make up a new TCB
|
||
|
||
MOUN.1: MOVE T1,P1 ;Get device name
|
||
SETZ T2, ;No known job number
|
||
SETZ T3, ;Don't know ppn of owner yet
|
||
PUSHJ P,G$MTCB## ;Get the block made up
|
||
|
||
MOUN.2: PUSHJ P,MVOLIN ;PROCESS THE VOLUME INFO
|
||
MOVEI S1,L$MOUN## ;ASSUME MAGTAPE
|
||
LOAD S2,TCB.CH(B),TC.TYP ;GET THE DEVICE TYPE
|
||
CAIN S2,%DTAP ;DECTAPE?
|
||
MOVEI S1,D$MDTA## ;YES
|
||
PUSHJ P,G$NPRC## ;CREATE CONTEXT, SET PARAMETERS
|
||
$RETT
|
||
SUBTTL O$CVDM - Volume Dismount message from MDA
|
||
|
||
;This routine handles the volume dismounted message from the allocator.
|
||
; It is responsible for cleaning up and perhaps deleting the TCB
|
||
|
||
O$CVDM::
|
||
MOVX S1,.RECDV ;Argument block type
|
||
PUSHJ P,FNDBLK ;Find drive spec block in message
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, that's a problem
|
||
MOVE S1,.RECDN(S1) ;Get the sixbit drive name
|
||
PUSHJ P,G$FTCB## ;Go find this guy's database
|
||
JUMPF .RETT ;Not there??? We must have restarted
|
||
PUSHJ P,CANWTO ;Cancel outstanding WTOR's
|
||
MOVX S1,TI.OAV ;Get open for AVR bit
|
||
IORM S1,TCB.IO(B) ;Lite so release will throw out lbl DDB
|
||
MOVX S1,TS.KIL ;Get the rundown bit
|
||
IORM S1,TCB.ST(B) ;Lite so we throw out the TCB
|
||
MOVEI S1,O$UNW ;Get TCB level code to unwind
|
||
PJRST G$NPRC## ;Come back at TCB level
|
||
|
||
;Here when the TCB has been scheduled
|
||
O$UNW:
|
||
PUSHJ P,T$OPEN## ;Get the label DDB set up
|
||
$RETT ;Return, and flush the TCB, and Lbl DDB
|
||
SUBTTL MVOLIN - Process volume info for newly mounted volume
|
||
|
||
;This routine takes whatever MDA tells us about a volume and
|
||
; stores that info in our TCB
|
||
;Call -
|
||
; M /Message addrs
|
||
; B /TCB adrs
|
||
|
||
MVOLIN: $SAVE <P1,P2>
|
||
MOVX S1,.VOLMN ;Block type for the volume info block
|
||
PUSHJ P,FNDBLK ;Find that one
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE P1,S1 ;Save addr of block
|
||
LOAD LT,.VMNIN(P1),VI.LTY ;Get the label type
|
||
STORE LT,TCB.LT(B) ;Save in TCB for future reference
|
||
MOVE S1,.VMNIV(P1) ;Get the initial volume name
|
||
MOVEI S2,TCB.VL(B) ;Offset of where to store volid
|
||
PUSHJ P,CN6VL8 ;Convert SIXBIT volid to 8-bit
|
||
MOVE S1,.VMNFV(P1) ;Get first volume in set
|
||
MOVEI S2,TCB.FV(B) ;Offset of where to store it
|
||
PUSHJ P,CN6VL8 ;Convert that one, too
|
||
LOAD S1,.VMNIN(P1),VI.WLK ;Get the write-locked bit
|
||
STORE S1,TCB.PT(B),TP.RWL ;Save in TCB for software write-lock
|
||
LOAD P2,.VMNIN(P1),VI.JOB ;Get this guy's job number
|
||
STORE P2,TCB.JB(B) ;Save in TCB for future
|
||
MOVE S1,P2 ;Move job # into place
|
||
MOVX S2,JI.USR ;Code to get user id
|
||
$CALL I%JINF ;Get this guy's [p,pn]
|
||
STORE S2,TCB.OW(B) ;Save in TCB
|
||
PUSHJ P,I$USRN## ;Get the user's name (job # in S1)
|
||
$RETT
|
||
SUBTTL OACVSD - Action routine for volume switch directives
|
||
|
||
;This routine fields directions from MDA for TCBs which are
|
||
; waiting for volume switch requests
|
||
; It will swap the units, and get the unit scheduled again
|
||
;Returns TRUE if the message could be processed now,
|
||
; FALSE if the message should be queued up and run later
|
||
|
||
O$CVSD::
|
||
$SAVE <P1,P2,P3> ;Save some space
|
||
MOVX S1,.VSDBL ;Look for this type of block
|
||
PUSHJ P,FNDBLK ;Find a Volume switch directive block
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE P1,S1 ;Save the addrs of the VSD block
|
||
LOAD S1,.VSDID(P1) ;Get the old drive name
|
||
PUSHJ P,G$FTCB## ;Find that one
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
LOAD S1,TCB.WS(B) ;Get the wait state
|
||
CAIE S1,TW.MNT ;Is it expecting this?
|
||
$RETF ;TCB busy, try again later
|
||
|
||
PUSHJ P,CANWTO ;Cancel outstanding WTOR's
|
||
SETZM S1 ;Default to no errors
|
||
MOVE S2,.MSFLG(M) ;Get the flags
|
||
TXNE S2,%VABT ;Have we been gonged?
|
||
MOVX S1,PLR%CN ;Yes,,get 'cancelled' status
|
||
TXNE S2,%VEOF ;No, how about EOF?
|
||
MOVX S1,PLR%ES ;Yes,,get 'EOF' status
|
||
TXNE S2,%VTMV ;How about volume limit exceeded ?
|
||
MOVX S1,PLR%TM ;Yes,,get 'Too Many Volumes' status
|
||
JUMPN S1,[STORE S1,TCB.AC+S1(B) ;Error,,save status in TCB
|
||
PJRST G$STFL## ] ;And return false
|
||
|
||
PUSHJ P,MVOLIN ;Move the volume info
|
||
LOAD S1,.VSDCD(P1) ;Get the new device
|
||
CAMN S1,TCB.DV(B) ;Same drive as before?
|
||
JRST VDIR.2 ;Yup, charge on!
|
||
MOVE P2,S1 ;Save the new drive name
|
||
MOVE P3,B ;Save the old drive TCB
|
||
PUSHJ P,G$FTCB## ;Find the new one's data base
|
||
JUMPT VDIR.1 ;Got it
|
||
MOVE T1,P2 ;Get the drive name back
|
||
SETZB T2,T3 ;No job, no PPN
|
||
PUSHJ P,G$MTCB## ;Make some space
|
||
VDIR.1: LOAD S1,TCB.WS(B) ;Get the prospecitve new TCB wait state
|
||
CAIE S1,TW.IGN ;Idle?
|
||
JSP S1,COMERR ;No!, error
|
||
PUSHJ P,CANWTO ;Cancel outstanding WTOR's
|
||
EXCH B,P3 ;Get to the old TCB
|
||
MOVE S1,P2 ;Get the new drive name
|
||
PUSHJ P,T$NUNI## ;Swap the guy over to this unit
|
||
JRST VDIR.3 ;ONWARD
|
||
VDIR.2: PUSHJ P,T$SUNI## ;SWAP SAME UNIT
|
||
VDIR.3: PJRST G$STTR## ;just return true to process
|
||
|
||
SUBTTL CN6VL8 - Convert SIXBIT volume id to 8-bit
|
||
|
||
;Call -
|
||
; S1/ SIXBIT volume id
|
||
; S2/ Addr where string whould be stored
|
||
;Return
|
||
; TRUE (always)
|
||
|
||
O$CN68::
|
||
CN6VL8: $SAVE <P1>
|
||
MOVE P1,S1 ;Save the volume id
|
||
HRLI S2,(POINT 8,) ;Make an 8-bit pointer
|
||
MOVE S1,[POINT 6,P1] ;Aim at the volid
|
||
CN6V.1: ILDB TF,S1 ;Get a byte
|
||
ADDI TF,40 ;Convert to ASCII
|
||
IDPB TF,S2 ;Store it
|
||
TLNE S1,770000 ;Done six yet?
|
||
JRST CN6V.1 ;No, keep moving
|
||
$RETT
|
||
|
||
; Convert 8-bit reelid to something useful in S2
|
||
O$CN86::$SAVE <P1,P2> ;SAVE P1 AND P2
|
||
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
|
||
MOVE P1,[POINT 6,S2] ;BYTE POINTER TO STORAGE
|
||
MOVEI P2,6 ;BYTE COUNT
|
||
CN86.1: ILDB TF,S1 ;GET A BYTE
|
||
SUBI TF,40 ;CONVERT TO SIXBIT
|
||
IDPB TF,P1 ;PUT A BYTE
|
||
SOJG P2,CN86.1 ;LOOP FOR ALL CHARACTERS
|
||
POPJ P, ;RETURN
|
||
SUBTTL FNDBLK - Find a given block in the incoming message
|
||
|
||
;Call with S1/ desired block type
|
||
; M/Message addrs
|
||
;Returns: Addrs of data in block if found (TRUE return)
|
||
; or false, block not found in message
|
||
|
||
O$FNDBLK::
|
||
FNDBLK:
|
||
$SAVE <P1>
|
||
LOAD P1,.OARGC(M) ;Get the number of blocks in the message
|
||
MOVEI S2,.OHDRS(M) ;Aim at the first block
|
||
FNDB.1: SOJL P1,.RETF ;Return if none found
|
||
LOAD TF,ARG.HD(S2),AR.TYP ;Get the type of this block
|
||
CAMN TF,S1 ;Match what we're looking for?
|
||
JRST [MOVEI S1,ARG.DA(S2) ;Yes, aim at its data
|
||
$RETT] ;And return true
|
||
LOAD TF,ARG.HD(S2),AR.LEN ;Get length of this block
|
||
ADD S2,TF ;And step over it
|
||
JRST FNDB.1 ;And try next
|
||
SUBTTL Error Typeout Utility Routines
|
||
|
||
;ROUTINE TO TYPE DRIVE NAME FOLLOWED BY A MESSAGE
|
||
;CALLED WITH S1 POINTING TO AN $ITEXT MESSAGE TO BE TYPED AFTER THE DEVICE NAME
|
||
;On call, B must point to the TCB in question.
|
||
;The ITEXT passed must not use the S regs, or the T regs.
|
||
;This routine will send a WTOR and wait for
|
||
;an OPR response. If the response is NOT PROCEED or ABORT,
|
||
;the operator will be asked again, until the answer is right.
|
||
;Call -
|
||
; S1/ Addr of 'text' line ITEXT (can't reference S1-T4)
|
||
;For O$LERT and O$SERT only
|
||
; S2/ Addr of 'Type RESPOND <number> ABORT' to xxx ITEXT
|
||
;Returns -
|
||
; TRUE or FALSE, depending on OPRs answer
|
||
|
||
O$LERR::MOVEI S2,0 ;Clear RESPOND text
|
||
O$LERT::MOVE T4,S2 ;Save RESPOND text (if any)
|
||
MOVEI S2,[ITEXT(<Label error>)]
|
||
PJRST OPRWAT ;Type the messages, wait for ack
|
||
|
||
;Here on a structure error. Str TCB addr in B, ITEXT in S1
|
||
O$SERR::MOVEI S2,0 ;Clear RESPOND text
|
||
O$SERT::MOVE T4,S2 ;Save RESPOND text (if any)
|
||
MOVEI S2,[ITEXT(<Problem removing structure>)]
|
||
; PJRST OPRWAT ;Type the mesages, wait for ack
|
||
|
||
;Enter here to type the error and wait for OPR
|
||
; to get it right.
|
||
; S1/ Addr of 'text' field ITEXT
|
||
; S2/ Addr of 'type' field ITEXT
|
||
; T4/ Addr of RESPOND ITEXT block (0=standard ABORT, PROCEED)
|
||
OPRWAT: DMOVE T1,S1 ;Copy the two fields
|
||
JUMPN T4,OPRW.1 ;Got something good?
|
||
MOVEI T4,[ITEXT(<Type 'RESPOND ^I/number/ ABORT' to terminate this operation
|
||
Type 'RESPOND ^I/number/ PROCEED' to continue processing>)]
|
||
OPRW.1: AOS T3,G$ACK## ;Get next ack code
|
||
STORE T3,TCB.AK(B) ;Save so we can recognize RESPOND
|
||
$WTOR (<^I/(T2)/>,<^I/(T1)/^M^J^I/(T4)/>,TCB.OB(B),T3,$WTFLG(WT.SJI))
|
||
MOVX S1,TW.LBL ;Get Label wait code
|
||
STORE S1,TCB.WS(B) ;Mark in the TCB
|
||
PUSHJ P,G$NJOB## ;Set the code, and wait
|
||
ZERO TCB.AK(B) ;Clear the ack code
|
||
PUSH P,S1 ;SAVE OPR RESPONSE CODE
|
||
LOAD S1,TCB.CH(B),TC.TYP ;Get the device type
|
||
CAIN S1,%DISK ;Is it a disk?
|
||
JRST OPRW.2 ;YES
|
||
MOVEI S1,TCB.OB(B) ;Get the object block address
|
||
MOVE S1,OBJ.UN(S1) ;Get the device name
|
||
DEVTYP S1, ;Get the owners job number
|
||
SETZ S1, ;Can't
|
||
TXNE S1,TY.MDA ;DEVICE OWNED BY MDA?
|
||
SKIPA TF,[TRUE] ;YES--SET TRUE
|
||
MOVX TF,FALSE ;ELSE SET FALSE
|
||
OPRW.2: POP P,S1 ;RESTORE OPR RESPONSE CODE
|
||
POPJ P, ;RETURN EITHER TRUE OR FALSE
|
||
SUBTTL O$NTAP - Get a new tape mounted for initialization
|
||
|
||
;This routine will arrange with the operator to get a new tape mounted
|
||
; during intialization. The operator has a number of choices.
|
||
; S/he can simply mount the next tape on the initializing
|
||
; drive and continue either via AVR or Manual Volume Recognition.
|
||
; Or, S/he can RESPOND to the WTOR with ABORT or CANCEL
|
||
; to get out of the initialization state.
|
||
|
||
;Call -
|
||
; S1/ Adrs of ASCIZ type field for WTOR
|
||
; S2/ Adrs of ITEXT for text field for WTOR
|
||
; This ITEXT must not use the T's for pointers/data
|
||
; B/ TCB adrs
|
||
|
||
O$NTAP::
|
||
$CALL .SAVET ;Save the Ts
|
||
DMOVE T1,S1 ;Save the type, text pointers
|
||
NTAP.1: MOVX S1,TW.INM ;Get Initialization Mount wait state
|
||
STORE S1,TCB.WS(B) ;Let the world know
|
||
AOS T3,G$ACK## ;Get a new ack ID
|
||
STORE T3,TCB.AK(B) ;Save so we can find it later
|
||
$WTOR (<^T/0(T1)/>,<^I/0(T2)/
|
||
Type 'RESPOND ^I/number/ ABORT' to terminate this operation
|
||
Type 'RESPOND ^I/number/ PROCEED' after completing requested operation>,TCB.OB(B),T3,$WTFLG(WT.SJI))
|
||
PUSHJ P,G$NJOB## ;Run someone else
|
||
JUMPT .POPJ ;Wins, try this tape
|
||
CAXN S1,PLR%TY ;Want to retype?
|
||
JRST NTAP.1 ;Yes, do it
|
||
$RETF ;Otherwise, give the gong
|
||
SUBTTL RESPONSE command for label errors
|
||
;Enter with M pointing to incoming message
|
||
;Returns true always, but may start up a waiting process
|
||
|
||
O$CRSP::
|
||
PUSHJ P,.SAVE1 ;Save a reg
|
||
LOAD S1,.MSCOD(M) ;Get the ack number
|
||
PUSHJ P,G$FACK## ;Find TCB with that ack number
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
ZERO TCB.AK(B) ;Clear out this ack code, it's been answered
|
||
MOVEI P1,.OHDRS(M) ;Get pointer to data area
|
||
LOAD S2,ARG.HD(P1),AR.TYP ;Find out the type of argument
|
||
LOAD S1,.OARGC(M) ;Get number of arguments on the message
|
||
CAIN S1,2 ;We demand exactly two args
|
||
CAIE S2,.CMTXT ;And it must be a text arg
|
||
JSP S1,COMERR ;Not the case, OPR is out of sync
|
||
MOVEI S1,RSPTAB ;Aim at legal OPR responses
|
||
HRROI S2,ARG.DA(P1) ;Get a pointer to the OPR text
|
||
$CALL S%TBLK ;Find a match
|
||
TXNN S2,TL%EXM!TL%ABR ;A match??
|
||
SKIPA S1,[EXP OACR.R] ;Set dispatch routine for retyping
|
||
HRRZ S1,(S1) ;Get particular service routine
|
||
PUSHJ P,(S1) ;Call the service routine
|
||
PJRST G$STTF## ;Save the TF indicator for the process,
|
||
;And continue the process
|
||
|
||
;These routines set the TCB to retype or just ABORT on OPR errors
|
||
;Handle the PROCEED response
|
||
OACR.P: PUSHJ P,CHKMNT ;Waiting for MOUNT?
|
||
JUMPT OACR.R ;PROCEED IS ILLEGAL IF MOUNT WAIT
|
||
MOVEI S1,PLR%PR ;GET PROCEED CODE
|
||
MOVEM S1,TCB.AC+S1(B) ;SET IT
|
||
$RETT ;AND RETURN
|
||
|
||
;Here if we want to retype the request
|
||
OACR.R: LOAD S1,ARG.HD(P1),AR.LEN ;Get length of text
|
||
ADDI P1,(S1) ;Advance ptr to next block
|
||
LOAD S1,ARG.HD(P1),AR.TYP ;Get type of block
|
||
CAIE S1,.ACKID ;Is this block a ACK code?
|
||
JSP S1,COMERR ;No, die, we're out of sync w ORION
|
||
$ACK (<Invalid Response>,,,ARG.DA(P1))
|
||
MOVX S1,PLR%TY ;Set code to retype error
|
||
JRST OACR.S ;Go store, and retype
|
||
|
||
; Handle the RETRY response
|
||
OACR.T: MOVX S1,TS.FSE ;GET A BIT
|
||
TDNN S1,TCB.S2(B) ;FILE SEQUENCE ERROR PROCESSING?
|
||
JRST OACR.R ;NO--BAD RESPONSE
|
||
MOVEI S1,PLR%RT ;OPR SAID RETRY
|
||
MOVEM S1,TCB.AC+S1(B) ;SET IN TCB
|
||
$RETT ;RETURN
|
||
|
||
;Handle the ABORT response
|
||
OACR.A: MOVX S1,PLR%AB ;Don't retype, OPR ABORTed
|
||
OACR.S: STORE S1,TCB.AC+S1(B) ;Set retype code in TCB
|
||
$RETF ;Return false (to set in TCB)
|
||
|
||
;Little routine to return true if TCB is waiting for MOUNT
|
||
CHKMNT: LOAD S1,TCB.WS(B) ;Get wait state code
|
||
CAIE S1,TW.MNT ;MOUNT wait?
|
||
$RETF ;No, return false
|
||
$RETT ;Yes, return true
|
||
|
||
;Some storage for the RESPONSE command
|
||
RSPTAB: $STAB
|
||
KEYTAB (OACR.A,ABORT) ;ABORT ,, set bad
|
||
KEYTAB (OACR.P,PROCEED) ;PROCEED ,, return true
|
||
KEYTAB (OACR.T,RETRY) ;RETRY ,, return true
|
||
$ETAB
|
||
;Routine to cancel a WTOR. This happens if the OPR hangs a tape (AVR)
|
||
; for which PULSAR has sent a WTOR
|
||
;
|
||
;Call: B/ TCB address
|
||
;
|
||
;Ret: +1 always
|
||
|
||
CANWTO::
|
||
SKIPE TCB.AK(B) ;Waiting for OPR response ???
|
||
$KWTOR (TCB.AK(B)) ;Yes,,kill the WTOR
|
||
SETZM TCB.AK(B) ;Zap the ACK code
|
||
$RET ;Return
|
||
|
||
|
||
; Special routine to cancel a WTOR when labeler abort is processed.
|
||
; Call: MOVEI S1, text address
|
||
; PUSHJ P,O$KWTO
|
||
|
||
O$KWTO::SKIPE TCB.AK(B) ;PENDING WTOR?
|
||
$WTOR (<>,<^T/(S1)/>,TCB.OB(B),TCB.AK(B),<$WTFLG(WT.KIL!WT.SJI)>)
|
||
SETZM TCB.AK(B) ;CLEAR ACK CODE
|
||
$RETT ;RETURN
|
||
SUBTTL Debugging type-out routine
|
||
|
||
IFN FTTRACE,<
|
||
STSD.L::
|
||
$SAVE <P1,P2,P3>
|
||
$TEXT (,<Label Status:^A>)
|
||
MOVSI P2,-NUMBTS ;Get number of bits to check
|
||
MOVE P1,TCB.ST(B) ;GET THE STATUS BITS
|
||
STSD.1: HRRZ P3,BITTAB(P2) ;Get addr of word with bit to check
|
||
TDNE P1,(P3) ;Is the bit on?
|
||
$TEXT (,<^W3/BITTAB(P2)/!^A>) ;Yes, note it
|
||
AOBJN P2,STSD.1 ;Check all of them
|
||
LOAD P1,TCB.EC(B),TE.TRM ;GET THE ERROR CODE
|
||
SKIPE P1 ;
|
||
$TEXT (,<Err=^O/P1/^A>)
|
||
POPJ P, ;Return as if nothing happened
|
||
|
||
DEFINE BITS(X),<IRP X,<
|
||
XWD ''X'',[EXP TS.'X']
|
||
>
|
||
>;END DEFINE BITS
|
||
BITTAB: BITS(<VLV,PSN,INP,OUT,NTP,NOW,WLK,EXP,D1A,FFF,ERR,NFI,NFO,PSF,IHL,ATM,IUD>)
|
||
NUMBTS==.-BITTAB
|
||
|
||
>;END IFN FTTRACE
|
||
SUBTTL O$STAT Send updated status message to MDA
|
||
;This routine takes a TCB addr in B and sends a status message to
|
||
; MDA. This message is sent in response to a request
|
||
; from MDA to recognize the labels on a tape
|
||
; If the TCB is for a disk, and the caller is trying to send updated
|
||
; status to MDA because HOM blocks were just read, then:
|
||
; T1/ HOMe block id (volume id)
|
||
; T2/ Volid of next volume in structure
|
||
; T3/ Logical unit number in structure
|
||
; T4/ Structure name in SIXBIT
|
||
|
||
O$STAT::MOVE S1,TCB.DV(B) ;Get MTxnnn device name
|
||
MOVEM S1,UNIBLK+.STUNT ;Save as drive name in status block
|
||
SETZM UNIBLK+.STFLG ;Clear status word
|
||
LOAD S1,TCB.ST(B),TS.NTP ;Get offline bit from status word
|
||
STORE S1,UNIBLK+.STFLG,ST.OFL ;Save in message to MDA
|
||
JUMPN S1,STAT.1 ;Offline, don't send volume id
|
||
LOAD S1,TCB.PT(B),TP.RWL ;Get write lock bit as read from drive
|
||
STORE S1,UNIBLK+.STFLG,ST.LOK ;Set in message to MDA
|
||
LOAD S1,TCB.CH(B),TC.TYP ;Get the device type
|
||
CAIN S1,%TAPE ;Magtape?
|
||
JRST MTASTS ;Yes
|
||
CAIN S1,%DISK ;Structure?
|
||
JRST DSKSTS ;Yes
|
||
CAIN S1,%DTAP ;DECtape?
|
||
JRST DTASTS ;Yes
|
||
$RETF ;Else just give up
|
||
|
||
MTASTS: MOVX S1,.TLSTA ;Get block type - tape status
|
||
STORE S1,STSVOL+ARG.HD,AR.TYP ;Set this block for us
|
||
SETZM VOLBLK+.TLVOL ;Clear volume id
|
||
MOVE S1,TCB.LT(B) ;Get label type code
|
||
STORE S1,UNIBLK+.STFLG,TS.LAB ;Save label type code
|
||
LOAD S1,TCB.PS(B),TP.DEN ;Get density code as read from drive
|
||
STORE S1,UNIBLK+.STFLG,TS.DEN ;And put in message
|
||
MOVE S1,[POINT 6,VOLBLK+.TLVOL] ;SIXBIT ptr to volume id in message
|
||
MOVEM S1,STSPTR ;Save in ptr for $TEXT coroutine
|
||
HRRI S1,TCB.VL(B) ;Addr of volume id
|
||
HRLI S1,(POINT 8,) ;8-bit bytes
|
||
$TEXT (STSDBP,<^Q6/S1/^A>) ;Convert the VOLID to SIXBIT
|
||
STAT.1: DMOVE S1,[EXP SSBLEN,STSSAB] ;Len, adr of send arg block
|
||
$CALL C%SEND ;Off to MDA
|
||
$RETT
|
||
|
||
;A little routine to convert 8-bit ASCII to SIXBIT as $TEXT output
|
||
STSDBP: SKIPE S1 ;Null byte?
|
||
SUBI S1,40 ;No, convert ASCII to SIXBIT
|
||
IDPB S1,STSPTR ;And dump in volume block
|
||
$RETT ;And back to $TEXT
|
||
|
||
|
||
;Here to return the DECtape reelid contained in T1
|
||
DTASTS: MOVEI S1,.DLSTA ;GET BLOCK TYPE
|
||
STORE S1,STSVOL+ARG.HD,AR.TYP ;SET IN MESSAGE
|
||
MOVEM T1,VOLBLK+.DLRID ;SAVE REELID
|
||
PJRST STAT.1 ;GO SEND MESSAGE
|
||
|
||
|
||
;Here if sending valid volume status for a disk unit
|
||
;The T ACs contain valuable info!
|
||
DSKSTS: MOVEI S1,.DSSTA ;Get block type - disk status
|
||
STORE S1,STSVOL+ARG.HD,AR.TYP ;Set this block for us
|
||
MOVEM T1,VOLBLK+.DSHID ;Put in volume ID
|
||
MOVEM T2,VOLBLK+.DSNXV ;Next volume in str
|
||
MOVEM T3,VOLBLK+.DSLUN ;Logical volume (unit) in str
|
||
MOVEM T4,VOLBLK+.DSSNM ;And structure name
|
||
MOVE S1,TCB.OW(B) ;Get owner PPN
|
||
MOVEM S1,VOLBLK+.DSPPN ;Save it
|
||
JRST STAT.1 ;Go send the message
|
||
|
||
;CONTINUED ON NEXT PAGE
|
||
;CONTINUED FROM PREVIOUS PAGE
|
||
|
||
STSPTR: BLOCK 1 ;Space for the pointer
|
||
|
||
;Data space for the update status message to MDA
|
||
STSSAB: $BUILD SAB.SZ
|
||
$SET (SAB.LN,,STSSIZ) ;Size of the message
|
||
$SET (SAB.MS,,STSMSG) ;Addr of the message
|
||
$SET (SAB.SI,SI.FLG,1) ;Send by system PID
|
||
$SET (SAB.SI,SI.IDX,SP.MDA) ;Send to MDA
|
||
$EOB
|
||
SSBLEN==.-STSSAB ;Length of the SAB
|
||
|
||
;The message is a header, and one block
|
||
STSMSG: $BUILD .OHDRS
|
||
$SET (.MSTYP,MS.CNT,STSSIZ) ;Size of the message
|
||
$SET (.MSTYP,MS.TYP,.QOTST) ;Message type - tape status
|
||
$SET (.OARGC,,2) ;Two argument blocks
|
||
$EOB
|
||
|
||
$BUILD ARG.DA ;Device descriptor block
|
||
$SET (ARG.HD,AR.LEN,ARG.DA+.STLEN) ;Length of block
|
||
$SET (ARG.HD,AR.TYP,.STSTS) ;Device status block type
|
||
$EOB
|
||
|
||
UNIBLK: $BUILD .STLEN ;Status for device
|
||
;Contents filled in @ runtime
|
||
$EOB
|
||
|
||
STSVOL: $BUILD ARG.DA
|
||
$SET (ARG.HD,AR.LEN,VOLSIZ) ;Length of the arg block
|
||
; $SET (ARG.HD,AR.TYP,.TLVOL) ;Volume type - set at runtime (disk or tape)
|
||
$EOB
|
||
|
||
;Note - We always send the same size blocks, regardless of
|
||
; whether it is a disk or a tape.
|
||
; Hopefully, MDA will ignore the discrepancy
|
||
|
||
VOLBLK: $BUILD .DSSIZ
|
||
;Contents of this block filled in
|
||
; on a call to O$STAT
|
||
$EOB
|
||
|
||
VOLSIZ==.-STSVOL ;Length of the volume block
|
||
|
||
STSSIZ==.-STSMSG ;Length of the message
|
||
SUBTTL O$CASL - Add or remove str to user's search list
|
||
|
||
;This is the action routine for the .QOASL message from MDA
|
||
;Call -
|
||
; M/ .QOASL message addrs
|
||
|
||
O$CASL::PUSHJ P,D$SLCH## ;PROCESS SEARCH LIST CHANGE MESSAGE
|
||
$RETT ;RETURN
|
||
SUBTTL OACBLD - Build a structure
|
||
|
||
;This is the action routine for the .QOBLD message from MDA
|
||
; This routine will build at TCB for the strucutre, fill
|
||
; in the neccessary items, and set the TCB runnable.
|
||
; The structure TCB will run, requesting HOM block reading and
|
||
; all the other good stuff, and eventually, the strucutre will
|
||
; be built.
|
||
;Call -
|
||
; M/ .QOBLD message adrs
|
||
;Returns -
|
||
; Marks structure TCB as runnable to build structure
|
||
|
||
O$CBLD::
|
||
PUSHJ P,ESTRBL ;Extract the block info, setup TCB
|
||
JUMPF .POPJ ;Can't, so quit
|
||
MOVEI S1,D$SDEF## ;Where to start - Str definer
|
||
PUSHJ P,G$NPRC## ;Fire it up!
|
||
$RETT
|
||
SUBTTL OACDSM - Dismount a structure
|
||
|
||
;This is the action routine for a .QODSM directive from MDA.
|
||
;This routine will setup a process which will run the structure
|
||
; dismount code.
|
||
;Call -
|
||
; M/ .QODSM message adrs
|
||
;Returns -
|
||
; Structure TCB runnable at the structure dismounter
|
||
|
||
O$CDSM::
|
||
PUSHJ P,ESTRBL ;Get the structure info into a TCB
|
||
JUMPF .POPJ ;Can't, so quit
|
||
MOVEI S1,D$SREM## ;Routine to run - structure remover
|
||
PUSHJ P,G$NPRC## ;Start the TCB there
|
||
$RETT
|
||
SUBTTL ESTRBL - Extract structure info from a MDA message
|
||
|
||
;This routine breaks down a message from MDA and moves pertinent info into
|
||
; the TCB. The message is either a .QOBLD (Define a structure)
|
||
; or .QODSM (Dismount str). This is a common preprocessor routine since
|
||
; those messages are similar in format.
|
||
;Call -
|
||
; M/ .QOBLD or .QODSM message adrs
|
||
;Returns - TRUE:
|
||
; (FALSE if the message looks bad!)
|
||
; B/ Structure TCB adrs
|
||
|
||
ESTRBL: $SAVE <P1>
|
||
MOVX S1,.BLDSN ;Block type - structure name
|
||
PUSHJ P,FNDBLK ;Get there
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
MOVE P1,S1 ;Preserve that guy for a minute
|
||
LOAD S1,0(P1) ;Get the structure name to be built
|
||
PUSHJ P,G$FTCB## ;Get that TCB
|
||
JUMPT BLD.1 ;Got it, so run it
|
||
LOAD T1,0(P1) ;Get the str name again
|
||
SETZB T2,T3 ;Clear the extraneous stuff
|
||
PUSHJ P,G$MTCB## ;Make up some space
|
||
BLD.1: LOAD S1,1(P1) ;Get the owner's ppn
|
||
STORE S1,TCB.OW(B) ;And stuff that in the TCB
|
||
SETZM TCB.SF(B) ;Init structure flag word
|
||
LOAD S1,.OFLAG(M),.DMNCK ;Get /NOCHECK bit
|
||
STORE S1,TCB.SF(B),TS.NCK ;Set/clear it
|
||
LOAD S1,.OFLAG(M),.MTWLK ;Get /WRITE-LOCKED bit
|
||
STORE S1,TCB.SF(B),TS.HWP ;Set/clear it
|
||
LOAD S1,.OFLAG(M),.DMNRQ ;Get number of requests that need str
|
||
STORE S1,TCB.SF(B),TS.NRQ ;Save for REMCHK
|
||
LOAD S1,.OFLAG(M),.DMOSN ;Get /OVERRIDE-SET-NUMBER bit
|
||
STORE S1,TCB.SF(B),TS.OSN ;Set/clear it
|
||
MOVX S1,.BLDUN ;Block type - units
|
||
PUSHJ P,FNDBLK ;Get that block
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, complain
|
||
LOAD S2,-ARG.DA(S1),AR.LEN ;Get the length of the block
|
||
SUBI S2,ARG.DA ;Discount the block header length
|
||
LSH S2,-1 ;Get real number of units
|
||
SKIPLE S2 ;Reasonable number?
|
||
CAILE S2,MAXVOL ;Do we have space for this structure?
|
||
JRST [$WTO (<PULSAR Internal error>,<Volume list for ^W/0(P1)/: Length of ^D/S2/ is wrong>,,$WTFLG(WT.SJI))
|
||
$RETF] ;Lose
|
||
STORE S2,TCB.NV(B) ;Save the # of volids
|
||
HRRI P1,TCB.DU(B) ;Point at the Disk Unit name area
|
||
BLD.2: MOVE TF,0(S1) ;Get the next unit name
|
||
MOVEM TF,0(P1) ;Save in unit list
|
||
MOVE TF,1(S1) ;Get the next volume name (pack id)
|
||
MOVEM TF,TCB.VL-TCB.DU(P1) ;Save in volume name list
|
||
ADDI S1,2 ;Account for the words just moved
|
||
AOS P1 ;And step to next Vol/Unit entry
|
||
SOJG S2,BLD.2 ;Do each of the Vol/Unit pairs
|
||
$RETT ;Return with TCB in B
|
||
SUBTTL - Ack/Nak senders
|
||
|
||
;These routines will send positive and negative acknowledgments to
|
||
; MDA after various flavors of requests.
|
||
; Typically, these routines are called after some function has been
|
||
; completed, and the function must tell MDA success or failure.
|
||
;Call -
|
||
; S1/ Flags,,Ack code type (%CAT, %MOUNT,%DSMNT)
|
||
; S2/ SIXBIT volume set name (structure name)
|
||
; Someday, we should take a pointer to a long VSN....
|
||
; G$COD/ Ack code to identify this request from others in QUASAR
|
||
|
||
O$ACK:: TDZA TF,TF ;Get winning indicator
|
||
O$NAK:: SETOM TF ;Get losing indicator
|
||
PUSHJ P,BLDACK ;Build the ack,
|
||
ACK.1: DMOVE S1,[EXP SAB.SZ,G$MSAB##] ;Aim at the arg block
|
||
$CALL C%SEND ;Fire it off
|
||
$RETT
|
||
|
||
;Here to just build the ack
|
||
;
|
||
; TF/ 1 for NAK, 0 for ACK
|
||
; S1/ Flags,,ack type
|
||
; S2/ SIXBIT volid
|
||
|
||
BLDACK: $SAVE <P1,P2,P3> ;Preserve some regs
|
||
DMOVE P1,S1 ;Save the input args
|
||
MOVE P3,TF ;Save good/bad indicator
|
||
$CALL M%GPAG ;Get a message page
|
||
MOVEM S1,G$MSAB##+SAB.MS ;Save in send block
|
||
MOVX S2,PAGSIZ ;Size of message
|
||
MOVEM S2,G$MSAB##+SAB.LN ;Save in arg block
|
||
MOVX S2,.QOACK ;Message type - ACK
|
||
STORE S2,.MSTYP(S1),MS.TYP ;Save in message
|
||
LOAD S2,P1,.MTWLK ;Get write-locked bit
|
||
STORE S2,.OFLAG(S1),.MTWLK ;Tell QUASAR
|
||
MOVX S2,.OHDRS+ARG.DA ;Initial size of message
|
||
STORE S2,.MSTYP(S1),MS.CNT ;Count the message
|
||
HRRZS P1 ;Strip off flags
|
||
STORE P1,.MSFLG(S1),AK.TYP ;Save ack type
|
||
STORE P3,.MSFLG(S1),AK.NAK ;Set ack/nak indicator
|
||
MOVE S2,G$COD## ;Get old ack code
|
||
MOVEM S2,.MSCOD(S1) ;Identify this ack from the rest
|
||
MOVEI S2,1 ;Only one..
|
||
MOVEM S2,.OARGC(S1) ; ...argument block
|
||
MOVX S2,<ARG.DA,,.RCTVS> ;Block type - volume set name
|
||
MOVEM S2,.OHDRS+ARG.HD(S1) ;Label the block
|
||
HRRI P1,.OHDRS+ARG.DA(S1) ;Place to put volume set name
|
||
HRLI P1,(POINT 7,) ;Make a pointer to it
|
||
MOVEM P1,ACKPTR ;Save that one
|
||
$TEXT (ACKDPB,<^W/P2/^0>) ;Move in the volume set name
|
||
HRRZ S1,ACKPTR ;Get terminating word
|
||
SUBI S1,-1(P1) ;Figure # words used
|
||
HRLZS S1 ;To LH (count field)
|
||
MOVE S2,G$MSAB##+SAB.MS ;Get message adrs again
|
||
ADDM S1,.MSTYP(S2) ;Update total message length
|
||
ADDM S1,.OHDRS+ARG.HD(S2) ;And update block length
|
||
$RETT
|
||
|
||
ACKDPB: IDPB S1,ACKPTR ;Stuff the next byte
|
||
$RETT ;And get out
|
||
|
||
ACKPTR: BLOCK 1 ;Space for the byTE pointer
|
||
SUBTTL O$ACKU - User Mount/Dismount ACK processor
|
||
; O$NCKU - User Mount/Dismount NAK processor
|
||
|
||
;These routines build the ACK/NAK back to MDA when a user does a
|
||
; structure Mount/Dismount.
|
||
;
|
||
;
|
||
; CALL: S1/ Type code (%ADSTR or %DMSTR)
|
||
; S2/ Sixbit structure name
|
||
; G$COD/ Ack code to identify this request from others in QUASAR
|
||
;
|
||
; RET: True Always
|
||
|
||
O$ACKU::TDZA TF,TF ;This is an ACK !!!
|
||
O$NCKU::SETOM TF ;This is a NAK !!!
|
||
PUSHJ P,BLDACK ;Build the message
|
||
SKIPN G$TXTB## ;Any additional info ???
|
||
JRST NCKU.1 ;No,,send the ACK/NAK off
|
||
$SAVE <P1,P2> ;Save some work ACs
|
||
MOVE P1,G$MSAB##+SAB.MS ;Get the message adrs
|
||
LOAD P2,.MSTYP(P1),MS.CNT ;Get length
|
||
AOS .OARGC(P1) ;One more arg block
|
||
ADDI P2,0(P1) ;Aim at first free
|
||
MOVE S1,[TXTSIZ,,.OMTXT] ;Get the text block length,,type
|
||
MOVEM S1,ARG.HD(P2) ;Store block header
|
||
HLLZS S1 ;Get just additional length
|
||
ADDM S1,.MSTYP(P1) ;Update total message length
|
||
MOVEI S1,ARG.DA(P2) ;Get destination address
|
||
HRLI S1,G$TXTB## ;Get source,,destination address
|
||
BLT S1,ARG.DA+TXTSIZ-1(P2) ;Copy the text to the ACK/NAK message
|
||
|
||
NCKU.1: DMOVE S1,[EXP SAB.SZ,G$MSAB##] ;Aim at the arg block
|
||
$CALL C%SEND ;Fire it off
|
||
$RETT ;Return
|
||
SUBTTL O$CLST - MANIPULATE SYSTEM LISTS
|
||
|
||
;This routine is the one that finally handles the
|
||
; operators request to add or remove and file structure or
|
||
; disk unit from the system-search-list or
|
||
; the crash-dump-list, or the active-swap-list
|
||
|
||
O$CLST::
|
||
$SAVE <P1,P2>
|
||
MOVEI S1,.STRDV ;Block type
|
||
PUSHJ P,FNDBLK ;Go get it
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;Nope, give up
|
||
HRROI S1,0(S1) ;Aim at the block
|
||
$CALL S%SIXB ;Convert to SIXBIT
|
||
MOVE P2,S2 ;Protect the device name
|
||
MOVEI S1,.SLSTY ;Block type -List descriptor
|
||
PUSHJ P,FNDBLK ;Find it
|
||
SKIPT ;Got it?
|
||
JSP S1,COMERR ;No, Oh well
|
||
LOAD P1,0(S1),SL.TCD ;Get the list ID
|
||
HRRZ S2,ADDTAB-SL.TMN(P1) ;Assume we want to add
|
||
MOVE S1,P2 ;Put back the device name
|
||
LOAD TF,.OFLAG(M),AD.REM ;Get the removal bit
|
||
SKIPE TF ;Is it really remove?
|
||
HLRZ S2,ADDTAB-SL.TMN(P1) ;Yes, get the removal adrs
|
||
PUSHJ P,0(S2) ;Add it, or remove it
|
||
PUSHJ P,@POSTAB(P1) ;Do whatever is customary at completion
|
||
$RETT
|
||
|
||
;Table of removal routines,,add routines
|
||
ADDTAB: XWD D$RSSL##,D$ASSL## ;System Search List
|
||
XWD D$RCDL##,D$ACDL## ;Crash Dump List
|
||
XWD D$RSUN##,D$ASUN## ;Active swap list
|
||
|
||
;Table of post-removal/addition routines
|
||
POSTAB: EXP CPOPJ
|
||
EXP CPOPJ
|
||
EXP CPOPJ
|
||
|
||
CPOPJ: $RETT
|
||
SUBTTL O$SLST - SHOW SYSTEM LISTS
|
||
|
||
;This routine pre-processes the message from OPR
|
||
; requesting information about various system lists
|
||
; Then it calls P$SLST to do the display
|
||
|
||
O$SLST::
|
||
MOVEI S1,.SLSTY ;Block type - list descriptor
|
||
PUSHJ P,FNDBLK ;See if there is one
|
||
JUMPF SLST.1 ;Is there a list block?
|
||
MOVE S1,0(S1) ;Yes, get the list type
|
||
SKIPA S1,LSTBLK-SL.TMN(S1) ;Load the right bit
|
||
SLST.1: MOVE S1,[EXP DS.ALL] ;No list block, show all lists
|
||
PJRST P$SLST## ;Go do the work
|
||
|
||
LSTBLK: EXP DS.SSL ;Display the system search list
|
||
EXP DS.CDL ;Display the crash dump list
|
||
EXP DS.ASL ;Display the active swapping list
|
||
END
|