mirror of
https://github.com/PDP-10/stacken.git
synced 2026-04-19 16:40:09 +00:00
663 lines
23 KiB
Plaintext
663 lines
23 KiB
Plaintext
TITLE PLRTAP - Tape Processing Module
|
||
SUBTTL Author: Clifford Romash/WLH/DC/NT 3-Aug-83
|
||
|
||
;
|
||
;
|
||
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
|
||
;1980,1981,1982,1983,1984,1985,1986,1987. ALL RIGHTS RESERVED.
|
||
;
|
||
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
|
||
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
|
||
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
|
||
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
|
||
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
|
||
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
|
||
;
|
||
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
|
||
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
|
||
; BY DIGITAL EQUIPMENT CORPORATION.
|
||
;
|
||
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
|
||
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
|
||
; DIGITAL.
|
||
|
||
SEARCH GLXMAC
|
||
SEARCH ORNMAC ;For the WTO definitions
|
||
SEARCH PLRMAC
|
||
PROLOG (PLRTAP)
|
||
|
||
|
||
;THIS MODULE CONTAINS THE TAPE I/O ROUTINES FOR PULSAR. ALL ROUTINES
|
||
; ALL CALLED WITH 'B' CONTAINING THE ADDRESS OF THE TCB,
|
||
; AND RETURN WITH S1 CONTAINING A TRUE/FALSE INDICATOR.
|
||
;
|
||
;ARGUMENTS ARE PASSED IN S1 AND S2.
|
||
|
||
;ROUTINES IN THIS MODULE USE AC'S S1 AND S2 ONLY. ALL OTHER ACS
|
||
; ARE GUARANTEED TO BE PRESERVED.
|
||
SUBTTL Directory for PLRTAP
|
||
SUBTTL T$INIT -- Initialize PLRTAP
|
||
|
||
;CALLED DURING PULSAR INITIALIZATION TO INITIALIZE PLRTAP'S
|
||
; LOCAL DATABASE.
|
||
|
||
ENTRY T$INIT
|
||
|
||
T$INIT: POPJ P, ;JUST RETURN FOR NOW
|
||
SUBTTL T$OPEN -- Open A Magtape For I/O
|
||
|
||
;T$OPEN IS CALLED TO INITIALIZE A MAGTAPE FOR LABEL PROCESSING I/O
|
||
; IT IS CALLED WITH THE TCB ADDRESS IN 'B'
|
||
; IF T$OPEN SUCCEEDS, IT RETURNS TRUE/FALSE AND CALLS THE
|
||
; CALLING ROUTINE AS A CO-ROUTINE. ON THE CALLERS RETURN, IT CALLS
|
||
; T$RELE. IF MORE THAN ONE CALL TO T$OPEN IS MADE BEFORE THE
|
||
; ORIGINAL CALLER RETURNS, T$OPEN IS A NOOP WHICH RETURNS TRUE.
|
||
|
||
ENTRY T$OPEN
|
||
|
||
T$OPEN: $TRACE (T$OPEN,6)
|
||
LOAD S1,TCB.IO(B) ;GET IO STATUS
|
||
TXNE S1,TI.OPN ;IS DEVICE OPEN?
|
||
$RETT ;YES, DON'T DO ANYTHING
|
||
LOAD LT,TCB.LT(B) ;GET THE LABEL TYPE FROM THE TCB
|
||
PUSH P,T1 ;SAVE
|
||
PUSH P,T2 ; THE
|
||
PUSH P,T3 ; 'T'
|
||
PUSH P,T4 ; AC's
|
||
PUSHJ P,MAKBUF ;Make up some buffers for the TCB
|
||
MOVX T1,TI.OPN ;GET DEVICE IS OPEN BIT
|
||
IORM T1,TCB.IO(B) ;TURN IT ON
|
||
MOVEI T1,.TFLBG ;FUNCTION FOR LABEL GET
|
||
LOAD T2,TCB.DV(B) ;DEVICE NAME
|
||
MOVE T3,[2,,T1] ;AC FOR TAPOP.
|
||
SETZM TCB.DN(B) ;No device yet
|
||
; (in case offline during label get)
|
||
TAPOP. T3, ;GET THE LABEL DDB
|
||
STOPCD (LGF,HALT,,<Label get failed>)
|
||
STORE T3,TCB.DN(B) ;STORE LABEL DDB NAME IN TCB
|
||
MOVE T2,T3 ;USE IT AS DEVICE NAME FOR OTHER TAPOP.'S
|
||
MOVEI T1,.TFBSZ+.TFSET ;FUNCTION TO SET BLOCKSIZE
|
||
MOVX T3,BFRSIZ+1 ;GET BUFFER SIZE + A LITTLE EXTRA
|
||
MOVE T4,[3,,T1] ;AC FOR TAPOP.
|
||
TAPOP. T4, ;SET THE BLOCKSIZE
|
||
STOPCD (CSB,HALT,,<Can't set blocksize>)
|
||
MOVEI T3,.TFM8B ;INDUSTRY COMPATIBLE 8 BIT MODE
|
||
MOVEI T1,.TFMOD+.TFSET ;ASK TO SET IT
|
||
MOVE T4,[3,,T1] ;AC FOR TAPOP.
|
||
TAPOP. T4, ;SET MODE
|
||
STOPCD (CSI,HALT,,<Can't set industry compatible mode>)
|
||
REPEAT 0,<
|
||
LOAD T3,TCB.PS(B),TP.DEN ;GET DENSITY FROM THE TCB
|
||
JUMPE T3,OPEN.0 ;DON'T KNOW THE DENSITY
|
||
MOVEI T1,.TFDEN+.TFSET ;ARG TO SET IT
|
||
MOVE T4,[3,,T1] ;AC FOR TAPOP.
|
||
TAPOP. T4, ;SET THE DENSITY
|
||
STOPCD (CSD,HALT,,<Can't set density>)
|
||
OPEN.0:>;END REPEAT 0
|
||
MOVX S1,UU.DEL+.IODMP ;Get bit to disable error logging
|
||
MOVEM S1,TCB.FI(B) ;Light in FILOP I/O status word
|
||
MOVX S1,.FOMAU ;Update mode (Input and Output)
|
||
PUSHJ P,T$FILOP ;Do the FILOP
|
||
MOVX S1,FO.ASC ;Get assign ext channel bit
|
||
ANDCAM S1,TCB.FU(B) ;We've got a channel, don't ask again
|
||
MOVEI S1,PS.RDO!PS.RDH ;TRAP OFF-LINE AND HUNG DEVICE
|
||
PUSHJ P,I$PICD## ;CONNECT DEVICE TO PSI SYSTEM
|
||
SKIPT ;CHECK FOR ERRORS
|
||
STOPCD (CCT,HALT,,<Can't connect tape to PSI system>)
|
||
MOVX S1,.TFRDB ;SET UP TO READ 'READ-BACKWARDS' BIT
|
||
LOAD S2,TCB.DV(B) ;GET REAL DEVICE NAME
|
||
MOVE T1,[2,,S1] ;LOAD AC FOR TAPOP
|
||
CAIE LT,.TFLNV ;UNLABELD USER-EOT?
|
||
TAPOP. T1, ;NO - READ THE BIT
|
||
SETZ T1, ;ASSUME NOT READ-BACKWARDS
|
||
JUMPE T1,OPEN.1 ;IF NOT READING BACKWARDS,,CONTINUE
|
||
MOVX S1,LE.IOP ;ELSE GET POSITIONING ERROR
|
||
MOVEM S1,G$TERM## ;SET IT
|
||
MOVX S1,TS.ERR ;GET THE ERROR INTERLOCK
|
||
IORM S1,TCB.ST(B) ;AND SET IT ALSO
|
||
|
||
OPEN.1: POP P,T4 ;RESTORE
|
||
POP P,T3 ; THE
|
||
POP P,T2 ; 'T'
|
||
POP P,T1 ; AC's
|
||
MOVEI S1,T$RELE ;GET THE ADDRESS FOR CALLER TO RETURN TO
|
||
EXCH S1,0(P) ;EXCHANGE IT WITH CALLERS ADDRESS
|
||
PUSH P,S1 ;PUT CALLERS ADDRESS BACK ON STACK
|
||
MOVX S1,TS.ERR ;GET THE ERROR LOCK BIT
|
||
TDNN S1,TCB.ST(B) ;IS IT ON?
|
||
$RETT ;NO,,ALL'S OK !!!
|
||
$RETF ;ERROR WAS ON, RETURN FALSE
|
||
SUBTTL T$RELE -- Routine To Release Label IO Channel
|
||
|
||
;THIS ROUTINE IS CALLED AT THE END OF LABEL PROCESSING TO RELEASE
|
||
; THE IO CHANNEL USED FOR LABEL IO AND TO DO THE LABEL RELEASE
|
||
; TO START THE JOB WHICH WAS BLOCKED
|
||
;
|
||
;IT IS CALLED WITH 'B' CONTAINING THE ADDRESS OF THE TCB. AND RETURNS
|
||
; TRUE/FALSE
|
||
|
||
ENTRY T$RELEASE
|
||
|
||
T$RELE: $TRACE (T$RELE,6)
|
||
$CALL .SAVET ;SAVE SOME AC'S
|
||
PUSHJ P,I$PIRD## ;REMOVE PSI CONDITIONS
|
||
MOVE T4,TCB.IO(B) ;GET IO STATUS
|
||
MOVE S1,G$TERM## ;GET THE TERMINATION CODE
|
||
CAILE S1,LE.EOF ;IS IT ONE WHICH IS
|
||
CAIN S1,LE.BOT ;CONTINUABLE??
|
||
JRST RELE.1 ;YES, DON'T SET ERROR
|
||
MOVX S1,TS.SLR ;GET A BIT
|
||
TDNE S1,TCB.ST(B) ;SKIP LABEL RELEASE?
|
||
JRST RELE.1 ;YES
|
||
MOVX S1,TS.ERR ;GET THE ERROR INTERLOCK BIT
|
||
IORM S1,TCB.ST(B) ;AND TURN IT ON
|
||
MOVE S1,G$TERM## ;GET THE TERMINATION CODE
|
||
STORE S1,TCB.EC(B),TE.TRM ;STORE SO USER WILL GET THE SAME ERROR
|
||
|
||
RELE.1: LOAD S1,TCB.FU(B),TF.DVH ;Get channel #
|
||
RESDV. S1, ;RELEASE, BUT DON'T WRITE TAPE MARKS
|
||
JFCL ;Ignore the error
|
||
SETZM TCB.IC(B) ;ZAP INPUT CCW
|
||
SETZM TCB.OC(B) ;ZAP OUTPUT CCW
|
||
MOVE S1,TCB.ST(B) ;GET STATUS BITS
|
||
TXZ S1,TS.SLR ;CLEAR "SKIP LABEL RELEASE"
|
||
EXCH S1,TCB.ST(B) ;UPDATE
|
||
TXNE S1,TS.SLR ;SKIP LABEL RELEASE?
|
||
JRST RELE.2 ;YES
|
||
MOVEI T1,.TFLRL ;FUNCTION FOR LABEL RELEASE
|
||
LOAD T2,TCB.DV(B) ;GET THE REAL DEVICE NAME
|
||
JUMPE T2,RELE.3 ;No label ddb, quit
|
||
MOVE T3,G$TERM## ;GET TERMINATION CODE
|
||
MOVX S1,TS.ERR ;GET THE ERROR BIT
|
||
TDNE S1,TCB.ST(B) ;IS IT SET
|
||
LOAD T3,TCB.EC(B),TE.TRM ;YES, USE THE OLD CODE
|
||
IFN FTTRACE,<
|
||
SKIPE G$DEBUG ;Are we debugging?
|
||
$TEXT (,<Closing Label DDB with termination code of #^O/T3/>)
|
||
>;END OF FTTRACE CONDITIONAL
|
||
MOVE S1,[3,,T1] ;AC FOR TAPOP.
|
||
TAPOP. S1, ;SET THE TERM CODE
|
||
STOPCD (LRF,HALT,,<Label release failed>)
|
||
|
||
RELE.2: TXNN T4,TI.OAV ;SPECIAL AVR OPEN MODE
|
||
JRST RELE.3 ;NO, CONTINUE
|
||
MOVEI T1,.TFLDD ;YES, MUST DESTROY THE DDB
|
||
LOAD T2,TCB.DV(B) ;GET THE DEVICE NAME
|
||
MOVE T3,[2,,T1] ;AC FOR TAPOP
|
||
TAPOP. T3, ;DO THE LABEL DESTROY
|
||
JFCL ;IGNORE THE ERROR
|
||
SETZM TCB.IO(B) ;CLEAR THE I/O WORD
|
||
|
||
RELE.3: TXNN T4,TI.LND ;DOES LABEL DDB NEED TO BE DESTROYED?
|
||
JRST RELE.4 ;DON'T NEED TO DESTROY DDB
|
||
MOVEI T1,.TFLDD ;FUNCTION FOR LABEL DESTROY
|
||
LOAD T2,TCB.DS(B) ;OLD DEVICE NAME
|
||
MOVE T3,[2,,T1] ;AC FOR TAPOP
|
||
TAPOP. T3, ;DO THE LABEL DESTROY
|
||
JFCL ;IGNORE THE ERROR
|
||
|
||
RELE.4: MOVE T1,[TI.EOF!TI.EOT!TI.OPN!TI.BOT!TI.LND!TI.SOP] ;GET LOTSA BITS
|
||
ANDCAM T1,TCB.IO(B) ;CLEAR THEM
|
||
$RETT ;GIVE GOOD RETURN
|
||
SUBTTL T$NUNI -- Routine to Switch to New Unit
|
||
|
||
;THIS ROUTINE IS CALLED WITH S1 CONTAINING THE NEW UNIT NAME IN SIXBIT
|
||
; AND B POINTING TO THE TCB
|
||
;IT RETURNS WITH THE TCB SET UP TO USE THE NEW UNIT
|
||
;AND TRUE/FALSE
|
||
|
||
ENTRY T$NUNI
|
||
|
||
T$NUNI: $TRACE (T$NUNI,6,S1)
|
||
$CALL .SAVET ;SAVE SOME AC'S TO WORK IN
|
||
$SAVE <P1,P2> ;And some more regs
|
||
MOVE P1,S1 ;Save new device name
|
||
MOVE P2,B ;Save ptr to the TCB
|
||
PUSHJ P,G$FTCB## ;Ask for new device's TCB
|
||
SKIPT ;Found it?
|
||
STOPCD (SND,HALT,,<Switch units with non-existent device (see P1)>)
|
||
MOVX T1,TI.OPN ;Get channel opened bit
|
||
TDNE T1,TCB.IO(B) ;Is this DDB open?
|
||
STOPCD (SIO,HALT,,<Switch units with OPEN label DDB>)
|
||
EXCH B,P2 ;Reset to our TCB, save new TCB
|
||
MOVE T3,P1 ;GET NEW DEVICE IN T3
|
||
LOAD T2,TCB.DV(B) ;AND OLD DEVICE TO T2
|
||
MOVEI T1,.TFLSU ;TAPOP FUNCTION TO SWITCH UNITS
|
||
MOVE T4,[3,,T1] ;AC FOR TAPOP.
|
||
TAPOP. T4, ;DO THE SWITCH UNITS
|
||
STOPCD (CSU,HALT,,<Can't switch units>)
|
||
STORE T3,TCB.DV(B) ;SAVE NEW DEVICE NAME
|
||
SKIPN TCB.DS(B) ;KEEP THE ORIGIONAL DRIVE NAME
|
||
STORE T2,TCB.DS(B) ;SAVE OLD DEVICE TO BE DESTROYED
|
||
MOVX T1,TI.LND ;FLAG FOR LABEL DDB NEEDS DESTUCTION
|
||
IORM T1,TCB.IO(B) ;TURN IT ON
|
||
STORE T2,TCB.DV(P2) ;Make new TCB look like old TCB
|
||
|
||
MOVE T1,TCB.CH(B) ;Get device dependent stuff
|
||
EXCH T1,TCB.CH(P2) ;Swap with old unit
|
||
MOVEM T1,TCB.CH(B) ;Save the new stuff
|
||
$RETT ;AND RETURN TRUE
|
||
SUBTTL T$SUNI -- Routine to Switch to Same Unit
|
||
|
||
|
||
T$SUNI::$TRACE (T$SUNI,6,S1)
|
||
$CALL .SAVET ;SAVE SOME ACS
|
||
MOVE T1,[3,,T2] ;SET UP UUO AC
|
||
MOVEI T2,.TFLSU ;FUNCTION CODE
|
||
MOVE T3,TCB.DV(B) ;GET DRIVE NAME
|
||
MOVE T4,T3 ;SAME UNIT, REMEMBER?
|
||
TAPOP. T1, ;KICK MONITOR
|
||
PUSHJ P,S..CSU ;SHOULDN'T FAIL
|
||
POPJ P, ;AND RETURN
|
||
SUBTTL T$LTYP -- IS THE DRIVE IN LABEL MODE
|
||
|
||
;CALLED WITH S1 CONTAINING THE UNIT NAME IN SIXBIT
|
||
|
||
T$LTYP:: $CALL .SAVET ;SAVE SOME TEMPS
|
||
MOVE T1,[XWD 3,T2] ;UUO ARGUMENT
|
||
MOVEI T2,.TFLBL ;FUNCTION TO GET LABEL TYPE
|
||
MOVE T3,S1 ;COPY THE DEVICE NAME
|
||
TAPOP. T1, ;GET THE LABEL TYPE
|
||
STOPCD (RLT,HALT,,<Failed reading label type>)
|
||
SKIPE T1 ;BLP MODE
|
||
CAILE T1,.TFLIU ;IS IT A LEGAL TYPE
|
||
$RETF ;NO
|
||
$RETT ;YES, LEGAL LABEL TYPE
|
||
SUBTTL T$CKAV -- Check unit's acceptibility
|
||
|
||
;CALLED WITH S1 CONTAINING A UNIT NAME IN SIXBIT
|
||
|
||
T$CKAV::MOVE S2,S1 ;SAVE DEVICE NAME
|
||
DEVCHR S1, ;SEE IF THE DEVICE IS AVAILABLE
|
||
TXNE S1,DV.ASC!DV.ASP ;IS THE DEVICE OWNED BY SOMEONE?
|
||
$RETF ;YES, LOSE
|
||
$RETT ;NO, WIN
|
||
SUBTTL T$POS -- Position Tape
|
||
|
||
;T$POS IS CALLED WITH B CONTAINING THE TCB ADDRESS AND S1 CONTAINING
|
||
; THE DESIRED POSITIONING FUNCTION. POSITIONING FUNCTIONS
|
||
; ARE 3 CHARACTER SIXBIT CODES. LEGAL CODES ARE:
|
||
;
|
||
; 'REW' REWIND THE TAPE
|
||
; 'UNL' UNLOAD THE TAPE
|
||
; 'SBL' SKIP FORWARD 1 BLOCK
|
||
; 'SFL' SKIP FORWARD 1 FILE
|
||
; 'BBL' SKIP BACKWARD 1 BLOCK
|
||
; 'BFL' SKIP BACKWARD 1 FILE
|
||
; 'EOT' SKIP TO LOGICAL EOT
|
||
; 'DSE' DATA SECURITY ERASE
|
||
|
||
;RETURNS TRUE ALWAYS.
|
||
|
||
T$POS:: $TRACE (T$POS,6,S1)
|
||
$CALL .SAVE3 ;SAVE P1-P3
|
||
MOVSI P1,-PFUNCN ;MAKE AOBJN POINTER
|
||
POS.1: MOVE P2,PFUNCT(P1) ;GET THE FUNCTION
|
||
CAIN S1,(P2) ;DO THE COMPARE
|
||
JRST POS.2 ;GOT ONE
|
||
AOBJN P1,POS.1 ;AND LOOP
|
||
STOPCD (IPF,HALT,,<Illegal positioning function>)
|
||
|
||
POS.2: IFN FTTRACE,<
|
||
SKIPE G$DEBUG ;Are we debugging?
|
||
$TEXT (,<PULSAR (PLRTAP) positioning for ^T/@POS.T(P1)/>)
|
||
JRST POS.4 ;Skip over the in-line table
|
||
POS.T: [ASCIZ /REWIND/]
|
||
[ASCIZ /UNLOAD/]
|
||
[ASCIZ /SKIP ONE BLOCK/]
|
||
[ASCIZ /SKIP ONE FILE/]
|
||
[ASCIZ /EOT/]
|
||
[ASCIZ /BACKSPACE ONE BLOCK/]
|
||
[ASCIZ /BACKSPACE ONE FILE/]
|
||
POS.4:
|
||
>;END OF FTTRACE CONDITIONAL
|
||
MOVE S2,TCB.IO(B) ;GET I/O STATUS BITS
|
||
TXZ S2,TI.EOT!TI.EOF ;CLEAR EOT & EOF SINCE TAPE WILL MOVE
|
||
CAIN S1,'REW' ;REWIND?
|
||
TXOA S2,TI.BOT ;POSITIONING TO BOT (SKIP TO ZAP LEOT)
|
||
CAIN S1,'UNL' ;UNLOAD?
|
||
TXZ S2,TI.LET ;CLEAR LEOT
|
||
MOVEM S2,TCB.IO(B) ;UPDATE STATUS
|
||
PUSHJ P,T$CLRS ;CLEAR ANY PENDING I/O ERRORS
|
||
HLRZ P1,P2 ;PUT FUNCTION IN P1
|
||
LOAD P2,TCB.FU(B),TF.DVH ;GET THE CHANNEL NUMBER
|
||
MOVE P3,[2,,P1] ;LOAD ARG POINTER
|
||
CAXN P1,.TFUNL ;ABOUT TO DO UNLOAD?
|
||
SETOM G$UNL## ;YES, SET FLAG FOR OFFLINE TRAP
|
||
TAPOP. P3, ;AND DO IT
|
||
SKIPA S1,TCB.PI(B) ;FAILED - GET PSI WORD
|
||
JRST POS.5 ;ONWARD
|
||
TXNE S1,PS.RDH ;HUNG DEVICE?
|
||
PJRST TAPHNG ;YES
|
||
HRRZS P1 ;ISOLATE FUNCTION CODE
|
||
CAIN P1,.TFDSE ;DATA SECURITY ERASE?
|
||
$RETF ;EASY ONE TO HANDLE
|
||
TXNE S1,PS.RDO ;UNIT OFF-LINE?
|
||
JRST POS.6 ;YES
|
||
STOPCD (PRF,HALT,,<Positioning request failed>)
|
||
|
||
POS.6: CAXE P1,.TFREW ;Were we doing a rewind?
|
||
JRST POS.5 ;No, continue, else give it another try
|
||
SETZM TCB.PI(B) ;Clear the PSI word
|
||
SETZM TCB.WS(B) ;Clear the wait state
|
||
MOVE P3,[2,,P1] ;Get a pointer to try rewinding again
|
||
LOAD P2,TCB.FU(B),TF.DVH ;Get the channel number
|
||
MOVX P1,.TFREW ;Get the rewind code
|
||
TAPOP. P3, ;Do it
|
||
JFCL ;Let following catch error
|
||
POS.5: SETZM G$UNL## ;CLEAR 'UNLOADING' FLAG
|
||
MOVX S1,TS.NTP ;GET NO TAPE PRESENT BIT
|
||
CAXN P1,.TFUNL ;WAS IT AN UNLOAD?
|
||
IORM S1,TCB.ST(B) ;YES, SET APPROPRIATE FLAG
|
||
CAXE P1,.TFUNL ;WAS IT AN UNLOAD?
|
||
CAXN P1,.TFREW ;DOING A REWIND
|
||
$RETT ;DON'T WAINT ON ERROR
|
||
CAXE P1,.TFFSF ;Skip file?
|
||
CAXN P1,.TFBSF ;or backspace file?
|
||
PUSHJ P,G$OJOB## ;Yes, that'll take a while, service
|
||
; other tape requests
|
||
PUSHJ P,T$WAIT ;Wait for things to settle down
|
||
MOVX S1,.FOGET ;FILOP code to pull GETSTS
|
||
PUSHJ P,T$FILOP ;Get the bits
|
||
MOVE P1,S2 ;Save status bits
|
||
PUSHJ P,T$CLRS ;Go clear the status
|
||
MOVE S1,TCB.IO(B) ;GET I/O STATUS WORD
|
||
TRNE P1,IO.EOF ;EOF?
|
||
TXO S1,TI.EOF ;YES
|
||
TRNE P1,IO.BOT ;BOT?
|
||
TXO S1,TI.BOT ;YES
|
||
MOVEM S1,TCB.IO(B) ;UPDATE I/O STATUS WORD
|
||
TRNN P1,IO.EOF!IO.BOT ;ANY INTERESTING BITS?
|
||
JRST POS.3 ;NO
|
||
MOVX P2,CL.OUT ;Get suppress output close bit
|
||
IORM P2,TCB.FI(B) ;Turn it on,
|
||
MOVX S1,.FOCLS ;FILOP code to CLOSE
|
||
PUSHJ P,T$FILOP ;Close input side, clearing EOF
|
||
ANDCAM P2,TCB.FI(B) ;Clear the suppress output close bit
|
||
POS.3: TRNN P1,IO.IMP!IO.DER!IO.DTE ;ANY OTHER ERRORS? (IGNORE IO.BKT)
|
||
$RETT ;NO, RETURN
|
||
PJRST RETERR ;STORE ERROR IN G$TERM AND RETURN
|
||
|
||
|
||
;POSITIONING FUNCTION TABLE XWD TAPOP FUNCTION,SIXBIT CODE
|
||
|
||
PFUNCT: XWD .TFREW, 'REW' ;REWIND
|
||
XWD .TFUNL, 'UNL' ;UNLOAD
|
||
XWD .TFFSB, 'SBL' ;SKIP ONE BLOCK
|
||
XWD .TFFSF, 'SFL' ;SKIP ONE FILE
|
||
XWD .TFSLE, 'EOT' ;SKIP TO LOGICAL END OF TAPE
|
||
XWD .TFBSB, 'BBL' ;BACKSPACE ONE BLOCK
|
||
XWD .TFBSF, 'BFL' ;BACKSPACE ONE FILE
|
||
XWD .TFDSE, 'DSE' ;DATA SECURITY ERASE
|
||
PFUNCN=.-PFUNCT ;LENGTH OF POSITIONING DISPATCH TABLE
|
||
SUBTTL Tape I/O Routines
|
||
|
||
|
||
INTERN T$WRTM ;WRITE A TAPE MARK
|
||
INTERN T$WRRC ;WRITE A RECORD
|
||
INTERN T$RDRC ;READ A RECORD
|
||
INTERN T$CLOS ;DO A CLOSE OUTPUT
|
||
SUBTTL T$WRTM -- Write a Tape Mark
|
||
|
||
;CALLED TO WRITE A TAPE MARK.
|
||
|
||
T$WRTM: $TRACE (T$WRTM,6)
|
||
$CALL .SAVE2 ;SAVE P1 AND P2
|
||
MOVX S1,<TI.EOT!TI.EOF> ;GET BITS FOR EOT AND EOF
|
||
ANDCAM S1,TCB.IO(B) ; AND CLEAR THEM
|
||
MOVEI P1,.TFWTM ;GET TAPOP FUNCTION
|
||
LOAD P2,TCB.FU(B),TF.DVH ;GET THE CHANNEL NUMBER
|
||
MOVE S1,[2,,P1] ;LOAD ARG POINTER
|
||
TAPOP. S1, ;DO IT
|
||
CAIN S1,TPWWL% ;WRITE LOCKED TAPE?
|
||
JRST WRTM.1 ;ANALYZ I/O STATUS
|
||
STOPCD (CWT,HALT,,<Can't write tape-mark>)
|
||
|
||
WRTM.1: MOVX S1,.FOGET ;FILOP code to GETSTS
|
||
PUSHJ P,T$FILOP ;Get it
|
||
MOVE P1,S2 ;Get is status
|
||
TRNN P1,IO.DTE!IO.DER!IO.IMP ;ANY ERRORS?
|
||
$RETT ;NO, JUST RETURN
|
||
PUSHJ P,T$CLRS ;Clear the error status
|
||
PJRST RETERR ;STORE ERROR AND RETURN
|
||
SUBTTL T$WRRC -- Write A Record
|
||
|
||
;CALLED TO WRITE A RECORD ON TAPE
|
||
|
||
T$WRRC: $TRACE (T$WRRC,6,,<MOVEI S1,TCB.WB(B)
|
||
TLO S1,(POINT 8,0)
|
||
$TEXT (,<^M^J^Q/S1/>)>)
|
||
$CALL .SAVE1 ;SAVE A REGISTER
|
||
MOVX S1,<TI.EOT!TI.EOF> ;GET BITS FOR EOT AND EOF
|
||
ANDCAM S1,TCB.IO(B) ; AND CLEAR THEM
|
||
MOVX S1,.FOOUT ;FILOP code to do an OUT
|
||
PUSHJ P,T$FILOP ;Write the buffer
|
||
SKIPF ;Any errors?
|
||
$RETT ;NO ERRORS, GIVE GOOD RETURN
|
||
MOVE P1,S2 ;Save the error bits
|
||
PUSHJ P,T$CLRS ;Clear out the error bits
|
||
MOVX S1,TI.EOT ;OPERATION SAW EOT BIT
|
||
TRNE P1,IO.EOT ;DID IT?
|
||
IORM S1,TCB.IO(B) ;YES, TURN IT ON IN TCB
|
||
TRNN P1,IO.IMP!IO.DER!IO.BKT!IO.DTE ;ANY ERRORS?
|
||
$RETT ;NO, GIVE GOOD RETURN
|
||
PJRST RETERR ;STORE ERRORS AND RETURN
|
||
SUBTTL T$RDRC -- Read A Record
|
||
|
||
;CALLED TO READ A RECORD FROM MAGTAPE
|
||
|
||
T$RDRC: $CALL .SAVE3 ;SAVE SOME REGS
|
||
LOAD S1,TCB.IO(B),TI.DEC ;GET THE DO DEC COMPAT IO BIT
|
||
JUMPE S1,RDRC.1 ;DON'T CHANGE MODE IF NOT ON
|
||
LOAD P2,TCB.DN(B) ;GET NAME RETURNED BY LABEL GET
|
||
MOVEI P1,.TFMOD+.TFSET ;ARG TO TAPOP TO SET MODE
|
||
MOVEI P3,.TFMDD ;DEC COMPATIBLE MODE
|
||
MOVE S1,[3,,P1] ;AC FOR TAPOP.
|
||
TAPOP. S1, ;SET THE MODE
|
||
STOPCD (CSM,HALT,,<Can't set DIGITAL compatible mode>)
|
||
RDRC.1: MOVX S1,<TI.EOT!TI.EOF> ;GET BITS FOR EOT AND EOF
|
||
ANDCAM S1,TCB.IO(B) ; AND CLEAR THEM
|
||
MOVX S1,.FOINP ;FILOP code to do INPUT
|
||
PUSHJ P,T$FILOP ;Read next block
|
||
SKIPF ;OK?
|
||
IFE FTTRACE,< $RETT > ;ALL IS WELL
|
||
IFN FTTRACE,< JRST RDRC.9>
|
||
MOVE P1,S2 ;Save the error bits
|
||
TRNN P1,IO.IMP!IO.DER!IO.DTE!IO.EOF!IO.BKT ;ANY IO ERRORS?
|
||
$RETT ;NO, JUST FINISH UP
|
||
PUSHJ P,T$CLRS ;Clear the bits
|
||
TRNN P1,IO.EOF ;END OF FILE?
|
||
JRST RDRC.3 ;NO, PROCEED
|
||
MOVX S1,TI.EOF ;SAY END OF FILE SEEN
|
||
IORM S1,TCB.IO(B) ;IN THE TCB
|
||
MOVX P2,CL.OUT ;Get suppress output close bit
|
||
IORM P2,TCB.FI(B) ;Light in FILOP block
|
||
MOVX S1,.FOCLS ;FILOP code to CLOSE
|
||
PUSHJ P,T$FILOP ;Close the input side of tape
|
||
ANDCAM P2,TCB.FI(B) ; to clear EOF. Clear suppress bit
|
||
RDRC.3: TRNE P1,IO.IMP!IO.DER!IO.DTE ;ANY IO ERRORS?
|
||
PJRST RETERR ;YES, STORE ERROR AND RETURN
|
||
RDRC.9: $TRACE (T$RDRC,6,,<MOVEI S1,TCB.IB(B)
|
||
TLO S1,(POINT 8,0)
|
||
$TEXT (,<^M^J^Q/S1/>)>)
|
||
$RETT ;NO, RETURN NOW
|
||
SUBTTL T$CLOS -- Close Output
|
||
|
||
;CALLED TO DO A CLOSE OUTPUT AFTER WRITING LABELS
|
||
|
||
T$CLOS: $TRACE (T$CLOS,6)
|
||
$CALL .SAVE3 ;SAVE SOME REGS
|
||
SETZM TCB.FI(B) ;Clear Status bits
|
||
MOVX S1,<TI.EOT!TI.EOF> ;GET BITS FOR EOT AND EOF
|
||
ANDCAM S1,TCB.IO(B) ; AND CLEAR THEM
|
||
MOVX S1,.FOCLS ;FILOP code to close channel
|
||
PUSHJ P,T$FILOP ;Finished with the device
|
||
MOVX S1,.FOWAT ;Want to wait for I/O to finish
|
||
PUSHJ P,T$FILOP ; So do it...
|
||
MOVX S1,.FOGET ;FILOP code to GETSTS
|
||
PUSHJ P,T$FILOP ;Read the error bits
|
||
MOVE P1,S2 ;Pick bits out of FILOP block
|
||
TRNE P1,IO.IMP!IO.DER!IO.DTE ;ANY ERRORS?
|
||
PJRST RETERR ;YES, STORE ERROR AND RETURN
|
||
$RETT ;NO,,RETURN
|
||
SUBTTL Special Purpose Routines
|
||
|
||
;This routine takes a device name in S1.
|
||
;PULSAR doesn't know about this device, but assumedly, it is a magtape.
|
||
;This routine will try to get the user out of event wait by getting
|
||
;and releasing the label DDB.
|
||
|
||
T$LGET:: $TRACE (T$LGET,6,S1)
|
||
MOVEI T1,.TFLRL ;FUNCTION FOR LABEL RELEASE
|
||
MOVE T2,S1 ;COPY DEVICE NAME TO T2
|
||
MOVE T3,G$TERM## ;TERMINATION CODE
|
||
MOVE T4,[3,,T1] ;AC FOR TAPOP
|
||
TAPOP. T4, ;DO THE LABEL RELEASE
|
||
JFCL ;Oh well, user loses
|
||
MOVEI T1,.TFLDD ;LABEL DESTROY
|
||
MOVE T3,[2,,T1] ;AC FOR TAPOP
|
||
TAPOP. T3, ;DESTROY USELESS DDB
|
||
JFCL ;OH WELL, WE TRIED !!!
|
||
$RETT ;RETURN
|
||
;HERE TO CHECK WRITE RING STATUS OF TAPE.
|
||
;TAPE HAS BEEN REWOUND.
|
||
;RETURNS S2=1 IF TAPE IS WRITE-LOCKED (RING OUT), S2=0 IF NOT
|
||
|
||
T$WRCK:: $CALL .SAVET ;SAVE SOME REGISTERS
|
||
MOVEI T1,.TFWLK ;TAPOP. FUNCTION
|
||
LOAD T2,TCB.FU(B),TF.DVH ;GET DEVICE TO USE
|
||
MOVE T3,[2,,T1] ;AC FOR TAPOP.
|
||
TAPOP. T3, ;GET THE STATUS FROM THE TAPE
|
||
STOPCD (CCR,HALT,,<Can't check ring status>)
|
||
MOVE S2,T3 ;COPY RETURNED ANSWER TO S2
|
||
$RETT ;RETURN
|
||
SUBTTL T$FILOP - Routine to pull a FILOP for the TCB
|
||
|
||
;Call with S1/ FILOP function code
|
||
; B/ TCB addrs
|
||
;Returns - TRUE if FILOP skips
|
||
; FALSE if FILOP loses on an IN or OUT
|
||
; If the FILOP loses and we aren't doing IN or OUT, T$FILOP STOPCDs
|
||
; For function .FOGET, the IO status bits are returned in S2
|
||
; If and IN or OUT fails, the IO status bits come back in S2 also
|
||
|
||
T$FILOP::
|
||
STORE S1,TCB.FU(B),RHMASK ;Stash desired opcode
|
||
|
||
FILO.0: SETZM S2 ;CLEAR S2
|
||
CAXN S1,.FOINP ;Doing input ?
|
||
MOVEI S2,TCB.IC(B) ;Yes, get input CCW list address
|
||
CAXN S1,.FOOUT ;Doint output ?
|
||
MOVEI S2,TCB.OC(B) ;Yes, get output CCW list address
|
||
SKIPE S2 ;Still null,,don't set
|
||
MOVEM S2,TCB.FI(B) ;Save the CCW
|
||
HRRI S2,TCB.FB(B) ;Aim at block
|
||
HRLI S2,FLPLEN ;And set the length
|
||
CAXE S1,.FOINP ;Doing input
|
||
CAXN S1,.FOOUT ; or output
|
||
TRNA ; No, don't wait
|
||
JRST FILO.1 ;Don't bother waiting & lenght ok
|
||
PUSHJ P,T$WAIT ;Yes, wait for any positioning
|
||
HRLI S2,2 ;The block lenght must now be 2
|
||
FILO.1: FILOP. S2, ;Do the work
|
||
SKIPA ;No, see if we can hack it
|
||
$RETT ;Wins, so does caller
|
||
MOVEI TF,0 ;CLEAR AC
|
||
EXCH TF,TCB.PI(B) ;GET INTERRUPT BITS AND CLEAR
|
||
TRNN TF,PS.RDO!PS.RDH ;OFF-LINE OR HUNG?
|
||
$RETF ;MUST BE A REAL I/O ERROR
|
||
TRNE TF,PS.RDH ;HUNG DEVICE?
|
||
JRST TAPHNG ;YES
|
||
TRNE TF,PS.RDO ;OFF-LINE?
|
||
JRST TAPOFL ;YES
|
||
$RETF ;SHOULDN'T GET HERE
|
||
|
||
TAPOFL: MOVX S1,TS.NTP ;GET NO TAPE PRESENT BIT
|
||
IORM S1,TCB.ST(B) ;SET FOR OPR NOTIFY
|
||
PUSHJ P,O$STAT## ;TELL THE OPERATOR
|
||
MOVX S1,TS.INI ;GET THE INITIALIZATION BIT
|
||
TDNE S1,TCB.ST(B) ;DOING THAT?
|
||
JRST TAPINI ;WAIT FOR DRIVE TO COME ONLINE
|
||
MOVE S1,TCB.DV(B) ;GET DEVICE NAME
|
||
PUSHJ P,T$CKAV ;SEE IF IN USE
|
||
JUMPT TAPKIL ;NO--KILL OFF THE TCB
|
||
PUSH P,TCB.FU(B) ;SAVE FILOP FUNCTION WORD
|
||
PUSH P,TCB.FI(B) ;AND I/O STATUS WORD
|
||
PUSHJ P,T$CLRS ;CLEAR ANY I/O ERRORS
|
||
POP P,TCB.FI(B) ;RESTORE
|
||
POP P,TCB.FU(B) ; ...
|
||
JRST TAPINI ;AND TRY AGAIN LATER
|
||
TAPHNG: MOVEI S1,LE.DER ;DEVICE
|
||
MOVEM S1,G$TERM## ; ERROR
|
||
MOVX S1,TS.SLR ;MAKE SURE USER GETS TERMINATION CODE
|
||
ANDCAM S1,TCB.ST(B) ; BY INSURING WE DO A LABEL RELEASE
|
||
$WTO (<Hung device>,,TCB.OB(B),$WTFLG(WT.SJI))
|
||
TAPKIL: PUSHJ P,T$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 (RKM,HALT,,<Running a killed magtape TDB>)
|
||
|
||
TAPINI: PUSHJ P,G$NJOB## ;RUN ANOTHER JOB WHILE WE WAIT
|
||
LOAD S1,TCB.FU(B),RHMASK ;GET THE FILOP FUNCTION
|
||
JRST FILO.0 ;AND TRY AGAIN
|
||
SUBTTL T$CLRS - Clear IO status bits
|
||
|
||
;Call with B pointing to TCB.
|
||
;This routine will reset the IO status for that device
|
||
;The device must be OPENed on some channel
|
||
|
||
T$CLRS::
|
||
MOVX S1,UU.DEL+.IODMP ;Get bit to disable error logging
|
||
MOVEM S1,TCB.FI(B) ;Save in TCB's FILOP block
|
||
MOVX S1,.FOSET ;code to set IO status
|
||
PJRST T$FILOP ;Do it, and return
|
||
SUBTTL T$WAIT - Wait until I/O is done
|
||
|
||
;This routine will wait for I/O is complete in an attempt to put a
|
||
;stop to those annoying tape label problems that happen
|
||
;"once every two days when the moon is 3/4 full."
|
||
;Call: (B) = TCB address
|
||
|
||
T$WAIT::PUSHJ P,.SAVE3 ;Save some regs
|
||
MOVX P1,.TFWAT ;Get the wait function
|
||
LOAD P2,TCB.FU(B),TF.DVH ;Get the channel number
|
||
MOVE P3,[XWD 2,P1] ;Get the arg pointer
|
||
TAPOP. P3, ;Do it
|
||
$RETF ;Shouldn't happen
|
||
$RETT
|
||
SUBTTL Buffer builder and releaser routines
|
||
|
||
;MAKBUF - Routine to build input and output buffer rings for a TCB
|
||
;Call - with TCB addrs in B
|
||
;Return - True always
|
||
|
||
MAKBUF: MOVX S1,FO.ASC ;WE WILL WANT EXTENDED CHANNELS
|
||
MOVEM S1,TCB.FU(B) ; SO SET THAT
|
||
MOVEI S1,TCB.IB(B) ;GET INPUT BUFFER ADDRESS
|
||
ADD S1,[IOWD BFRSIZ+1,0] ;GEN AN INPUT CCW
|
||
MOVEM S1,TCB.IC(B) ;GEN INPUT COMMAND LIST
|
||
MOVEI S1,TCB.WB(B) ;GET OUTPUT BUFFER ADDRESS
|
||
ADD S1,[IOWD BFRSIZ+1,0] ;GEN AN OUTPUT CCW
|
||
MOVEM S1,TCB.OC(B) ;GEN OUTPUT COMMAND LIST
|
||
$RETT ;RETURN
|
||
SUBTTL Translate IO Error into Extended Error
|
||
SUBTTL Routine to Decode Error and Return
|
||
|
||
;ALWAYS CALLED WITH P1 CONTAINING THE IO STATUS WITH ONE OF
|
||
; IO.IMP, IO.DTE, OR IO.DER ON.
|
||
; STORES THE CORRECT CODE INTO G$TERM AND
|
||
; RETURNS FALSE
|
||
|
||
RETERR: TXNN P1,IO.DTE!IO.DER!IO.IMP ;ANY ERROR BIT ON?
|
||
STOPCD (NEB,HALT,,<No error bit>)
|
||
TXNE P1,IO.DTE ;DATA ERROR?
|
||
MOVEI S1,.TFTDE ;YES, RETURN DATA ERROR CODE FOR TAPOP
|
||
TXNE P1,IO.DER ;DEVICE ERROR?
|
||
MOVEI S1,.TFTDV ;YES, RETURN DEVICE ERROR CODE FOR TAPOP
|
||
TXNE P1,IO.IMP ;WRITE LOCK ERROR?
|
||
MOVEI S1,.TFTWL ;YES, RETURN WRITE LOCK ERROR CODE FOR TAPOP
|
||
MOVEM S1,G$TERM## ;SAVE TO RETURN TO USER
|
||
$RETF ;RETURN FALSE
|
||
END
|