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