Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/qsrt20.mac
There are 36 other files named qsrt20.mac in the archive. Click here to see a list.
TITLE	QSRT20  --  Operating System Interface for QUASAR-20
SUBTTL	Larry Samberg   Chuck O'Toole /CER  13 Nov 77




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1975, 1976, 1977, 1978 BY
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH	QSRMAC		;PARAMETER FILE

	PROLOGUE(QSRT20)	;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 QSRT20

BSD	BAD SPOOL DATA
CAP	CANNOT ACQUIRE A PID
CDD	CANT DEFAULT DIRECTORY
CDU	CANT DEFAULT USER
CGJ	CAN'T GET JOB NUMBER
CGP	CAN'T GET PACKET SIZE
CGU	CANT GET USER
COP	CANT OPEN PRIME QUEUE
CSQ	CANNOT SET IPCF QUOTAS
CUF	CANT UPDATE FILE
CUI	CANT UPDATE INDEX
DIF	DEBRK OF INTERRUPT FAILED
FSP	FAILURE TO SET SYSTEM PID TABLE
MRF	MESSAGE RECEIVE FAILURE
NSD	NO SPOOLING DIRECTORY
NXU	NON-EXISTANT USER
ODE	OWNER DOESNT EXIST
PIC	PID TO INTERRUPT FAILED
PQI	PRIME QUEUE INTERLOCKED

\
COMMENT \
	TOPS20 Field Interpretation

1)  External Owner ID is a User Name
2)  Owner ID (Internal) is a User Number

\
SUBTTL	Module Storage

SLPVAL:	EXP	^D60000			;SLEEP INTERVAL
CENSTA:	EXP	0			;STATION # OF CENTRAL SITE
MEMFLG:	EXP	0			;ZERO = ALLOW IPCF INTERRUPTS
AWOKEN:	EXP	0			;INTERRUPTED OUT OF DISMS IF SET
BLOKED:	EXP	0			;WE HAVE DONE A DISMS
IPCPC:	BLOCK	1			;PC AT IPCF INTERRUPT
FILJFN:	BLOCK	1			;JFN OF MASTER QUEUE FILE
FSPAGN:	BLOCK	1			;SCRATCH PAGE FOR I$READ/I$WRIT
FSADDR:	BLOCK	1			; SAME AS FSPAGN BUT AS AN ADDRESS

UNIDIR:	BLOCK	INPNUM*12		;BLOCK FOR STORING CONNECTED
					; DIRECTORY FOR /UNIQUE CHECK

;LEVTAB AND CHNTAB MUST BE CONTIGUOUS AND IN THE FOLLOWING ORDER
;	THEY ARE CLEARED BY A SINGLE BLT

LEVTAB:	BLOCK	3			;OLD PC ADDRESS POINTERS
CHNTAB:	BLOCK	^D36			;INTERRUPT DISPATCH ADDRESS
SUBTTL	Initialization Routine

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

I$INIT:: RESET				;RESET THE WORLD
	CIS				;CLEAR THE INTERRUPT SYSTEM
	PUSHJ	P,.SAVET##		;SAVE T REGS
	MOVE	S1,[LEVTAB,,LEVTAB+1]	;SETUPT BLT POINTER
	ZERO	LEVTAB			;CLEAR FIRST WORD
	BLT	S1,CHNTAB+^D35		;BLT LEVEL AND CHANNEL TABLES TO ZERO
	MOVE	S1,[INT.PL,,C$INT##]	;LEVEL,,ADR OF IPCF INT RTN
	MOVEM	S1,CHNTAB+INT.PI	;AND STORE IT
	MOVEI	S1,IPCPC		;WHERE TO STORE INTERRUPT PC
	MOVEM	S1,LEVTAB+INT.PL-1	;STORE IN LEVTAB (NO ZERO'TH ENTRY)
	MOVX	S1,.FHSLF		;MY RELATIVE FORK HANDLE
	MOVE	S2,[LEVTAB,,CHNTAB]	;SET UP ADDRESS WORDS
	SIR				;TO SETUP INTERRUPT SYSTEM
	MOVX	S1,.FHSLF		;SETUP MY FORK HANDLE
	MOVX	S2,1B<INT.PI>		;SETUP A MASK
	AIC				;ACTIVATE THE CHANNEL
	MOVEI	S1,.MUMPS		;FUNCTION FOR MAX PACKET SIZE
	MOVEM	S1,INIT.B		;STORE AWAY
	ZERO	INIT.B+1		;CLEAR SECOND WORD
	MOVEI	S1,2			;GET BLOCK SIZE
	MOVEI	S2,INIT.B		;AND ADDRESS OF BLOCK
	MUTIL				;GET THE INFO
	  STOPCD(CGP,FATAL)		;++CAN'T GET PACKET SIZE
	MOVE	S1,INIT.B+1		;GET THE ANSWER
	MOVEM	S1,G$MPS##		;SAVE IT
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,[ASCIZ /PS:<SPOOL>/]	;DIRECTORY OF SPOOL
	RCDIR				;RECOGNIZE IT
	TXNE	S1,RC%NOM		;MATCH?
	STOPCD	(NSD,FATAL)		;++NO SPOOLING DIRECTORY
	MOVE	S1,T1			;COPY DIR NUMBER INTO S1
	MOVEI	S2,INIT.C		;LOAD ADDR OF BLOCK
	ZERO	T1			;DON'T WANT THE PASSWORD
	GTDIR				;GET DIRECTORY INFO
	HRRZ	S1,INIT.C+7		;GET DEFAULT PROTECTION
	MOVEM	S1,G$SPRT##		;AND STORE IT
	ZERO	G$MCOR##		;THERE IS NO SYSTEM MINIMUM
	SETO	S1,			;-1 = MY JOB
	HRROI	S2,T2			;POINT TO ARG BLOCK
	SETZ	T1,			;WORD 0
	GETJI				;GET MY JOB NUMBER
	  STOPCD(CGJ,FATAL)		;++CANT GET JOB NUMBER
	$SITEM	T2,QJOB			;AND STORE IT
	PJRST	I$ION			;ENABLE INTERRUPTS AND RETURN


INIT.B:	BLOCK	2		;MUTIL BLOCK
INIT.C:	BLOCK	^D14		;GTDIR BLOCK
SUBTTL	Information

;ENTRY POINTS

	INTERN	I$WHEEL		;CHECK IF CURRENT SENDER 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 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$PRVS##		;GET ENABLED CAPABILITIES WORD
	TXNE	S1,SC%WHL!SC%OPR	;IS HE A WHEEL OR AN OPR?
	  PJRST	.TRUE##			;YES!!
	PJRST	.FALSE##		;NO, HE LOSES
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

;THE TIME RETURNED IS ACTUALLY BACKED OFF BY 1 MINUTE FOR NOTHING IS
;	SAFE FROM THE "CEASE" COMMAND

I$KSYS:	MOVE	S1,[SIXBIT/DWNTIM/]	;THE SYSTEM TABLE NAME
	SYSGT				;GET THE TABLE NUMBER AND ENTRY 0
	JUMPL	S2,KSYS.1		;JUMP IF THE TABLE EXISTS
	ZERO	S1			;ELSE RETURN A ZERO
KSYS.1:	PJUMPE	S1,.POPJ##		;EXIT IF NONE PENDING
	PUSH	P,S1			;SAVE TIME FOR NOW
	MOVEI	S1,1			;FIND NOW PLUS 1 MINUTE
	PUSHJ	P,I$AFT			;COMPUTE IT
	POP	P,S2			;NOW GET WHEN SCHEDULED
	CAMLE	S2,S1			;IS SCHEDULED SHUTDOWN PAST
	  PJRST	I$AGE			;NO, COMPUTE DIFFERENCE AND RETURN
	SETO	S1,			;YES, RETURN -1
	POPJ	P,			;RETURN IT
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:	GTAD			;GET THE TIME AND DATE
	MOVEM	S1,G$NOW##	;STORE IN GLOBAL LOCATION
	POPJ	P,		;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:	LOAD	S1,G$SID##		;GET SENDER'S ID
	CAME	S1,S2			;IS HE THE OWNER
	PJRST	I$WHEEL			;NO, WIN ONLY IF WHEEL
	PJRST	.TRUE##			;YES, LET HIM DO IT
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	S1,[.SFOPR]	;CHECK IF OPERATOR ON DUTY
I$LOGN:	MOVX	S1,.SFPTY	;CHECK IF PTY LOGINS ARE ALLOWED
	TMON			;GET STATUS OF THE SYSTEM
	PJUMPE	S2,.FALSE##	;RETURN FALSE IF NOT SET
	PJRST	.TRUE##		;TRUE IF CONDITIONS ARE MET
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 IN SIXBIT
;	PUSHJ	P,I$VSTR
;
;
;RETURNS S1 = .TRUE. IF STRUCTURE IS THERE
;	    =  .FALSE. IF OFF-LINE OR NOT A DISK
;	 S2 = STRUCTURE NAME

I$VSTR:	PUSHJ	P,.SAVET##		;SAVE T1 THRU T4
	MOVEM	S1,VSTR.C		;SAVE ARG FOR THE RETURN
	MOVE	T1,[POINT 6,S1]		;POINTER TO SIXBIT STR NAME
	MOVE	T2,[POINT 7,VSTR.B]	;POINT TO STORE IN ASCII
VSTR.1:	ILDB	S2,T1			;GET A CHARACTER
	JUMPE	S2,VSTR.2		;DONE
	ADDI	S2,"A"-'A'		;CONVERT TO ASCII
	IDPB	S2,T2			;AND DEPOSIT IT
	TLNE	T1,770000		;GET 6 CHARACTERS?
	JRST	VSTR.1			;NO, LOOP

VSTR.2:	MOVEI	S2,0			;LOAD A NULL
	IDPB	S2,T2			;DEPOSIT IT
	HRROI	S1,VSTR.B		;POINTER TO STRUCTURE NAME
	MOVEM	S1,VSTR.A		;SAVE THE ARGUMENT FOR MSTR
	MOVE	S1,[5,,.MSGSS]		;GET STRUCTURE STATUS
	MOVEI	S2,VSTR.A		;ARG BLOCK ADR
	MSTR				;GET THE INFO
	ERJMP	VSTR.3			;LOSE, MUST NOT BE THERE
	MOVE	S2,VSTR.C		;LOAD THE STR NAME
	MOVX	S1,MS%DIS		;GET "DISMOUNT IN PROGRESS" BIT
	TDNE	S1,VSTR.A+1		;IS IT SET?
	PJRST	.FALSE##		;YES, RETURN "OFF-LINE"
	PJRST	.TRUE##			;NO, RETURN TRUE

VSTR.3:	MOVE	S2,VSTR.C		;LOAD THE STRUCTURE NAME
	PJRST	.FALSE##		;AND LOSE


VSTR.A:	BLOCK	5			;ARG BLOCK FOR MSTR JSYS
VSTR.B:	BLOCK	2			;STRUCTURE NAME IN ASCII
VSTR.C:	BLOCK	1			;STRUCTURE NAME IN 6BIT
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
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:	SETOM	BLOKED		;SET THE BLOCKED FLAG
	SKIPE	AWOKEN		;HAS SOMETHING INTERESTING HAPPENED
	  JRST	SLP.1		;YES, DON'T BOTHER WAITING
	ZERO	S1		;SET INFINITE
	EXCH	S1,SLPVAL	;FOR THE NEXT TIME
	SKIPN	S1		;SLEEP FOREVER (UNTIL INTERRUPT)
	  WAIT			;YES, WAIT FOR NEXT INTERRUPT TO HAPPEN
	  DISMS			;NO, WAIT FOR INTERRUPT OR TIMER
	  JFCL			;THIS NO-OP IS NEEDED FOR "PC" ALIGNMENT
SLP.1:	ZERO	AWOKEN		;CLEAR THE AWOKEN FLAG
	ZERO	BLOKED		;CLEAR THE BLOCKED FLAG
	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:	MOVEI	S1,SLP.1	;GET RETURN ADDRESS FOR INTERRUPT
	SETOM	AWOKEN		;FLAG THAT THE DISMS WAS INTERRUPTED
	SKIPE	BLOKED		;WERE WE BLOCKED?
	MOVEM	S1,IPCPC	;YES, RESET THE INTERRUPTED PC
	SETZM	BLOKED		;CLEAR THE BLOCKED FLAG
	POPJ	P,		;AND RETURN
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,.FHSLF	;MY RELATIVE FORK HANDLE
	DIR			;DISABLE INTERRUPTS
	POPJ	P,		;AND RETURN
SUBTTL	I$ION  --  Routine to enable the interrupt system

;ROUTINE TO TURN ON THE INTERRUPT SYSTEM

I$ION:	MOVX	S1,.FHSLF	;MY RELATIVE FORK HANDLE
	EIR			;ENABLE INTERRUPTS
	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	Memory Manager Interface Routines

;ENTRY POINTS

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

;I$MFFP IS CALLED TO FIND THE FIRST FREE PAGE IN QUASAR'S ADDRESS SPACE.
;	THE PAGE NUMBER IS RETURNED IN S1.

I$MFFP:	MOVSI	S1,.FHSLF		;LOAD MY FORK HANDLE
MFFP.1:	RPACS				;READ PAGE ACCESSABILITY
	TXNE	S2,PA%PEX		;DOES PAGE EXIST?
	AOJA	S1,MFFP.1		;YES, KEEP LOOPING

	HRRZ	S1,S1			;NO, GOT IT!!
	POPJ	P,			;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 ROUTINE TO ESTABLISH PIDS ETC.
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:	MSEND				;SEND THE MESSAGE
	  SKIPA				;ERROR RETURN
	TDZA	S2,S2			;WIN, SET S2=0 AND SKIP
	SETO	S2,			;LOSE, SET S2=-1
	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:	MRECV				;RECEIVE THE PACKET
	  STOPCD(MRF,FATAL)		;++MESSAGE RECEIVE FAILURE
	POPJ	P,			;AND RETURN
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
	MOVEI	S1,.MUQRY		;GET MUTIL FNC CODE FOR QUERY
	MOVEM	S1,IPQ.A		;AND SAVE IT
	MOVE	S1,G$QPID##		;GET QUASAR'S PID
	MOVEM	S1,IPQ.A+1		;AND SAVE AS MUTIL ARG
	MOVEI	S1,5			;GET LENGTH
	MOVEI	S2,IPQ.A		;AND ADDRESS
	MUTIL				;AND DO THE QUERY
	  PJRST	.FALSE##		;FAILED, RETURN 0
	HRRZ	S1,IPQ.A+.IPCFL+1	;GET RIGHT HALF OF FLAGS
	HLL	S1,IPQ.A+.IPCFP+1	;GET 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:	MOVEI	S1,.MUQRY		;MUTIL FUNCTION FOR QUERY
	MOVEM	S1,GMIS.A		;SAVE IT
	MOVE	S1,G$QPID##		;GET QUASAR'S PID
	MOVEM	S1,GMIS.A+1		;AND SAVE IT
	MOVEI	S1,5			;BLOCK LENGTH
	MOVEI	S2,GMIS.A		;ADDRESS
	MUTIL				;DO IT!!
	  PJRST	.FALSE##		;RETURN FALSE
	HRRZ	S1,GMIS.A+.IPCFL+1	;GET FLAGS (RH)
	HLL	S1,GMIS.A+.IPCFP+1	;AND LENGTH
	POPJ	P,			;AND RETURN

GMIS.A:	BLOCK	6			;LOCAL STORAGE
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
	MOVEM	S1,EPID.A		;SAVE TABLE INDEX
	MOVEI	S1,3			;THREE WORDS
	MOVEI	S2,T1			;INTO T1
	MOVEI	T1,.MURSP		;FUNCTION READ SYSTEM PID TABLE
	MOVE	T2,EPID.A		;ENTRY REQUESTED
	MUTIL				;EXECUTE THE UTILITY
	  ZERO	T3			;FAILED, DOES NOT CONTAIN A VALID PID
	MOVEM	T3,EPID.B		;ASSUME IT IS MY PID
	JUMPN	T3,EPID.1		;CONNECT IT IF THERE WAS ONE
	MOVEI	S1,3			;THREE WORDS
	MOVEI	S2,T1			;INTO T1
	MOVEI	T1,.MUCRE		;CREATE A PID
	MOVX	T2,IP%JWP!.FHSLF	;JOB WIDE FOR THIS FORK
	MUTIL				;GET THE PID PLEASE
	  STOPCD(CAP,FATAL)		;++CANNOT ACQUIRE A PID
	MOVEM	T3,EPID.B		;STORE MY PID
	MOVEI	S1,3			;NUMBER OF WORDS
	MOVEI	S2,T1			;THEY'RE IN T1
	MOVEI	T1,.MUSSP		;SET SYSTEM PID TABLE
	MOVE	T2,EPID.A		;THE ENTRY
	MOVE	T3,EPID.B		;THE PID I JUST GOT
	MUTIL				;ESTABLISH THE SYSTEM COMPONENT
	  STOPCD(FSP,FATAL)		;++FAILURE TO SET SYSTEM PID TABLE
	MOVEI	S1,3			;THREE WORDS
	MOVEI	S2,T1			;THEY'RE IN T1
	MOVEI	T1,.MUSSQ		;FUNCTION SET QUOTAS
	MOVE	T2,EPID.B		;FOR THE PID I JUST GOT
	MOVEI	T3,777777		;MAKE THE QUOTAS LARGE
	MUTIL				;ASK THE EXEC
	  STOPCD(CSQ,FATAL)		;++CANNOT SET IPCF QUOTAS
EPID.1:	MOVEI	S1,3			;THREE WORDS
	MOVEI	S2,T1			;FROM T1
	MOVEI	T1,.MUPIC		;FUNCTION PLACE PID ON INTERRUPT
	MOVE	T2,EPID.B		;PID TO ENABLE
	MOVX	T3,INT.PI		;CHANNEL NUMBER FOR INTERRUPTS
	MUTIL				;ESTABLISH INTERRUPT CORRESPONDENCE
	  STOPCD(PIC,FATAL)		;++PID TO INTERRUPT FAILED
	MOVE	S1,EPID.B		;THE PID ACQUIRED THROUGH THIS SEQUENCE
	POPJ	P,			;AND RETURN

EPID.A:	BLOCK	1			;SYSTEM PID TABLE INDEX
EPID.B:	BLOCK	1			;PID ACQUIRED DURING I$EPID
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,.SAVET##		;SAVE T1-T4 FOR USE HERE
	MOVEM	S1,CSM.B		;REMEMBER ADDRESS OF SPOOL MESSAGE FOR LATER
	MOVE	T1,[CSM.A,,CSM.A+1]	;SET UP TO ZERO CSM AREA
	ZERO	CSM.A			;ZERO FIRST WORD
	BLT	T1,CSM.A+CSMSIZ-1	;AND ALL THE REST
	LOAD	T1,SPL.JB(S1),SP.JOB	;GET THE JOB NUMBER
	STORE	T1,CSM.A+CSM.JB,CS.JOB	;AND SAVE IT IN CSM
	LOAD	T1,SPL.FL(S1),SP.DFR	;GET THE DEFER BIT
	STORE	T1,CSM.A+CSM.JB,CS.DFR	;AND SAVE IT@IN SPOOL MESSAGE
	LOAD	T1,SPL.FL(S1),SP.LOC	;GET THE STATION NUMBER
	STORE	T1,CSM.A+CSM.JB,CS.LOC	;AND SAVE IT IN CSM
	LOAD	T1,G$SID##		;GET THE USERS ID
	STORE	T1,CSM.A+CSM.OI		;STORE IT IN CSM
	LOAD	T1,SPL.BV(S1),SP.SIZ	;GET THE FILE SIZE IN PAGES
	STORE	T1,CSM.A+CSM.FS		;SAVE IT IN CSM
	MOVE	T1,CSM.F		;GET THE STANDARD FLAGS FOR SPOOLING
	STORE	T1,CSM.A+CSM.FP		;INTO THE CSM
	MOVEI	S1,SPL.FD(S1)		;GET THE ADDRESS OF THE FD
	MOVE	T1,S1			;PUT IN T1 ALSO
	STORE	S1,CSM.A+CSM.FD,CS.FDA	;AND SAVE IT AS THE ADDRESS OF THE CSM FD
	PUSHJ	P,I$FSTR		;EXTRACT THE STRUCTURE
	MOVEM	S1,CSM.A+CSM.ST		;AND SAVE IT
	HRLI	T1,(POINT 7,0)		;MAKE T1 A BYTE POINTER TO THE FD
	ZERO	T2			;BUT DON'T STORE THIS 
	MOVX	T3,<76,,0>		;TERMINATE ON RIGHT  ANGLE BRACKET
	ZERO	T4			;NO COUNT
	PUSHJ	P,FBREAK		;SKIP TO END OF DIRECTORY
	JUMPE	S1,CSM.2		;IF WE ENDED ON NUL, LOSE
	MOVE	T2,[POINT 6,CSM.A+CSM.DV] ;STORE NEXT STUFF AS DEVICE
	MOVEI	T4,6			;ONLY 6 CAHRACTERS
	MOVE	T3,["-",,"A"-'A']	;STOP ON -, CONVERT TO SIXBIT
	PUSHJ	P,FBREAK		;PICK UP DEVICE NAME
	JUMPE	S1,CSM.2		;IF NUL TERMINATES, LOSE
	ZERO	T2			;DON'T STORE ANYTHING
	ZERO	T4			;NO COUNT
	MOVSI	T3,"-"			;STOP ON MINUS
	PUSHJ	P,FBREAK		;SKIP THE STATION NUMBER
	JUMPE	S1,CSM.2		;OOPS
	ZERO	T4			;NO COUNT
	ZERO	T2			;NO DESTINATION
	MOVSI	T3,"-"			;STOP ON MINUS
	PUSHJ	P,FBREAK		;AND THE DIRECTORY NUMBER
	JUMPE	S1,CSM.2		;OOPS

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

	MOVE	T2,[POINT 6,CSM.A+CSM.EN] ;SET UP TO STORE THE ENTERED NAME
	MOVEI	T4,6			;ONLY 6 CHARACTERS
	MOVE	T3,[".",,"A"-'A']	;ENDED WITH ., CONVERTED TO SIXBIT
	PUSHJ	P,FBREAK		;PICK UP THE ENTERED NAME
	JUMPE	S1,CSM.2		;NOT ENOUGH FD IN SPOOL MESSAGE
	MOVE	S2,CSM.B		;GET THE ADDRESS OF THE SPOOL MESSAGE
	SKIPN	S1,CSM.A+CSM.EN		;GET ENTERED NAME INTO S1
	LOAD	S1,SPL.PG(S2)		;IF NO ENTERED NAME,USE PROGRAM NAME
	STORE	S1,CSM.A+CSM.EN		;SAVE AS ENTERED NAME
CSM.1:	ILDB	T2,T1			;PICK UP NEXT CHARACTER
	JUMPN	T2,CSM.1		;LOOP UNTIL A NUL
	TLZ	T1,-1			;CONVERT BYTE POINTER TO ADDRESS
	SUBI	T1,SPL.FD-1(S2)		;AND MAKE INTO LENGTH OF FD
	STORE	T1,CSM.A+CSM.FD,CS.FDL	;SAVE THAT IN CSM
	MOVEI	S1,CSM.A		;PUT ADDRESS OF CSM IN S1 FOR CALLER
	POPJ	P,			;AND RETURN
CSM.2:	STOPCD (BSD,FATAL)		;++BAD SPOOL DATA

CSM.A:	BLOCK	CSMSIZ			;PLACE FOR CSM
CSM.B:	BLOCK	1			;WORD TO SAVE SPOOL MESSAGE ADDRESS
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.FL(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

I$FSTR:	PUSHJ	P,.SAVET##		;SAVE T1 THRU T4
	SETZM	FSTR.A			;CLEAR OUT THE ANSWER WORD
	MOVEI	T4,^D6			;LOAD A CHARACTER COUNT
	MOVE	T3,[":",,"A"-'A']	;LOAD BREAK,,OFFSET
	MOVE	T2,[POINT 6,FSTR.A]	;LOAD DESTINATION POINTER
	MOVSI	T1,(POINT 7,0)		;START MAKING SOURCE POINTER
	HRR	T1,S1			;FINISH MAKING SOURCE POINTER
	PUSHJ	P,FBREAK		;GET THE STRUCTURE
	CAIN	S1,":"			;BREAK ON COLON?
	SKIPA	S1,FSTR.A		;YES, LOAD THE ANSWER AND SKIP
	MOVSI	S1,'PS '		;NO, USE "PS"
	POPJ	P,			;AND RETURN

FSTR.A:	BLOCK	1			;PLACE TO STORE STRUCTURE NAME
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==.FALSE##			;UNTIL PARSER IS WRITTEN
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			;Match a request and an RDB
	INTERN	I$DFEQ			;Default and check an 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:	PUSHJ	P,.SAVET##		;SAVE T1 THRU T4
	MOVSI	S2,.EQOWN(S1)		;SETUP TO BLT THE OWNER'S NAME
	HRRI	S2,.QEOWN(AP)		;FORM EQ TO QE
	BLT	S2,.QEOWN+7(AP)		;ZAP!!
	MOVSI	S2,.EQCON(S1)		;POINT TO CONNCECTED DIRECTORY
	HRRI	S2,.QECON(AP)		;PLACE TO BLT TO
	BLT	S2,.QECON+11(AP)	;AND BLT IT
	HRROI	S2,.EQOWN(S1)		;POINT TO EXTERNAL OWNER FIELD
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	RCUSR				;RECOGNIZE USER
	TXNE	S1,RC%NOM		;NO MATCH?
	STOPCD	(NXU,FATAL)		;++NON-EXISTANT USER
	STORE	T1,.QEOID(AP)		;STORE THE OWNER ID
	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:	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 THE OWNER ID
	HRROI	S1,.EQOWN(AP)		;POINT TO EQ
	DIRST				;CONVERT TO STRING
	  STOPCD(ODE,FATAL)		;++OWNER DOESNT EXIST
	POPJ	P,			;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

	SKIPE	.RDBOW(S1)		;IS THERE AN OWNER?
	JRST	RMCH.2			;YES, GO ON
	PUSH	P,S1			;NO, LETS DEFAULT IT
	HRROI	S1,.RDBOW(S1)		;POINT TO THE BLOCK
	LOAD	S2,G$SID##		;USER SENDER'S ID
	DIRST				;AND GET THE STRING
	ERJMP	RMCH.3			;FAILED?
	POP	P,S1			;RESTORE S1
RMCH.2:	MOVEI	S2,.RDBOW(S1)		;GET THE ADDRESS
	HRLI	S2,(POINT 7,0)		;AND MAKE A BYTE POINTER
	MOVX	S1,<POINT 7,.QEOWN(AP)>	;POINT TO REQUEST OID
	PJRST	STGWLD			;MATCH AND PROPAGATE TRUE OR FALSE

RMCH.3:	STOPCD	(CGU,FATAL)		;++CANT GET USER
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:	PUSHJ	P,.SAVET##		;SAVE T REGS
	MOVE	T2,S1			;COPY EQ ADR INTO T2
	SETZB	T3,T4			;CLEAR SOME FLAGS
	SKIPE	.EQOWN(S1)		;IS OWNER SET?
	JRST	DFEQ.1			;YES, CONTINUE
	SETOM	T3			;FLAG DEFAULT ON .EQOWN
	HRROI	S1,.EQOWN(T2)		;NO, POINT TO LOCATION
	LOAD	S2,G$SID##		;GET DEFAULT
	DIRST				;AND GET DEFAULT ONWER STRING
	ERJMP	DFEQ.4			;JUMP IF LOSSAGE

DFEQ.1:	SKIPE	.EQCON(T2)		;IS CON DIR SET?
	JRST	DFEQ.2			;YES, DONT DEFAULT IT
	SETOM	T4			;FLAG DEFAULTED .EQCON
	HRROI	S1,.EQCON(T2)		;POINT TO BLOCK
	LOAD	S2,G$CDI##		;GET THE DEFAULT
	DIRST				;GET THE CONNECTED DIRECTORY
	ERJMP	DFEQ.5			;JUMP IF WE LOSE

DFEQ.2:	JUMPL	T3,DFEQ.3		;DON'T CHECK IF EQOWN WAS DEFAULT
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,.EQOWN(T2)		;POINT TO THE OWNER BLOCK
	RCUSR				;GET THE NUMBER
	TXNE	S1,RC%NOM		;NO MATCH?
	PJRST	.FALSE##		;YES, NO MATCH
	CAME	T1,G$SID##		;MATCH, IS IT OK?
	PJRST	I$WHEEL			;NO, WIN ONLY IF HE'S A WHEEL
DFEQ.3:	PJUMPL	T4,.TRUE##		;JUST RETURN IF CON DIR WAS DEFAULTED
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,.EQCON(T2)		;NOW CHECK CONNECTED
	RCDIR				;CHECK IT
	TXNE	S1,RC%NOM		;MATCH?
	PJRST	.FALSE##		;NO, LOSE
	CAME	T1,G$CDI##		;IS IT OK?
	PJRST	I$WHEEL			;NO, WIN ONLY IF HE'S A WHEEL
	PJRST	.TRUE##			;YES, WIN

DFEQ.4:	STOPCD	(CDU,FATAL)		;++CANT DEFAULT USER
DFEQ.5:	STOPCD	(CDD,FATAL)		;++CANT DEFAULT DIRECTORY
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:	IMULI	S1,12			;GET INDEX INTO UNIDIR
	ADDI	S1,UNIDIR		;GET DESTINATION ADDRESS
	HRLI	S1,.QECON(AP)		;GET SOURCE ADDRESS
	HRRZ	S2,S1			;SETUP AC FOR END OF BLT
	BLT	S1,11(S2)		;STORE THE DIRECTORY
	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:	IMULI	S1,12			;MULTIPLY BY THE SIZE
	ZERO	UNIDIR(S1)		;CLEAR THE FIRST 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:	PUSHJ	P,.SAVE1##		;SAVE P1
	IMULI	S1,12			;MULITPLY BY THE ENTRY SIZE
	ADDI	S1,UNIDIR		;POINT TO FIRST WORD
	HRLI	S1,-12			;MAKE IT AN AOBJN POINTER ALSO
	MOVEI	S2,.QECON(AP)		;POINT TO FIRST WORD IN QE

UQCH.1:	MOVE	P1,0(S1)		;GET A WORD
	CAME	P1,0(S2)		;LOOK FOR A MATCH
	PJRST	.FALSE##		;NO MATCH JUST RETURN
	AOJ	S2,			;ELSE INCREMENT POINTER 2
	AOBJN	S1,UQCH.1		;INCREMNT PTR 1 AND LOOP
	PJRST	.TRUE##			;MATCH!!
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.

I$WRIT:	PUSHJ	P,.SAVET##		;SAVE T1-T4
	MOVE	T1,S1			;GET BLOCK NUMBER
	IDIVI	T1,FSSBPS		;DIVIDE BY BLOCKS/SECTION
	CAIN	T2,FSSFIB		;IS IT AN INDEX BLOCK?
	  JRST	WRIT.1			;YES, DO SOMETHING SPECIAL
	DMOVEM	S1,WRIT.A		;STORE INPUT ARGUMENTS
	HRR	T3,FSADDR		;ADDRESS OF SCRATCH PAGE
	HRL	T3,WRIT.A+1		;GET SOURCE,,DEST IN T3
	HLRZ	T4,WRIT.A+1		;GET LENGTH OF DATA
	ADDI	T4,-1(T3)		;ADD IN BASE ADR-1
	BLT	T3,(T4)			;AND BLT THE DATA
	MOVE	S1,FSPAGN		;GET 0,,SOURCE-PAGE
	HRLI	S1,.FHSLF		;<FORK-HANDLE>,,<SOURCE-PAGE>
	MOVE	S2,WRIT.A		;GET 0,,<DEST-PAGE>
	HRL	S2,FILJFN		;GET <JFN>,,<DEST-PAGE>
	MOVX	T1,PM%RD!PM%WT		;READ AND WRITE ACCESS
	PMAP				;AND MAP THE PAGE OUT
	HRL	S1,FILJFN		;GET <JFN>,,0
	HRR	S1,WRIT.A		;GET <JFN>,,<FILE-PAGE>
	MOVEI	S2,1			;AND A REPEAT COUNT
	UFPGS				;UPDATE THE DISK
	  STOPCD(CUF,FATAL)		;++CANT UPDATE FILE
	MOVE	T1,WRIT.A		;GET FILE PAGE NUMBER
	CAMG	T1,G$NBW##		;HIGHEST PAGE YET
	  POPJ	P,			;NO, RE-USING SOME SPACE
	MOVEM	T1,G$NBW##		;YES, SAVE NEW FILE SIZE
	MOVSI	S1,.FBUSW		;FILL IN USER-SPECIFIED-WORD
	HRR	S1,FILJFN		;FOR MASTER FILE
	SETO	S2,			;FILL ENTIRE WORD WITH T1
	CHFDB				;CHANGE THE FILE BLOCK
	POPJ	P,			;AND RETURN

;HERE IF WRITING AN INDEX PAGE

WRIT.1:	HRL	S1,FILJFN		;GET <JFN>,,<PAGE-NUMBER>
	MOVEI	S2,1			;AND A REPEAT COUNT
	UFPGS				;AND UPDATE THE INDEX
	  STOPCD(CUI,FATAL)		;++CANT UPDATE INDEX
	POPJ	P,			;RETURN

WRIT.A:	BLOCK	2			;INPUT ARGUMENTS
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:	PUSHJ	P,.SAVET##		;SAVE T1-T4
	MOVE	T1,S1			;GET BLOCK NUMBER
	IDIVI	T1,FSSBPS		;DIVIDE BY BLOCKS/SECTION
	CAIN	T2,FSSFIB		;IS IT AN INDEX BLOCK?
	  JRST	READ.1			;YES, GO MAP IT IN
	DMOVE	T1,S1			;COPY ARGS FROM S TO T
	MOVE	S1,T1			;GET 0,,<SOURCE-PAGE>
	HRL	S1,FILJFN		;GET <JFN>,,<SOURCE-PAGE>
	MOVE	S2,FSPAGN		;GET 0,,<DEST-PAGE>
	HRLI	S2,.FHSLF		;<FORK-HANDLE>,,<DEST-PAGE>
	MOVX	T1,PM%RD		;AND READ ACCESS
	PMAP				;AND MAP IN THE PAGE
	HRL	T1,FSADDR		;GET <SOURCE-ADR>,,0
	HRR	T1,T2			;GET <SOURCE-ADR>,,<DEST-ADR>
	HLRZ	T3,T2			;GET LENGTH OF DATA
	ADDI	T3,-1(T2)		;ADD IN BASE ADR -1
	BLT	T1,(T3)			;AND BLT TO REQUESTORS PAGE
	SETO	S1,			;NOW SETUP TO RELEASE THE
	HRRZ	S2,FSPAGN		; MAPPED SCRATCH PAGE FROM
	HRLI	S2,.FHSLF		; OUR ADDRESS SPACE
	SETZ	T1,			;FLAGS ARE MEANINGLESS
	PMAP				;DO IT!!
	POPJ	P,			;AND RETURN

;HERE TO MAP IN AN INDEX PAGE

READ.1:	HRL	S1,FILJFN		;GET JFN,,SOURCE-PAGE
	TLZ	S2,-1			;GET 0,,<DEST-ADR>
	ADR2PG	S2			;GET 0,,<DEST-PAGE>
	HRLI	S2,.FHSLF		;<FORK-HANDLE>,,<DEST-PAGE>
	MOVX	T1,PM%RWX		;READ/WRITE/EXECUTE
	PMAP				;MAP IT!
	POPJ	P,			;AND RETURN
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		;NUMBER OF WORDS TO WRITE
	PUSHJ	P,.SAVET##		;SAVE T REGS
	DMOVE	T3,S1			;SAVE ARGS IN T3 AND T4
	HRRZ	S1,S2			;GET 0,,<SOURCE-ADR>
	ADR2PG	S1			;GET 0,,<SOURCE-PAGE>
	HRLI	S1,.FHSLF		;GET <FHANDLE>,,<SOURCE-PAGE>
	HRRZ	S2,T3			;GET 0,,<DEST-PAGE>
	HRL	S2,FILJFN		;GET <JFN>,,<DEST-PAGE>
	MOVX	T1,PM%WR		;SET WRITE ACCESS FLAG
	PMAP				;MAP THE PAGE OUT
	DMOVE	S1,T3			;RECOVER THE ARGS
	PUSHJ	P,I$READ		;MAP THE PAGE IN
	DMOVE	S1,T3			;RECOVER THE ARGS AGAIN
	PJRST	I$WRIT			;UPDATE THE WORLD AND RETURN
SUBTTL	I$OQUE  --  Open master queue files

;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
;	THE MASTER QUEUE FILE.

I$OQUE:	ZERO	OQUE.A			;FIRST TIME THRU
OQUE.1:	MOVX	S1,<GJ%SHT!GJ%OLD>	;DO A SHORT GTJFN, OLD FILE ONLY
	HRROI	S2,[MQFNAM]		;POINT TO MASTER QUEUE NAME
	GTJFN				;GO GET IT
	  JRST	OQUE.2			;NOT THERE, CREATE IT
	HRRZM	S1,FILJFN		;SAVE THE JFN
	HRRZS	S1			;AND ZERO THE LEFT HALF OUT
	PUSH	P,T1			;SAVE T1
	MOVX	S2,<1,,.FBUSW>		;READ USER SUPPLIED ARGUMENT
	MOVEI	T1,OQUE.B		;INTO LOCAL STORAGE
	GTFDB				;READ FILE BLOCK INFORMATION
	MOVE	T1,OQUE.B		;WE FILL IN HIGHEST PAGE NUMBER
	MOVEM	T1,G$NBW##		;SAVE THE FILE SIZE
	POP	P,T1			;AND RESTORE T1
	MOVE	S1,FILJFN		;GET THE JFN
	MOVX	S2,<OF%RD+OF%WR+OF%NWT>	;GET OPENF BITS
	OPENF				;OPEN THE FILE
	  PUSHJ	P,OQUE.4		;LOSE!!
	SAVE	AP			;SAVE AP FOR A MINUTE
	PUSHJ	P,M$ACQP##		;GET A PAGE FOR I$READ/I$WRITE
	MOVEM	AP,FSPAGN		;FOR THEIR SCRATCH USE
	PG2ADR	AP			;CONVERT TO ADDRESS ALSO
	MOVEM	AP,FSADDR		;FOR EASIER USE
	POPJ	P,			;AND RETURN

OQUE.2:	SKIPE	OQUE.A			;FIRST TIME THRU?
	PUSHJ	P,OQUE.3		;NO, GIVE A STOPCD
	MOVX	S1,<GJ%NEW!GJ%SHT!GJ%FOU> ;NEW FILE, OUTPUT, SHORT GTJFN
	HRROI	S2,[MQFNAM]		;POINT TO MASTER QUEUE NAME
	GTJFN				;GET IT
	  PUSHJ	P,OQUE.3		;LOSE?
	MOVX	S2,OF%WR		;WRITE
	HRRZS	S1			;CLEAR LH
	PUSH	P,S1			;AND SAVE JFN
	OPENF				;OPEN THE FILE
	  PUSHJ	P,OQUE.3		;CAN'T?
	POP	P,S1			;RESTORE THE JFN
	CLOSF				;CLOSE THE FILE
	  JFCL				;REALLY SHOULDN'T HAPPEN
	SETOM	OQUE.A			;WE'VE BEEN HERE ONCE ALREADY
	JRST	OQUE.1			;AND TRY AGAIN

OQUE.3:	STOPCD	(COP,FATAL)		;++CANT OPEN PRIME QUEUE
OQUE.4:	CAIE	S1,OPNX9		;IS IT ILLEGAL SIMUL ACCESS?
	JRST	OQUE.3			;NO
	STOPCD	(PQI,FATAL)		;++PRIME QUEUE INTERLOCKED

OQUE.A:	BLOCK	1			;LOCAL STORAGE
OQUE.B:	BLOCK	1			;LOCAL STORAGE
SUBTTL	FBREAK  --  Find a break character

;FBREAK IS USED TO SEPARATE PIECES OUT OF CHARACTER STRINGS.  IT WILL
;ALSO DO A FIXED OFFSET CONVERSION OF THE CHARACTERS
;IT IS CALLED WITH:
;	T1 = BYTE POINTER TO SOURCE STRING
;	T2 = BYTE POINTER TO DESTINATION STRING
;	T3 = CHARACTER TO STOP ON,,CONVERSION OFFSET (SUBTRACTED FROM SOURCE CHARACTER
;	T4 = COUNT OF CHARACTERS TO STORE (OTHERS TO BREAK ARE SKIPPED)
;IT RETURNS:
;	T1 = BYTE POINTER TO FIRST CHARACTER AFTER BREAK IN SOURCE
;	S1 = TERMINATION CHARACTER (EITHER BREAK AS SPECIFIED IN T3 OR NULL
;	S2,T2-T3 UNDEFINED

FBREAK:	HLRZ	S2,T3			;GET CHARACTER TO STOP ON
	HRRES	T3			;AND MAKE T3 CONVERSION OFFSET
FBRE.1:	ILDB	S1,T1			;GET A CHARACTER FROM THE SOURCE
	JUMPE	S1,.POPJ##		;ALWAYS STOP ON NULL
	CAMN	S1,S2			;IS IT THE BREAK CHARACTER
	POPJ	P,			;YES, RETURN
	SUB	S1,T3			;DO THE CONVERSION
	SOSL	T4			;DECREMENT NUMBER OF CHARACTERS TO STORE
	IDPB	S1,T2			;STORE IT
	JRST	FBRE.1			;AND LOOP BACK FOR MORE
SUBTTL	STGWLD  --  Match a "wild" string

;STGWLD IS CALLED WITH S1 CONTAINING A POINTER TO A "BASE" STRING
;	LIKE A JOBNAME OR FILENAME AND S2 CONTAINING A POINTER TO
;	A STRING WITH POSSIBLE WILDCARD CHARACTERS * AND % IN IT.
;	IT THE BASE STRING MATCHES THE WILD STRING, TRUE IS RETURNED
;	OTHERWISE FALSE.

STGWLD:	PUSHJ	P,.SAVET##		;SAVE T REGS

STGW.1:	ZERO	T1			;CLEAR * FLAG
STGW.2:	ILDB	T4,S2			;GET A CHARACTER FROM "WILD"
STGW.3:	CAIL	T4,"A"+40		;CHECK FOR LOWER CASE
	CAILE	T4,"Z"+40		; "
	SKIPA				;ITS NOT LC
	SUBI	T4,40			;IT IS, MAKE IT UPPER CASE
STGW.4:	ILDB	T3,S1			;GET A CHARACTER FROM "BASE"
	CAIL	T3,"A"+40		;CHECK IT FOR LOWER CASE
	CAILE	T3,"Z"+40
	SKIPA				;ITS NOT LOWER
	SUBI	T3,40			;IT IS, MAKE IT UC
	CAME	T3,T4			;MATCH?
	JRST	STGW.5			;NO, THAT WOULD BE TOO SIMPLE
	PJUMPE	T3,.TRUE##		;YES, RETURN IF END OF STRINGS
	JRST	STGW.1			;ELSE JUST LOOP

STGW.5:	CAIN	T4,"*"			;IS "WILD" A *?
	PJUMPE	T3,.TRUE##		;YES, WIN IF END OF STRING
	JUMPN	T1,STGW.4		;IF LAST "WILD" WAS *, KEEP GOING
	PJUMPE	T3,.FALSE##		;IF NOT END-OF-STRING DOES NOT MATCH
	CAIN	T4,"%"			;IS "WILD" A %
	JRST	STGW.7			;YES, MATCH AND GO AROUND AGAIN
	CAIE	T4,"*"			;NO, IS IT A *
	PJRST	.FALSE##		;NO, LOSE
STGW.6:	AOSA	T1			;YES, SET * FLAG
STGW.7:	ZERO	T1			;CLEAR * FLAG
STGW.8:	ILDB	T4,S2			;GET NEXT "WILD" CHARACTER
	CAIN	T4,"*"			;IS IT A *?
	JRST	STGW.6			;YES, "**"="*"
	CAIE	T4,"%"			;NO, A %  ?
	JRST	STGW.3			;NO, PLAIN OLD ALPHANUMERIC
	JRST	STGW.8			;YES, "*%" = "*"
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
	HRROI	S1,[ASCIZ /QUASAR STOP CODE - /]
	CAIE	P1,.SCFAT		;FATAL??
	  HRROI	S1,[ASCIZ /QUASAR TRACE:/]
	PSOUT				;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
	PBOUT				;OUTPUT THE ASCII CHARACTER
	AOBJN	P4,STCD.1		;AND LOOP
	HRROI	S1,[BYTE (7) .CHCRT,.CHLFD,0]  ;CHARRIAGE RETURN-LINE FEED PAIR
	PSOUT				;OUTPUT CR-LF
	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
	HALTF				;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:	HRROI	1,[ASCIZ /Crash ACs Copied
Going to DDT
/]
	PSOUT				;TELL HIM
	MOVSI	17,G$CRAC##		;SETUP A BLT POINTER
	BLT	17,17			;RESTORE THE CRASH ACS
	JRST	770000			;AND GO BACK TO DDT


	END