TITLE	QSRT10  --  Operating System Interface for QUASAR-10
SUBTTL	Larry Samberg   Chuck O'Toole /CER  6 Jan 77

;***Copyright (C) 1974, 1975, 1976, 1977,  Digital Equipment Corp., Maynard, MA.***

	SEARCH	QSRMAC		;PARAMETER FILE

	PROLOGUE(QSRT10)	;GENERATE THE NECESSARY SYMBOLS




;
;NOTES:
;
;ALL GLOBAL ROUTINES IN THIS MODULE USE "ONLY" ACS S1 AND S2.
;	CALLERS ARE GUARANTEED THAT ALL OTHER ACS WILL BE
;	RETURNED INTACT.

;THE LAST PAGE IN THIS MODULE (I$STCD ROUTINE) CONTAINS INFORMATION
;	ON QUASAR DEBUGGING AIDS.
COMMENT\

	STOPCDs found in QSRT10

CAP	CANNOT ACQUIRE A PID
CCI	CANNOT CONNECT INTERRUPT SYSTEM
COF	CANNOT TURN OFF INTERRUPT SYSTEM
CON	CANNOT TURN ON INTERRUPT SYSTEM
COP	CANT OPEN PRIME QUEUE
COR	CANT OPEN REDUNDANT QUEUE
CSQ	CANNOT SET IPCF QUOTAS
DIF	DEBRK OF INTERRUPT FAILED
EEP	ERROR EXPANDING PRIME QUEUE
EER	ERROR EXPANDING REDUNDANT QUEUE
FSP	FAILURE TO SET SYSTEM PID TABLE
HUF	HIBERNATE UUO FAILED
ICF	IPCF CONNECT FAILURE
LMI	LOST MESSAGE FROM [SYSTEM]IPCC
MRF	MESSAGE RECEIVE FAILURE
NGF	NECESSARY GETTAB FAILED
NGS	NO GALAXY-10 SUPPORT
PQI	PRIME QUEUE INTERLOCKED
PWE	PRIME WRITE ERROR
REF	READING END OF FILE
RIE	READ I/O ERROR
RWE	REDUNDANT WRITE ERROR
WBL	WRITING BAD LENGTH

\
COMMENT \

	TOPS10 Interpretation of Fields

1)  External Owner ID is a PPN
2)  Onwer ID (Internal) is a PPN

\
SUBTTL	Module Storage

SLPVAL:	EXP	^D60000			;SLEEP INTERVAL
MEMFLG:	EXP	0			;ZERO = IPCF INTERRUPTS ALLOWED
CENSTA:	BLOCK	1			;STATION # OF CENTRAL SITE
IPCPID:	BLOCK	1			;PID OF [SYSTEM]IPCC
SPLDIR:	BLOCK	1			;SPOOLING DIRECTORY
FFAPPN:	BLOCK	1			;FULL FILE ACCESS PPN [OPR]
PRMDIR:	BLOCK	1			;DIRECTORY FOR PRIME QUEUE
UNIDIR:	BLOCK	INPNUM			;UNIQUE DIRECTORY TABLE

IFN FTRQUE,<
REDDIR:	BLOCK	1			;DIRECTORY FOR REDUNDANT QUEUE
>  ;END IFN FTRQUE

;INTERRUPT CONTROL CELLS MUST BE IN THE FOLLOWING ORDER
;	THEY ARE REFERENCED BY THE OFFSET FROM THE BASE

INTBLK:	BLOCK	0			;BASE ADDRESS OF INTERRUPT VECTOR
IPCBLK::BLOCK	4			;IPC INTERRUPT BLOCK
INTEND==.-1				;END OF INTERRUPT VECTOR
SUBTTL	Initialization Routine

;ROUTINE TO INITIALIZE THE WORLD.  I$INIT INITIALIZES THE I/O
;	SYSTEM, AND ENABLES THE INTERRUPT SYSTEM.
;

I$INIT:: RESET				;RESET ALL I/O
	MOVX	S1,%CNST2		;GET SECOND STATES WORD
	PUSHJ	P,DOGTAB		;FOR SUPPORTED FEATURES
	TXNN	S1,ST%GAL		;THIS MONITOR SUPPORT GALAXY-10
	  STOPCD(NGS,FATAL)		;++NO GALAXY-10 SUPPORT
	MOVEI	S1,INTBLK		;BASE ADDRESS OF INTERRUPT VECTOR
	PIINI.	S1,			;AND INITIALIZE PSI SYSTEM
	  STOPCD(CCI,FATAL)		;++CANNOT CONNECT INTERRUPT SYSTEM
	MOVE	S1,[INTBLK,,INTBLK+1]
	ZERO	INTBLK			;PREPARE TO CLEAR INTERRUPT VECTOR
	BLT	S1,INTEND		;ZAP!!
	MOVEI	S1,C$INT##		;ADDRESS OF IPCF INTERRUPT ROUTINE
	MOVEM	S1,IPCBLK		;SAVE IT
	MOVE	S1,[PS.FAC+IPCSET]
	PISYS.	S1,			;ENABLE IPCF INTERRUPTS
	  STOPCD(ICF,FATAL)		;++IPCF CONNECT FAILURE
	MOVX	S1,%LDSPP		;GETTAB TO SPOOLED FILE PROTECTION
	PUSHJ	P,DOGTAB		;GET IT
	LSH	S1,-^D27		;RIGHT-JUSTIFY IT
	MOVEM	S1,G$SPRT##		;AND STORE AWAY
	MOVX	S1,%LDQUE		;GETTAB TO SPOOLING DIRECTORY
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,SPLDIR		;AND STORE IT AWAY
	MOVX	S1,%LDFFA		;FULL FILE ACCESS PERSON
	PUSHJ	P,DOGTAB		;GETTAB IT
	MOVEM	S1,FFAPPN		;SAVE FOR I$WHEEL CHECKS
	MOVX	S1,%LDSYS		;GETTAB FOR "SYS"
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,PRMDIR		;AND SAVE THE DIRECTORY

IFN FTRQUE,<
	MOVX	S1,%LDQUE		;GETTAB FOR "QUE"
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,REDDIR		;AND SAVE IT
>  ;END IFN FTRQUE


				;I$INIT IS CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

	MOVX	S1,%IPCML		;GETTAB FOR MAX PACKET SIZE
	PUSHJ	P,DOGTAB		;GET IT
	CAIGE	S1,SPL.SZ		;IS IT BIGGER THAN A SPOOL MESSAGE?
	MOVE	S1,SPL.SZ		;NO, LOAD SIZE OF SPOOL MESSAGE
	MOVEM	S1,G$MPS##		;AND STORE IT
	MOVEI	S1,.GTLOC		;GETTAB FOR CENTRAL SITE
	GETTAB	S1,			;GET IT
	  MOVEI	S1,0			;DEFAULT TO 0
	MOVEM	S1,CENSTA		;AND STORE IT
	MOVX	S1,%SIIPC		;FIND PID OF [SYSTEM]IPCC
	PUSHJ	P,DOGTAB		;FROM THE GETTAB'ABLE PID TABLE
	MOVEM	S1,IPCPID		;SAVE FOR I$SIPC
	MOVX	S1,%CNMMX		;GET SMALLEST LEGAL CORMAX
	PUSHJ	P,DOGTAB		;FROM THE CONFIG TABLE
	ADR2PG	S1			;CONVERT WORDS TO PAGES
	MOVEM	S1,G$MCOR##		;SAVE FOR THE SCHEDULER
	PJOB	S1,			;GET JOB NUMBER
	$SITEM	S1,QJOB			;AND SET THE ITEM
	PJRST	I$ION			;ENABLE INTERRUPTS AND RETURN

IPCSET:	EXP	.PCIPC			;ENABLE FOR IPCF INTERRUPTS
	IPCBLK-INTBLK,,0		;VECTOR OFFSET,,I/O REASON
	EXP	0			;RESERVED
SUBTTL	Information

;ENTRY POINTS

	INTERN	I$WHEEL		;CHECK IF G$DIR IS SOME FLAVOR OF OPERATOR
	INTERN	I$KSYS		;RETURN SECONDS UNTIL SYSTEM SHUTDOWN
	INTERN	I$NOW		;RETURN CURRENT DATE/TIME IN INTERNAL FORMAT
	INTERN	I$AGE		;COMPUTE AGE USING INTERNAL FORMAT DATE/TIME
	INTERN	I$AFT		;MODIFY AN INTERNAL TIME BY ADDITION
	INTERN	I$CHAC		;CHECK ACCESS
	INTERN	I$MIDS		;MAKE AN INTERNAL DEVICE SPECIFIER
	INTERN	I$MSDN		;MAKE A SIXBIT DEVICE NAME
	INTERN	I$LOGN		;CHECK IF OPERATOR ALLOWS LOGINS
	INTERN	I$OPER		;CHECK IF AN OPERATOR IS ON DUTY
	INTERN	I$VSTR		;VERIFY THAT A FILE STRUCTURE IS ONLINE
SUBTTL	I$WHEEL  --  Determine of the caller is an Operator

;ROUTINE CALLED TO CHECK IF THE CURRENT SENDER (G$DIR) IS AN OPERATOR PERSON.
;	USED TO PREVENT UNAUTHORIZED PERSONS FROM BECOMING
;	KNONW COMPONENTS OR CREATE REQUESTS FOR ANOTHER DIRECTORY.

;CALL	PUSHJ	P,I$WHEEL
;	  ALWAYS RETURNS HERE WITH S1 = .FALSE. IF NOT AN OPERATOR
;				   S1 = .TRUE.  IF ONE
;DESTROYS S1, S2

I$WHEEL: MOVE	S1,G$SID##		;GET CURRENT SENDERS PPN
	MOVE	S2,FFAPPN		;AND FULL FILE ACCESS PERSON
	CAMN	S1,S2			;SAME DIRECTORY
	  PJRST	.TRUE##			;YES, CAN DO ANYTHING
	HRRZS	S1			;ISOLATE PROGRAMMER NUMBER
	CAIE	S1,(S2)			;SAME PROGRAMMER
	  PJRST	.FALSE##		;NO, RETURN FALSE
	MOVE	S1,G$PRVS##		;GET CURRENT ENABLED CAPABILITIES
	TXNN	S1,IP.JAC		;IS JACCT SET
	  PJRST	.FALSE##		;NO, NOT AN OPERATOR
	PJRST	.TRUE##			;SON(DAUGHTER) - OF - OPR WITH JACCT
SUBTTL	I$KSYS  --  Routine to get KSYS time

;ROUTINE TO RETURN THE NUMBER OF SECONDS UNTIL SYSTEM SHUTDOWN
;CALL:
;	PUSHJ P,I$KSYS
;	  RETURN HERE WITH RESULT IN S1
;
;S1 =  +NN  SECONDS TO KSYS
;	00  NO KSYS
;	-1  TIMESHARING IS OVER

I$KSYS:	MOVX	S1,%NSKTM		;GET THE GETTAB
	GETTAB	S1,			;GET THE DATA
	  ZERO	S1			;ASSUME NO KSYS
	JUMPLE	S1,.POPJ##		;RETURN IF NONE OR OVER
	IMULI	S1,^D60			;CONVERT MINUTES TO SECONDS
	POPJ	P,			;AND RETURN
SUBTTL	I$NOW  --  Routine to return time in internal format

;ROUTINE TO RETURN THE CURRENT DATE/TIME IN INTERNAL FORMAT
;CALL:
;	PUSHJ	P,I$NOW
;	  RETURN HERE WITH S1 = DATE/TIME IN INTERNAL FORMAT
;
;GLOBAL LOCATION G$NOW IS ALSO FILLED IN.

I$NOW:	MOVX	S1,%CNDTM	;UNIVERSAL DATE/TIME
	PUSHJ	P,DOGTAB	;GET THE DATA
	MOVEM	S1,G$NOW##	;STORE IN GLOBAL LOCATION
	POPJ	P,		;AND RETURN
SUBTTL	I$AGE  --  Routine to compare two times in internal format

;ROUTINE TO COMPUTE THE AGE IN SECONDS BASED ON THE INTERNAL DATE/TIME FORMAT
;
;CALL:
;	S1 AND S2 ARE THE TIMES TO COMPUTE AGES
;	PUSHJ	P,I$AGE
;	  RETURNS HERE WITH AGE IN SECONDS IN S1
;DESTROYS S1,S2,TEMP IN THE PROCESS

I$AGE:	CAMGE	S1,S2		;ORDERING CHECK
	EXCH	S1,S2		;WANT THE LARGEST IN S1
	SUB	S1,S2		;SUBTRACT THEM
	IDIVI	S1,3		;RESOLUTION IS APPROX. 1/3 SEC
	POPJ	P,		;AND RETURN
SUBTTL	I$AFT  --  Routine to modify an internal time

;ROUTINE TO RETURN G$NOW + A SPECIFIED INTERVAL.
;
;CALL:
;	S1 CONTAINS INTERVAL IN MINUTES
;	PUSHJ P,I$AFT
;	  RETURN HERE WITH S1=G$NOW+SPECIFIED INTERVAL

I$AFT:	ZERO	S2			;ZERO FOR A SHIFT
	ASHC	S1,-^D17		;GENERATE DOUBLE CONSTANT
					; = ARG*2^18
	DIVI	S1,^D1440		;DIVIDE BY MIN/DAY
	ADD	S1,G$NOW##		;ADD IN NOWTIM
	POPJ	P,			;AND RETURN
SUBTTL	I$CHAC  --  Routine to Check File Access

;ROUTINE TO CHECK FILE AND QUEUE REQUEST ACCESS
;
;CALL:
;	MOVE	S1,[ACCESS CODE,,PROTECTION]
;	MOVE	S2,DIRECTORY OF FILE OR REQUEST
;	PUSHJ	P,I$CHAC
;	  RETURN HERE ALWAYS
;
;CHECK IS MADE AGAINST SENDER OF CURRENT REQUEST
;RETURN	S1 = .TRUE. = ACCESS ALLOWED
;	S1 = .FALSE. = ACCESS NOT ALLOWED

I$CHAC:	MOVEM	S1,CHAC.A		;SAVE CODE AND PROTECTION
	MOVEM	S2,CHAC.A+1		;ALSO SAVE OWNER OF FILE
	MOVE	S1,G$SID##		;CURRENT SENDER (KILL, MODIFY)
	MOVEM	S1,CHAC.A+2		;SET UP CHKACC UUO BLOCK
	MOVEI	S1,CHAC.A		;POINT TO IT
	CHKACC	S1,			;ASK THE FILE SERVICE
	  PJRST	.FALSE##		;RETURN FALSE
	SETCA	S1,			;FLIP TOPS10 RETURN
	POPJ	P,			;RETURN

CHAC.A:	BLOCK	3			;LOCAL STORAGE
SUBTTL	I$MIDS  --  Routine to generate an IDS

;CALL WITH S1 CONTAINING A SIXBIT DEVICE NAME, AND S2 CONTAINING
;	THE DEFAULT STATION NUMBER.  RETURN WITH S1 CONTAINING
;	THE IDS FOR THE SPECIFIED DEVICE.  IF THE ORIGINAL DEVICE
;	SPECIFICATION IS ILLEGAL, S1 IS RETURNED 0.

I$MIDS:	TLNN	S1,007777		;MUST BE AT LEAST 2 CHARACTERS
	  PJRST	.FALSE##		;ISN'T, GIVE BAD RETURN
	PUSHJ	P,.SAVE3##		;SAVE P1 - P3
	MOVE	P1,S1			;COPY THE ARGUMENT
	MOVEI	P2,6			;LOOP COUNTER
MIDS.0:	LSH	P1,6			;NOW CHECK FOR IMBEDDED NULLS
	TLNE	P1,770000		;NULL CHARACTER AT THE TOP
	  SOJG	P2,MIDS.0		;NO, KEEP GOING
	PJUMPN	P1,.FALSE##		;YES, GIVE ERROR IF MORE REMAINS
	LOAD	P1,S1,DV.GDN		;GET THE DEVICE REQUESTED
	TRZ	P1,77			;CLEAR THE 3RD CHARACTER
	CAIN	P1,'LU '		;REQUEST FOR UPPER CASE ONLY PRINTER
	  JRST	MIDS.7			;YES, GO PROCESS THAT
	CAIN	P1,'LL '		;OR FOR LOWER CASE ONLY
	  JRST	MIDS.8			;THEY NEED SOME SPECIAL PROCESSING
	LDB	P3,[POINT 6,S1,35]	;SPLIT THE CHARACTERS FOR EASIER CHECKS
	LDB	P2,[POINT 6,S1,29]	;  ...
	LDB	P1,[POINT 6,S1,23]	;  ...
	ZERO	S1,DV.DMD		;CLEAR RESULTANT DEVICE MODIFIERS
MIDS.1:	CAIE	P1,'S'			;REQUEST FOR 'DEVSnn'
	  JRST	MIDS.4			;NO, LOOK FOR OTHER FORMS
	JUMPN	P3,MIDS.2		;YES, JUMP IF TWO DIGITS
	MOVEI	P1,'0'			;CONVERT TO STANDARD NAMES
	JRST	MIDS.3			; P2 IS ALREADY CORRECT
MIDS.2:	MOVE	P1,P2			;'SHIFT' OUT THE 'S'
	MOVE	P2,P3			;EVERYTHING UP ONE DIGIT
MIDS.3:	ZERO	P3			;NOW IS STATION GENERIC
MIDS.4:	JUMPN	P2,MIDS.5		;NOW DETERMINE IF UNIT AT DEFAULT STATION
	JUMPN	P3,MIDS.5		;IS THAT IF BOTH WERE NULL
	MOVE	P3,P1			;GET UNIT NUMBER (MAY ALSO BE NULL)
	LDB	P1,[POINT 3,S2,32]	;FIRST DIGIT OF DEFAULT STATION
	TRO	P1,'0'			;MAKE IT SIXBIT TOO
	LDB	P2,[POINT 3,S2,35]	;GET THE SECOND DIGIT
	TRO	P2,'0'			;AGAIN, TO SIXBIT

;   FALL INTO FINAL ASSEMBLY STAGE (ON THE NEXT PAGE)


; I$MIDS IS CONTINUED ON THE NEXT PAGE
; HERE TO ASSEMBLE THE STATION AND UNIT FROM THE CHARACTERS IN P1,P2, AND P3

MIDS.5:	SKIPN	P3			;GENERIC STATION
	  TXO	S1,DV.NUL		;YES, SET 'UNIT WAS NULL'
	CAIG	P1,'7'			;STATION NUMBERS ARE OCTAL
	 CAIGE	P1,'0'			;SO NOW LOOK FOR BAD DIGITS
	  PJRST	.FALSE##		;GIVE BAD RETURN
	CAIG	P2,'7'			;SAME CHECK FOR THE OTHERS
	 CAIGE	P2,'0'			; THIS PREVENTS 'LPTFOO'
	  PJRST	.FALSE##		;WHICH WILL BE THE FIRST TEST OF THIS
	LSH	P1,3			;MAKE ROOM FOR THE OTHER DIGIT
	ADDI	P1,-'0'(P2)		;ADD THEM TOGETHER FOR BINARY STATION NUMBER
	ANDI	P1,77			;IGNORE SIXBIT OVERFLOW
	JUMPE	P3,MIDS.6		;SKIP THIS IF UNIT NOT SPECIFIED
	CAIG	P3,'7'			;ANOTHER SET OF CHECKS FOR THAT DIGIT
	 CAIGE	P3,'0'			;SINCE UNIT NUMBERS ARE OCTAL AS WELL
	  PJRST	.FALSE##		;ILLEGALLY FORMATTED DEVICE SPEC
	STORE	P3,S1,DV.UTN		;STORE THE UNIT NUMBER
MIDS.6:	TLNN	S1,000077		;END UP LESS THAN 3 CHARACTERS
	  PJRST	.FALSE##		;YES, CAN DETECT ILLEGALITY NOW
	STORE	P1,S1,DV.STN		;STORE FULL STATION NUMBER
	JUMPN	P1,.POPJ##		;ALL DONE IF IT WAS A NUMBER
	LOAD	P1,CENSTA		;DIDN'T, GET THE CENTRAL SITE
	STORE	P1,S1,DV.STN		;STORE THAT INSTEAD
	POPJ	P,			;AND RETURN

; HERE TO PARSE THE ALLOWABLE FORMS FOR LL: AND LU:

MIDS.7:	PUSHJ	P,MIDS.9		;PREPARE THE FIELDS
	PJUMPE	S1,.POPJ##		;ILLEGAL SPEC
	TXO	S1,DV.LUP!DV.NUL	;BITS FOR LU:
	JRST	MIDS.1			;AND ENTER COMMON CODE

MIDS.8:	PUSHJ	P,MIDS.9		;PREPARE/VALIDATE
	PJUMPE	S1,.POPJ##		;ILLEGAL
	TXO	S1,DV.LLP!DV.NUL	;INDICATE LL:
	JRST	MIDS.1			;AND RESUME

MIDS.9:	TRNE	S1,000077		;SPECIFY FULL 6 CHARACTERS
	  PJRST	.FALSE##		;YES, ILLEGAL TO DO SO
	TLNE	S1,000077		;ONLY 2 CHARACTERS
	 TRNE	S1,777777		;NO, BUT WAS IT ONLY 3 CHARACTERS
	  SKIPA				;ALL IS OK SO FAR
	   PJRST .FALSE##		;BAD SPEC IF EXACTLY 3 CHARACTERS
	LDB	P1,[POINT 6,S1,17]	;LOAD UP CHARACTERS 3,4 AND 5
	LDB	P2,[POINT 6,S1,23]	;FOR THE COMMON CODE
	LDB	P3,[POINT 6,S1,29]	;  ...
	MOVSI	S1,'LPT'		;TURN LL/LU INTO LPT:
	PJUMPE	P3,.POPJ##		;RETURN IF NOT 5 CHARACTERS
	CAIE	P1,'S'			;IF 5, THEN MUST BE 'Snn'
	  PJRST	.FALSE##		;BAD SPEC IF NOT
	POPJ	P,			;RETURN TO BUILD FULL IDS
SUBTTL	I$MSDN  --  Convert an IDS into a device name

;CALL WITH S1 CONTAINING THE IDS FOR A DEVICE, RETURN WITH S1 CONTAINING
;	THE DEVICE NAME IN SIXBIT.

I$MSDN:	PUSHJ	P,.SAVET##		;SAVE T1-T4
	MOVE	T1,S1			;COPY THE ARGUMENT
	TRZ	S1,-1			;CLEAR THE RH OF THE ANSWER
	TXNN	T1,DV.STN		;NULL STATION?
	JRST	MSDN.1			;YES, MAKE DEVICE MORE READABLE
	LOAD	T2,T1,DV.STN!DV.UTN	;GET DEVICE AND UNIT FIELDS
	IDIVI	T2,100			;SPLIT OFF THE FIRST DIGIT
	IDIVI	T3,10			;SPLIT OFF THE SECOND DIGIT
	LSH	T2,14			;SHIFT FIRST DIGIT OVER
	LSH	T3,6			;SHIFT SECOND DIGIT OVER
	TRO	T2,'000'(T3)		;MAKE FIRST TWO DIGITS
	TRO	T2,(T4)			;ADD IN THE THIRD DIGIT
	HRR	S1,T2			;AND COPY RESULT TO THE ANSWER
	TXNE	T1,DV.NUL		;NULL UNIT?
	TRZ	S1,77			;YES, MAKE IT SO
	TXNE	T1,DV.LLP		;LOWER CASE LPT?
	HRLI	S1,'LL@'		;YES, MAKE IT
	TXNE	T1,DV.LUP		;UPPER CASE LPT?
	HRLI	S1,'LU@'		;YUP!
	POPJ	P,			;RETURN

MSDN.1:	LOAD	T2,T1,DV.UTN		;GET THE UNIT NUMBER
	LSH	T2,^D12			;SHIFT OVER TO 4TH CHARACTER
	TXNN	T1,DV.NUL		;NULL UNIT?
	TRO	T2,'0  '		;NO, MAKE IT SIXBIT
	HRR	S1,T2			;PUT NAME TOGETHER
	TXNE	T1,DV.LLP		;WAS IT REALLY LL?
	MOVSI	S1,'LL '		;YUP
	TXNE	T1,DV.LUP		;OR LU?
	MOVSI	S1,'LU '		;YES
	POPJ	P,			;ALL DONE, RETURN
SUBTTL	I$LOGN & I$OPER  --  Check for operator settings and attendence

;CALL	PUSHJ	P,I$LOGN OR I$OPER
;
;	RETURNS HERE WITH S1 = .TRUE. IF BATCH LOGINS ARE PERMITTED
;				      IF OPERATOR IS ON DUTY
;			       .FALSE.IF NOT

I$OPER:	SKIPA	S2,[ST%NOP]		;NO OPERATOR BIT IN STATES WORD
I$LOGN:	MOVX	S2,ST%NRL!ST%NLG	;BITS THAT PROHIBIT LOGINS
	MOVX	S1,%CNSTS		;GET THE STATES BITS
	PUSHJ	P,DOGTAB		;GET THE DATA
	TDNN	S1,S2			;CHECK FOR "DON'T ALLOW" BITS
	  PJRST	.TRUE##			;RETURN TRUE IF ALL OFF
	PJRST	.FALSE##		;OTHERWISE, SAY PROHIBITTED
SUBTTL	I$VSTR  --  Verify That A File Structure Is On-Line

;ROUTINE TO VERIFY THAT A STRUCTURE IS ON-LINE FOR THE SCHEDULER
;CALL	S1 = THE STRUCTURE
;	PUSHJ	P,I$VSTR
;
;
;RETURNS S1 = .TRUE. IF STRUCTURE IS THERE
;	    =  .FALSE. IF OFF-LINE OR NOT A DISK
;	 S2 = STRUCTURE NAME

I$VSTR:	MOVEM	S1,VSTR.A		;SAVE NAME AS ARG TO DSKCHR
	MOVE	S1,[5,,VSTR.A]		;SETUP ARG POINTER
	DSKCHR	S1,UU.PHY		;DO THE DSKCHR
	  PJRST	VSTR.1			;STRANGE?
	LDB	S2,[POINTR(S1,DC.TYP)]	;GET ARG TYPE
	CAIE	S2,.DCTFS		;IS IT A FILE-STRUCTURE?
	PJRST	VSTR.1			;NO, SO ITS NOT ON-LINE
	MOVE	S2,VSTR.A+.DCSNM	;GET THE STRUCTURE NAME
	TXNE	S1,DC.OFL!DC.SAF!DC.NNA
					;CHECK FOR "NOT":
					;  OFF-LINE, SINGLE-ACCESS
					;  NO-NEW-ACCESSES
	PJRST	.FALSE##		;RETURN FALSE IF ANY OF THEM
	PJRST	.TRUE##			;WIN!!

VSTR.1:	MOVE	S2,VSTR.A+.DCNAM	;GET ORIG ARG
	PJRST	.FALSE##		;AND LOSE

VSTR.A:	BLOCK	5			;ARG BLOCK FOR DSKCHR UUO
SUBTTL	Utilities

;ENTRY POINTS

	INTERN	I$SLP		;Suspend Job (SLEEP)
	INTERN	I$IOFF		;Turn off interrupt system
	INTERN	I$ION		;Turn on interrupt system
	INTERN	I$DBRK		;Dismiss Current Interrupt
	INTERN	I$POST		;Post a "wakeup" at interrupt level
	INTERN	I$SVAL		;Set SLEEP interval for subsequent call to I$SLP
	REMARK	DOGTAB		;Do necessary GETTABs
SUBTTL	I$SLP  --  Routine to SLEEP for a given time

;ROUTINE TO SUSPEND THE JOB FOR A GIVEN LENGTH OF TIME.
;CALL:
;	PUSHJ  P,I$SLP
;	  RETURN HERE UPON WAKING
;
;USES THE VALUE IN SLPVAL FROM CALLS TO I$SVAL AND RESETS IT
;	TO AN INFINITE WAIT

I$SLP:	ZERO	S1		;SET INFINITE
	EXCH	S1,SLPVAL	;GET THIS INTERVAL, SET UP FOR NEXT TIME
	TXO	S1,HB.IPC	;WAKE ON IPC RECEIVES
	HIBER	S1,		;SLEEP!
	  STOPCD(HUF,FATAL)	;++HIBERNATE UUO FAILED
	PJRST	I$NOW		;AND RETURN VIA I$NOW
SUBTTL	I$POST  --  Post a wakeup at interrupt level

;I$POST IS CALLED BY THE INTERRUPT LEVEL ROUTINE TO RESET
;	THE PC AND THE AWOKEN AND BLOCKED FLAGS CORRECTLY

I$POST==.POPJ##			;NO-OP ON TOPS10
SUBTTL	I$SVAL  --  Set up a SLEEP interval

;CALL	S1 = THE NUMBER OF SECONDS REQUESTED
;	PUSHJ	P,I$SVAL
;	  ALWAYS RETURNS HERE

;A SUBSEQUENT CALL TO I$SLP WILL USE THE VALUE SAVED IN SLPVAL
;	WHICH IS THE SMALLEST OF THE REQUESTED TIMES

I$SVAL:	SKIPG	S1		;CHECK FOR BAD DATA
	  MOVEI	S1,1		;ASSUME 1 SECOND IF BAD
	CAILE	S1,^D60		;MORE THAN 1 MINUTE
	  MOVEI	S1,^D60		;YES, THAT IS THE MAXIMUM
	IMULI	S1,^D1000	;CONVERT TO MILLI-SECONDS
	SKIPE	SLPVAL		;FIRST TIME THIS PASS
	 CAMGE	S1,SLPVAL	;NO, THE SMALLEST YET
	  MOVEM	S1,SLPVAL	;YES, SAVE IT
	POPJ	P,		;AND RETURN
SUBTTL	I$IOFF  --  Routine to disable the interrupt system

;ROUTINE TO DISABLE THE INTERUPT SYSTEM

I$IOFF:	MOVX	S1,PS.FOF	;TURN OFF THE INTERUPTS SYSTEM
	PISYS.	S1,		;OFF!!
	  STOPCD(COF,FATAL)	;++CANNOT TURN OFF INTERRUPT SYSTEM
	POPJ	P,		;RETURN
SUBTTL	I$ION  --  Routine to enable the interrupt system

;ROUTINE TO TURN ON THE INTERRUPT SYSTEM

I$ION:	MOVX	S1,PS.FON	;TURN IT ON
	PISYS.	S1,		;ON!!
	  STOPCD(CON,FATAL)	;++CANNOT TURN ON INTERRUPT SYSTEM
	POPJ	P,		;AND RETURN
SUBTTL	I$DBRK  --  Routine to Dismiss the Current Interrupt

;I$DBRK IS CALLED (VIA JRST) TO RETURN FROM INTERRUPT LEVEL

I$DBRK:	DEBRK.			;DONE WITH THE INTERRUPT
	  JFCL			;FALL INTO THE STOPCD
	  STOPCD(DIF,FATAL)	;++DEBRK OF INTERRUPT FAILED
SUBTTL	DOGTAB  --  Routine to do necessary gettabs

;CALL DOGTAB TO DO ANY GETTABS WHICH ARE REQUIRED TO SUCCEED.  IF THE
;	GETTAB FAILS, A NGF STOPCD IS GIVEN.
;
;CALL WITH S1 CONTAINING THE GETTAB TO BE DONE.

DOGTAB:	GETTAB	S1,			;DO THE GETTAB
	  STOPCD(NGF,FATAL)		;++NECESSARY GETTAB FAILED
	POPJ	P,			;SUCCEED
SUBTTL	Memory Manager Interface Routines

;ENTRY POINTS

	INTERN	I$MFFP			;FIND FIRST FREE PAGE
SUBTTL	I$MFFP  --  Find First Free Page

;ROUTINE TO FIND THE FIRST FREE PAGE IN QUASAR'S ADDRESS SPACE.
;	RETURNS THE PAGE NUMBER IS S1.

I$MFFP:	HLRZ	S1,.JBSA		;GET JOBFF
	ADDI	S1,777			;ROUND UP TO A PAGE
	ADR2PG	S1			;CONVERT TO A PAGE NUMBER
	POPJ	P,			;AND RETURN
SUBTTL	IPCF Interace

;ENTRY POINTS

	INTERN	I$IPS			;IPCF SEND
	INTERN	I$IPR			;IPCF RECEIVE
	INTERN	I$IPQ			;IPCF QUERY
	INTERN	I$GMIS			;GET MESSAGE INTERRUPT STATUS
	INTERN	I$OKIN			;CHECK IF OK TO PROCESS IPCF INTERRUPT
	INTERN	I$NOIN			;SET NOT OK TO PROCESS IPCF INTERRUPTS
	INTERN	I$EPID			;IPCF INIT ESTABLISHES PIDS
SUBTTL	I$IPS  --  Send an IPCF Message

;ROUTINE TO SEND AN IPCF MESSAGE.
;CALL:
;	MOVE	S1,PDB SIZE
;	MOVE	S2,ADDRESS OF PDB
;	PUSHJ	P,I$IPS
;	  RETURN HERE ALWAYS, S2=0 ON SUCCESS
;			      S2=-1 ON FAILURE (ERROR CODE IN S1)

I$IPS:	MOVSS	S1			;GET LENGTH,,0
	HRR	S1,S2			;GET LENGTH,,ADDRESS
	ZERO	S2			;ASSUME SUCCESS
	IPCFS.	S1,			;SEND THE MESSAGE
	  SETO	S2,			;SET THE ERROR FLAG
	POPJ	P,			;AND RETURN
SUBTTL	I$IPR  --  Receive an IPCF Message

;ROUTINE TO RECEIVE AN IPCF MESSAGE.
;CALL:
;	MOVE	S1,PDB SIZE
;	MOVE	S2,PDB ADDRESS
;	PUSHJ	P,I$IPR
;	  RETURN HERE ALWAYS,  S1 = ASSOCIATED VARIABLE

I$IPR:	MOVSS	S1			;GET LENGTH,,0
	HRR	S1,S2			;GET LENGTH,,ADDRESS
	MOVEM	S1,IPR.A		;SAVE IN CASE OF FAILURE
IPR.1:	IPCFR.	S1,			;RECEIVE THE MESSAGE
	  SKIPA				;FAILED, SEE WHY
	POPJ	P,			;AND RETURN
	CAIE	S1,IPCUP%		;WAS FAILURE BECAUSE OF SPACE
	  STOPCD(MRF,FATAL)		;++MESSAGE RECEIVE FAILURE
	PUSHJ	P,M$IPRM##		;HAVE QSRMEM MAKE SOME ROOM FOR IT
	MOVE	S1,IPR.A		;GET IPCF PARAMETERS AGAIN
	JRST	IPR.1			;TRY IT NOW

IPR.A:	BLOCK	1			;HOLDS IPCF POINTERS
SUBTTL	I$IPQ  --  Query QUASAR's IPCF Queue

;ROUTINE TO RETURN INFORMATION ABOUT THE NEXT THING IN QUASAR'S
;	IPCF RECIEVE QUEUE.
;CALL:
;	PUSHJ	P,I$IPQ
;	  ALWAYS RETURN HERE, S1 = ASSOCIATED VARIABLE FOR RECEIVE (COULD BE ZERO)

I$IPQ:	MOVE	S1,[IPQ.A,,IPQ.A+1]	;SETUP A BLT POINTER
	CLEARM	IPQ.A			;CLEAR THE FIRST WORD
	BLT	S1,IPQ.A+5		;CLEAR THE REST
	MOVE	S1,[4,,IPQ.A]		;UUO ARG
	IPCFQ.	S1,			;QUERY
	  PJRST	.FALSE##		;FAILED, RETURN 0
	HRRZ	S1,IPQ.A+.IPCFL		;GET RIGHT HALF OF FLAGS
	HLL	S1,IPQ.A+.IPCFP		;AND LENGTH
	POPJ	P,			;AND RETURN

IPQ.A:	BLOCK	6			;LOCAL STORAGE
SUBTTL	I$GMIS  --  Get Message Interrupt Status

;ROUTINE TO RETURN THE ASSOCIATED VARIABLE OF THE PACKET TO BE
;	RECEIVED ON AN INTERRUPT.
;CALL:
;	PUSHJ	P,I$GMIS
;	  ALWAYS RETURN HERE, S1=ASSOCIATED VARIABLE (COULD BE ZERO)
;
;**WARNING**
;	THIS ROUTINE IS CALLED AT INTERRUPT LEVEL, SO ANY ROUTINES
;	CALLED BY IT MUST ALSO RECOGNIZE THIS FACT.

I$GMIS:	MOVE	S1,IPCBLK+.PSVIS	;GET INTERRUPT STATUS
	POPJ	P,			;AND RETURN
SUBTTL	I$OKIN & I$NOIN  --  IPCF & QSRMEM interface

;I$OKIN RETURNS .TRUE. IF IT IS OK TO PROCESS THIS IPCF INTERRUPT
;	.FALSE. IF IT IS INCONVENIENT (QSRMEM IS CHANGING THE FREE LISTS)

I$OKIN:	SKIPN	MEMFLG			;DID QSRMEM TELL US NOT TO ALLOW THEM
	  PJRST	.TRUE##			;NO, OK TO PROCESS
	PJRST	.FALSE##		;CANNOT DO IT NOW, TRY LATER


;I$NOIN IS CALLED BY QSRMEM WHEN IT DETERMINES THAT IT IS CHANGING THINGS THAT
;	COULD BE USED AT INTERRUPT LEVEL.  THIS ACTS AS A CO-ROUTINE TO
;	CLEAR THE STATE WHEN QSRMEM POPJ'S

I$NOIN:	SKIPE	MEMFLG			;RE-CURSIVE CALL
	  POPJ	P,			;YES, WAIT FOR THE TOP CALLER TO RETURN
	POP	P,MEMFLG		;REMOVE CALL, SET FLAG NON-ZERO
	PUSHJ	P,@MEMFLG		;CALL THE CALLER
	 SKIPA				;NON-SKIP RETURN
	  AOS	(P)			;PROPOGATE THE SKIP RETURN
	SETZM	MEMFLG			;ALLOW INTERRUPTS NON
	POPJ	P,			;AND RETURN TO SOMEBODY
SUBTTL	I$EPID  --  Get A PID for [SYSTEM]xxxxxx

;I$EPID IS CALLED WITH S1 CONTAINING THE INDEX INTO THE SYSTEM PID TABLE FOR THE
;	ENTRY TO SET. ESTABLISHES THAT ENTRY AND RETURNS S1 = THE PID ACQUIRED

I$EPID:	PUSHJ	P,.SAVET##		;SAVE T REGS
	SAVE	AP			;SAVE AP
	SAVE	H			;SAVE H
	MOVEM	S1,SYSENT		;STORE TABLE INDEX INTO SET FUNCTION
	MOVSI	S1,(S1)			;PUT INDEX INTO LH
	HRRI	S1,.GTSID		;USE SYSTEM PID TABLE GETTAB
	PUSHJ	P,DOGTAB		;GO GET IT
	JUMPN	S1,.POPJ##		;IF ALREADY EXISTS, ASSUME IT IS US
	PJOB	S1,			;GET MY JOB NUMBER
	MOVEM	S1,PIDMJB		;JOB TO CREATE A PID FOR
	MOVEI	AP,PIDBLK		;NO PID EXISTS, CREATE ONE
	PUSHJ	P,SNDIPC		;SEND AND GET THE RESPONSE
	SKIPE	S2			;DID AN ERROR OCCUR
	  STOPCD(CAP,FATAL)		;++CANNOT ACQUIRE A PID
	MOVE	S1,PIDANS-PIDFNC(S1)	;GET THE RETURNED PID
	MOVEM	S1,EPID.A		;THAT IS THE PID TO BE RETURNED
	MOVEM	S1,SYSIDN		;STORE FOR WRITE SYSTEM PID TABLE
	MOVEM	S1,QTAIDN		;AND FOR QUOTA SET
	PUSHJ	P,C$PUT##		;RETURN THE ANSWER
	MOVEI	AP,SYSPID		;NOW, ESTABLISH THE SYSTEM COMPONENT
	PUSHJ	P,SNDIPC		;SEND AND GET THE RESPONSE
	SKIPE	S2			;DID AN ERROR OCCUR
	  STOPCD(FSP,FATAL)		;++FAILURE TO SET SYSTEM PID TABLE
	SKIPN	QTAQTA			;ALREADY SET THE QUOTAS
	  JRST	EPID.1			;YES, CAN STOP NOW
	PUSHJ	P,C$PUT##		;NO, FIRST RETURN THE CELL
	MOVEI	AP,QTASET		;SET THE SEND/RECEIVE QUOTAS
	PUSHJ	P,SNDIPC		;SEND AND GET THE RESPONSE
	SKIPE	S2			;ALL DONE IF THAT WORKED
	  STOPCD(CSQ,FATAL)		;++CANNOT SET IPCF QUOTAS
	ZERO	QTAQTA			;DON'T NEED TO SET QUOTAS AGAIN
EPID.1:	PUSHJ	P,C$PUT##		;RETURN LAST ANSWER
	MOVE	S1,EPID.A		;PID ACQUIRED THROUGH THIS SEQUENCE
	POPJ	P,			;RETURN

EPID.A:	BLOCK	1			;PID CREATED/READ DURING I$EPID

;THE MESSAGE BLOCKS ARE ON THE NEXT PAGE
;MESSAGES BLOCKS SEND DURING I$EPID SEQUENCE

PIDBLK:	EXP	IP.CFP,0,0		;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
	XWD	PIDLEN,PIDFNC		;LENGTH,,ADDR
PIDFNC:	XWD	PIDFNC,.IPCSC		;CODE,,CREATE A PID FOR A JOB
PIDMJB:	EXP	0			;MY JOB NUMBER FILLED IN
PIDANS:	EXP	0			;PID RETURNED
PIDLEN==.-PIDFNC			;LENGTH OF MESSAGE

SYSPID:	EXP	IP.CFP,0,0		;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
	XWD	SYSLEN,SYSFNC		;LENGTH,,ADDR
SYSFNC:	XWD	SYSFNC,.IPCWP		;WRITE SYSTEM PID TABLE
SYSENT:	EXP	0			;ENTRY FILLED IN
SYSIDN:	EXP	0			;TO MY PID (FILLED IN)
SYSLEN==.-SYSFNC			;LENGTH OF MESSAGE

QTASET:	EXP	IP.CFP,0,0		;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
	XWD	QTALEN,QTAFNC		;LENGTH,ADDR
QTAFNC:	XWD	QTAFNC,.IPCSQ		;CODE,,SET QUOTA FUNCTION
QTAIDN:	EXP	0			;MY PID (FILLED IN)
QTAQTA:	EXP	777777			;SEND = RECEIVE = INFINITY
QTALEN==.-QTAFNC			;LENGTH OF THE SET QUOTA MESSAGE
SUBTTL	SNDIPC  --  Send/Receive a message from [SYSTEM]IPCC

;CALLED WITH AP POINTING TO A PACKET DESCRIPTOR BLOCK FOR C$SEND
;RETURNS WITH
;	AP = THE PACKET ADDRESS (FOR CALL TO C$PUT)
;	S1 = THE ADDRESS OF THE MESSAGE PROPER
;	S2 = THE ERROR BITS FROM .IPCFL

;THIS ROUTINE IS CALLED BY I$EPID DURING INITIALIZATION OF OTHER MODULES

SNDIPC:	MOVE	S1,IPCPID		;EXTERNAL VALUE OF [SYSTEM]IPCC
	MOVEM	S1,.IPCFR(AP)		;AS RECEIVER OF THIS SEND
	LOAD	S1,.IPCFP(AP),IPM.AD	;GET ADDRESS OF MESSAGE
	MOVE	S1,(S1)			;GET CODED RESPONSE
	MOVEM	S1,SNDI.A		;SAVE CODE RESPONSE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE TO [SYSTEM]IPCC
	PUSHJ	P,C$RAPK##		;RECEIVE ALL OUTSTAND PACKETS
	LOAD	AP,<HDRIPC##+.QHLNK>,QH.PTL  ;SEARCH FOR IT BACKWARDS
SNDI.1:	SKIPN	AP			;OFF THE END
	  STOPCD(LMI,FATAL)		;++LOST MESSAGE FROM [SYSTEM]IPCC
	LOAD	S1,IPCFLG(AP),IP.CFC	;GET SENDER CODE
	CAIE	S1,.IPCCC		;FROM [SYSTEM]IPCC
	  JRST	SNDI.2			;NO, TRY ANOTHER
	LOAD	S1,IPCMES(AP),IPM.AD	;GET ADDRESS OF MESSAGE (NEVER PAGED)
	MOVE	S2,0(S1)		;FIRST WORD OF RESPONSE
	CAME	S2,SNDI.A		;ONE WE ARE LOOKING FOR
	  JRST	SNDI.2			;NO, TRY ANOTHER
	MOVEI	H,HDRIPC##		;POINT TO THE QUEUE
	PUSHJ	P,M$DLNK##		;REMOVE THE MESSAGE
	LOAD	S1,IPCMES(AP),IPM.AD	;POINT TO IT AGAIN
	LOAD	S2,IPCFLG(AP),IP.CFE	;GET THE ERROR BITS
	POPJ	P,			;RETURN TO CALLER
SNDI.2:	LOAD	AP,.QELNK(AP),QE.PTP	;GO BACKWARDS
	JRST	SNDI.1			;LOOK AT THIS ONE

SNDI.A:	BLOCK	1			;SAVED CODE FOR RESPONSE
SUBTTL	FD Manipulation Routines

	INTERN	I$CSM			;Create a Canonical SPOOL Message
	INTERN	I$CLM			;Create a Canonical LOGOUT Message
	INTERN	I$FSTR			;Extract STRUCTURE from an FD
	INTERN	I$FMCH			;Determine if 2 FD's match with masks
SUBTTL	I$CSM  --  Create a Canonical SPOOL Message

;CALL I$CSM TO CONVERT A SPOOL MESSAGE RECEIVED FROM THE OPERATING SYSTEM
;	INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:	MOVE	S1,[ADR OF SPOOL MESSAGE FROM OPERATING SYSTEM]
;	PUSHJ	P,I$CSM
;	  RETURN HERE WITH S1 CONTAINING THE ADR OF THE CSM

I$CSM:	PUSHJ	P,.SAVE2##		;SAVE P1-P2
	MOVEI	S2,CSM.A		;LOAD ADR OF BLOCK FOR CONVENIENCE
	LOAD	P1,SPL.JB(S1),SP.JOB	;GET THE JOB NUMBER
	STORE	P1,CSM.JB(S2),CS.JOB	;AND STORE IT
	LOAD	P1,SPL.JB(S1),SP.LOC	;GET DEFAULT LOCATION
	STORE	P1,CSM.JB(S2),CS.LOC
	LOAD	P1,SPL.JB(S1),SP.DFR	;GET DEFER'ED SPOOLING BIT
	STORE	P1,CSM.JB(S2),CS.DFR	;AND STORE IT
	DMOVE	P1,SPL.US(S1)		;GET THE USER NAME
	DMOVEM	P1,CSM.US(S2)		;AND STORE IT
	LOAD	P1,G$SID##		;GET USER'S DIRECTORY
	STORE	P1,CSM.OI(S2)		;AND STORE IT
	LOAD	P1,SPL.DV(S1)		;GET OPEN'ED DEVICE
	STORE	P1,CSM.DV(S2)		;AND STORE IT
	LOAD	P1,SPL.ST(S1)		;GET THE FILESTRUCTURE
	STORE	P1,CSM.ST(S2)		;STORE IN CSM
	STORE	P1,CSM.B+.FDSTR		;AND STORE IN THE FD AREA
	LOAD	P1,SPL.EN(S1)		;GET THE ENTER'ED FILENAME
	STORE	P1,CSM.EN(S2)		;AND STORE IT
	LOAD	P1,SPL.FS(S1)		;GET THE FILE SIZE
	STORE	P1,CSM.FS(S2)		;STORE IT AWAY
	MOVEI	P1,FDMSIZ		;LENGTH OF FD
	STORE	P1,CSM.FD(S2),CS.FDL	;STORE THE LENGTH
	MOVE	P1,CSM.F		;STANDARD FLAGS FOR SPOOLED FILES
	STORE	P1,CSM.FP(S2)		;SAVE FOR Q$INCL
	MOVEI	P1,CSM.B		;WHERE WE BUILD THE FD
	STORE	P1,CSM.FD(S2),CS.FDA	;STORE IT

;NOW FINISH MOVING THE FD AREA

	LOAD	P1,SPL.FN(S1)		;GET THE FILE NAME
	STORE	P1,CSM.B+.FDNAM		;STORE IT
	LOAD	P1,SPLDIR		;GET SPOOLING DIRECTORY
	LOAD	P2,SPL.JB(S1),SP.IUD	;GET IN-USER-DIRECTORY BIT
	SKIPE	P2			;IS IT SET?
	LOAD	P1,G$SID##		;YES, USE HIS DIR
	STORE	P1,CSM.B+.FDPPN		;STORE IT
	LOAD	S2,SPL.JB(S1),SP.LOC	;GET DEFAULT LOCATION
	LOAD	S1,SPL.DV(S1)		;LOAD DEVICE SPECIFIED
	PUSHJ	P,I$MIDS		;MAKE AN IDS
	HLLZM	S1,CSM.B+.FDEXT		;AND STORE GENERIC DEV AS EXTENSION
	MOVEI	S1,CSM.A		;LOAD THE ANSWER
	POPJ	P,			;AND RETURN

CSM.A:	BLOCK	CSMSIZ			;THE CSM TO RETURN
CSM.B:	BLOCK	FDMSIZ			;THE FD AREA
CSM.F:	INSVL.(.FPFAS,FP.FFF)!INSVL.(1,FP.FSP)!FP.DEL!FP.SPL!INSVL.(1,FP.FCY)
SUBTTL	I$CLM  --  Create a Canonical LOGOUT Message

;CALL I$CLM TO CONVERT A LOGOUT MESSAGE RECEIVED FROM THE OPERATING SYSTEM
;	INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:
;	MOVE S1,[ADR OF LOGOUT MESSAGE FROM OPERATING SYSTEM]
;	PUSHJ P,I$CLM
;	  RETURN HERE WITH S1 CONTAINING THE ADR OF THE CLM

I$CLM:	MOVX	S2,.IPCSL		;GET FUNCTION CODE
	STORE	S2,<CLM.A+CLM.FC>	;STORE THE FUNCTION
	LOAD	S2,LGO.JB(S1),LG.JOB	;GET JOB NUMBER
	STORE	S2,<CLM.A+CLM.JB>,CL.JOB ;STORE IT
	LOAD	S2,LGO.JB(S1),LG.BAT	;GET THE BATCH BIT
	STORE	S2,<CLM.A+CLM.JB>,CL.BAT ;STORE IT
	MOVEI	S1,CLM.A		;LOAD ADR OF THE CLM
	POPJ	P,			;AND RETURN

CLM.A:	BLOCK	CLMSIZ			;BLOCK TO RETURN CLM
SUBTTL	I$FSTR  --  Routine to extract the STRUCTURE from an FD

;CALL I$FSTR WITH THE ADDRESS OF AN FD AREA AND RETURN WITH THE STRUCTURE NAME.
;
;CALL:
;	MOVE	S1,[ADR OF FD AREA]
;	PUSHJ	P,I$FSTR
;	  RETURN HERE WITH STRUCTURE NAME IN S1
;
;CALLS I$VSTR FOR PROPER CONVERSION

I$FSTR:	MOVE	S1,.FDSTR(S1)		;GET THE STRUCTURE NAME
	PUSHJ	P,I$VSTR		;CONVERT TO A STRNAME 
	MOVE	S1,S2			;RETURN IT IN S1
	POPJ	P,			;RETURN
SUBTTL	I$FMCH  --  Match 2 FD areas with masks and length

;I$FMCH IS USED BY FILE SPECIFIC MODIFY TO MATCH SPECIFIED FILE WITH THE ORIGINAL
;	REQUEST ACCOUNTING FOR WILD CARDS.

;CALL:	MOVEI	S1,[ADDRESS OF ARGUMENT BLOCK]
;	MOVEI	S2,LENGTH OF FD TO COMPARE
;	PUSHJ	P,I$FMCH

;RETURNS S1 = .TRUE. IF THEY MATCH
;	 S1 = .FALSE. IF THEY DON'T

;THE CALLERS MUST DETERMINE IF ALL FD'S ARE THE SAME LENGTH

;ARGUMENT BLOCK CONTAINS:
;	+0 ADDRESS OF THE 1ST FD
;	+1 ADDRESS OF THE 2ND FD
;	+2 ADDRESS OF THE MASKS

I$FMCH:	PUSHJ	P,.SAVE3##		;SAVE P1 - P3 FIRST
	MOVE	P1,0(S1)		;GET FIRST FD ADDRESS
	MOVE	P2,1(S1)		;AND THE SECOND
	MOVE	P3,2(S1)		;AND THE MASKS
FMCH.1:	MOVE	S1,0(P1)		;GET A WORD
	XOR	S1,0(P2)		;SEE IF THEY MATCH
	AND	S1,0(P3)		;TO THE NUMBER OF CHARACTERS SPECIFIED
	PJUMPN	S1,.FALSE##		;STOP NOW IF NOT A MATCH
	INCR	P1			;TO NEXT ITEMS TO COMPARE
	INCR	P2			;...
	INCR	P3			;...
	SOJG	S2,FMCH.1		;TRY ALL WORDS
	PJRST	.TRUE##			;RETURN ON A COMPLETE MATCH
SUBTTL	Routines to handle system dependent fields

	INTERN	I$EQQE			;Move fields from EQ to QE
	INTERN	I$QELA			;Move fields from QE to Listanswer
	INTERN	I$SMEQ			;Move fields from CSM to EQ
	INTERN	I$RMCH			;Make request and RDB
	INTERN	I$DFEQ			;Default and check the EQ
SUBTTL	I$EQQE  -  Move fields from EQ to QE

;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE EXTERNAL
;	QUEUE REQUEST (EQ) TO THE INTERNAL QUEUE ENTRY (QE).
;
;CALL:
;	MOVE  S1,<ADDRESS OF EQ>
;	MOVE  AP,<ADDRESS OF QE>
;	PUSHJ P,I$EQQE
;	  ALWAYS RETURN HERE

I$EQQE:	LOAD	S2,.EQOWN(S1)		;GET OWNER'S PPN
	STORE	S2,.QEOID(AP)		;STORE IT IN THE QE AS OWNER ID
	DMOVE	S1,.EQUSR(S1)		;GET USER NAME
	DMOVEM	S1,.QEUSR(AP)		;SAVE IT
	POPJ	P,			;AND RETURN
SUBTTL	I$QELA  -  Move fields from QE to Listanswer

;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE INTERNAL
;	QUEUE REQUEST (QE) TO THE LISTANSWER MESSAGE.
;
;CALL:
;	MOVE  S1,<ADDRESS OF QE>
;	MOVE  AP,<ADDRESS OF LISTANSWER MESSAGE>
;	PUSHJ P,I$QELA##
;	  ALWAYS RETURN HERE

I$QELA:	DMOVE	S1,.QEUSR(S1)		;GET THE USER NAME
	DMOVEM	S1,LST.US(AP)		;SAVE IT
	POPJ	P,			;AND RETURN
SUBTTL	I$SMEQ  --  Move fields from CSM to EQ

;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE CANONICAL
;	SPOOL MESSAGE (CSM) TO THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
;	MOVE  S1,<ADDRESS OF CSM>
;	MOVE  AP,<ADDRESS OF EQ>
;	PUSHJ P,I$SMEQ
;	  ALWAYS RETURN HERE

I$SMEQ:	LOAD	S2,CSM.OI(S1)		;GET OWNER ID
	STORE	S2,.EQOWN(AP)		;SAVE IT IN THE EQ
	DMOVE	S1,CSM.US(S1)		;GET USER NAME
	DMOVEM	S1,.EQUSR(AP)		;SAVE IN THE EQ
	POPJ	P,			;AND RETURN
SUBTTL	I$RMCH  --  Match a request and an RDB

;ROUTINE TO DETERMINE WHETHER OR NOT A PARTICULAR QUEUE ENTRY MATCHES
;	THE REQUEST DESCRIPTION IN A PARTICULAR REQUEST DESCRIPTION
;	BLOCK (RDB)
;
;CALL:
;	MOVE  S1,<ADDRESS OF RDB>
;	MOVE  AP,<ADDRESS OF QE>
;	PUSHJ P,I$RMCH
;	  ALWAYS RETURN HERE

I$RMCH:	PUSHJ	P,.SAVE1##		;SAVE P1
	SKIPN	P1,.RDBES(S1)		;LOAD EXTERNAL SEQ #
	JRST	RMCH.1			;ZERO ASSUME A MATCH
	LOAD	S2,.QESEQ(AP),QE.SEQ	;GET SEQUENCE NUMBER FROM THE QE
	CAME	S2,P1			;DO THEY MATCH?
	PJRST	.FALSE##		;NO, STOP NOW

RMCH.1:	LOAD	S2,.QEJOB(AP)		;GET JOBNAME FROM QE
	XOR	S2,.RDBJB(S1)		;FIND WHATS DIFFERENT
	AND	S2,.RDBJM(S1)		;MASK OUT INSIGNIFICANT PARTS
	PJUMPN	S2,.FALSE##		;AND RETURN IF NO MATCH

	LOAD	S2,.QEOID(AP)		;GET OWNER ID
	SKIPN	P1,.RDBOI(S1)		;LOAD SPECIFIED OID
	MOVE	P1,G$SID##		;USE THE DEFAULT IF 0
	XOR	S2,P1			;FIND OUT WHATS DIFFERENT
	AND	S2,.RDBOM(S1)		;MASK OUT INSIGNIFICANT PARTS
	PJUMPN	S2,.FALSE##		;NO MATCH IF NOT 0
	PJRST	.TRUE##			;WIN!!
SUBTTL	I$DFEQ  --  Default and check the EQ

;ROUTINE TO DEFAULT AND CHECK THE OPERATING SYSTEM DEPENDENT VALUES
;	IN THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
;	MOVE  S1,<ADDRESS OF EQ>
;	PUSHJ P,I$DFEQ
;	  ALWAYS RETURN HERE WITH T/F INDICATION

I$DFEQ:	LOAD	S2,.EQOWN(S1)		;GET OWNER
	CAME	S2,G$SID##		;SAME AS SENDER?
	PJUMPN	S2,I$WHEEL		;IF NOT, AND IF NOT 0, RETURN THRU WHEEL
	LOAD	S2,G$SID##		;LOAD  CURRENT SENDER
	STORE	S2,.EQOWN(S1)		;STORE IT
	PJRST	.TRUE##			;AND WIN
SUBTTL	Batch Stream Unique Directory Routines

	INTERN	I$UQST			;SET DIRECTORY FOR A STREAM
	INTERN	I$UQCL			;CLEAR DIRECTORY FOR A STREAM
	INTERN	I$UQCH			;COMPARE STREAM FOR UNIQNESS
SUBTTL	I$UQST  --  Set Directory for a Stream

;ROUTINE TO SET THE DIRECTORY FOR A STREAM FROM THE BATCH QUEUE ENTRY
;
;CALL:
;	MOVEI	S1,<STREAM NUMBER>
;	MOVE	AP,<BATCH QUEUE ENTRY (QE)>
;	PUSHJ	P,I$UQST
;	  ALWAYS RETURN HERE

I$UQST:	MOVE	S2,.QEOID(AP)		;GET THE PPN
	MOVEM	S2,UNIDIR(S1)		;SAVE IT
	POPJ	P,			;AND RETURN
SUBTTL	I$UQCL  --  Clear the directory for a stream

;ROUTINE TO CLEAR OUT THE DIRECTORY FOR A STREAM
;
;CALL:
;	MOVEI	S1,<STREAM NUMBER>
;	PUSHJ	P,I$UQCL
;	  ALWAYS RETURN HERE

I$UQCL:	ZERO	UNIDIR(S1)		;CLEAR THE WORD
	POPJ	P,			;AND RETURN
SUBTTL	I$UQCH  --  Check for directory match

;ROUTINE TO WHETHER A BATCH QUEUE REQUEST IS FOR THE SAME DIRECTORY
;	AS A PARTICULAR STREAM.
;CALL:
;	MOVEI	S1,<STREAM NUMBER>
;	MOVE	AP,<BATCH QUEUE ENTRY (QE)>
;	PUSHJ	P,I$UQCH
;	  ALWAYS RETURN HERE WITH .TRUE. ON MATCH

I$UQCH:	MOVE	S2,.QEOID(AP)		;GET THE DIRECTORY
	CAME	S2,UNIDIR(S1)		;MATCH?
	PJRST	.FALSE##		;NO.
	PJRST	.TRUE##			;YES!!
SUBTTL	Failsoft System Interface

;ENTRY POINTS

	INTERN	I$WRIT			;WRITE SOMETHING INTO THE MASTER
	INTERN	I$READ			;READ SOMETHING FROM THE MASTER
	INTERN	I$CRIP			;CREATE AN INDEX PAGE
	INTERN	I$OQUE			;OPEN MASTER QUEUE FILES
SUBTTL	I$WRIT  --  Write something into master queue file

;ROUTINE TO WRITE SOMETHING INTO THE MASTER QUEUE FILES.  CALL WITH S1
;	CONTAINING THE BLOCK NUMBER TO WRITE, AND S2 CONTAINING AN
;	IO-POINTER OF THE FORM:
;
;		XWD	LENGTH,ADDRESS
;
;	WHERE 'LENGTH' IS THE NUMBER OF WORDS TO WRITE, AND 'ADDRESS'
;	IS THE PLACE TO START WRITING FROM.
;
;NOTE:  WRITES "BOTH" MASTERS.

I$WRIT:	MOVEM	S1,WRIT.A		;SAVE BLOCK NUMBER
	MOVEM	S2,WRIT.B		;SAVE POINTER WORD
	HLRZ	S1,S2			;GET THE LENGTH
	SKIPLE	S1			;LE 0
	CAILE	S1,1000			;OR GREATER THAN A PAGE?
	STOPCD	(WBL,FATAL)		;++WRITING BAD LENGTH
	MOVNS	S1			;NEGATE IT
	HRLZS	S1			;GET -LEN,,0
	SUBI	S2,1			;MAKE ADR-1
	HRR	S1,S2			;AND MAKE AN IOWD
	MOVEM	S1,WRIT.C		;SAVE IT
	CLEARM	WRIT.C+1		;SET END OF LIST
WRIT.1:	MOVE	S1,WRIT.A		;GET BLOCK NUMBER BACK
	USETO	CMQ1,(S1)		;SET IT
	OUT	CMQ1,WRIT.C		;AND WRITE FILE 1
	  JRST	WRIT.2			;WIN!! GO ON
	GETSTS	CMQ1,S1			;GET I/O STATUS
	TXZN	S1,IO.BKT		;RUN OUT OF ROOM?
	STOPCD	(PWE,FATAL)		;++PRIME WRITE ERROR
	SETSTS	CMQ1,(S1)		;YES, CLEAR INDICATOR
	MOVEI	S1,12			;LOOP 10 SECS
	SLEEP	S1,			;SLEEP SOME
	JRST	WRIT.1			;AND TRY AGAIN
WRIT.2:
IFN FTRQUE,<
	MOVE	S1,WRIT.A		;GET BLOCK NUMBER BACK
	USETO	CMQ2,(S1)		;SET IT
	OUT	CMQ2,WRIT.C		;WRITE FILE 2
	  JRST	WRIT.3			;WIN! GO ON
	GETSTS	CMQ2,S1			;GET I/O STATUS
	TXZN	S1,IO.BKT		;RUN OUT OF ROOM?
	STOPCD	(RWE,FATAL)		;++REDUNDANT WRITE ERROR
	SETSTS	CMQ2,(S1)		;YES, CLEAR INDICATOR
	MOVEI	S1,12			;LOOP 10 SECS
	SLEEP	S1,			;SLEEP SOME
	JRST	WRIT.2			;AND TRY AGAIN
>  ;END IFN FTRQUE

				;"I$WRIT" IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

WRIT.3:	HLRZ	S1,WRIT.B		;GET NUMBER OF WORDS
	SUBI	S1,1			;ROUND DOWN
	IDIVI	S1,FSSBKS		;AND GET NUMBER OF BLOCKS
	ADD	S1,WRIT.A		;ADD IN DPA OF FIRST BLOCK
	CAMG	S1,G$NBW##		;GREATER THAN PREVIOUS LAST BLOCK?
	POPJ	P,			;NO, RETURN
	MOVEM	S1,G$NBW##		;YES, SAVE AS GREATEST
	MOVX	S1,<FO.PRV!<CMQ1>B17!.FOURB>
	MOVE	S2,[1,,S1]		;LOAD ARGBLOCK
	FILOP.	S2,			;UPDATE THE RIB FOR THE FIRST ONE
	  STOPCD(EEP,FATAL)		;++ERROR EXPANDING PRIME QUEUE

IFN FTRQUE,<
	MOVX	S1,<FO.PRV!<CMQ2>B17!.FOURB>
	MOVE	S2,[1,,S1]		;LOAD THE ARGBLOCK
	FILOP.	S2,			;UPDATE THE RIB FOR THE SECOND ONE
	  STOPCD(EER,FATAL)		;++ERROR EXPANDING REDUNDANT QUEUE
>  ;END IFN FTRQUE

	POPJ	P,			;AND RETURN

WRIT.A:	BLOCK	1			;LOCAL STORAGE
WRIT.B:	BLOCK	1			;LOCAL STORAGE
WRIT.C:	BLOCK	2			;LOCAL STORAGE
SUBTTL	I$READ  --  Read something from master queue file


;ROUTINE TO READ SOMETHING FROM THE MASTER QUEUE FILE.  CALL WITH S1
;	CONTAINING A BLOCK TO START THE READ AT AND S2 CONTAINING AN
;	IO-POINTER OF THE FORM:
;
;		XWD	LENGTH,ADDRESS
;
;	WHERE 'LENGTH' IS THE NUMBER OF WORDS TO READ, AND 'ADDRESS'
;	IS THE PLACE TO START READING THEM INTO.

I$READ:	MOVEM	S1,READ.A		;SAVE BLOCK NUMBER
	MOVEM	S2,READ.B		;SAVE IO-POINTER
	USETI	CMQ1,(S1)		;SET THE INPUT BLOCK
	HLRZ	S1,S2			;GET THE LENGTH
	MOVNS	S1			;NEGATE IT
	HRLZS	S1			;GET -LEN,,0
	SUBI	S2,1			;MAKE ADR-1
	HRR	S1,S2			;MAKE AN IOWD
	MOVEM	S1,READ.C		;SAVE IT
	CLEARM	READ.C+1		;SET END-OF-LIST
	IN	CMQ1,READ.C		;READ THE BLOCK
	  POPJ	P,			;NO ERROR,  RETURN
	GETSTS	CMQ1,S1			;I/O ERROR, GET THE STATUS
	TXNE	S1,IO.EOF		;WAS IT AN EOF?
	STOPCD	(REF,FATAL)		;++READING END OF FILE
	STOPCD	(RIE,FATAL)		;++READ I/O ERROR

READ.A:	BLOCK	1			;LOCAL STORAGE
READ.B:	BLOCK	1			;LOCAL STORAGE
READ.C:	BLOCK	2			;LOCAL STORAGE
SUBTTL	I$CRIP  --  Create an index page in master file

;I$CRIP IS CALLED WHEN THE FAILSOFT SYSTEM DECIDES TO START A NEW FILE
;	SECTION (INCLUDING THE VERY FIRST) TO WRITE OUT THE NEW INDEX
;	PAGE INTO THE FILE.  CALL WITH S1 CONTAINING THE BLOCK NUMBER OF
;	THE PAGE, AND S2 CONTAINING THE ADDRESS OF THE PAGE.

I$CRIP:	HRLI	S2,FSSWPI		;GET LENGTH TO WRITE
	PJRST	I$WRIT			;AND WRITE IT OUT
SUBTTL	I$OQUE  --  Open master queue files

;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
;	THE MASTER QUEUE FILE(S).  OPENS ONE FILE IF FTRQUE IS
;	OFF AND TWO IF FTRQUE IS ONE

I$OQUE:	PUSHJ	P,.SAVE1##		;SAVE P1
	PUSHJ	P,SETOQF		;SETUP CONSTANT PARAMETERS
	MOVE	P1,[MQFNM1]		;GET NAME OF PRIME QUEUE
	MOVEM	P1,.RBNAM(S2)		;STORE IT
	MOVE	P1,PRMDIR		;GET DIRECTORY OF PRIME QUEUE
	MOVEM	P1,.RBPPN(S2)		;STORE IT
	MOVSI	P1,CMQ1			;GET CHANNEL FOR PRIME QUEUE
	IORM	P1,.FOFNC(S1)		;STORE IT
	HRLI	S1,6			;GET LEN,,ADR
	FILOP.	S1,			;AND OPEN THE PRIME QUEUE!
	  JRST	OQUE.1			;DO SOME EVALUATION
	MOVE	S1,.RBSIZ(S2)		;GET THE SIZE OF FILE (WRITTEN)
	ADDI	S1,FSSBKS-1		;ROUND UP
	IDIVI	S1,FSSBKS		;AND CONVERT TO BLOCKS
	MOVEM	S1,G$NBW##		;AND SAVE AS NUMBER OF BLOCKS WRITTEN

IFN FTRQUE,<
	PUSHJ	P,SETOQF		;SETUP CONSTANT PARAMETERS
	MOVE	P1,[MQFNM2]		;GET NAME OF REDUNDANT QUEUE
	MOVEM	P1,.RBNAM(S2)		;STORE IT
	MOVE	P1,REDDIR		;GET DIRECTORY OF REDUNDANT QUEUE
	MOVEM	P1,.RBPPN(S2)		;STORE IT
	MOVSI	P1,CMQ2			;GET THE CHANNEL NUMBER
	IORM	P1,.FOFNC(S1)		;STORE IT
	HRLI	S1,6			;GET LEN,,ADR
	FILOP.	S1,			;OPEN THE REDUNDANT QUEUE!!
	  STOPCD(COR,FATAL)		;++CANT OPEN REDUNDANT QUEUE
>  ;END IFN FTRQUE

	POPJ	P,			;RETURN

;HERE ON A FILOP. FAILURE FOR THE PRIME QUEUE

OQUE.1:	CAIN	S1,ERFBM%		;SPECIAL CASE: FILE BEING MODIFIED
	STOPCD	(PQI,FATAL)		;++PRIME QUEUE INTERLOCKED
	STOPCD	(COP,FATAL)		;++CANT OPEN PRIME QUEUE
SUBTTL	SETOQF  --  Setup to OPEN master queue files

;SETOQF IS CALLED BY I$OQUE TO SETUP THE INVARIANT PART OF THE FILOP AND
;	LOOKUP UUO BLOCKS.  INTO THE LOOKUP BLOCK IT FILLS IN:
;		BLOCK LENGTH
;		FILE-NAME EXTENSION
;		PROTECTION
;		ESTIMATED LENGTH
;		FILE STATUS BITS
;INTO THE FILOP BLOCK IT PUTS
;		FILOP FUNCTION
;		I/O STATUS
;		FILE-STRUCTURE NAME
;		ADDRESS OF LOOKUP BLOCK

;RETURN WITH S1 CONTAINING ADDRESS OF FILOP BLOCK AND S2 CONTAINING THE
;	ADDRESS OF THE LOOKUP BLOCK

SETOQF:	CLEARM	SETO.A			;CLEAR FIRST WORD OF LOOKUP BLOCK
	MOVE	S1,[SETO.A,,SETO.A+1]
	BLT	S1,SETO.A+.RBSTS	;AND CLEAR THE REST
	CLEARM	SETO.B			;CLEAR THE FIRST WORD OF FILOP BLOCK
	MOVE	S1,[SETO.B,,SETO.B+1]
	BLT	S1,SETO.B+5		;AND CLEAR THE REST

	MOVEI	S1,.RBSTS		;GET LENGTH OF LKP BLOCK
	MOVEM	S1,SETO.A+.RBCNT	;SAVE IT
	MOVSI	S1,'QSR'		;GET THE EXTENSION
	MOVEM	S1,SETO.A+.RBEXT	;SAVE IT
	MOVSI	S1,FSSPRT_9		;GET FILE PROTECTION
	MOVEM	S1,SETO.A+.RBPRV	;STORE IT AWAY
	MOVEI	S1,1000			;ESTIMATE 1 FILE SECTION
	MOVEM	S1,SETO.A+.RBEST	;SAVE IT
	MOVX	S1,RP.ABC		;ALWAYS BAD CHECKSUM
	MOVEM	S1,SETO.A+.RBSTS	;AND SAVE IT

	MOVX	S1,<FO.PRV+.FOSAU>	;SINGLE ACCESS UPDATE
	MOVEM	S1,SETO.B+.FOFNC	;SAVE FUNCTION WORD
	MOVX	S1,<UU.PHS+.IODMP>	;PHONLY DUMP MODE
	MOVEM	S1,SETO.B+.FOIOS	;SAVE STATUS
	MOVX	S1,FSSSTR		;GET THE STR NAME
	MOVEM	S1,SETO.B+.FODEV	;SAVE IT
	MOVEI	S2,SETO.A		;GET ADDRESS OF LKP BLOCK
	MOVEM	S2,SETO.B+.FOLEB	;SAVE IT
	MOVEI	S1,SETO.B		;LOAD ADR OF FILOP BLOCK
	POPJ	P,			;AND RETURN


SETO.A:	BLOCK	.RBSTS+1		;THE LOOKUP BLOCK
SETO.B:	BLOCK	6			;THE FILOP BLOCK
SUBTTL	I$STCD  --  STOPCODE Routine

	INTERN	I$STCD

;I$STCD IS CALLED WHEN A STOPCD MACRO IS EXECUTED, THE MAIN MODULE
;	CALLS I$STCD AFTER PRESERVING ALL ACCUMULATORS.

;CALL:	S1 = THE TYPE OF STOPCD
;	S2 = THE STOPCD NAME

;I$STCD TYPES THE APPROPRIATE MESSAGE AND IF THE STOPCD TYPE INDICATES
;	A FATAL ERROR, STORES CRASH INFORMATION THEN RETURNS TO MONITOR LEVEL.

I$STCD:	PUSHJ	P,.SAVE4##		;SAVE ALL P REGS
	DMOVE	P1,S1			;COPY THE ARGUMENTS
	HRLZM	P2,G$CRAC##+23		;AND STORE STOPCD NAME AWAY
	MOVEI	S1,[ASCIZ /QUASAR STOP CODE - /]
	CAIE	P1,.SCFAT		;FATAL??
	  MOVEI	S1,[ASCIZ /QUASAR TRACE:/]
	OUTSTR	(S1)			;OUTPUT THE MESSAGE
	MOVE	P3,[POINT 6,P2,17]	;POINT TO THE CODE
	MOVSI	P4,-3			;LOAD AN AOBJN POINTER
STCD.1:	ILDB	S1,P3			;GET A CHARACTER
	ADDI	S1,"A"-'A'		;CONVERT TO ASCII
	OUTCHR	S1			;OUTPUT THE ASCII CHARACTER
	AOBJN	P4,STCD.1		;AND LOOP
	OUTSTR	[BYTE (7) .CHCRT,.CHLFD,0]  ;CHARRIAGE RETURN-LINE FEED PAIR
	CAIE	P1,.SCFAT		;FATAL??
	  POPJ	P,			;NO, RETURN TO LUUO HANDLER
	MOVEI	S1,PAGTBL##		;GET ADDRESS OF PAGE TABLE
	MOVEM	S1,G$CRAC##+20		;AND STORE IT AWAY
	MOVEI	S1,TBLHDR##		;ADDRESS OF QUEUE HEADERS
	HRLI	S1,NQUEUE##		;GET NUMBER OF QUEUES
	MOVEM	S1,G$CRAC##+21		;STORE IT AWAY
	MOVEI	S1,PDL##		;ADDRESS OF PDL
	MOVEM	S1,G$CRAC##+22		;AND STORE IT AWAY
	MOVEI	S1,G$CRAC##		;GET ADDRESS OF ACS
	MOVEM	S1,DEBUGW		;SAVE IT WHERE WE'LL FIND IT
	MONRT.				;EXIT TO THE MONITOR
	JRST	.-1			;WITH NO CONTINUE
;NOTES ON DEBUGGING QUASAR CRASHES:
;
;ON ALL FATAL STOPCODES, THE G$CRAC BLOCK IN QUASAR IS FILLED WITH
;	INFORMATION WHICH MIGHT PROVE USEFUL WHEN LOOKING AT A CRASH
;	OF QUASAR.
;	THE FOLLOWING INFORMATION MAY BE FOUND THERE:
;
;G$CRAC+
;	0-17	;ACCUMULATORS AT EXECUTION OF THE STOPCD
;	20	;ADDRESS OF QUASAR'S INTERNAL PAGE TABLE
;	21	;# OF QUEUES,,ADDRESS OF "TBLHDR", THE LIST OF Q HDRS
;	22	;THE ADRESS OF THE BOTTOM OF THE PUSHDOWN STACK
;	23	;THE STOP-CODE IN LEFT-JUSTIFIED SIXBIT
;
;THE ADDRESS OF THE G$CRAC BLOCK IS STORED IN DEBUGW (135) SO IT
;	CAN BE FOUND.
;
;IF AN INSTALLATION WANTS TO ADD MORE ITEMS TO BE STORED, IT IS
;	RECOMMENDED THAT ANOTHER BLOCK BE ALLOCATED (E.G. STCD.A)
;	AND ITS ADDRESS STORED IN LOCATION 136.


CRASH:	HRRZ	0,.JBDDT		;GET DDT START ADDRESS
	MOVEM	0,CRAS.A		;SAVE IT
	MOVSI	17,G$CRAC##		;SETUP A BLT POINTER
	BLT	17,17			;AND RESTORE CRASH ACS
	OUTSTR	[ASCIZ /Crash ACs Copied
Going to DDT
/]
	JRST	@CRAS.A			;AND GO AHEAD

CRAS.A:	BLOCK	1			;SAVE DDT START ADDRESS


	END