Google
 

Trailing-Edge - PDP-10 Archives - tops10_703a_sys_atpch16_bb-fr67f-bb - plrt10.x16
There are 2 other files named plrt10.x16 in the archive. Click here to see a list.
TITLE	PLRT10 - TOPS10 Operating System Dependent Module
	SUBTTL	Author: Cliff Romash/WLH/DC 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 library universal
	SEARCH	ORNMAC			;Get WTO symbols
	SEARCH	PLRMAC			;SEARCH UNIVERSAL FILE
	PROLOG	(PLRT10)		;SEARCH OTHER NEEDED FILES
	SUBTTL	I$INIT - Initialization

I$INIT::PUSHJ	P,I$PIVC		;SET UP PSI VECTORS
	SKIPE	G$DEBUG##		;Are we debugging
	 JRST	INIT.6			;Yes, don't clear any watch bits
	HRLZI	S1,.STWTC		;Set Watch bits,, set 'em all to 0
	SETUUO	S1,			;So we don't type out on unloads
	STOPCD	(CCW,HALT,,<Can't clear watch bits>)
INIT.6:	MOVX	S1,%LDMFD		;GETTAB index for PPN of MFD
	GETTAB	S1,			;Ask monitor for it
	 MOVE	S1,[XWD 1,1]		;Can't, assume [1,1]
	MOVEM	S1,G$MFDP##		;Save for the world
	MOVX	S1,%LDSYS		;GETTAB index for SYS: ppn
	GETTAB	S1,			;Get that
	 MOVE	S1,[XWD 1,4]		;Can't, make an assumption
	MOVEM	S1,G$SYSP##		;Save it
	MOVX	S1,%LDUFP		;Level-D item, UFD protection
	GETTAB	S1,			;Ask the monitor
	 MOVX	S1,<INSVL.(775,RB.PRV)>	;Default
	LOAD	S1,S1,RB.PRV		;Right justify it
	MOVEM	S1,G$PROU##		;Save it
	MOVX	S1,%LDSTP		;STANDARD FILE PROTECTION
	GETTAB	S1,			;ASK THE MONITOR
	  MOVX	S1,<INSVL.(057,RB.PRV)>	;DEFAULT
	LOAD	S1,S1,RB.PRV		;RIGHT JUSTIFY IT
	MOVEM	S1,G$PSTP##		;SAVE IT
	MOVX	S1,%LDFFA		;GET [OPR] PPN
	GETTAB	S1,			;ASK THE MONITOR
	  MOVE	S1,[1,,2]		;SHOULD BE THIS
	MOVEM	S1,G$FFAP##		;STORE IT
	SETZM	G$INDP##		;INIT FLAG
	MOVX	S1,%CNSTS		;STATES WORD
	GETTAB	S1,			;WANT INDPPN
	  MOVEI	S1,0			;HMMM.
	TXNE	S1,ST%IND		;TURNED ON?
	SETOM	G$INDP##		;YES
IFN FTFLBK,<
	MOVE	S1,[%CNDAE]		;ARGUMENTS
	GETTAB	S1,			;GET MONITOR VERSION
	  SETZ	S1,			;ANCIENT MONITOR
	MOVEM	S1,MONVER		;SAVE
>
INIT.1:	MOVX	S1,SP.MDA		;GET MDA'S SPECIAL PID INDEX
	PUSHJ	P,C%RPRM		;GET MDA'S PID
	JUMPF	INIT.2			;LOSE,,WAIT A SECOND AND RETRY
	MOVX	S1,SP.QSR		;GET QSR'S SPECIAL PID INDEX
	PUSHJ	P,C%RPRM		;GET QSR'S PID
	JUMPT	.RETT			;WIN,,RETURN
INIT.2:	MOVEI	S1,3			;DO NOT CONTINUE TILL
	PUSHJ	P,I%SLP			;   MDA/QSR IS RUNNING SO LETS
	JRST	INIT.1			;      WAIT FOR 3 SECONDS AND RETRY !!!

IFN FTFLBK,<
MONVER:	BLOCK	1			;MONITOR VERSION
>
SUBTTL	I$CKAC - check a user's access to a tape

;CALLED WITH:
;	T1 = PROTECTION
;	T2 = PPN OF OWNER
;	T3 = PPN OF USER
;RETURNS TRUE/FALSE
;RETURNS IN S2:	-1 IF NO ACCESS
;		 0 IF READ ACCESS ONLY
;		 1 IF WRITE ACCESS


I$CKAC:: HRLI	T1,.ACCPR		;GET PROTECTION FOR WRITE ACCESS
	MOVEI	S1,T1			;GET ADDR FOR ARGS
	CHKACC	S1,			;CHECK FOR WRITE ACCESS
	STOPCD	(CUF,HALT,,<CHKACC UUO failed>)
	JUMPN	S1,CKAC.1		;CAN'T WRITE, TRY READ
	MOVEI	S2,1			;CODE FOR WRITE ACCESS
	$RETT				;GIVE GOOD RETURN

CKAC.1:	MOVEI	S1,T1			;ADDR OF ARGS
	HRLI	T1,.ACRED		;CODE FOR READ ACCESS
	CHKACC	S1,			;TRY FOR READ
	  JRST	S..CUF			;THIS SHOULD NEVER HAPPEN!!
	MOVE	S2,S1			;COPY ACCESS TO S2
	$RETT				;AND GIVE GOOD RETURN
SUBTTL	Check for owner privs


; This routine is used to determine owner privs.  Owner privs
; allow a user to request a tape to be re-initialized by using
; the /NEW-VOLUME switch in the MOUNT command.
; Call:	MOVE	S1, owner (from tape)
;	MOVE	S2, owner (from MOUNT)
;	PUSHJ	P,I$OWN
;
; TRUE return:	User owns the tape
; FALSE return:	Loser is a menace to society
;
I$OWN::	SKIPE	G$INDP##		;MONITOR HAVE IND PROJ-PROG NUMBERS?
	JRST	OWN1			;YES
	HRRZS	S1			;KEEP JUST THE
	HRRZS	S2			; PROGRAMMER NUMBERS
OWN1:	CAME	S1,S2			;MATCH?
	$RETF				;NO
	$RETT				;YES--VALID OWNER
SUBTTL	Check job privs


; Check for [1,2] or JACCT jobs
; Call:	MOVE	B,TCB address
;	PUSHJ	P,I$PRIV
;
; TRUE return:	Job controlling device has [1,2] or JACCT
; FALSE return:	Loser owns tape
;
I$PRIV::MOVE	TF,TCB.OW(B)		;GET PPN
	CAMN	TF,G$FFAP##		;OPERATOR ?
	$RETT				;YES
	MOVN	TF,TCB.JB(B)		;GET NEGATIVE JOB NUMBER
	JOBSTS	TF,			;READ JOB STATUS
	  $RETF				;CAN'T
	TXNE	TF,JB.UJC		;JACCT SET ?
	$RETT				;YES
	$RETF				;NO
SUBTTL	I$DATE - Return Today's Date
SUBTTL	I$DATI - convert 15 bit date to ASCII YYDDD

;no arguments
;returns true/false,
;byte pointer to date in s2
;date is ascii string of form (blank)yyddd

;I$DATI TAKES DATE IN S1 INSTEAD OF DOING DATE UUO


I$DATE:: DATE	S1,			;GET THE DATE FROM THE MONITOR
I$DATI:: $CALL	.SAVET			;SAVE THE T ACS
	PUSH	P,S1			;SAVE IT ON THE STACK
	IDIVI	S1,^D31*^D12		;SEPARATE OUT THE YEAR
	ADDI	S1,^D1964		;ADD IN STARTING YEAR
	IDIVI	S1,^D100		;NOW DO SAME WITH  100'S DIGIT
	MOVE	S1,S2			;AND USE REMAINDER
	IDIVI	S1,^D10			;GET TENS DIGIT
	ADDI	S1,"0"			;MAKE IT ASCII
	ADDI	S2,"0"			;MAKE ONES ASCII ALSO
	MOVE	T2,DATE.A		;GET BYTE POINTER TO USE TO STORE 
	MOVEI	T1," "			;GET AN ASCII BLANK
	IDPB	T1,T2			;STORE THE BLANK
	IDPB	S1,T2			;STORE THE TENS DIGIT OF THE YEAR
	IDPB	S2,T2			;STORE THE ONES DIGIT OF THE YEAR
	MOVE	S1,(P)			;GET BACK DATE
	IDIVI	S1,^D31*^D12		;GET YEAR IN S1
	IDIVI	S2,^D31			;GET MONTH IN S2, DAY IN T1
	ADD	T1,DATE.B(S2)		;ADD IN NUMBER OF DAYS FOR FIRST OF MONTH
	ADDI	S1,^D1964		;ADD IN START YEAR
	IDIVI	S1,^D4			;DIVIDE BY 4
	JUMPN	S2,DATE.2		;NOT A LEAP YEAR, PROCEED
	IDIVI	S1,^D25			;DID NUMBER ALSO DIVIDE BY 100?
	JUMPN	S2,DATE.1		;ITS A LEAP YEAR, ADD A DAY
	IDIVI	S1,^D10			;DID YEAR DIVIDE BY 1000?
	JUMPN	S2,DATE.2		;NO, NOT A LEAP YEAR
DATE.1:	MOVE	S1,(P)			;GET ORIGINAL DATE FROM STACK
	IDIVI	S1,^D31*^D12		;MAKE S2 = MONTHS AND DAYS
	MOVE	S1,S2			;GET INTO S1
	IDIVI	S1,^D31			;GET MONTHS IN S1
	SUBI	S1,2			;SUBTRACT OFF 2 
	JUMPL	S1,DATE.2		;IF MONTH = JAN OR FEB, DON'T ADD DAY
	ADDI	T1,1			;ADD DAY FOR LEAP YEAR
DATE.2:	POP	P,(P)			;FIX STACK
	MOVE	S1,T1			;GET DAY OF YEAR IN S1
	IDIVI	S1,^D100		;MAKE S1 = 100'S DIGIT
	IDIVI	S2,^D10			;MAKE S2 = 10'S DIGIT, T1 = 1'S DIGIT
	ADDI	S1,"0"			;MAKE ALL THREE ASCII
	ADDI	S2,"0"			;...
	ADDI	T1,"0"			;...
	IDPB	S1,T2			;AND STORE
	IDPB	S2,T2			; ALL THE
	IDPB	T1,T2			; DIGITS
	MOVE	S2,DATE.A		;GET THE BYTE POINTER IN S2
	$RETT				;GIVE GOOD RETURN

DATE.A:	POINT	8,DATE.C		;8 BIT BYTES, START AT DATE.C
DATE.B:	EXP	^D1			;DAY OFFSET FOR JANUARY
	EXP	^D32			;DAY OFFSET FOR FEB
	EXP	^D60			;DAY OFFSET FOR MARCH
	EXP	^D91			;DAY OFFSET FOR APRIL
	EXP	^D121			;DAY OFFSET FOR MAY
	EXP	^D152			;DAY OFFSET FOR JUNE
	EXP	^D182			;DAY OFFSET FOR JULY
	EXP	^D213			;DAY OFFSET FOR AUGUST
	EXP	^D244			;DAY OFFSET FOR SEPTEMBER
	EXP	^D274			;DAY OFFSET FOR OCTOBER
	EXP	^D305			;DAY OFFSET FOR NOVEMBER
	EXP	^D335			;DAY OFFSET FOR DECEMBER
DATE.C:	BLOCK	2			;STORAGE FOR STRING TO RETURN

SUBTTL	I$CPSN - Return System Serial Number

;NO ARGUMENTS
;RETURNS SYSTEM SERIAL NUMBER IN S1

I$CPSN:: MOVE	S1,[%CNSER]		;GETTAB FOR CPU SERIAL NUMBER
	GETTAB	S1,			;ASK MONITOR FOR IT
	STOPCD	(GSF,HALT,,<GETTAB for serial number failed>)
	POPJ	P,			;RETURN
SUBTTL	I$USRN - Return User's Name

;Call with TCB addr in B.
;Returns ASCII user name in TCB.UN

I$USRN:: $CALL	.SAVET			;SAVE SOME AC'S
	LOAD	S2,TCB.JB(B)		;GET JOB FROM TCB
	MOVEI	S1,.GTNM1		;GETTAB FOR FIRST PART OF NAME
	HRL	S1,S2			;JOB NUMBER IN LH
	GETTAB	S1,			;GET USER'S NAME FROM MONITOR
	STOPCD	(GNF,HALT,,<GETTAB for user's name failed>)
	MOVE	T1,S1			;SAVE FIRST PART OF NAME IN T1	
	MOVEI	S1,.GTNM2		;GETTAB FOR 2ND PART OF NAME
	HRL	S1,S2			;JOB NUMBER IN LH
	GETTAB	S1,			;ASK MONITOR
	  SETZ	S1,			;OH WELL
	MOVE	T2,S1			;PUT 2ND PART OF NAME IN T2
	MOVE	S1,[POINT 6,T1]		;POINT AT NAME
	HRRI	S2,TCB.UN(B)		;Get addr of where to store
	HRLI	S2,(POINT 7,)		;Make it an ASCII pointer
	MOVEI	T4,^D12			;LENGTH OF NAME
USRN.1:	ILDB	T3,S1			;GET A CHARACTER FROM THE NAME
	ADDI	T3,"0"-'0'		;CONVERT TO ASCII
	IDPB	T3,S2			;AND SAVE ITTO RETURN
	SOJG	T4,USRN.1		;LOOP FOR ALL OF NAME
	$RETT
SUBTTL	I$RLID - set reelid and label type for drive in monitor

;CALLED WITH S1 POINTING TO SIX CHARACTER REELID, B CONTAINING
;THE TCB addr
;The tape should be open

I$RLID:: $CALL	.SAVET			;SAVE SOME AC'S
	MOVE	T1,S1			;COPY ADDRESS OF REELID
	HRLI	T1,(POINT 8,)		;MAKE IT A BYTE POINTER
	MOVE	T2,[POINT 6,S2]		;AND MAKE ONE FOR WHERE TO SAVE NAME
	MOVEI	T4,6			;HOW MANY CHARS TO GET
RLID.1:	ILDB	T3,T1			;GET A CHARACTER
	SUBI	T3,"0"-'0'		;CONVERT TO SIXBIT
	IDPB	T3,T2			;SAVE IT AWAY
	SOJG	T4,RLID.1		;LOOP FOR ALL OF REELID
	LOAD	S1,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	MTAID.	S1,			;ASET THE REELID
	STOPCD	(MCF,HALT,,<MTAID. UUO failed>)
	MOVE	T1,[XWD 3,T2]		;AC FOR TAPOP.
	MOVEI	T2,.TFSET+.TFPLT	;SET LABEL TYPE
	LOAD	T3,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	LOAD	T4,TCB.LT(B)		;GET THE LABEL TYPE
	TAPOP.	T1,		;SET THE LABEL TYPE
	STOPCD	(SLT,HALT,,<Set label type failed>)
	$RETT				;GIVE GOOD RETURN
SUBTTL	I$BCNT - Determine Block Count 

;CALLED WITH B POINTING TO THE TCB
;RETURNS BLOCK COUNT IN S1

I$BCNT::$CALL	.SAVET			;SAVE SOME AC'S
	MOVE	S1,[.TSREC+1,,S2]	;SET UP AC FOR TAPOP.
	MOVX	S2,.TFSTA		;FUNCTION FOR TAPOP.
	LOAD	T1,TCB.FU(B),TF.DVH	;GET CHANNEL NUMBER INTO T1
	TAPOP.	S1,0
	STOPCD	(RSF,HALT,,<TAPOP. to read statistics failed>)
	SKIPGE	S1,.TSREC(S1)		;COPY COUNT TO S1
	MOVEI	S1,0			;AVOID ILL MEM REFS
	POPJ	P,0			;AND RETURN
	SUBTTL	I$PDEN - Pick a starting density for a drive

;This routine will find a good starting density for the drive
; and set that, if appropriate.  Controller type is also stored
; in the TCB, as well as possible densities.
;Call -
;	B/	TCB (unit should be OPEN on a channel)

I$PDEN:: $CALL	.SAVET			;SAVE SOME AC'S
	MOVEI	T1,.TFPDN		;Code for possible densities
	LOAD	T2,TCB.FU(B),TF.DVH	;Get channel number
	MOVE	T3,[2,,T1]		;Point at the block
	TAPOP.	T3,			;Get the capabilities
	STOPCD	(CDC,HALT,,<Can't determine density capabilities>)
	STORE	T3,TCB.CH(B),TC.PDN	;Save possibilities
	MOVEI	S1,.TFD62+1		;First density to try
	STORE	S1,TCB.PS(B),TP.DEN	;Set that up
	PUSHJ	P,I$NDEN		;Try the next one after that
	JUMPT	.RETT			;Win,,continue
	STOPCD	(NVD,HALT,,<No valid density>)	;No,,oh well !!!
	SUBTTL	I$NDEN - Set a New Density

;CALLED WITH B POINTING TO A TCB
;TRIES DENSITIES FROM 6250 DOWN. RETURNS FALSE IF ALL DENSITIES TRIED

I$NDEN:: LOAD	S1,TCB.PS(B),TP.DEN	;GET DENSITY FROM TCB
	SKIPN	S1			;SYSTEM DEFAULT?
	MOVEI	S1,.TFD62+1		;YES, START AT 6250
NDEN.1:	SOSG	S1			;Try the next one down
	$RETF				;Tried'em all, quit
	MOVEI	S2,1			;Get a bit
	LSH	S2,-1(S1)		;Move to capability bit
	TDNN	S2,TCB.CH(B)		;Can the drive hack this density?
	JRST	NDEN.1			;No, try the next one
	STORE	S1,TCB.PS(B),TP.DEN	;Save new density in TCB
	PUSHJ	P,I$SDEN		;Set this density
	JUMPT	.POPJ			;Wins... so do we
	STOPCD	(CCD,HALT,,<Can't change density>)
	SUBTTL	I$SDEN - Set a density for a tape drive

;This routine will set a certain density for a given tape drive
; The tape must be OPEN.
;
;The monitor will ensure that the density is set for both
;the label DDB and the real DDB.
;
;Call  S1/	Required density code
;	B/	Open TCB adrs
;
;Return T	If the density set won
;	F	If it loses

I$SDEN::
	$SAVE	<P1>
	MOVE	S2,S1			;Arg 3 - Density code
	MOVE	S1,TCB.DN(B)		;Arg 2 - Label DDB name
	MOVX	TF,.TFDEN+.TFSET	;Arg 1 - Set density function code
	MOVX	P1,<3,,TF>		;Aim at the argument list
	TAPOP.	P1,			;Do it
	 $RETF				;Can't,,lose
	$RETT				;Win
SUBTTL	I$GDEN  Get user density

;I$GDEN asks the monitor for the density of a drive
; This is neccessary for controllers which detect PE/NRZI bursts automatically
; We do rewind, read, and the drive tells the monitor what density
; was used, and the monitor gives us the info via
; this routine.

I$GDEN::MOVE	S1,[2,,T1]		;Aim at arg block
	LOAD	T2,TCB.FU(B),TF.DVH	;Density on our label DDB
	MOVEI	T1,.TFDEN		;Code to read density
	TAPOP.	S1,			;Ask thi monitor
	STOPCD	(CGD,HALT,,<Can't get density>)
	STORE	S1,TCB.PS(B),TP.DEN	;Save in TCB
	$RETT
SUBTTL	I$DT15 - convert YYDDD to TOPS10 format

;CALLED WITH YYDDD IN S1
;RETURNS 15 BIT DATE IN S1

I$DT15:: IDIVI	S1,^D1000		;SEPARATE YEAR AND DAYS
	SUBI	S1,^D64			;CLEAR ORIGINAL OFFSET
	JUMPL	S1,DT15.3		;BEFORE 1964, RETURN 0
	IMULI	S1,^D31*^D12		;POSITION YEAR CORRECTLY FOR 15 BIT FORMAT
	PUSH	P,S1			;SAVE IT FOR LATER
	HRLZI	S1,-^D12		;GET AOBJN PTR TO MONTH TABLE
	CAML	S2,DATE.B(S1)		;BEFORE START OF THIS MONTH?
	AOBJN	S1,.-1			;NO, TRY NEXT MONTH
	JUMPGE	S1,DT15.2		;RETURN 0 IF PAST END OF TABLE
	HRRZI	S1,-1(S1)		;MAKE S1 INTO CORRECT  MONTH
	SUB	S2,DATE.B(S1)		;AND MAKE S2 IN CORRECT DAY
	IMULI	S1,^D31			;OFFSET MONTH CORRECTLY
	ADD	S2,S1			;ADD IT INTO DAY
	ADDM	S2,0(P)			;ADD TO YEAR 
	IDIVI	S1,^D31			;MAKE S1 MONTH AGAIN
	SUBI	S1,2			;DONE IF MONTH IS JAN OR FEB
	JUMPL	S1,DT15.1		;EXIT IF SO
	MOVE	S1,0(P)			;GET ENTIRE DATE AGAIN
	IDIVI	S1,^D31*^D12		;MAKE S1 INTO YEAR ONLY
	IDIVI	S1,^D4			;YEAR DIVISIBLE BY 4?
	MOVNI	S1,1			;GET -1 IN S1
	SKIPN	S2			;LEAP YEAR IF SO
	ADDM	S1,0(P)			;ADJUST DAY IF LEAP YEAR
DT15.1:	POP	P,S1			;GET GOOD DATE INTO S1
	POPJ	P,			;AND RETURN
DT15.2:	POP	P,(P)			;ADJUST STACK

DT15.3:	SETZ	S1,			;SET TO RETURN ZERO
	POPJ	P,			;RETURN
SUBTTL	I$CLLP - clear label parameters in monitor


;NO ARGS
;NO VALUES
;CLEARS LABEL PARAMETER AREA IN TCB AND IN MONITOR

I$CLLP:: ZERO	TCB.LN(B)		;CLEAR LENGTHS
	ZERO	TCB.PR(B)		;CLEAR PROTECTION
	ZERO	TCB.EX(B),TE.EXP!TE.CRE	;CLEAR EXPIRATION AND CREATION
	ZERO	TCB.RF(B),TF.RFM	;CLEAR RECORD FORMAT
	MOVE	S1,[ASCII /     /]	;GET FIVE ASCII BLANKS
	STORE	S1,TCB.FN+0(B)		;FILE NAME PART 1
	STORE	S1,TCB.FN+1(B)		;FILE NAME PART 2
	STORE	S1,TCB.FN+2(B)		;FILE NAME PART 3
	STORE	S1,TCB.FN+3(B)		;FILE NAME PART 4
	MOVE	S1,[WRLP.A+.TPREC,,WRLP.A+.TPREC+1] ;CLEAR THE ARGUMENT BLOCK
	SETZM	WRLP.A+.TPREC
	BLT	S1,WRLP.A+RDLPSZ-1
	LOAD	S1,TCB.PS(B),TP.POS	;GET THE POSITION
	MOVEM	S1,WRLP.A+.TPSEQ
	MOVEI	S1,.TFLPR+.TFSET	;FUNCTION FOR SET LABEL PARAMS
	MOVEM	S1,WRLP.A+.TPFUN
	LOAD	S1,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	MOVEM	S1,WRLP.A+.TPDEV	;STORE
	MOVE	S1,[RDLPSZ,,WRLP.A]	;UUO ARGUMENT
	TAPOP.	S1,			;CLEAR THE BLOCK
	STOPCD	(CPF,HALT,,<Clear label parameters failed>)
	$RETT				;RETURN TRUE
SUBTTL	I$STLP - set label parameters for monitor

;NO ARGS
;NO VALUES
;SETS TCB LABEL PARAMETER NUMBERS IN MONITOR

I$STLP:: $CALL	.SAVET			;SAVE THE TEMPS
	MOVEI	S1,.TFLPR+.TFSET 	;FUNCTION FOR TAPOP.
	MOVEM	S1,WRLP.A+.TPFUN	;STORE THE FUNCTION
	LOAD	S1,TCB.FU(B),TF.DVH	;GET CHANNEL NUMBER FOR TAPE
	MOVEM	S1,WRLP.A+.TPDEV
	LOAD	S1,TCB.RF(B),TF.RFM	;GET RECORD FORMAT
	STORE	S1,WRLP.A+.TPREC,TR.RFM	;STORE IN THE ARGUMENT BLOCK
	LOAD	S1,TCB.RF(B),TF.FCT	;Get form control code
	STORE	S1,WRLP.A+.TPREC,TR.FCT	;Save in arg block
	LOAD	S1,TCB.LN(B),TL.REC	;GET RECORD LENGTH
	MOVEM	S1,WRLP.A+.TPRSZ
	LOAD	S1,TCB.LN(B),TL.BLK	;GET BLOCK LENGTH
	MOVEM	S1,WRLP.A+.TPBSZ
	LOAD	S1,TCB.EX(B),TE.EXP	;GET EXPIRATION DATE
	STORE	S1,WRLP.A+.TPEXP,TP.EEX
	LOAD	S1,TCB.EX(B),TE.CRE	;GET THE CREATION DATE
	STORE	S1,WRLP.A+.TPEXP,TP.ECR
	LOAD	S1,TCB.PR(B)		;GET PROTECTION
	MOVEM	S1,WRLP.A+.TPPRO
	LOAD	S1,TCB.PS(B),TS.POS	;GET THE POSITION
	MOVEM	S1,WRLP.A+.TPSEQ
	HRLI	T1,TCB.FN(B)		;MOVE FROM THE TCB FILE NAME
	HRRI	T1,WRLP.A+.TPFNM	;MOVE TO THE LABEL PARAM ARG AREA
	BLT	T1,WRLP.A+.TPFNM+<<^D17+4>/5>-1 ;MOVE THE 17 CHAR FILENAME
	LOAD	S1,TCB.GV(B),TG.GEN	;GET THE GENERATION NUMBER
	STORE	S1,WRLP.A+.TPGEN,TP.GEN
	LOAD	S1,TCB.GV(B),TG.VER	;GET THE VERSION NUMBER
	STORE	S1,WRLP.A+.TPGEN,TP.VER
	MOVE	S1,[RDLPSZ,,WRLP.A]	;AC FOR TAPOP.
	TAPOP.	S1,			;SET THE PARAMETERS
	STOPCD	(SPF,HALT,,<Set label parameters failed>)
	$RETT
SUBTTL	I$RDLP	--	Routine to read label parameters from monitor

;NO ARGS
;NO VALUES
;SETS UP VALUES IN TCB -- WILL DERIVE RECORD FORMAT,EXPIRATION DATE,
;   RECORD LENGTH, BLOCK LENGTH, AND PROTECTION IF USER HASN'T SET THEM


I$RDLP::$CALL	.SAVE1			;SAVE A WORKING REGISTER
	$CALL	.SAVET			;SAVE THE TEMPS
	MOVX	S2,.TFLPR		;READ LABEL PARAMETERS FUNCTION
	MOVEM	S2,RDLP.A+.TPFUN	;SAVE IN TAPOP. BLOCK
	LOAD	S2,TCB.FU(B),TF.DVH	;GET DEVICE NAME TCB
	MOVEM	S2,RDLP.A+.TPDEV	;SAVE IN TAPOP. BLOCK
	MOVE	P1,[RDLPSZ,,RDLP.A]	;AC FOR TAPOP.
	TAPOP.	P1,0			;READ THE LABEL PARAMETERS
	STOPCD	(RPF,HALT,,<Read label parameters failed>)
	LOAD	S1,RDLP.A+.TPREC,TR.RFM	;Get the user's record format code
	SKIPLE	S1			;Too little
	CAILE	S1,.TRFMX		;Or out of range code...
	MOVX	S1,.RFDEF		;Yes, Take our default
	STORE	S1,TCB.RF(B),TF.RFM	;SAVE IN TCB
	LOAD	S1,RDLP.A+.TPREC,TR.FCT	;Get form control index
	SKIPLE	S1			;Too little?
	CAILE	S1,.TFCMX		;Or too big?
	MOVX	S1,.TFCNO		;Out of range, assume the default
	STORE	S1,TCB.RF(B),TF.FCT	;Save in TCB
	SKIPE	S1,RDLP.A+.TPRSZ	;ANY RECORD LENGTH?
	JRST	RDLP.1			;YES, PROCEED
	MOVX	S1,.TFBSZ		;FUNCTION TO READ BUFFER SIZE
	LOAD	S2,TCB.DV(B)		;NEED TO USE USER'S DEVICE NAME!
	MOVE	P1,[2,,S1]		;AC FOR TAPOP.
	TAPOP.	P1,0			;READ USER'S BUFFER SIZE
	STOPCD	(CRB,HALT,,<Can't read buffer size>)
	SUBI	P1,1			;MONITOR LIES BY 1 WORD
	PUSH	P,P1			;SAVE SIZE ON STACK
	MOVX	S1,.TFMOD		;READ USER'S MODE
	MOVE	P1,[2,,S1]		;AC FOR TAPOP.
	TAPOP.	P1,			;READ IT
	STOPCD	(CRM,HALT,,<Can't read user's mode>)
	POP	P,S1			;GET BUFFER SIZE IN S1
	IMUL	S1,CPWTBL(P1)		;MULTIPLY BY CHARS PER WORD
RDLP.1:	STORE	S1,TCB.LN(B),TL.REC	;SAVE AS RECORD LENGTH
	SKIPN	S1,RDLP.A+.TPBSZ	;WAS A BLOCK LENGTH SPECIFIED?
	LOAD	S1,TCB.LN(B),TL.REC	;NO, USE RECORD LENGTH
	STORE	S1,TCB.LN(B),TL.BLK	;SAVE IN TCB
	LOAD	S1,RDLP.A+.TPEXP,TP.EEX	;GET EXPIRATION DATE
	STORE	S1,TCB.EX(B),TE.EXP	;SAVE IN TCB
	ZERO	TCB.EX(B),TE.CRE	;CLEAR CREATION DATE
	MOVE	S1,RDLP.A+.TPPRO	;GET PROT CODE
	STORE	S1,TCB.PR(B)		;SAVE IN TCB
	MOVX	S2,TS.PSF!TS.PSN	;GET THE POSITION REQUIRED BITS
	ANDCAM	S2,TCB.ST(B)		;CLEAR THEM
	MOVX	S2,TS.PSN		;GET THE POSITION REQUIRED BIT
	SKIPN	S1,RDLP.A+.TPSEQ	;GET THE POSITION FIELD
	JRST	RDLP.2			;NONE
	IORM	S2,TCB.ST(B)		;SET POSITIONING FLAG
	STORE	S1,TCB.RP(B),TP.RQP	;STORE THE REQUESTED POSITION
RDLP.2:	MOVE	S1,[ASCII /     /]	;GET FIVE ASCII BLANKS
	STORE	S1,TCB.FN+0(B)		;FILE NAME PART 1
	STORE	S1,TCB.FN+1(B)		;FILE NAME PART 2
	STORE	S1,TCB.FN+2(B)		;FILE NAME PART 3
	STORE	S1,TCB.FN+3(B)		;FILE NAME PART 4
	SKIPN	S1,RDLP.A+.TPFNM	;GET THE FIRST 5 CHARS OF THE FILENAME	
	JRST	RDLP.3			;NONE SPECIFIED
	LDB	S1,[POINT 7,S1,6]	;GET THE FIRST CHARACTER
	CAIN	S1," "			;IS IT THE DEFAULT?
	JRST	RDLP.3			;YES, LEAVE THE FILENAME AT SPACES
	MOVX	S1,TS.PSF		;GET POSITION BY FILE NAME
	IORM	S1,TCB.ST(B)		;SET IT
	$TEXT	(<-1,,TCB.FN(B)>,<^T17L /RDLP.A+.TPFNM/^A>)
RDLP.3:	LOAD	S1,RDLP.A+.TPGEN,TP.GEN	;GET DESIRED GENERATION NUMBER
	STORE	S1,TCB.GV(B),TG.GEN	;SAVE IN TCB
	LOAD	S1,RDLP.A+.TPGEN,TP.VER	;GET VERSION NUMBER
	STORE	S1,TCB.GV(B),TG.VER	;SAVE IN TCB
	$RETT
SUBTTL	LABEL PARAMTERS AREA
WRLP.A:
RDLP.A:	BLOCK	.TPLEN			;BLOCK FOR LABEL PARAMETER HANDLING
	RDLPSZ==.-RDLP.A		;Block length

;NOW TABLE OF CHARACTERS PER WORD INDEXED BY TAPE MODE

CPWTBL:	5				;EITHER EQUIV TO 1 OR ILLEGAL
	5				;DEC CORE DUMP
	4				;INDUSTRY COMPATIBLE
	6				;TU70 SIXBIT
	5				;ANSI ASCII
	6				;7-TRK CORE DUMP (SHOULD NEVER HAPPEN)
SUBTTL	I$OPRP - Determine if An Operator Is Present


;RETURNS TRUE IF OPERATOR PRESENT, FALSE IF NOT

I$OPRP:: MOVE	S1,[%CNSTS]		;GETTAB FOR STATES WORD
	GETTAB	S1,			;READ IT
	STOPCD	(CGS,HALT,,<Can't GETTAB states word>)
	TXNE	S1,ST%NOP		;IS OPERATOR PRESENT
	$RETF				;NO
	$RETT				;YES
SUBTTL	I$RDEV Read reelid, job, ppn for arbitrary device

;Call - S1/ SIXBIT device name
;Returns - T1/SIXBIT REELID/
;	T2/ Job number of owner
;	T3/ Owner's PPN
I$RDEV::
	MOVE	T1,[XWD 2,T2]		;Aim at TAPOP. arg block
	MOVX	T2,.TFRID		;Function - obtain reelid
	MOVE	T3,S1			;Copy device name
	TAPOP.	T1,			;Ask TAPUUO
IRDV.1:	STOPCD	(TUF,HALT,,<TAPOP. UUO failed>)	;Arrgh!!
	MOVE	T2,S1			;Copy dev name again
	DEVTYP	T2,			;Get some status on it
	PUSHJ	P,IRDV.1		;Can't
	LOAD	T2,T2,TY.JOB		;Get job number
	HRL	T3,T2			;Make index to JBTPPN
	HRRI	T3,.GTPPN		;Indicate table name
	GETTAB	T3,			;Ask the monitor
	PUSHJ	P,IRDV.1		;Can't have it
	$RETT
SUBTTL	Software Interrupt System Interface and Database

VECTOR::!				;BEGINING OF PSI INTERRUPT VECTORS
VECIPC:	BLOCK	4			;IPCF INTERRUPT BLOCK
VECDEV:	BLOCK	4*<VECNUM==^D16>	;ROOM FOR VECNUM VECTORS
VECEND:!				;END OF SI VECTORS

;Check the IPCF interrupt vector assignment
IFN <CHNIPC-<VECIPC-VECTOR>>,
<PRINTX ?IPCF interrupt vector is misplaced in PLRT10>
SUBTTL	PSI interface -- Set up interrupt vectors


I$PIVC::MOVE	S1,[VECTOR,,VECTOR+1]	;SET UP BLT
	SETZM	VECTOR			;CLEAR FIRST WORD
	BLT	S1,VECEND-1		;CLEAR ALL VECTORS
	MOVEI	S1,INTIPC		;GET SERVICE ROUTINE ADDRESS
	MOVEM	S1,VECIPC+.PSVNP	;SAVE AS THE NEW PC
	POPJ	P,			;RETURN
SUBTTL	PSI interface -- Connect a device to the PSI system


; Connect a device to the PSI system
; Call:	MOVE	S1, conditions
;	MOVE	B, TDB address
;	PUSHJ	P,I$PICD
;
; TRUE return:	device connected
; FALSE return:	failed, operator notified
;
I$PICD::$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	MOVE	P1,S1			;COPY CONDITIONS
	MOVEI	S2,VECDEV		;POINT TO START OF DEVICE VECTORS

PICD.1:	SKIPN	(S2)			;FREE?
	JRST	PICD.2			;YES
	ADDI	S2,4			;POINT TO NEXT VECTOR
	CAIGE	S2,<VECDEV+<4*VECNUM>>	;END OF DEVICE VECTORS?
	JRST	PICD.1			;LOOP
	STOPCD	(NFV,HALT,,<No free interrupt vectors>)

PICD.2:	HRLZM	S1,TCB.PV(B)		;SAVE CONDITIONS
	HRRM	S2,TCB.PV(B)		;SAVE VECTOR ADDRESS
	MOVEI	S1,INTDEV		;GET INTERRUPT ADDRESS
	MOVEM	S1,.PSVNP(S2)		;SAVE IT IN THE VECTOR
	SETZM	.PSVOP(S2)		;ZAP OLD PC
	SETZM	.PSVFL(S2)		;AND FLAGS
	SETZM	.PSVIS(S2)		;AND INTERRUPT CONDITIONS
	LOAD	P1,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	SUBI	S2,VECTOR		;GET OFFSET FROM VECTOR BASE
	HRLZ	P2,S2			;GET OFFSET
	HLR	P2,TCB.PV(B)		;GET CONDITIONS
	SETZ	P3,			;PRIORITY ZERO
	MOVE	S1,[PS.FON+PS.FCS+PS.FAC+P1] ;SET UP UUO
	SETZ	S2,			;INDICATE TRYING TO ADD CONDITION
	PISYS.	S1,			;ADD THE CONDITIONS
	  JRST	PSIERR			;CAN'T
	$RETT				;RETURN
SUBTTL	PSI intercase -- Remove a device from the PSI system


; Remove a device from the PSI system
; Call:	MOVE	B, TDB address
;	PUSHJ	P,I$PIRD
;
; TRUE return:	device removed
; FALSE return:	failed, operator notified
;
I$PIRD::SKIPN	S1,TCB.PV(B)		;GET CONDITIONS AND VECTOR ADDRESS
	$RETT				;NO PSI FOR THIS DEVICE
	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	LOAD	P1,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	SUBI	S1,VECTOR		;GET OFFSET FROM VECTOR BASE
	MOVS	P2,S1			;PUT IN ARG BLOCK
	SETZ	P3,			;PRIORITY ZERO
	MOVX	S1,PS.FCS+PS.FRC+P1	;SET UP UUO
	MOVEI	S2,1			;INDICATING REMOVING CONDITIONS
	PISYS.	S1,			;DO IT
	  JRST	PSIERR			;CAN'T
	HRRZ	S1,TCB.PV(B)		;GET VECTOR ADDRESS
	SETZM	(S1)			;MAKE VECTOR USABLE BY SOMEONE ELSE
	SETZM	TCB.PV(B)		;ZAP POINTER
	$RETT				;AND RETURN


; Here on PISYS. UUO errors
; S1:= error code
; S2:= 0 if adding a condition, 1 if removing a condition
;
PSIERR:	$WTO	(<PULSAR error>,<^I/PSIITX/>,TCB.OB(B),$WTFLG(WT.SJI))
	$RETF				;RETURN

PSIITX:	ITEXT	(<PISYS. error (^O/S1/) trying to ^T/@PSITXT(S2)/ the interrupt system>)
PSITXT:	[ASCIZ	|connect to|]
	[ASCIZ	|remove from|]
SUBTTL	PSI interface -- IPCF interrupts


INTIPC:	$BGINT	1			;Start the interrupt process
	$CALL	C%INTR			;Note the IPCF receive
	$DEBRK				;That's all folks
SUBTTL	PSI interface -- Device I/O interrupts


; Here for all device I/O interrupts
; This routine will switch to interrupt context and decode the type
; of interrupt and dispatch appropriately. The following ACs will
; be setup prior to dispatching:
;
;	P1:= vector address
;	P2:= interrupting conditions
;	P3:= device type from the TCB
;	P4:= interrupt status word
;
INTDEV:	$BGINT	1			;CONTEXT SWITCH
	HRRZ	P1,TCB.PV(B)		;GET VECTOR ADDRESS
	MOVE	P2,.PSVFL(P1)		;GET CONDITIONS WE INTERRUPTED ON
	SETZM	.PSVFL(P1)		;CLEAR FOR NEXT TIME
	LOAD	P3,TCB.CH(B),TC.TYP	;GET DEVICE TYPE
	MOVE	P4,.PSVIS(P1)		;GET INTERRUPT STATUS WORD
	MOVE	S1,P2			;GET CONDITIONS
	LSH	S1,23			;LEFT JUSTIFY THE BITS
	JFFO	S1,.+1			;CONPUTE TABLE INDEX
	SKIPE	INTTAB(S2)		;CAN WE PROCESS THIS TYPE OF INTERRUPT?
	PUSHJ	P,@INTTAB(S2)		;YES - DISPATCH
	$DEBRK				;RETURN FROM INTERRUPT

INTTAB:	EXP	0			;PS.RID INPUT DONE
	EXP	0			;PS.ROD OUTPUT ONE
	EXP	0			;PS.REF END OF FILE
	EXP	0			;PS.RIE INPUT ERROR
	EXP	0			;PS.ROE OUTPUT ERROR
	EXP	INTOFL			;PS.RDO OFF-LINE
	EXP	0			;PS.RDF DEVICE FULL
	EXP	0			;PS.RQE QUOTA EXCEEED
	EXP	0			;PS.RWT REWIND WAIT
	EXP	0			;PS.ROL ON-LINE
	EXP	0			;PS.RRC RIB HAS CHANGED
	EXP	INTHNG			;PS.RDH DEVICE HUNG
	EXP	0			;1B31 UNASSIGNED
	EXP	0			;1B32 UNASSIGNED
	EXP	0			;1B33 UNASSIGNED
	EXP	0			;1B34 UNASSIGNED
	EXP	0			;1B35 UNASSIGNED
SUBTTL	PSI interface -- Device off-line interrupts


INTOFL:	SKIPE	G$UNL##			;UNLOAD IN PROGRESS?
	JRST	UNLOFL			;YES
	SKIPN	G$PROC##		;RUNNING A TCB?
	POPJ	P,			;NO
	CAIN	P3,%DISK		;A DISK?
	JRST	DSKOFL			;YES
	CAIN	P3,%TAPE		;A MAGTAPE?
	JRST	MTAOFL			;YES
	CAIN	P3,%DTAP		;A DECTAPE?
	JRST	DTAOFL			;YES
	POPJ	P,			;SHOULDN'T GET HERE

; Here on tape off-line during an unload
UNLOFL:	AOS	.PSVOP(P1)		;POINT PC AT THE UUO ERROR RETURN
	AOS	.PSVOP(P1)		;PUSH PC PAST TAPOP. UUO ERROR RETURN
	POPJ	P,			;RETURN

; Here on disk off-line interrupts
DSKOFL:	MOVE	S1,@.PSVOP(P1)		;GET INSTRUCTION AT INTERRUPTING PC
IFN FTFLBK,<
	HRRZ	S2,MONVER		;GET THIS MONITOR'S VERSION
	CAIL	S2,703			;OLD CRUFT?
	JRST	DSKOF2			;GOOD STUFF
	TDZ	S1,[Z 17,@UU.PHY(17)]	;CLEAR OUT JUNK
	CAMN	S1,[FILOP.]		;A FILOP. UUO?
	JRST	DSKOF1			;YES - PSISER BEHAVING NORMALLY
	AOS	.PSVOP(P1)		;MUST HAVE BEEN HWP ERROR ON WRITE
	AOS	.PSVOP(P1)		;SO SET RETURN PC TO THE FILOP. ERROR
DSKOF1:	MOVX	S1,TS.HWC		;GET HWP CHECK BIT
	MOVX	S2,TS.HWP		;GET HWP BIT
	TDZN	S1,TCB.SF(B)		;CHECKING FOR HWP?
	JRST	MTAOFL			;NO - ENTER TAPE CODE
	IORM	S2,TCB.SF(B)		;YES
	MOVEI	S1,PS.RDO		;GET OFF-LINE BIT
	IORM	S1,TCB.PI(B)		;LITE IT
	POPJ	P,			;ALL DONE
DSKOF2:>
	MOVX	S1,TS.HWC		;GET HWP CHECK BIT
	MOVX	S2,TS.HWP		;GET HWP BIT
	TDZN	S1,TCB.SF(B)		;CHECKING FOR HWP?
	JRST	MTAOFL			;NO - ENTER TAPE CODE
	IORM	S2,TCB.SF(B)		;YES
	AOS	.PSVOP(P1)		;POINT PC AT UUO ERROR RETURN
	MOVEI	S1,PS.RDO		;GET OFF-LINE BIT
	IORM	S1,TCB.PI(B)		;LITE IT
	POPJ	P,			;ALL DONE


; Magtapeape off-line interrupts
MTAOFL:


; DECtape off-line interrupts
DTAOFL:	AOS	.PSVOP(P1)		;POINT PC AT UUO ERROR RETURN
	MOVX	S1,TW.OFL		;WAIT STATE CODE FOR OFFLINE
	STORE	S1,TCB.WS(B)		;SAVE IN TCB
	MOVEI	S1,PS.RDO		;GET OFF-LINE BIT
	IORM	S1,TCB.PI(B)		;LITE IT
	POPJ	P,			;RETURN
SUBTTL	PSI interface -- Device hung interrupts


INTHNG:	MOVEI	S1,PS.RDH		;GET HUNG DEVICE BIT
	IORM	S1,TCB.PI(B)		;LITE IT
	POPJ	P,			;RETURN
SUBTTL	I$DEVT - Get device type from monitor

;This routine determines the generic device type of a given
;device.
; Call -
;	S1/	SIXBIT device name
; Returns
;	S1/	Code describing the device type (%DISK, %TAPE, etc)

I$DEVT::MOVE	S2,S1			;Copy drive name
	MOVEI	S1,%DISK		;Assume disk
	DEVCHR	S2,			;Ask the monitor
	TXNE	S2,DV.MTA		;Magtape?
	MOVEI	S1,%TAPE		;Yes
	TXNE	S2,DV.DTA		;DECtape?
	MOVEI	S1,%DTAP		;Yes
	$RETT				;Return
	END