Google
 

Trailing-Edge - PDP-10 Archives - cuspmar86binsrc_1of2_bb-x128b-sb - 10,7/acct/actlib.mac
There are 9 other files named actlib.mac in the archive. Click here to see a list.
UNIVERSAL ACTPRM - PARAMETER FILE FOR THE ACCOUNTING SUBROUTINE PACKAGE


;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1986. 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.


; VERSION NUMBERS
	APRVER==1		;VERSION NUMBER
	APRMIN==0		;MINOR VERSION NUMBER
	APREDT==1		;EDIT NUMBER
	APRWHO==0		;WHO EDITED LAST
	%%ACTP==:<BYTE(3)APRWHO(9)APRVER(6)APRMIN(18)APREDT>


	SALL			;CLEAN LISTINGS
	.DIREC	FLBLST		;CLEANER LISTINGS
SUBTTL	MODULE INITIALIZATION MACRO


; MACRO TO SEARCH THE APPROPRIATE UNIVERSALS AND TO INITIALIZE ASSEMBLY
DEFINE	MODULE	(NAME),<

	SALL			;;CLEAN LISTINGS
	.DIREC	FLBLST		;;CLEAN LISTINGS

	SEARCH	ACTSYM		;;ACCOUNTING DEFINITIONS
	SEARCH	GLXMAC		;;GALAXY DEFINITIONS
;	SEARCH	ORNMAC		;;PARSING DEFINITIONS

	PROLOG	('NAME)		;;INIT GALACTIC STUFF

	%%ACTP==:%%ACTP		;;FORCE ACTPRM VERSION INTO THE SYMBOL TABLE

	TWOSEG	400K		;;MAKE US SHARABLE
	RELOC	400K		;;START LOADING THE HIGH SEG BY DEFAULT

> ;END DEFINE MODULE

	MODULE	(ACTPRM)
SUBTTL	ASSEMBLY PARAMETERS


; ASSEMBLY PARAMETERS
	ND	ACTFIL,<SIXBIT /ACTDAE/> ;ACCOUNTING FILE NAME


; SPECIAL AC ASSIGNMENTS USED BY REACT AND CUSREA
	U==.A13		        ;POINTER TO USER BLOCK
	X==.A14		        ;ALTERNATE POINTER TO USER BLOCK
SUBTTL	ERROR MACROS


DEFINE	FATAL	(PFX,TXT,DAT,RET<MAIN>),<.ERR.	("?",PFX,<TXT>,DAT,RET)>
DEFINE	WARN	(PFX,TXT,DAT,RET<.+1>),<.ERR.	("%",PFX,<TXT>,DAT,RET)>
DEFINE	INFO	(PFX,TXT,DAT,RET<.+1>),<.ERR.	("[",PFX,<TXT>,DAT,RET)>

DEFINE	.ERR.	(CHR,PFX,TXT,DAT,RET),<
	PUSHJ	P,[PUSHJ P,A$ERRM##
		   XWD	CHR,''PFX''
		   XWD	RET,[ITEXT (<TXT>)]
	IFB  <DAT>,< EXP 0>
	IFNB <DAT>,< EXP DAT>
		  ]
> ;END DEFINE .ERR.
SUBTTL	PROFILE DESCRIPTORS


; PROFILE DESCRIPTORS USED IN THE TABLE DRIVEN CHANGE AND
; SELECTION CODE

	PD.RTN==1B0		;CALL A ROUTINE
	PD.NSL==1B1		;NO SELECTION IS TO BE DONE
	PD.UNP==1B2		;UNPRIVILEGED FIELD
	PD.MSK==1B3		;MASKABLE WORD
	PD.EXT==1B4		;EXTENSIBLE QUANTITY
	PD.NMD==1B5		;NOT MODIFIABLE VIA UGCUP$
	PD.CND==1B6		;CAN NOT BE DEFAULTED
	PD.NDI==1B7		;CAN NOT BE DISPLAYED
	PD.WRD==777B17		;WORD (REPEAT) COUNT


;DEFINE SOME SYMBOLS FOR DEALING WITH .AEMAP

DEFINE	AE (NAM,LEN,BITS,RTN),<
	.DF'NAM==<.AE'NAM/^D36>	;;WORD OFFSET IN MAP
	DF.'NAM==1B<.AE'NAM-.DF'NAM*^D36>	;;BIT IN WORD
	DF$'NAM==.AEMAP+.DF'NAM	;;WORD IN PROFILE
>

	AEPROF			;DEFINE THE SYMBOLS

	PURGE	AE		;DON'T KEEP THE MACRO AROUND
SUBTTL	PROFILE ENTRY VECTOR DEFINITIONS USED BY REACT AND CUSREA


; OFFSETS INTO THE PROFILE ENTRY VECTOR
	CG.FLG==:0	;FLAGS
	   FL.NTY==:1B0	   ;IGNORE THIS BLOCK ON TYPEOUT
	   FL.XCR==:1B1	   ;OUTPUT AN EXTRA CRLF AFTER TYPEOUT
	CG.IDX==:1	;PROFILE ENTRY INDEX
	CG.PRM==:2	;PROMPT STRING
	CG.GET==:3	;ROUTINE TO GET VALUES FROM COMMAND BLOCK
	CG.CMP==:4	;ROUTINE TO COMPARE VALUES IN TWO BLOCKS
	CG.CHG==:5	;ROUTINE TO REQUEST CHANGES FROM ACTDAE
	CG.RES==:6	;ROUTINE TO RESTORE OLD VALUES
	CG.PRT==:7	;ROUTINE TO TYPE OUT VALUES IN PRETTY FORM
	CG.HLP==:10	;ADDRESS OF HELP TEXT
	CG.PRS==:11	;ADDRESS OF PARSE BLOCKS
	CG.PFL==:12	;PROFILE OFFSET FOR ENTRY
	CG.DFL==:13	;ROUTINE TO RESET TO DEFAULTS

	ENTNUM==:700000	;INITIALIZE PROFILE ENTRY INDEX


; MACRO TO GENERATE THE PROFILE ENTRY VECTORS
DEFINE	.ENTRY	(ABV,PFL,TEXT,FLAGS,%A),<

	.XCREF	%A
	.ASSIGN	%A,ENTNUM,1

ABV::	EXP	FLAGS
	XLIST
	EXP	<%A&7777>+1
	IFIW	[ASCIZ \TEXT\]
	IFIW	ABV'GET
	IFIW	ABV'CMP
	IFIW	ABV'CHG
	IFIW	ABV'RES
	IFIW	ABV'PRT
	IFIW	ABV'HLP
	IFIW	ABV'PRS
	EXP	PFL
	IFIW	ABV'DFL
	LIST
> ;END DEFINE .ENTRY

	PRGEND
TITLE	ACTERR - SUPPORT FOR THE ERROR MESSAGE MACROS


	SEARCH	ACTPRM
	MODULE	(ACTERR)

	ENTRY	A$ERRI

; INITIALIZE
A$ERRI::HRLZM	S1,PGMPFX	;SAVE PROGRAM PREFIX
	MOVEM	S2,PGMSUB	;SAVE EXIT SUBROUTINE ADDRESS
	POPJ	P,		;RETURN


; THIS CODE CAN ONLY BE INVOKED BY USING THE FATAL, WARN, AND INFO
; MACROS DEFINED IN ACTPRM

A$ERRM::DMOVEM	T1,ERRACS	;SAVE T1 AND T2
	DMOVEM	T3,ERRACS+2	;SAVE T3 AND T4
	HRRZ	T1,(P)		;GET ADDRESS OF ARGS FROM CALL
	POP	P,(P)		;GET EXTRA PUSHJ OFF THE STACK
	MOVE	T2,2(T1)	;GET DATA WORD
	MOVEM	T2,ERRDAT	;SAVE
	SKIPE	PGMSUB		;ERROR SUBROUTINE SUPPLIED?
	JRST	ERRM1		;YES
	HRROI	T2,.GTWCH	;GETTAB TO
	GETTAB	T2,		; RETURN WATCH BITS
	  SETZ	T2,		;STRANGE ...
	TXNN	T2,JW.WPR!JW.WFL ;HAVE PREFIX OR FIRST LINE SET?

ERRM1:	TXO	T2,JW.WPR!JW.WFL ;NO--DEFAULT TO THEM
	MOVEI	T3," "		;GET A SPACE
	TXNE	T2,JW.WPR	;PREFIX?
	TXNN	T2,JW.WFL	; AND FIRST LINE?
	SETZ	T3,		;NO
	MOVEM	T3,ERRSPC	;SAVE SPACE
	HLRZ	T3,0(T1)	;GET INITIAL CHARACTER
	MOVEM	T3,ERRICH	;SAVE
	MOVEI	T4,"]"		;INCASE INFORMATIONAL
	CAIE	T3,"["		;CHECK
	MOVEI	T4,0		;ISN'T
	MOVEM	T4,ERRFCH	;SAVE FINAL CHARACTER
	MOVE	T3,PGMPFX	;GET PROGRAM PREFIX
	HRR	T3,0(T1)	;INCLUDE ERROR PREFIX
	TXNN	T2,JW.WPR	;WANT PREFIX?
	SETZ	T3,		;NO
	MOVEM	T3,ERRPFX	;SAVE
	HRRZ	T3,1(T1)	;GET ITEXT BLOCK
	TXNN	T2,JW.WFL	;WANT FIRST LINE?
	MOVEI	T3,[ITEXT (<>)]	;NO
	MOVEM	T3,ERRTXT	;SAVE
	HLRZ	T3,1(T1)	;GET RETURN ADDRESS
	HRRM	T3,(P)		;SAVE ON STACK
	SKIPE	PGMSUB		;ERROR SUBROUTINE SUPPLIED?
	JRST	ERRM2		;YES--DON'T TYPE ANYTHING
	MOVE	T1,[2,,T2]	;SET UP UUO AC
	MOVEI	T2,.TOFLM	;FUNCTION CODE
	MOVNI	T3,1		;-1 FOR US
	TRMOP.	T1,		;FORCE LEFT MARGIN
	  SKIPA	S1,[.CHCRT]	;DO IT THE HARD WAY
	JRST	ERRM2		;ONWARD
	PUSHJ	P,T%TTY		;TYPE <CR>
	MOVEI	S1,.CHLFD	;GET LINE FEED
	PUSHJ	P,T%TTY		;TYPE <LF>

ERRM2:	DMOVE	T1,ERRACS	;RESTORE T1 AND T2
	DMOVE	T3,ERRACS+2	;RESTORE T3 AND T4
	SKIPE	PGMSUB		;ERROR SUBROUTINE SUPPLIED?
	PJRST	@PGMSUB		;YES--GIVE CALLER CONTROL
	$TEXT	(T%TTY,<^7/ERRICH/^W/ERRPFX/^7/ERRSPC/^I/@ERRTXT/^7/ERRFCH/>)
	POPJ	P,		;RETURN
; ROUTINE TO PROCESS A QUEUE. UUO ERROR
; CALL:	MOVE	T1, UUO AC
;	MOVE	T2, ADDRESS OF QUEUE. UUO BLOCK
;	MOVE	T3, RETURN ADDRESS
;	MOVE	T4, EXTRA DATA
;	PUSHJ	P,A$QERR

A$QERR::DMOVEM	T1,ERRACS	;SAVE T1 AND T2
	DMOVEM	T3,ERRACS+2	;SAVE T3 AND T4
	MOVE	T1,[ERRBLK,,ERRBLK+1] ;SET UP BLT
	SETZM	ERRBLK		;CLEAR FIRST WORD
	BLT	T1,ERRBLK+4	;ZAP ENTIRE BLOCK
	MOVE	T1,[PUSHJ P,A$ERRM] ;INSTRUCTION TO CALL ERROR HANDLER
	MOVEM	T1,ERRBLK+0
	POP	P,T1		;PHASE STACK
	SKIPN	T3		;HAVE A RETURN ADDRESS
	MOVE	T3,T1		;NO--RETURN .+1
	HRLZM	T3,ERRBLK+2	;SAVE
	MOVEM	T4,ERRBLK+3	;SAVE EXTRA DATA

; CHECK FOR A RESPONSE BLOCK
QERR1:	DMOVE	T1,ERRACS	;GET T1 AND T2 BACK
	TXNE	T1,QU.RBT!QU.RBR;RESPONSE BLOCK RETURNED?
	JUMPN	T2,QERR2	;YES
	MOVE	T2,T1		;COPY ERROR CODE
	MOVEM	T2,ERRTMP	;SAVE INCASE UNKNOWN
	CAIL	T2,QUEELN	;KNOWN ERROR CODE?
	MOVEI	T2,0		;NO
	MOVS	T3,QUEETB(T2)	;GET PREFIX,,ITEXT
	HLRM	T3,ERRBLK+2	;SAVE ITEXT
	HRLI	T3,"?"		;FATAL ERROR
	MOVEM	T3,ERRBLK+1	;SAVE PREFIX
	JRST	QERR4		;FINISH UP

QERR2:	MOVEI	T1,[ITEXT(<^T/@ERRTMP/>)]
	HRRM	T1,ERRBLK+2	;SAVE ITEXT BLOCK
	HRRZ	T2,.QURSP(T2)	;GET ADDRESS OF THE RESPONSE BLOCK
	MOVE	T1,(T2)		;GET PREFIX CHARACTER AND SIXBIT PREFIX
	MOVEM	T1,ERRBLK+1	;SAVE
	MOVEI	T1,1(T2)	;POINT TO START OF STRING
	MOVEM	T1,ERRTMP	;SAVE ADDRESS FOR LATER
	HRLI	T1,(POINT 7,)	;MAKE A BYTE POINTER

QERR3:	ILDB	T3,T1		;GET A CHARACTER
	CAIE	T3,.CHLFD	;LINE FEED?
	CAIN	T3,.CHCRT	;CARRIAGE RETURN?
	MOVEI	T3,.CHNUL	;YES--WE DON'T DO MULTI-LINE STUFF
	IDPB	T3,T1		;PUT A CHARACTER
	SKIPE	T3		;DONE?
	JRST	QERR3		;NO

QERR4:	DMOVE	T1,ERRACS+0	;RESTORE T1 AND T2
	DMOVE	T3,ERRACS+2	;RESTORE T3 AND T4
	PUSHJ	P,ERRBLK	;GENERATE ERROR MESSAGE (NEVER RETURN)
QUEETB:	XWD	'UUE',[ITEXT (<Unknown QUEUE. UUO error ^O/ERRTMP/>)]
	XWD	'IAL',[ITEXT (<Illegal argument list>)]
	XWD	'IFC',[ITEXT (<Illegal function code>)]
	XWD	'NFC',[ITEXT (<No monitor free core>)]
	XWD	'ADC',[ITEXT (<Address check>)]
	XWD	'CNR',[ITEXT (<Component not running; no system pid>)]
	XWD	'EFO',[ITEXT (<Fatal error returned from component>)]
	XWD	'IMO',[ITEXT (<Invalid message from component>)]
	XWD	'NPV',[ITEXT (<Not privileged>)]
	XWD	'NRA',[ITEXT (<No response from component>)]
QUEELN==.-QUEETB

	LIT

	RELOC	0

PGMSUB:	BLOCK	1		;ERROR SUBROUTINE
PGMPFX:	BLOCK	1		;3-CHARACTER PROGRAM PREFIX

ERRBLK:	BLOCK	5		;DUMMY ERROR BLOCK
ERRTMP:	BLOCK	1		;TEMP STORAGE

ERRACS::BLOCK	4		;ERROR ACS (T1-T4)
ERRDAT::BLOCK	1		;DATA WORD
ERRPFX::BLOCK	1		;ERROR PREFIX
ERRTXT::BLOCK	1		;ERROR TEXT
ERRICH::BLOCK	1		;INITIAL ERROR CHARACTER
ERRFCH::BLOCK	1		;FINAL ERROR CHARACTER
ERRSPC::BLOCK	1		;SPACE CHARACTER


	PRGEND
TITLE	ACTNAM - CHECK FOR RESERVED NAMES

	SEARCH	ACTPRM
	MODULE	(ACTNAM)

	ENTRY	A$CKNM, A$CKPP


; THIS ROUTINE WILL WEED OUT RESERVED NAMES SUCH AS "*-DEFAULT"
; AND "NNN-DEFAULT" WHERE NNN IS A VALID PROJECT NUMBER.  THE
; RESERVED NAMES ARE USED FOR THE DEFAULT PROFILES.  THIS ALSO
; CHECKS FOR "POSTMASTER", THE STANDARD NAME RESERVED FOR MAIL.
;
; NOTE THAT IN THE COMPARE LOOP BELOW, THE CHARACTER FROM OUR
; INTERNAL STRING IS CASE SHIFTED RATHER THAN MESSING AROUND
; WITH THE USER SUPPLIED STRING WHICH COULD CONTAIN UGLY 8-BIT
; CHARACTERS AND NECESSITATE THE USE OF ELABORATE CASE SHIFTING
; SCHEMES.
;
; RETURNS TRUE IF NAME IS OK FOR GENERAL USE.  RETURNS FALSE IF THE NAME
; IS RESERVED TO THE ACCOUNTING SYSTEM.  ON THE FALSE RETURN, S1 HOLDS
; THE PPN CORRESONDING TO THE RESERVED NAME.

A$CKNM::PUSHJ	P,.SAVET	;SAVE T1-T4
	PUSHJ	P,.SAVE1	;AND ANOTHER
	MOVE	T1,S1		;COPY ADDRESS OF NAME
	HRLI	T1,(POINT 8,)	;8-BIT ASCIZ
	MOVEI	T2,^D39-1	;LENGTH MINUS ONE
	MOVEI	T3,6		;DIGIT COUNTER
	MOVNI	T4,1		;ASSUME AN ASTERISK IS ON THE WAY
	ILDB	S1,T1		;GET A CHARACTER
	CAIE	S1,"P"		;PERHAPS "POSTMASTER"
	CAIN	S1,"P"+40	; IN EITHER CASE?
	SOJA	T3,CKNM4	;GO CHECK IT OUT
	SETO	T4,		;PROJECT FOR "*-DEFAULT"
	CAIN	S1,"*"		;SPECIAL DEFAULT FOR ALL PPNS?
	SOJA	T3,CKNM2	;YES--COUNT NEXT CHARACTER WE'RE ABOUT TO GET
	TDZA	T4,T4		;CLEAR PROJECT NUMBER RESULT

CKNM1:	ILDB	S1,T1		;GET A CHARACTER
	CAIL	S1,"0"		;RANGE
	CAILE	S1,"7"		; CHECK
	JRST	CKNM3		;NOT A DIGIT
	IMULI	T4,10		;PROJECT NUMBERS ARE OCTAL
	ADDI	T4,-"0"(S1)	;ADD IN DIGIT
	SOSLE	T2		;COUNT NEXT CHARACTER WE'RE ABOUT TO GET
	SOJG	T3,CKNM1	;LOOP BACK
	SKIPA			;NOW CHECK FOR A DASH

CKNM2:	ILDB	S1,T1		;GET NEXT CHARACTER

CKNM3:	CAIE	S1,"-"		;OCTAL STRING FOLLOWED BY A DASH?
	$RETT			;NAME IS LEGAL
	CAML	T4,[-1]		;RANGE
	CAILE	T4,377777	; CHECK
	$RETT			;OK NAME IF PROJECT OUT OF RANGE
	MOVE	T3,[POINT 7,[ASCIZ /DEFAULT/]] ;POINT TO "DEFAULT"
	MOVEI	P1,7		;CHARACTER COUNT
	JRST	CKNM5		;ENTER LOOP

CKNM4:	MOVE	T3,[POINT 7,[ASCIZ /OSTMASTER/]] ;STANDARD RESERVED FOR MAIL
	MOVEI	P1,11		;CHARACTER COUNT
	MOVSI	T4,'UPS'	;ERSATZ DEVICE RESERVED TO MAIL
	DEVPPN	T4,UU.PHY	;OBTAIN POSTMASTER'S PPN
	  MOVE	T4,[5,,35]	;DEFAULT VALUE

CKNM5:	ILDB	S1,T1		;GET CHARACTER FROM NAME
	ILDB	S2,T3		;GET CHARACTER FROM SPECIAL STRING
	MOVEI	TF,40(S2)	;GET LOWER CASE EQUIVALENT TOO
	CAIE	S2,(S1)		;MATCH UPPER CASE?
	CAIN	TF,(S1)		;MATCH LOWER CASE?
	SKIPA			;YES
	$RETT			;NAME IS LEGAL
	SOJLE	T2,.RETT	;RETURN IF NAME RUNS OUT
	SOJG	P1,CKNM5	;LOOP
	TLNN	T4,-1		;HAVE A PPN OR A PROJECT?
	HRLOS	T4		;PROJECT, MAKE IT A PPN
	MOVE	S1,T4		;RETURN THE CORRESPONDING PPN
	$RETF			;REQUESTED NAME IS RESERVED TO ACCT SYSTEM
; THIS ROUTINE CHECKS A PPN TO SEE IF IT IS ONE OF THOSE RESERVED TO THE
; ACCOUNTING SYSTEM.
;
; RETURNS TRUE IF THE PPN IS OK FOR GENERAL USE.  RETURNS FALSE IF THE PPN
; IS RESERVED.  BOTH RETURNS LEAVE S1 POINTING TO AN ASCIZ (7-BIT) TEXT
; STRING WHICH IS THE DEFAULT (OR RESERVED) NAME FOR THAT PPN.

A$CKPP::MOVE	S2,S1		;COPY THE PPN SUPPLIED
	AOJE	S2,CKPP.0	;*-DEFAULT IF [%,%]
	HLLO	S2,S1		;NO, GET PROJECT-DEFAULT FOR GIVEN VALUE
	CAMN	S2,S1		;MATCH?
	JRST	CKPP.1		;YES, GO DEAL WITH NNN-DEFAULT
	MOVSI	S2,'UPS'	;NO, GET MAILER'S ERSATZ DEVICE
	DEVPPN	S2,UU.PHY	;GET CORRESPONDING PPN
	  MOVE	S2,[5,,35]	;DEFAULT
	CAMN	S2,S1		;MATCH?
	JRST	CKPP.2		;YES, GO RETURN POSTMASTER
	$TEXT	(<-1,,PPNNAM>,<^O/S1,LHMASK/,^O/S1,RHMASK/^0>)
	MOVEI	S1,PPNNAM	;POINT TO BLOCK FOR "P,PN" NAME
	$RETT			;NON-RESERVED PPN

CKPP.0:	MOVEI	S1,[ASCIZ /*-DEFAULT/] ;POINT TO NAME FOR [%,%]
	$RETF			;RESERVED PPN

CKPP.1:	$TEXT	(<-1,,PPNNAM>,<^O/S1,LHMASK/-DEFAULT^0>)
	MOVEI	S1,PPNNAM	;POINT TO BLOCK FOR NNN-DEFAULT
	$RETF			;RESERVED PPN

CKPP.2:	MOVEI	S1,[ASCIZ /POSTMASTER/] ;NAME FOR MAILER'S PPN
	$RETF			;RESERVED PPN


	LIT

	RELOC	0		;LOWSEG

PPNNAM:	BLOCK	.AANLW		;SPACE TO MAKE A NAME

	PRGEND
TITLE	ACTPRS - PARSE AN OPTIONALLY WILDCARDED USER-ID

	SEARCH	ACTPRM
	MODULE	(ACTPRS)

	ENTRY	A$PWLD


; PARSE A USER-ID
; CALL:	MOVE	T1, WILDCARD BLOCK ADDRESS
;	MOVE	T2, BYTE POINTER TO USER-ID ACK BLOCK
;	PUSHJ	P,A$PWLD
;
; TRUE RETURN:	WILDCARD AND ACK BLOCKS FILLED IN
; FALSE RETURN:	NO PPN, NAME, OR QUOTED STRING TO BE PARSED

A$PWLD::PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	DMOVE	P1,T1		;COPY WILDCARD BLOCK, BYTE POINTER
	MOVSI	T1,0(P1)	;POINT TO START OF WILDCARD BLOCK
	HRRI	T1,1(P1)	;MAKE A BLT POINTER
	SETZM	(P1)		;CLEAR FIRST WORD
	BLT	T1,UW$SEL-1(P1)	;CLEAR ALL BUT SELECTION COUNT AND DATA
	PUSHJ	P,P$USER##	;TRY TO GET A PPN
	JUMPT	PRSPPN		;GOT IT
	PUSHJ	P,P$FLD##	;ELSE GO FOR A NAME
	JUMPT	PRSNAM		;GOT IT
	PUSHJ	P,P$QSTR##	;PERHAPS A QUOTED STRING?
	JUMPT	PRSQST		;YES
	$RETF			;GIVE UP
; PARSE A PPN
PRSPPN:	SETZM	UW$WST(P1)	;SET WILDCARD SEARCH TYPE TO PPN
	LOAD	S1,ARG.HD(S2),AR.LEN ;GET RETURNED LENGTH
	DMOVE	T1,ARG.DA(S2)	;GET PPN AND POSSIBLE MASK
	CAIE	S1,3		;WAS A MASK RETURNED?
	MOVNI	T2,1		;NO--DEFAULT TO NON-WILD
	ORCM	T1,T2		;MAKE SURE WILD FIELDS GET CAUGHT BELOW
	MOVEM	T1,UW$PPN(P1)	;SAVE PPN
	MOVEM	T2,UW$PPM(P1)	;SAVE MASK
	PJRST	PPNACK##	;GENERATE ACK TEXT AND RETURN
; PARSE A NAME
PRSNAM:	MOVE	T1,[POINT 8,1(S1)] ;POINT AT USERNAME
	MOVEI	T3,UW$NAM(P1)	;NAME FOR WILDCARDING
	HRLI	T3,(POINT 8,)	;8-BIT ASCIZ
	PUSH	P,[EXP 0]	;INIT WILD FLAG
	MOVEI	T2,1		;INIT OTHER WILD FLAG

PRSNA1:	ILDB	S2,T1		;GET A BYTE
	IDPB	S2,T3		;STORE IN NAME FOR WILDCARDING
	CAIE	S2,"*"		;IS IT A WILDCARD?
	CAIN	S2,"?"		;OR A DIFFERENT WILDCARD?
	ADDM	T2,(P)		;MAYBE FLAG THE FACT
	CAIN	S2,.CHCNV	;IS THIS THE QUOTE CHARACTER?
	TDZA	T2,T2		;YES, NEXT CHARACTER CAN'T LIGHT THE WILD FLAG
	MOVEI	T2,1		;NO, NEXT CHARACTER GETS CHECKED NORMALLY
	JUMPN	S2,PRSNA1	;LOOP
	POP	P,S1		;GET FLAG BACK
	MOVEI	S2,1		;ASSUME WILDCARDED NAME
	SKIPN	S1		;TEST
	MOVEI	S2,2		;NON-WILDCARDED NAME
	MOVEM	S2,UW$WST(P1)	;SAVE WILDCARD SEARCH TYPE
	PJRST	NAMACK##	;GENERATE ACK TEXT AND RETURN
; PARSE A QUOTED NAME
PRSQST:	MOVE	T1,[POINT 8,1(S1)] ;POINT AT USERNAME
	MOVEI	T2,UW$NAM(P1)	;NAME FOR WILDCARDING
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ

PRSQS1:	ILDB	S2,T1		;GET A BYTE
	IDPB	S2,T2		;STORE IN NAME FOR WILDCARDING
	JUMPN	S2,PRSQS1	;LOOP
	MOVEI	S1,2		;GET CODE
	MOVEM	S1,UW$WST(P1)	;SET WILDCARD SEARCH TYPE TO NON-WILD NAME
	PJRST	NAMACK##	;GENERATE ACK TEXT AND RETURN


	LIT

	PRGEND
TITLE	ACTACK - ACK TEXT GENERATOR

	SEARCH	ACTPRM
	MODULE	(ACTACK)

	ENTRY	A$WACK,	NAMACK,	PPNACK


; GENERATE ACK TEXT BASED ON WILDCARD BLOCK
; CALL:	MOVE	T1, WILDCARD BLOCK ADDRESS
;	MOVE	T2, BYTE POINTER TO USER-ID ACK BLOCK
;	PUSHJ	P,A$GACK

A$WACK::PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	DMOVE	P1,T1		;COPY WILDCARD BLOCK, BYTE POINTER
	SKIPN	UW$WST(P1)	;SKIP IF SEARCHING BY NAME
	JRST	PPNACK		;IT'S PPN

NAMACK::MOVEI	T2,UW$NAM(P1)	;POINT TO NAME
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ

NAMAC1:	ILDB	T1,T2		;GET A BYTE
	IDPB	T1,P2		;PUT A BYTE
	JUMPN	T1,NAMAC1	;LOOP BACK
	POPJ	P,		;AND RETURN

PPNACK::MOVEI	T1,"["		;GET A BRACKET
	IDPB	T1,P2		;STORE
	HLLZ	T1,UW$PPN(P1)	;GET PROJECT NUMBER
	HLR	T1,UW$PPM(P1)	;AND MASK
	PUSHJ	P,PPNAC1	;TYPE MASKED OCTAL HALF WORD
	MOVEI	T1,","		;GET A COMMA
	IDPB	T1,P2		;STORE
	HRLZ	T1,UW$PPN(P1)	;GET PROGRAMMER NUMBER
	HRR	T1,UW$PPM(P1)	;AND MASK
	PUSHJ	P,PPNAC1	;TYPE MASKED OCTAL HALF WORD
	MOVEI	T1,"]"		;GET A BRACKET
	IDPB	T1,P2		;STORE
	MOVEI	T1,0		;GET A NUL
	IDPB	T1,P2		;TERMINATE STRING
	POPJ	P,		;AND RETURN

PPNAC1:	TRCN	T1,-1		;MAKE MASK BIT 0 IF NOT WILD
	JRST	PPNAC5		;TYPE * IF ALL WILD
	HLRZ	T2,T1		;GET LH
	CAIN	T2,-2		;FUNNY NUMBER?
	JRST	PPNAC6		;YES
	CAIN	T2,-1		;DEFAULT NUMBER?
	JRST	PPNAC7		;YES
	MOVE	T2,T1		;MOVE TO CONVENIENT PLACE
	MOVEI	T3,6		;SET LOOP COUNT

PPNAC2:	MOVEI	T1,0		;CLEAR ACCUMULATOR
	LSHC	T1,3		;POSITION FIRST DIGIT
	JUMPN	T1,PPNAC4	;GO IF NON-ZERO
	SOJG	T3,PPNAC2	;LOOP UNTIL ALL DONE

PPNAC3:	MOVEI	T1,0		;CLEAR ACCUMULATOR
	LSHC	T1,3		;GET NEXT DIGIT

PPNAC4:	ADDI	T1,"0"		;CONVERT TO ASCII
	TLNE	T2,7		;CHECK MASK
	MOVEI	T1,"?"		;CHANGE TO ? IF WILD
	IDPB	T1,P2		;STORE CHARACTER
	SOJG	T3,PPNAC3	;LOOP UNTIL DONE
	POPJ	P,		;RETURN

PPNAC5:	MOVEI	T1,"*"		;GET AN ASTERISK
	IDPB	T1,P2		;STORE CHARACTER
	POPJ	P,		;RETURN

PPNAC6:	SKIPA	T1,["#"]	;FUNNY CHARACTER
PPNAC7:	MOVEI	T1,"%"		;DEFAULT CHARACTER
	IDPB	T1,P2		;STORE CHARACTER
	POPJ	P,		;RETURN
	LIT

	PRGEND
TITLE	ACTQUE - QUEUE UP A REQUEST FOR A PROFILE

	SEARCH	ACTPRM
	MODULE	(ACTQUE)

	ENTRY	A$QWLD

; QUEUE A REQUEST FOR A POSSIBLY WILDCARDED USER-ID TO [SYSTEM]ACCOUNTING
; CALL:	MOVE	T1, WILDCARD BLOCK ADDRESS
;	MOVE	T2, RESPONSE BLOCK ADDRESS
;	MOVE	T3, DEBUGGING PID ADDRESS,,MAXIMUM NUMBER OF SECONDS TO WAIT
;	MOVE	T4, PRIV-ENABLE FLAG (FALSE-OFF, TRUE-ON)
;	PUSHJ	P,A$QWLD
;
; TRUE RETURN:	FIRST/NEXT PROFILE RETURNED IN SPECIFIED BLOCK
; FLASE RETURN:	PROFILE NOT FOUND, S1 CONTAINS THE QUEUE. UUO ERROR CODE

	ND	.QUPID,.QUTIM+1	;IN CASE NOT YET IN UUOSYM

A$QWLD::PUSHJ	P,.SAVE1	;SAVE P1
	SKIPN	DEBUGW		;ARE WE DEBUGGING IN GALACTIC STYLE?
	ANDI	T3,-1		;NO, IGNORE THE PID ADDRESS
	MOVEI	P1,QUEBLK	;POINT TO ARG BLOCK
	MOVE	S1,[QF.RSP+.QUMAE] ;WANT RESPONSE BLOCK + ACCOUNTING FUNCTION
	MOVEM	S1,.QUFNC(P1)	;SAVE
	SETZM	.QUNOD(P1)	;CENTRAL STATION
	MOVE	S1,T2		;GET RESPONSE BLOCK ADDRESS
	HRLI	S1,.AEMAX	;LENGTH OF A USER PROFILE
	MOVEM	S1,.QURSP(P1)	;SAVE
	HRLI	P1,.QUARG	;LENGTH OF BLOCK SO FAR
	JUMPE	T3,QWLD1	;SKIP THIS STUFF IF NO TIME LIMIT
	MOVE	S1,[%CNDAE]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET MONITOR VERSION
	  SETZ	S1,		;ANCIENT MONITOR
	HRRZS	S1		;STRIP OFF THE SIXBIT STUFF
	CAIGE	S1,703		;CAN QUEUE. UUO TIMEOUT?
	JRST	QWLD1		;NO
	HRRZM	T3,.QUTIM(P1)	;SAVE
	ADD	P1,[1,,0]	;UPDATE THE HEADER LENGTH
	TLNN	T3,-1		;DO SOME MORE?
	JRST	QWLD1		;NO, SKIP .QUPID
	HLRZ	S1,T3		;YES, GET PID ADDRESS
	MOVE	S1,(S1)		;FETCH VALUE
	JUMPE	S1,QWLD1	;IGNORE THIS IF WANT DEFAULT PID AFTER ALL
	MOVEM	S1,.QUPID(P1)	;SET FOR QUEUE. UUO
	ADD	P1,[1,,0]	;ANOTHER HEADER WORD

QWLD1:	HLRZ	S1,P1		;GET WORD COUNT SO FAR
	CAIE	S1,.QUARG	;IF NOT THE DEFAULT,
	DPB	S1,[POINTR .QUFNC(P1),QF.HLN] ;STORE HEADER LENGTH
	ADD	P1,S1		;POINT AT FIRST FREE WORD
	DMOVE	S1,[EXP <QA.IMM!1B17!.QBAFN>,UGWLD$] ;ACCOUNTING SUB-FUNCTION
	SKIPE	T4		;WANT PRIVS?
	TXO	S2,AF.PRV	;YES, REQUEST THEM
	DMOVEM	S1,(P1)		;SAVE
	ADD	P1,[2,,2]	;ADVANCE POINTER
	HLRZ	S1,UW$TYP(T1)	;GET LENGTH OF MESSAGE
	SKIPN	S1		;IS IT SET UP?
	MOVEI	S1,UW$MIN	;NO--DEFAULT TO MINIMUM LENGTH
	CAIN	S1,UW$MIN	;ANY SELECTION DATA?
	SETZM	UW$SEL(T1)	;NO--CLEAR OUT BLOCK COUNT
	HRLZS	S1		;PUT LENGTH IN LH
	HRRI	S1,.QBAET	;INCLUDE BLOCK TYPE
	MOVE	S2,T1		;POINT TO WILDCARD BLOCK
	DMOVEM	S1,(P1)		;SAVE
	ADD	P1,[2,,2]	;ADVANCE POINTER
	HLRZ	S1,P1		;GET LENGTH OF BLOCK
	SUBB	P1,S1		;SET UP UUO AC
	QUEUE.	S1,		;SEND REQUEST TO ACCOUNTING DAEMON
	  $RETF			;NO SUCH USER

QWLD2:	MOVE	S1,.AEPPN(T2)	;GET RESULT
	MOVEM	S1,UW$BRE(T1)	;SAVE
	MOVSI	S1,.AENAM(T2)	;POINT TO NAME
	HRRI	S1,UW$BRE(T1)	;AND DESTINATION
	SKIPE	UW$WST(T1)	;SKIP IF WILDCARDING BY PPN
	BLT	S1,UW$ERE(T1)	;COPY FOR NEXT CALL
	AOS	UW$FND(T1)	;COUNT THE PROFILE RETURNED
	$RETT			;YES


	LIT

	RELOC	0

QUEBLK:	BLOCK	11		;QUEUE. UUO ARGUMENT BLOCK

	PRGEND
TITLE	ACTRMS - RMS-10 INTERFACE TO ACTDAE

	SEARCH	RMSINT,ACTPRM
	MODULE	(ACTRMS)

	ENTRY	INITIO


; SYMBOLS UNIQUE TO RMS THAT CALLERS MAY CARE ABOUT.  SAVES THEM HAVING
; TO USE RMSINT
	INTERN	ER$RNF,ER$DUP,SU$DUP,ER$CHG,ER$COF,ER$EOF,ER$FNF,ER$PRV
	INTERN	ER$RSZ,ER$RTB

; SPECIAL AC DEFINITIONS
	F==13			;CURRENT FAB
	R==14			;CURRENT RAB
SUBTTL	RMS-10 DATA STRUCTURES


; PROTOTYPE FAB
FAB:	FAB$B			;INITIALIZE A FAB
	  F$BSZ	^D9		  ;FILE BYTE SIZE
	  F$BKS	^D5		  ;BUCKET SIZE FOR FILE
	  F$FOP	FB$CIF		  ;CREATE IF NOT FOUND
	  F$MRS <<<<<.AEMAX>*4>>>> ;MAX RECORD (PROFILE) SIZE
	  F$ORG	FB$IDX		  ;INDEXED MODE
	  F$RFM	FB$VAR		  ;VARIABLE LENGTH RECORDS
	  F$SHR FB$NIL		  ;NO SHARING
	FAB$E			;END OF FAB


; PROTOTYPE RAB
RAB:	RAB$B			;INITIALIZE THE RAB
	  R$KRF	0		  ;DEFAULT KEY OF REF IS PRI INDEX
	  R$MBF	^D8		  ;ALLOW SOME REASONABLE # OF BUFFERS
	  R$PAD	0		  ;PAD CHAR
	RAB$E			;END OF RAB


; PROTOTYPE XAB FOR AREA 1 (PPN)
XABA1:	XAB$B ALL		;ALLOCATION
	  X$AID 1 		  ;PPN INDEX
	  X$BKZ 1 		  ;BUCKET SIZE
	  XAB$E			;END OF XAB


; PROTOTYPE XAB FOR AREA 2 (NAME SECONDARY DATA BUCKETS)
XABA2:	XAB$B ALL		;ALLOCATION
	  X$AID	2		  ;NAME SIDRS
	  X$BKZ	1		  ;BUCKET SIZE
	XAB$E			;END OF XAB


; PROTOTYPE XAB FOR AREA 3 (NAME INDEX)
XABA3:	XAB$B ALL		;ALLOCATION
	  X$AID	3		  ;NAME INDEX
	  X$BKZ	1		  ;BUCKET SIZE
	XAB$E			;END OF XAB


; PROTOTYPE XAB FOR KEY 0
XABK0:	XAB$B KEY		;KEY
	  X$REF	0		  ;THIS IS THE PRIMARY KEY
	  X$DTP	XB$EBC		  ;EBCDIC (9 BIT BYTES)
	  X$DAN	0		  ;IT LIVES IN THIS DATA AREA
	  X$DFL	1		  ;FILL 1/2 FULL
	  X$IAN	1		  ;IT LIVES IN THIS INDEX AREA
	  X$IFL	1		  ;FILL 1/2 FULL
	  X$POS <<<<<.AEPPN>*4>>>> ;OFFSET TO PPN
	  X$SIZ	^D4		  ;SIZE OF PPN (BYTES)
	XAB$E			;END OF XAB


; PROTOTYPE XAB FOR KEY 1
XABK1:	XAB$B KEY		;KEY
	  X$REF	1		  ;THIS IS THE SECOND KEY
	  X$DTP	XB$EBC		  ;EBCDIC (9 BIT BYTES)
	  X$DAN	2		  ;IT LIVES IN THIS DATA AREA
	  X$DFL	1		  ;FILL 1/2 FULL
	  X$IAN	3		  ;IT LIVES IN THIS INDEX AREA
	  X$IFL	1		  ;FILL 1/2 FULL
	  X$POS <<<<.AENAM*4>>>>  ;OFFSET TO NAME
	  X$SIZ	.AANLC		  ;SIZE OF NAME (BYTES)
	  X$FLG	XB$CHG		  ;VALUE OF KEY MAY CHANGE
	XAB$E			;END OF XAB
SUBTTL	RMS-10 INTERFACE INITIALIZATION


; INITIALIZE RMS-10 INTERFACE
; CALL:	PUSHJ	P,INITIO

INITIO::SETOM	SAVFLG		;INIT AC SAVE ROUTINES
	PUSHJ	P,ENTX		;SWITCH CONTEXTS
	JRST	.POPJ1		;RETURN FOR NOW
SUBTTL	OPEN A FILE


; CALL:	MOVE	AC1, ADDRESS OF ASCIZ FILESPEC
;	MOVE	AC2, READ/WRITE FLAG (0 = READ, 1 = WRITE)
;	PUSHJ	P,OPNA/OPNB/OPNC

OPNA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	XMOVEI	T1,A.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,A.ZEND	;POINT TO END OF STORAGE
	XMOVEI	T3,A.WXA1	;WORKING XAB FOR AREA 1
	MOVEM	T3,X.WXA1	;SAVE
	XMOVEI	T3,A.WXA2	;WORKING XAB FOR AREA 2
	MOVEM	T3,X.WXA2	;SAVE
	XMOVEI	T3,A.WXA3	;WORKING XAB FOR AREA 3
	MOVEM	T3,X.WXA3	;SAVE
	XMOVEI	T3,A.WXK0	;WORKING XAB FOR KEY 0
	MOVEM	T3,X.WXK0	;SAVE
	XMOVEI	T3,A.WXK1	;WORKING XAB FOR KEY 1
	MOVEM	T3,X.WXK1	;SAVE
	PUSHJ	P,OPNCOM	;OPEN THE FILE
	  POPJ	P,		;FAILED
	PUSHJ	P,CLSCOM	;NOW CLOSE THE FILE
	  POPJ	P,		;SHOULDN'T FAIL
	PUSHJ	P,OPNFIX	;FIX UP FILE PROTECTION AND STATUS WORD
	XMOVEI	T1,A.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,A.ZEND	;POINT TO END OF STORAGE
	PJRST	OPNCOM		;ENTER COMMON CODE


OPNB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	XMOVEI	T1,B.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,B.ZEND	;POINT TO END OF STORAGE
	XMOVEI	T3,B.WXA1	;WORKING XAB FOR AREA 1
	MOVEM	T3,X.WXA1	;SAVE
	XMOVEI	T3,B.WXA2	;WORKING XAB FOR AREA 2
	MOVEM	T3,X.WXA2	;SAVE
	XMOVEI	T3,B.WXA3	;WORKING XAB FOR AREA 3
	MOVEM	T3,X.WXA3	;SAVE
	XMOVEI	T3,B.WXK0	;WORKING XAB FOR KEY 0
	MOVEM	T3,X.WXK0	;SAVE
	XMOVEI	T3,B.WXK1	;WORKING XAB FOR KEY 1
	MOVEM	T3,X.WXK1	;SAVE
	PUSHJ	P,OPNCOM	;OPEN THE FILE
	  POPJ	P,		;FAILED
	PUSHJ	P,CLSCOM	;NOW CLOSE THE FILE
	  POPJ	P,		;SHOULDN'T FAIL
	PUSHJ	P,OPNFIX	;FIX UP FILE PROTECTION AND STATUS WORD
	XMOVEI	T1,B.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,B.ZEND	;POINT TO END OF STORAGE
	PJRST	OPNCOM		;ENTER COMMON CODE

OPNC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
	XMOVEI	T1,C.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,C.ZEND	;POINT TO END OF STORAGE
	XMOVEI	T3,C.WXA1	;WORKING XAB FOR AREA 1
	MOVEM	T3,X.WXA1	;SAVE
	XMOVEI	T3,C.WXA2	;WORKING XAB FOR AREA 2
	MOVEM	T3,X.WXA2	;SAVE
	XMOVEI	T3,C.WXA3	;WORKING XAB FOR AREA 3
	MOVEM	T3,X.WXA3	;SAVE
	XMOVEI	T3,C.WXK0	;WORKING XAB FOR KEY 0
	MOVEM	T3,X.WXK0	;SAVE
	XMOVEI	T3,C.WXK1	;WORKING XAB FOR KEY 1
	MOVEM	T3,X.WXK1	;SAVE
	PUSHJ	P,OPNCOM	;OPEN THE FILE
	  POPJ	P,		;FAILED
	PUSHJ	P,CLSCOM	;NOW CLOSE THE FILE
	  POPJ	P,		;SHOULDN'T FAIL
	PUSHJ	P,OPNFIX	;FIX UP FILE PROTECTION AND STATUS WORD
	XMOVEI	T1,C.ZBEG	;POINT TO START OF STORAGE
	XMOVEI	T2,C.ZEND	;POINT TO END OF STORAGE
	PJRST	OPNCOM		;ENTER COMMON CODE
; COMMON OPEN CODE
OPNCOM:	PUSHJ	P,OPNINI	;INIT STORAGE, FETCH ARGS, SETUP FAB/RAB
	  POPJ	P,		;FAILED
	$FETCH	T1,FAC,0(F)	;GET THE DESIRED ACCESS MODE
	TXNN	T1,FB$PUT	;DID WE ASK FOR WRITE ACCESS?
	JRST	OPNCO1		;NO, CAN'T DO $CREATE
	$CREATE	0(F)		;OPEN THE FILE.  AS THIS IS THE FIRST
				; RMS CALL, ACS 1 TO 4 MAY HAVE BEEN TRASHED
	JRST	OPNCO2		;CONTINUE

OPNCO1:	$OPEN	0(F)		;READ ONLY, CAN'T DO $CREATE EVEN THOUGH
				; IT'S A CREATE-IF THAT WOULDN'T
OPNCO2:	PUSHJ	P,ERRCKF	;CHECK FOR ERRORS
	  POPJ	P,		;FAILED
	PUSHJ	P,OPNBLK	;INIT FILOP, L/E/R, AND PATH BLOCKS
	$CONNEC	0(R)		;SET UP AN IO STREAM
	PUSHJ	P,ERRCKR	;CHECK FOR ERRORS
	  POPJ	P,		;FAILED
	PUSHJ	P,DOLOA		;SET LOAD MODE IF REQUESTED
	  JFCL			;IGNORE ERRORS
	PUSHJ	P,UPDFIX	;SEE IF PREVIOUS UPDATE NEEDS FIXING UP
	  POPJ	P,		;IT DID AND IT FAILED
	JRST	.POPJ1		;RETURN
; INITIALIZE FILE PROCESSING
; THIS ROUTINE WILL DO THE FOLLOWING:
;	1. ZERO STORAGE FOR THIS FILE
;	2. FETCH OPEN ARGUMENTS
;	3. SET UP FAB
;	4. SET UP RAB
;
; CALL:	MOVE	T1, START ADDRESS OF STORAGE
;	MOVE	T2, ENDING ADDRESS OF STORAGE
;	MOVE	F,  ADDRESS OF THE WORKING FAB
;	MOVE	R,  ADDRESS OF THE WORKING RAB
;	PUSHJ	P,OPNINI

OPNINI:	SETZM	0(T1)		;CLEAR FIRST WORD
	HRLS	T1		;COPY START ADDRESS TO LH
	HRRI	T1,1(T1)	;MAKE A BLT POINTER
	BLT	T1,-1(T2)	;CLEAR STORAGE

; FETCH ARGUMENTS
	MOVE	T1,SAVACS+1	;GET ADDRESS OF ASCIZ FILESPEC
	SKIPN	T2,SAVACS+2	;GET READ/WRITE FLAG
	SKIPA	T2,[FB$GET]	;READ-ONLY
	MOVX	T2,FB$PUT!FB$GET!FB$DEL!FB$UPD ;WRITE

; SET UP FAB
	MOVSI	T3,FAB		;POINT TO PROTOTYPE FAB
	HRRI	T3,(F)		;MAKE A BLT POINTER TO WORKING FAB
	BLT	T3,FA$LNG-1(F)	;COPY INTO FAB
	$STORE	T1,FNA,0(F)	;SET THE FILE NAME ADDRESS
	$STORE	T2,FAC,0(F)	;SET THE DESIRED ACCESS MODE

; SET UP RAB
	MOVSI	T4,RAB		;POINT TO PROTOTYPE RAB
	HRRI	T4,(R)		;MAKE A BLT POINTER TO WORKING RAB
	BLT	T4,RA$LNG-1(R)	;COPY INTO RAB
	$STORE	F,FAB,0(R)	;STORE THE FAB ADDRESS IN THE RAB

; XAB FOR AREA 1
	SETZ	T1,		;NO PREVIOUS XAB
	XMOVEI	T2,XABA1	;XAB ADDRESS
	MOVE	T3,X.WXA1	;WORKING STORAGE
	PUSHJ	P,OPNXAL	;SETUP

; XAB FOR AREA 2
	XMOVEI	T2,XABA2	;XAB ADDRESS
	MOVE	T3,X.WXA2	;WORKING STORAGE
	PUSHJ	P,OPNXAL	;SETUP

; XAB FOR AREA 3
	XMOVEI	T2,XABA3	;XAB ADDRESS
	MOVE	T3,X.WXA3	;WORKING STORAGE
	PUSHJ	P,OPNXAL	;SETUP

; XAB FOR KEY 0
	XMOVEI	T2,XABK0	;XAB ADDRESS
	MOVE	T3,X.WXK0	;WORKING STORAGE
	PUSHJ	P,OPNXKY	;SETUP

; XAB FOR KEY 1
	XMOVEI	T2,XABK1	;XAB ADDRESS
	MOVE	T3,X.WXK1	;WORKING STORAGE
	PUSHJ	P,OPNXKY	;SETUP

	JRST	.POPJ1		;RETURN
; INITIALIZE XAB FOR ALLOCATION
; CALL:	MOVE	T1, PREVIOUS XAB
;	MOVE	T2, PROTOTYPE XAB
;	MOVE	T3, WORKING XAB
;	MOVE	F, FAB
;	MOVE	R, RAB
;	PUSHJ	P,OPNXAL

OPNXAL:	SKIPN	T1		;SKIP IF A PREVIOUS XAB
	$STORE	T3,XAB,(F)	;LINK CURRENT XAB TO FAB
	SKIPE	T1		;SKIP IF NO PREVIOUS XAB
	$STORE	T3,NXT,(T1)	;LINK CURRENT XAB TO PREVIOUS XAB
	MOVSI	T4,(T2)		;POINT TO PROTOTYPE
	HRRI	T4,(T3)		;MAKE A BLT POINTER
	BLT	T4,XA$SXA-1(T3)	;COPY
	MOVE	T1,T3		;CURRENT XAB IS NOW THE PREVIOUS XAB
	POPJ	P,		;RETURN


; INITIALIZE XAB FOR ALLOCATION
; CALL:	MOVE	T1, PREVIOUS XAB
;	MOVE	T2, PROTOTYPE XAB
;	MOVE	T3, WORKING XAB
;	MOVE	F, FAB
;	MOVE	R, RAB
;	PUSHJ	P,OPNXKY

OPNXKY:	$STORE	T3,NXT,(T1)	;LINK CURRENT XAB TO PREVIOUS XAB
	MOVSI	T4,(T2)		;POINT TO PROTOTYPE
	HRRI	T4,(T3)		;MAKE A BLT POINTER
	BLT	T4,XA$SXK-1(T3)	;COPY
	MOVE	T1,T3		;CURRENT XAB IS NOW THE PREVIOUS XAB
	POPJ	P,		;RETURN
; INITIALIZE FILOP, LOOKUP/ENTER/RENAME, AND PATH BLOCKS
; MUST BE CALLED AFTER A SUCCESSFUL $CREATE OR $OPEN

OPNBLK:	MOVE	T1,[FFZBEG,,FFZBEG+1] ;SET UP BLT	
	SETZM	FFZBEG		;CLEAR FIRST WORD
	BLT	T1,FFZEND-1	;CLEAR STORAGE

; NOW GET FILESPEC ON OPENED CHANNEL
OPNBL1:	MOVE	T1,[2,,T2]	;SET UP UUO AC
	$FETCH	T2,JFN,0(F)	;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
	HRLZS	T2		;PUT IN LH
	HRRI	T2,.FOFIL	;FILOP. UUO FUNCTION CODE
	MOVE	T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
	FILOP.	T1,		;READ FILESPEC
	  POPJ	P,		;RETURN

; LOAD FILOP BLOCK
OPNBL2:	MOVEI	T1,FFFOP	;POINT TO BLOCK
	MOVE	T2,[FO.PRV!FO.ASC+.FORED] ;PRIV'ED, ASSIGN CHANNEL, READ
	MOVEM	T2,.FOFNC(T1)
	MOVE	T2,[UU.PHS+.IODMP] ;PHYSICAL DUMP MODE I/O
	MOVEM	T2,.FOIOS(T1)
	MOVE	T2,FFFIL+.FOFDV ;DEVICE NAME
	MOVEM	T2,.FODEV(T1)
	MOVEI	T2,FFLKP	;LOOKUP/ENTER/RENAME BLOCK
	MOVEM	T2,.FOLEB(T1)

; LOAD LOOKUP/ENTER/BLOCK
OPNBL3:	MOVEI	T1,FFLKP	;POINT TO BLOCK
	MOVEI	T2,.RBMAX	;LENGTH
	MOVEM	T2,.RBCNT(T1)
	MOVEI	T2,FFPTH	;PATH BLOCK
	MOVEM	T2,.RBPPN(T1)
	MOVE	T2,FFFIL+.FOFFN	;FILE NAME
	MOVEM	T2,.RBNAM(T1)
	MOVE	T2,FFFIL+.FOFEX	;EXTENSION
	MOVEM	T2,.RBEXT(T1)

; LOAD PATH BLOCK
OPNBL4:	MOVE	T1,[-<.PTMAX-.PTPPN>,,FFPTH+.PTPPN] ;POINT TO BLOCK
	MOVEI	T2,FFFIL+.FOFPP	;POINT TO RETURNED FILESPEC

OPNBL5:	MOVE	T3,(T2)		;GET A WORD
	MOVEM	T3,(T1)		;PUT A WORD
	AOS	T2		;ADVANCE POINTER
	AOBJN	T1,OPNBL5	;LOOP
	SETOM	FFFLG		;INDICATE GOODNESS
	POPJ	P,		;RETURN
; FIX UP THE FILE PROTECTION AND STATUS WORD
; MUST BE CALLED AFTER OPNBLK/CLOSE SEQUENCE

OPNFIX:	$FETCH	T1,FAC,0(F)	;GET THE DESIRED ACCESS MODE
	TXNE	T1,FB$PUT	;DID WE ASK FOR WRITE ACCESS?
	SKIPN	FFFLG		;YES--WAS CALL TO OPNBLK SUCCESSFUL?
	POPJ	P,		;NOPE
	MOVE	T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
	FILOP.	T1,		;LOOKUP THE FILE
	  POPJ	P,		;SHOULDN'T FAIL
	MOVE	T1,FFFOP+.FOFNC	;GET FUNCTION WORD
	TDZ	T1,[-1-FO.CHN]	;KEEP ONLY THE CHANNEL
	TDO	T1,[FO.PRV+FO.UOC+.FORNM] ;USE ALREADY OPENED CHANNEL FOR RENAME
	MOVEM	T1,FFFOP+.FOFNC	;UPDATE FUNCTION WORD
	MOVEI	T1,FFREN	;POINT TO RENAME BLOCK
	HRLM	T1,FFFOP+.FOLEB
	MOVE	T1,[FFLKP,,FFREN] ;SET UP BLT
	BLT	T1,FFREN+.RBMAX-1 ;COPY
	MOVE	T1,[%LDSSP]	;ASK MONITOR FOR SYS:*.SYS CODE
	GETTAB	T1,		;SO
	  MOVSI	T1,(157B8)	;DEFAULT
	LSH	T1,-33		;POSITION
	DPB	T1,[POINTR (FFREN+.RBPRV,RB.PRV)] ;STORE
	MOVEI	T1,RP.ABU	;CAUSE FILE TO ALWAYS BE BACKED UP
	IORM	T1,FFREN+.RBSTS	; TO TAPE REGARDLESS OF ACCESS DATE
	MOVE	T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
	FILOP.	T1,		;RENAME THE FILE
	  JFCL			;IGNORE ERRORS HERE
	MOVE	T1,[1,,T2]	;SET UP UUO AC
	MOVE	T2,FFFOP+.FOFNC ;GET FUNCTION WORD
	TDZ	T2,[-1-FO.CHN]	;KEEP ONLY THE CHANNEL
	HRRI	T2,.FOREL	;NEW FUNCTION
	FILOP.	T1,		;RELEASE THE CHANNEL
	  JFCL			;???
	POPJ	P,		;DONE
SUBTTL	CLOSE A FILE


; CLOSE FILE "A"
CLSA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	CLSCOM		;ENTER COMMON CODE


; CLOSE FILE "B"
CLSB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	CLSCOM		;ENTER COMMON CODE


; CLOSE FILE "C"
CLSC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	CLSCOM		;ENTER COMMON CODE


; COMMON CLOSE CODE
CLSCOM:	$CLOSE	0(F)		;CLOSE THE FILE
	PUSHJ	P,ERRCKF	;CHECK UP ON IT
	  POPJ	P,		;FAILED
	JRST	.POPJ1		;RETURN GOODNESS
SUBTTL	ERASE (DELETE) A FILE


; ERASE FILE "A"
ERSA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	ERSCOM		;ENTER COMMON CODE


; ERASE FILE "B"
ERSB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	ERSCOM		;ENTER COMMON CODE


; ERASE FILE "C"
ERSC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	ERSCOM		;ENTER COMMON CODE


; COMMON ERASE CODE
ERSCOM:	$ERASE	0(F)		;DELETE THE FILE
	PUSHJ	P,ERRCKF	;CHECK UP ON IT
	  POPJ	P,		;FAILED
	JRST	.POPJ1		;RETURN GOODNESS
SUBTTL	DELETE A RECORD


; CALL:	MOVE	AC1, FLAG (0 = PPN, -1 = NAME)
;	MOVE	AC2, PPN OR ADDRESS OF NAME
;	PUSHJ	P,DELA/DELB/DELC

DELA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	DELCOM		;ENTER COMMON CODE

DELB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	DELCOM		;ENTER COMMON CODE

DELC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	DELCOM		;ENTER COMMON CODE

; COMMON DELETE CODE
DELCOM:	SKIPE	ACTLCK		;LOCKED OUT?
	POPJ	P,		;YES--GO AWAY
	DMOVE	T1,ARGS		;GET CALLER'S ARGUMENTS
	JUMPGE	T1,DELCO1	;JUMP IF BY PPN
	MOVE	T2,T2		;COPY ADDRESS OF NAME
	HRLI	T2,(POINT 8,0)	;MAKE A SOURCE POINTER
	MOVE	T3,[POINT 9,TMPNAM] ;POINT TO A SCRATCH BUFFER
	PUSHJ	P,CVTNM1	;COPY THE STRING
	MOVEI	T1,1		;SECONDARY KEY
	MOVEI	T2,.AANLC	;EXACT MATCH
	JRST	DELCO2		;READY TO FIND

DELCO1:	MOVEM	T2,TMPNAM	;SAVE PPN AS SEARCH STRING
	MOVX	T1,0		;PRIMARY KEY
	MOVX	T2,^D4		;BYTES IN A PPN

DELCO2:	PUSHJ	P,SETFND	;SET UP FIND
	$FIND	0(R)		;NOW POSITION TO THAT RECORD
	PUSHJ	P,ERRCKR	;SEE IF WE FOUND IT
	  POPJ	P,		;FAILED
	$DELETE	0(R)		;TOSS THE RECORD
	PUSHJ	P,ERRCKR	;SEE IF WE DELETED IT
	  POPJ	P,		;FAILED
;	JRST	.POPJ1		;RETURN
	$FLUSH	0(R)		;*** FORCE BUFFERS OUT
	PUSHJ	P,ERRCKR	;*** CHECK FOR ERRORS
	  POPJ	P,		;*** FAILED
	JRST	.POPJ1		;RETURN
SUBTTL	GET A RECORD FROM A FILE


; HERE TO SET UP THE RMS CALL FOR A POSSIBLY WILDCARDED SEARCH
; CALL:	MOVE	AC1, ADDRESS OF BUFFER
;	MOVE	AC2, ADDRESS OF WILDCARD MESSAGE BLOCK
;	PUSHJ	P,GETA/GETB/GETC

GETA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	GETCOM		;ENTER COMMON CODE

GETB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	GETCOM		;ENTER COMMON CODE

GETC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	GETCOM		;ENTER COMMON CODE

GETCOM:	MOVE	P1,ARGS+1	;COPY WILDCARD MESSAGE BLOCK ADDRESS
	SETOM	WLDNXT		;INIT NEXT PROFILE FLAG
	PUSHJ	P,FIXNAM	;FIX UP POSSIBLY WILD NAME

GETCO1:	MOVEI	T1,.AEMAX	;GET MAXIMUM LENGTH OF PROFILE
	$STORE	T1,USZ,0(R)	;STORE SIZE IN RAB
	MOVE	T1,ARGS		;GET BUFFER ADDRESS
	$STORE	T1,UBF,0(R)	;STORE ADDRESS IN RAB
	PUSHJ	P,SRHSET	;SET UP SEARCH
	  POPJ	P,		;RETURN IF DONE
	PUSHJ	P,SETFND	;SET UP FIND
	$FETCH	T1,ROP,0(R)	;FETCH THE CURRENT OPTIONS
	SKIPN	WLDNXT		;FETCH NEXT PROFILE?
	TXO	T1,RB$KGT	;YES
	$STORE	T1,ROP,0(R)	;SAVE FLAGS AND BYTE COUNT
	$GET	0(R)		;READ SPECIFIED RECORD
	PUSHJ	P,ERRCKR	;SEE IF WE FOUND IT
	  JRST	GETCO3		;FAILED
	MOVE	T1,ARGS		;FETCH BUFFER ADDRESS
	PUSHJ	P,NAME8		;CONVERT 9-BIT NAME TO 8-BIT
	PUSHJ	P,MATCH		;COMPARE PPNS/NAMES
	  JRST	GETCO2		;NO MATCH
	PUSHJ	P,SELANL	;PERFORM SELECTION ANALYSIS
	  JRST	GETCO1		;FAILED, CHECK NEXT
	JRST	.POPJ1		;RETURN

GETCO2:	JUMPE	T1,.POPJ	;JUMP IF RETURN CODE SAYS "NO MORE"
	JRST	GETCO1		;GO TRY AGAIN

GETCO3:	MOVE	T1,UW$WST(P1)	;GET WILDCARD SEARCH TYPE
	CAIN	T1,1		;MUST BE A WILD NAME
	AOSE	WLDNXT		;MAYBE FETCH NEXT PROFILE
	POPJ	P,		;NO--GIVE UP
	JRST	GETCO1		;LOOP BACK
; FIX UP PREVIOUS NAME FOR WILD NAME SEARCHES
FIXNAM:	SKIPN	UW$WST(P1)	;SEARCHING BY PPNS?
	POPJ	P,		;NOTHING TO DO
	MOVE	T1,[BASNAM,,BASNAM+1] ;SET UP BLT
	SETZM	BASNAM		;CLEAR FIRST WORD
	BLT	T1,BASNAM+11	;NO--CLEAR BASE NAME STORAGE
	MOVEI	T2,UW$NAM(P1)	;POINT TO TARGET NAME
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ
	SKIPE	UW$BRE(P1)	;A PREVIOUS RESULT?
	SKIPA	T3,T2		;YES--JUST CONVERT TARGET NAME
	MOVE	T3,[POINT 8,BASNAM] ;POINT TO BASE NAME STORAGE
	MOVE	T4,UW$WST(P1)	;GET WILDCARD SEARCH TYPE
	SUBI	T4,1		;MAKE WILD NAME CODE = 0

FIXNA1:	ILDB	T1,T2		;GET A BYTE
	SKIPE	UW$BRE(P1)	;A PREVIOUS RESULT?
	JRST	FIXNA2		;YES--JUST DO CASE CONVERSION
	CAIN	T1,.CHCNV	;MAGIC QUOTE CHARACTER?
	JRST	FIXNA4		;YES, DO QUOTING
	JUMPN	T4,FIXNA2	;JUMP IF NON-WILD NAME
	CAIE	T1,"*"		;IS IT A WILDCARD?
	CAIN	T1,"?"		;OR A DIFFERENT WILDCARD?
	JRST	FIXNA3		;YES--ALMOST DONE

FIXNA2:	PUSHJ	P,CVTCAS	;DO CASE CONVERSION
	IDPB	T1,T3		;STORE IN BASE FOR WILDCARDING
	JUMPN	T1,FIXNA1	;LOOP

FIXNA3:	SKIPE	UW$BRE(P1)	;A PREVIOUS RESULT?
	POPJ	P,		;YES--ALL DONE
	MOVEI	T2,UW$NAM(P1)	;POINT TO TARGET NAME
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ
	MOVE	T3,T2		;SOURCE AND DESTINATION ARE SAME
	PJRST	CVTNM1		;CONVERT TO UPPER CASE

FIXNA4:	ILDB	T1,T2		;GET QUOTED CHARACTER
	JRST	FIXNA2		;COPY IT WITH NO WILDCARD CHECKING
; SEARCH SET UP
; CALL:	PUSHJ	P,SRHSET
;
; ON RETURN, T1 HAS KEY NUMBER AND T2 LENGTH OF KEY IN BYTES

SRHSET:	MOVE	T1,UW$SEL(P1)	;GET COUNT OF SELECTION BLOCKS
	MOVEM	T1,SELBLK	;SAVE
	SKIPN	UW$WST(P1)	;SKIP IF SEARCHING BY NAME
	JRST	SRHSE2		;GO SEARCH BY PPN

; SEARCH BY NAME
SRHSE1:	MOVEI	T2,UW$BRE(P1)	;POINT TO PREVIOUS RESULT
	MOVE	T3,UW$WST(P1)	;GET WILDCARD SEARCH TYPE
	SKIPE	(T2)		;BEEN HERE BEFORE?
	SOJG	T3,SRHSE3	;YES
	SKIPN	(T2)		;BEEN HERE BEFORE?
	MOVEI	T2,BASNAM	;FIRST TIME--POINT TO BASE NAME
	HRLI	T2,(POINT 8,0)	;MAKE A SOURCE POINTER
	MOVE	T3,[POINT 9,TMPNAM] ;POINT TO A SCRATCH BUFFER
	PUSHJ	P,CVTNM1	;COPY THE STRING
	MOVE	T1,UW$WST(P1)	;GET SEARCH TYPE
	CAIE	T1,2		;NON-WILD NAME?
	SKIPN	UW$BRE(P1)	;A PREVIOUS RESULT?
	SKIPA			;DON'T ASK FOR NEXT PROFILE
	SETZM	WLDNXT		;YES--ASK FOR NEXT PROFILE
	MOVEI	T1,1		;SECONDARY KEY
	MOVEI	T2,.AANLC	;EXACT MATCH
	JRST	.POPJ1		;READY TO FIND

; SEARCH BY PPN
SRHSE2:	MOVE	T1,UW$PPM(P1)	;GET MASK
	SKIPE	UW$BRE(P1)	;A PREVIOUS RESULT?
	AOJE	T1,SRHSE3	;YES
	MOVE	T1,UW$PPN(P1)	;GET PPN
	MOVE	T2,UW$PPM(P1)	;GET MASK
	AND	T1,T2		;MASK DOWN PPN
	SKIPE	T2,UW$BRE(P1)	;A PREVIOUS RESULT?
	MOVE	T1,T2		;YES--USE IT INSTEAD
	MOVEM	T1,TMPNAM	;SAVE PPN AS SEARCH STRING
	MOVE	T1,UW$PPM(P1)	;GET MASK
	CAME	T1,[EXP -1]	;WILD?
	SETZM	WLDNXT		;YES--FETCH NEXT PROFILE
	MOVEI	T1,0		;PRIMARY KEY
	MOVEI	T2,^D4		;BYTES IN A PPN
	JRST	.POPJ1		;READY TO FIND

; HERE IF NO SEARCH WILL BE DONE.  MAKE IT LOOK LIKE A STANDARD
; RMS "RECORD NOT FOUND" ERROR.
SRHSE3:	MOVEI	T1,ER$RNF	;CODE FOR RECORD NOT FOUND
	MOVEI	T2,0		;STATUS
	$STORE	T1,STS,0(R)	;SET STATUS
	$STORE	T2,STV,0(R)	;AND STATUS VALUE
	POPJ	P,		;RETURN
; CHECK FOR A MATCH
MATCH:	SKIPN	T1,UW$WST(P1)	;SKIP IF SEARCHING BY PPN
	PJRST	MATPPN		;COMPARE PPNS
	SOJG	T1,.POPJ1	;RETURN GOODNESS IF NON-WILD NAME
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSHJ	P,MATNAM	;COMPARE NAMES
	  SKIPA			;FAILED
	AOS	-2(P)		;SKIP
	POP	P,P3		;RESTORE P3
	POP	P,P2		;RESTORE P2
	POPJ	P,		;RETURN

; CHECK FOR A PPN MATCH
MATPPN:	MOVE	T2,ARGS		;FETCH BUFFER ADDRESS
	MOVE	T2,.AEPPN(T2)	;AND THE PPN RETURNED
	MOVEM	T2,UW$BRE(P1)	;SAVE
	SETZ	T1,		;SET RETURN CODE TO "NO MORE PROFILES"
	HLRZ	T2,UW$PPN(P1)	;GET PROJECT NUMBER
	JUMPE	T2,MATPP1	;ALL PROJECTS?
	HLRZ	T3,UW$BRE(P1)	;AND THE ONE FROM PROFILE
	CAILE	T3,(T2)		;GONE BEYOND THIS PROJECT NUMBER YET?
	POPJ	P,		;YES--STOP NOW
	HRRZ	T2,UW$PPN(P1)	;GET PROGRAMMER NUMBER
	JUMPE	T2,MATPP1	;ALL PROGRAMMERS?
	HRRZ	T3,UW$BRE(P1)	;AND THE ONE FROM PROFILE
	CAIG	T3,(T2)		;GONE BEYOND PROGRAMMER NUMBER YET?
	JRST	MATPP1		;NO
	MOVE	T3,UW$PPM(P1)	;GET MASK
	AOJE	T3,.POPJ	;RETURN IF NOT WILD
	HLLOS	UW$BRE(P1)	;MAKE IT [PROJECT,777777]
	JRST	MATPP2		;NO MATCH BUT MAYBE MORE TO COME

MATPP1:	MOVE	T2,UW$BRE(P1)	;GET PPN
	AND	T2,UW$PPM(P1)	;MASK
	MOVE	T3,UW$PPN(P1)	;GET REQUESTED PPN
	AND	T3,UW$PPM(P1)	;MASK
	CAMN	T2,T3		;MATCH?
	JRST	.POPJ1		;YES

MATPP2:	MOVNI	T1,1		;MAYBE MORE PROFILES AVAILABLE
	POPJ	P,		;SAY NO MORE
; CHECK FOR A NAME MATCH
MATNAM:	MOVE	T1,ARGS		;FETCH BUFFER ADDRESS
	MOVE	T3,T1		;COPY FOR LATER
	MOVSI	T1,.AENAM(T1)	;POINT TO RETURNED NAME
	HRRI	T1,UW$BRE(P1)	;AND TO RESULT NAME
	BLT	T1,UW$ERE(P1)	;COPY
	MOVEI	T1,UW$NAM(P1)	;POINT TO SOURCE NAME
	HRLI	T1,(POINT 8,)	;8-BIT ASCIZ STRING
	MOVEI	T2,.AANLC	;LENGTH IN CHARACTERS
	MOVEI	T3,.AENAM(T3)	;POINT TO NAME
	HRLI	T3,(POINT 8,)	;8-BIT ASCIZ STRING
	MOVEI	T4,.AANLC	;LENGTH IN CHARACTERS
	SETZM	WLDCNT		;NO ITERATIONS YET

MATNA1:	SOJL	T2,MATNA6	;MAYBE AT END
	ILDB	P2,T1		;GET CHARACTER FROM PROTOTYPE
	JUMPE	P2,MATNA6	;TEST FOR END MATCH IF NUL
	CAIN	P2,.CHCNV	;MAGIC QUOTE CHARACTER?
	JRST	MATNA8		;YES, SKIP WILDCARDING
	CAIN	P2,"*"		;FOUND THE SPECIAL CASE?
	JRST	MATNA2		;YES, RECURSE
	SOJL	T4,MATNA7	;NO, CHECK FOR ANOTHER CHARACTER HERE
	ILDB	P3,T3		;FETCH IT
	JUMPE	P3,MATNA7	;NO MATCH IF AT END
	CAIN	P2,"?"		;IF WILD,
	AOS	WLDCNT		;FLAG IT
	CAIE	P2,"?"		;IF WILD,
	CAMN	P2,P3		;OR IF THEY MATCH,
	JRST	MATNA1		;KEEP LOOKING
	JRST	MATNA7		;FAIL IF THEY DON'T MATCH

MATNA2:	AOS	WLDCNT		;ABOUT TO ITERATE
	ADJSP	P,4		;MAKE ROOM
	DMOVEM	T1,-3(P)	;SAVE PROTOTYPE POINTER

MATNA3:	DMOVEM	T3,-1(P)	;AND ENTRY POINTER
	PUSHJ	P,MATNA1	;CHECK FOR A MATCH
	  SKIPA			;FAILED
	JRST	MATNA5		;FINISH UP
	DMOVE	T1,-3(P)	;RETRIEVE WILDCARD POINTER
	DMOVE	T3,-1(P)	;RETRIEVE ENTRY POINTER
	SOJL	T4,MATNA4	;NO MATCH IF AT END
	ILDB	P3,T3		;GET NEXT CHARACTER
	JUMPN	P3,MATNA3	;TRY AGAIN IF NOT YET AT END

MATNA4:	ADJSP	P,-4		;TRIM STACK
	JRST	MATNA7		;ANOTHER SEARCH NEEDED

MATNA5:	ADJSP	P,-4		;TRIM STACK
	JRST	.POPJ1		;RETURN IF MATCH

MATNA6:	SOJL	T4,.POPJ1	;IF END HERE, THEY MATCH
	ILDB	P3,T3		;GET NEXT CHARACTER
	JUMPE	P3,.POPJ1	;MATCH

MATNA7:	SETZ	T1,		;SET RETURN CODE TO "NO MORE PROFILES"
	SKIPE	WLDCNT		;ANY CHARACTER MATCHES?
	MOVNI	T1,1		;YES--ANOTHER SEARCH IS NEEDED
	POPJ	P,		;RETURN NO MATCH ON THIS NAME

MATNA8:	SOJL	T2,MATNA7	;QUOTE REQUIRES A FOLLOWING CHARACTER
	ILDB	P2,T1		;FETCH IT
	JUMPE	P2,MATNA7	;REQUIRED TO BE PRESENT
	SOJL	T4,MATNA7	;CAN'T MATCH IF NO MORE CHARACTERS
	ILDB	P3,T3		;GET NEXT FROM PROFILE
	CAMN	P2,P3		;IF THE SAME,
	JRST	MATNA1		;THIS CHARACTER MATCHES
	JRST	MATNA7		;ELSE NO MATCH HERE
; HERE TO PERFORM SELECTION ANALYSIS

SELANL:	SKIPN	SELBLK		;ANY BLOCKS SPECIFIED?
	JRST	.POPJ1		;NO--SAY THIS PROFILE MATCHES
	MOVSI	T1,[REPEAT 4,<JRST .POPJ1>] ;SOME FRIENDLY INSTRUCTIONS
	HRRI	T1,CMPINS	;POINT TO STORAGE
	BLT	T1,CMPINS+3	;COPY
	HLRZ	P2,UW$TYP(P1)	;GET LENGTH OF MESSAGE
	SUBI	P2,UW$DAT	;KEEP ONLY COUNT OF SELECTION DATA WORDS
	MOVNS	P2		;NEGATE
	HRLZS	P2		;PUT IN LH
	HRRI	P2,UW$DAT(P1)	;POINT TO START OF SELECTION DATA
	MOVEM	P2,SELPTR	;SAVE
	SETOM	SELFLG		;FLAG SELECTION IN PROGRESS

SELAN1:	LOAD	T4,(P2),AF.SEL	;GET FUNCTION CODE
	CAIL	T4,1		;RANGE
	CAILE	T4,SELMAX	; CHECK
	POPJ	P,		;GIVE UP

SELAN2:	MOVE	T4,SELTAB-1(T4)	;POINT TO INSTUCTIONS
	DMOVE	T1,0(T4)	;FETCH
	DMOVE	T3,2(T4)	; AND
	DMOVEM	T1,CMPINS	;  INSTRUCTIONS
	DMOVEM	T3,CMPINS+2	;   ...
	PUSHJ	P,SELCMP	;COMPARE PROFILE DATA WITH THAT IN MSG
	  JRST	SELAN3		;PROFILE DOESN'T SATISFY CRITERIA
	PUSHJ	P,ADVBLK	;ADVANCE TO NEXT SELECTION SUB-BLOCK
	  JRST	.POPJ1		;RETURN IF NO MORE SUB-BLOCKS
	LOAD	T4,(P2),AF.SEL	;GET TYPE OF NEXT BLOCK
	CAIE	T4,.AFOR	;IS THIS AN "OR" BLOCK?
	JRST	SELAN1		;NO, JUST TRY IT
	JRST	.POPJ1		;YES, WE FOUND A WINNING SET OF CONSTRAINTS

SELAN3:	PUSHJ	P,ADVBLK	;LOST THIS TIME, LOOK FOR AN "OR" BLOCK
	  POPJ	P,		;ALL OUT OF POSSIBILITIES
	LOAD	T4,(P2),AF.SEL	;MAYBE, GET BLOCK TYPE
	CAIE	T4,.AFOR	;IS IT TIME TO START OVER?
	JRST	SELAN3		;NO, KEEP LOOKING
	JRST	SELAN2		;YES, TRY A NEW STRING OF CONSTRAINTS
; SELECTION FUNCTION TABLE
SELTAB:	IFIW	SELAND		;"AND"
	IFIW	SELOR		;"OR"
	IFIW	SELNOT		;"NOT"
	IFIW	SELGEQ		;".GE."
	IFIW	SELLEQ		;".LE."
SELMAX==.-SELTAB		;LENGTH OF TABLE


; "OR"
SELOR:!

; "AND"
SELAND:	CAMN	T1,T2		;COMPARE
	AOS	(P)		;SAME
	POPJ	P,		;RETURN


; "NOT"
SELNOT:	CAME	T1,T2		;COMPARE
	AOS	(P)		;DIFFERENT
	POPJ	P,		;RETURN

; "GEQ"
SELGEQ:	CAML	T1,T2		;PROFILE .GE. USER VALUE?
	AOS	(P)		;YES, SUCCEED
	POPJ	P,		;NO, FAIL

; "LEQ"
SELLEQ:	CAMG	T1,T2		;PROFILE .LE. USER VALUE?
	AOS	(P)		;YES, SUCCEED
	POPJ	P,		;NO, FAIL


; ADVANCE TO THE NEXT SELECTION SUB-BLOCK
ADVBLK:	SOSG	T1,SELBLK	;COUNT SELECTION BLOCKS
	POPJ	P,		;NO MORE
	LDB	T1,[POINT 9,(P2),17] ;GET LENGTH
	HRLS	T1		;PUT IN BOTH HALVES
	ADD	P2,T1		;ADVANCE
	MOVEM	P2,SELPTR	;UPDATE
	JUMPGE	P2,.POPJ	;JUMP IF POINTER RAN OUT
	JRST	.POPJ1		;ELSE RETURN OK


; COMPARE VALUES
SELCMP:	LOAD	T1,(P2),AF.OFS	;GET BLOCK TYPE
	CAIL	T1,.AEMIN	;RANGE CHECK
	POPJ	P,		;ILLEGAL
	MOVX	T2,AF.DEF	;DEFAULTING BIT
	TDNE	T2,(P2)		;WANTING TO CHECK FOR DEFAULTED FIELD?
	JRST	SELCM6		;YES, DO SO
	MOVE	T2,CHGTAB##(T1)	;NO, GET BITS FOR THIS BLOCK TYPE
	TXNE	T2,PD.NSL	;INVALID FOR SELECTION?
	POPJ	P,		;YES, FAIL
	MOVE	P3,ARGS		;POINT TO PROFILE BUFFER FOR CALLED ROUTINE
IFE 1B0-PD.RTN,<JUMPL T2,(T2)>	;CALL ROUTINE IF ONE IS PROVIDED
IFN 1B0-PD.RTN,<
	HRRZ	T3,T2		;GET POSSIBLE ROUTINE ADDRESS
	TXNE	T2,PD.RTN	;WAS IT PROVIDED?
	PJRST	(T3)		;YES, USE IT
>

SELCM1:	TXNE	T2,PD.EXT	;EXTENSIBLE BLOCK?
	JRST	SELCM2		;YES, HANDLE
	TXNN	T2,PD.MSK	;MASKABLE WORD?
	JRST	SELCM3		;NO, SIMPLE WORD COMPARES
	LDB	T3,[POINT 9,(P2),17] ;YES, GET SUPPLIED BLOCK LENGTH
	CAILE	T3,2		;WAS A MASK SUPPLIED?
	SKIPA	T2,2(P2)	;YES, USE IT
	SETO	T2,		;NO, USE FULLWORD
	CAIL	T3,2		;WAS A VALUE GIVEN?
	CAILE	T3,3		;OR MORE THAN VALUE & MASK?
	POPJ	P,		;YES, IT DOESN'T MATCH
	HRRZ	T3,ARGS+0	;OK, GET PROFILE BUFFER ADDRESS
	ADD	T3,T1		;GET BLOCK OFFSET
	MOVE	T1,1(P2)	;GET VALUE FROM THE SELECTION SUB-BLOCK
	AND	T1,T2		;KEEP ONLY PORTION TO COMPARE
	AND	T2,(T3)		;FETCH & MASK FROM PROFILE
	PJRST	CMPINS		;GO COMPARE AND RETURN TRUE/FALSE

; EXTENSIBLE BLOCK PROCESSING
SELCM2:	ADD	T1,P3		;GET ADDRESS TO FETCH
	MOVE	T1,(T1)		;DO SO
	ADD	T1,P3		;UN-RELATIVIZE THE AOBJN POINTER
	JRST	SELCM4		;JOIN COMMON CODE FOR WORD COMPARES

; REGULAR BLOCK PROCESSING
SELCM3:	LOAD	T2,CHGTAB##(T1),PD.WRD ;GET BLOCK LENGTH
	ADD	T1,P3		;GET ADDRESS OF BLOCK TO TEST
	MOVNS	T2		;GET MINUS BLOCK LENGTH
	HRL	T1,T2		;MAKE AOBJN POINTER TO BLOCK

;HERE FOR COMMON WORD-MODE COMPARISON CODE
SELCM4:	LDB	T2,[POINT 9,(P2),17] ;GET SUPPLIED BLOCK LENGTH
	SUBI	T2,1		;ONLY WANT DATA LENGTH
	MOVNS	T2		;USE NEGATIVE FOR AOBJN
	MOVSS	T2		;AOBJN CHECKS LH
	HRRI	T2,1(P2)	;POINT TO DATA
	DMOVE	T3,T1		;MOVE POINTERS TO SAFER ACS
SELCM5:	SKIPL	T3		;ANY MORE TO FETCH HERE?
	TDZA	T1,T1		;NOPE
	MOVE	T1,(T3)		;YES, GET IT
	SKIPL	T4		;SIMILARLY FOR USER DATA
	TDZA	T2,T2
	MOVE	T2,(T4)
	PUSHJ	P,CMPINS	;TEST IT
	  POPJ	P,		;FAILS THE CRITERIA
	AOBJP	T3,.+1		;ADVANCE POINTER
	AOBJN	T4,SELCM5	;LOOP OVER DATA
	JUMPL	T3,SELCM5	;AS LONG AS EITHER POINTER HOLDS OUT
	JRST	.POPJ1		;MEETS SELECTION CRITERIA

; DEFAULTED FIELD CHECKING
SELCM6:	IDIVI	T1,^D36		;GET MAP OFFSET & BIT NUMBER
	MOVN	T4,T2		;SHIFT VALUE
	MOVX	T2,1B0		;BIT TO SHIFT
	LSH	T2,(T4)		;GET BIT TO TEST
	ADDI	T1,.AEMAP	;OFFSET TO MAP
	HRRZ	T3,ARGS+0	;GET PROFILE ADDRESS
	ADD	T1,T3		;GET ADDRESS TO FETCH
	MOVE	T1,(T1)		;FETCH WORD FROM PROFILE MAP
	AND	T1,T2		;MAKE THINGS EASY
	PJRST	CMPINS		;TEST AND RETURN TRUE/FALSE
;SETFND - SET UP A $FIND
;
;T1/ KEY OF REFERENCE
;T2/ # OF BYTES
;TMPNAM/KEY TO MATCH

SETFND:	$STORE	T1,KRF,0(R)	;STORE WHICH KEY TO USE
	MOVEI	T1,TMPNAM	;BUFFER ADDRESS
	$STORE	T1,KBF,0(R)	;STORE KEY BUFFER ADDRESS
	$STORE	T2,KSZ,0(R)	;STORE KEY SIZE
	MOVEI	T1,RB$KEY	;KEYED ACCESS
	$STORE	T1,RAC,0(R)	;SET
	$FETCH	T1,ROP,0(R)	;FETCH THE CURRENT OPTIONS
	TXZ	T1,RB$KGE!RB$KGT ;MATCH SHOULD BE EQUAL
	$STORE	T1,ROP,0(R)	;PUT THEM BACK (AND RETURN TO CALLER)
	POPJ	P,		;DONE
; SETHDR - SETS UP THE RMS RECORD HEADER AND RAB GIVEN THE USER ARGS
; CALL:	MOVE	T1, BUFFER ADDRESS
;	PUSHJ	P,SETHDR

SETHDR:	$SAVE	P1		;FOR LOOPING
	MOVSI	T2,(T1)		;POINT TO USER ARGUMENT
	HRRI	T2,PROFIL	;POINT TO INTERNAL PROFILE BLOCK
	HRRZ	T3,.AEVRS(T1)	;GET LENGTH OF THIS PROFILE
	BLT	T2,PROFIL-1(T3)	;COPY
	MOVEI	T2,PROFIL	;FROM NOW ON, WE'LL USE INTERNAL BLOCK
	$STORE	T2,RBF,0(R)	;STORE BUFFER ADDRESS
	HRRZ	T2,.AEVRS(T2)	;GET BUFFER SIZE
	IMULI	T2,^D4		;MAKE SIZE INTO BYTES
	$STORE	T2,RSZ,0(R)	;TELL RMS HOW MUCH TO WRITE
	MOVEI	T2,RB$KEY	;KEYED ACCESS
	$STORE	T2,RAC,0(R)	;TELL RMS
	CAIN	T1,PROFIL	;INTERNAL BUFFER?
	POPJ	P,		;YES--ALREADY IN 9-BIT FORMAT
	MOVEI	T2,.AENAM(T1)	;POINT TO NAME
	HRLI	T2,(POINT 8,)	;8-BIT BYTES
	MOVE	T3,[POINT 9,PROFIL+.AENAM] ;POINTER TO STORAGE
	MOVEI	T4,.AANLC	;LENGTH IN CHARACTERS

SETHD1:	ILDB	T1,T2		;GET 8-BIT CHARACTER
	PUSHJ	P,CVTCAS	;DO CASE CONVERSION IF NECESSARY
	IDPB	T1,T3		;PUT 9-BIT CHARACTER
	SOJG	T4,SETHD1	;LOOP THROUGH NAME
	MOVEI	P1,.AEMIN	;OFF-THE-END INDEX FOR CHGTAB
SETHD2:	SOJL	P1,SETHD4	;LOOP OVER CHGTAB ENTRIES
	MOVE	T4,CHGTAB##(P1)	;GET CONTROL BITS
	TXNE	T4,PD.EXT	;MUST BE EXTENSIBLE
	TXNE	T4,PD.NMD!PD.CND ;MUST BE MODIFIABLE AND DEFAULTABLE
	JRST	SETHD2		;ELSE JUST TRUST THE CALLER
	HRRZ	T2,P1		;GET OFFSET
	SETO	T3,		;WANT TO TEST
	MOVEI	T1,PROFIL	;OUR COPY OF THE BLOCK
	PUSHJ	P,A$BMAP##	;SEE IF IT WAS DEFAULTED
	JUMPF	SETHD2		;NO, DON'T GRIND IT DOWN
	MOVE	T4,CHGTAB##(P1)	;YES, GET BITS AGAIN
	TXNN	T4,PD.EXT	;EXTENSIBLE?
	JRST	SETHD3		;NO, DON'T MESS WITH THE BLOCK
	SETO	T4,		;YES, DON'T WANT TO CHANGE THE DEFAULT BIT
	SETZ	T3,		;WE WANT TO DELETE THE BLOCK
	HRROI	T2,(P1)		;INDEX TO THE ENTRY
;	MOVEI	T1,PROFIL	;STILL SETUP
	SKIPE	PROFIL(T2)	;IF BLOCK IS IN USE,
	PUSHJ	P,A$EBLK##	;DELETE IT
	JRST	SETHD2		;KEEP CLEANING UP THE BLOCK

SETHD3:	LOAD	S1,T4,PD.WRD	;GET BLOCK SIZE
	MOVEI	S2,PROFIL(P1)	;AND ITS ADDRESS
	$CALL	.ZCHNK		;CLEAR IT OUT
	JRST	SETHD2		;KEEP CLEANING UP THE BLOCK

SETHD4:	HRRZ	T2,PROFIL+.AEVRS ;GET BUFFER SIZE
	IMULI	T2,^D4		;MAKE SIZE INTO BYTES
	$STORE	T2,RSZ,0(R)	;TELL RMS HOW MUCH TO WRITE
	POPJ	P,		;RETURN


; CONVERT 9-BIT INTERNAL ACCOUNTING USER NAME TO 8-BIT
; CALL:	MOVE	T1, PROFILE ADDRESS
;	PUSHJ	P,NAME8
NAME8:	MOVSI	T2,.AENAM(T1)	;POINT TO NAME
	HRRI	T2,TMPNAM	;TEMP STORAGE
	BLT	T2,TMPNAM+.AANLW-1 ;COPY
	SETZM	.AENAM(T1)	;WANT TO CLEAR LOW-ORDER BITS
	MOVEI	T2,.AENAM+1(T1)	;OF ENTIRE BLOCK
	HRLI	T2,.AENAM(T1)	;MAKE TRANSFER WORD
	BLT	T2,.AENAM+.AANLW-1(T1) ;CLEAR THE BLOCK
	MOVE	T2,[POINT 9,TMPNAM] ;POINT TO 9-BIT NAME
	MOVEI	T3,.AENAM(T1)	;WHERE TO RETURN THE CONVERTED NAME
	HRLI	T3,(POINT 8,)	;8-BIT ASCIZ
	MOVEI	T4,.AANLC	;LENGTH IN CHARACTERS
NAME81:	ILDB	T1,T2		;GET A CHARACTER
	IDPB	T1,T3		;PUT A CHARACTER
	SOJG	T4,NAME81	;LOOP
	POPJ	P,		;RETURN


CVTNM1:	MOVEI	T4,.AANLC	;MAX LENGTH OF USER NAME
CVNLUP:	SKIPE	T1,T2		;IF NOT OFF END,
	ILDB	T1,T2		;FETCH GIVEN NAME
	SKIPN	T1		;DONE?
	SETZ	T2,		;YES, MAKE SURE FILLED WITH ZEROS
	PUSHJ	P,CVTCAS	;DO CASE CONVERSION
	IDPB	T1,T3		;COPY INTO KEY
	SOJGE	T4,CVNLUP	;LOOP IF NOT (1 EXTRA FOR NULL @END)
	POPJ	P,		;RETURN


; CASE CONVERSION
;	"UPCASE" ANY 8 BIT CHARS TOO.  SCNSER SHOULD BE WORRYING IF
;	7-BIT TTY TYPES 8-BIT NAME.  I WON'T.
CVTCAS:	CAIL	T1,"A"+40	;CONVERT
	CAILE	T1,"Z"+40	; LOWER
	CAIL	T1,"A"+240	;  CASE TO
	CAILE	T1,"Z"+240	;   UPPER CASE
	POPJ	P,		;NOTHING TO CONVERT
	SUBI	T1," "		;OK, DO THE CONVERSION
	POPJ	P,		;RETURN
SUBTTL	PUT A RECORD INTO A FILE


; CALL:	MOVE	AC1, ADDRESS OF USER BUFFER
;	PUSHJ	P,PUTA/PUTB/PUTC

PUTA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	PUTCOM		;ENTER COMMON CODE

PUTB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	PUTCOM		;ENTER COMMON CODE

PUTC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	PUTCOM		;ENTER COMMON CODE

; COMMON PUT CODE
PUTCOM:	SKIPE	ACTLCK		;LOCKED OUT?
	POPJ	P,		;DON'T BOTHER RMS
	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT
	PUSHJ	P,SETHDR	;SET UP THE RECORD HEADER
PUTCO1:	$PUT	0(R)		;PUT THE RECORD IN THE FILE
	PUSHJ	P,ERRCKR	;CHECK FOR ERRORS
	  POPJ	P,		;FAILED
;	JRST	.POPJ1		;RETURN
	$FLUSH	0(R)		;*** FORCE BUFFERS OUT
	PUSHJ	P,ERRCKR	;*** CHECK FOR ERRORS
	  POPJ	P,		;*** FAILED
	JRST	.POPJ1		;RETURN
SUBTTL	UPDATE A FILE


; UPDATE THE LAST RECORD READ
; CALL:	MOVE	AC1, ADDRESS OF USER BUFFER
;	PUSHJ	P,UPDA/UPDB/UPDC

UPDA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	UPDCOM		;ENTER COMMON CODE

UPDB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	UPDCOM		;ENTER COMMON CODE

UPDC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	UPDCOM		;ENTER COMMON CODE

; COMMON UPDATE CODE
UPDCOM:	SKIPE	ACTLCK		;LOCKED OUT?
	POPJ	P,		;DON'T BOTHER RMS
	MOVEI	T1,.AEMIN+$AEFLT ;GET LENGTH OF PROFILE
	$STORE	T1,USZ,0(R)	;STORE SIZE IN RAB
	MOVEI	T1,TEMP		;POINT TO TEMP PROFILE STORAGE
	$STORE	T1,UBF,0(R)	;STORE ADDRESS IN RAB
	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT
	MOVE	T2,.AEPPN(T1)	;AND TARGET PPN FROM PROFILE
	MOVEM	T2,TMPNAM	;SAVE PPN AS SEARCH STRING
	MOVEI	T1,0		;PRIMARY KEY
	MOVEI	T2,4		;BYTES IN A PPN
	PUSHJ	P,SETFND	;SET UP FIND
	$GET	0(R)		;READ SPECIFIED RECORD
	PUSHJ	P,ERRCKR	;SEE IF WE FOUND IT
	  POPJ	P,		;MUST BE THERE
	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT
	PUSHJ	P,SETHDR	;SET UP HEADERS
	HRRZ	T1,TEMP+.AEVRS	;GET LENGTH OF PROFILE TO UPDATE
	HRRZ	T2,PROFIL+.AEVRS ;GET LENGTH OF PROFILE ON DISK
	CAIN	T1,(T2)		;UPDATE OF SAME SIZE?
	JRST	UPDCO3		;YES--THAT'S EASY

UPDCO1:	MOVE	T1,TEMP+.AEPPN	;TARGET PPN
	MOVEM	T1,PROFIL+.AEACS ;SAVE
	SETZM	PROFIL+.AEPPN	;ZAP PPN (KEY)
	MOVSI	T1,400000	;HIGH BIT OF FIRST CHARACTER IN USER NAME
	IORM	T1,PROFIL+.AENAM ;TURN IT ON
	PUSHJ	P,PUTCO1	;STORE TEMP PROFILE WITH PPN [0,0]
	  POPJ	P,		;FAILED
	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT
	MOVE	T2,.AEPPN(T1)	;AND TARGET PPN
	PUSHJ	P,DELCO1	;DELETE ORIGINAL PROFILE
	  JRST	UPDCO2		;UNWIND AS BEST WE CAN
	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT
	PUSHJ	P,SETHDR	;SET UP THE RECORD HEADER
	MOVE	T1,PROFIL+.AEPPN ;GET THE PPN
	MOVEM	T1,PROFIL+.AEACS ;SAVE AS THE UPDATE ACTIVE PPN
	PUSHJ	P,PUTCO1	;INSERT NEW PROFILE FOR ORIGINAL PPN
	  POPJ	P,		;FAILED
	SETZ	T2,		;GET [0,0]
	PUSHJ	P,DELCO1	;DELETE THAT PROFILE
	  POPJ	P,		;FAILED
	MOVE	T1,PROFIL+.AEACS ;GET TARGET PPN
	MOVEM	T1,TMPNAM	;SAVE AS KEY
	MOVEI	T1,0		;KEY OF REFERENCE
	MOVEI	T2,4		;KEY LENGTH
	PUSHJ	P,SETFND	;SET UP FIND
	$FIND	0(R)		;FIND THE RECORD
	PUSHJ	P,ERRCKR	;CHECK FOR ERRORS
	  POPJ	P,		;FAILED
	MOVEI	T1,PROFIL	;POINT TO INTERNAL PROFIL BUFFER
	JRST	UPDCO4		;GO FINISH UP

UPDCO2:	SETZ	T2,		;[0,0]
	PUSHJ	P,DELCO1	;TRY TO DELETE THE PPN
	  JFCL			;WHO CARES AT THIS POINT
	POPJ	P		;RETURN

UPDCO3:	MOVE	T1,ARGS		;GET CALLER'S ARGUMENT

UPDCO4:	PUSHJ	P,SETHDR	;SET UP THE RECORD HEADER
	SETZM	PROFIL+.AEACS	;MAKE SURE UPDATE ACTIVE PPN IS ZEROED
	$UPDATE	0(R)		;REPLACE THE RECORD IN THE FILE
	PUSHJ	P,ERRCKR	;CHECK FOR ERRORS
	  POPJ	P,		;FAILED
;	JRST	.POPJ1		;RETURN
	$FLUSH	0(R)		;*** FORCE BUFFERS OUT
	PUSHJ	P,ERRCKR	;*** CHECK FOR ERRORS
	  POPJ	P,		;*** FAILED
	JRST	.POPJ1		;RETURN
UPDFIX:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVEI	T1,.AEMAX	;GET MAXIMUM LENGTH OF PROFILE
	$STORE	T1,USZ,0(R)	;STORE SIZE IN RAB
	MOVEI	T1,PROFIL	;POINT TO TEMP PROFILE STORAGE
	$STORE	T1,UBF,0(R)	;STORE ADDRESS IN RAB
	SETZB	T1,TMPNAM	;KEY OF REFERENCE, PPN IS [0,0]
	MOVEI	T2,4		;KEY LENGTH
	PUSHJ	P,SETFND	;SET UP FIND
	$GET	0(R)		;FETCH TEMPORARY PROFILE
	PUSHJ	P,ERRCKR	;SEE IF FOUND
	  JRST	.POPJ1		;NOT THERE SO NO UPDATE WAS IN PROGRESS
	SKIPN	P1,PROFIL+.AEACS ;GET ACTIVE UPDATE PPN
	POPJ	P,		;MUST BE ONE
	MOVEM	P1,TMPNAM	;SAVE PPN AS KEY
	SETZ	T1,		;PRIMARY KEY
	MOVEI	T2,4		;KEY LENGTH
	PUSHJ	P,SETFND	;SET UP FIND
	$GET	0(R)		;FETCH PROFILE
	PUSHJ	P,ERRCKR	;CHECK FOR ERRORS
	  JRST	UPDFI2		;NOT THERE

UPDFI1:	MOVE	T2,PROFIL+.AEPPN ;GET ORIGINAL PPN
	PUSHJ	P,DELCO1	;DELETE ITS PROFILE
	  POPJ	P,		;FAILED

UPDFI2:	SETZB	T1,TMPNAM	;KEY OF REFERENCE, PPN IS [0,0]
	MOVEI	T2,4		;KEY LENGTH
	PUSHJ	P,SETFND	;SET UP FIND
	$GET	0(R)		;FETCH TEMPORARY PROFILE AGAIN
	PUSHJ	P,ERRCKR	;SEE IF FOUND
	  POPJ	P,		;SHOULD NOT FAIL
	MOVE	T1,PROFIL+.AEACS ;GET ACTIVE UPDATE PPN
	MOVEM	T1,PROFIL+.AEPPN ;SAVE AS REAL PPN NOW
	MOVSI	T1,400000	;HIGH BIT OF FIRST WORD IN USER NAME
	ANDCAM	T1,PROFIL+.AENAM ;CLEAR IT
	MOVEI	T1,PROFIL	;POINT TO BUFFER
	PUSHJ	P,SETHDR	;SET UP THE RECORD HEADER
	PUSHJ	P,PUTCO1	;INSERT PROFILE WITH ORIGINAL PPN
	  POPJ	P,		;FAILED
	SETZ	T2,		;[0,0]
	PUSHJ	P,DELCO1	;DELETE TEMPORARY PROFILE
	  POPJ	P,		;FAILED
	MOVEM	P1,TMPNAM	;TARGET IS ORIGINAL PPN AGAIN
	MOVEI	T1,0		;KEY OF REFERENCE
	MOVEI	T2,4		;KEY LENGTH
	PUSHJ	P,SETFND	;SET UP FIND
	$GET	0(R)		;FETCH TEMPORARY PROFILE AGAIN
	PUSHJ	P,ERRCKR	;SEE IF FOUND
	  POPJ	P,		;SHOULD NOT FAIL
	MOVEI	T1,PROFIL	;POINT TO INTERNAL PROFILE BUFFER
	PJRST	UPDCO4		;GO CLEAR UPDATE ACTIVE PPN AND RETURN
SUBTTL	SET RMS-SPECIFIC OPTIONS


;  BIT FIDDLER'S DELIGHT
; CALL:	MOVE	AC1, OPTION-NUMBER
;	MOVE	AC2, VALUE
;	PUSHJ	P,OPTA/OPTB/OPTC

OPTA::	PUSHJ	P,ENTA		;SWITCH TO FILE "A" CONTEXT
	JRST	OPTCOM		;ENTER COMMON CODE

OPTB::	PUSHJ	P,ENTB		;SWITCH TO FILE "B" CONTEXT
	JRST	OPTCOM		;ENTER COMMON CODE

OPTC::	PUSHJ	P,ENTC		;SWITCH TO FILE "C" CONTEXT
;	JRST	OPTCOM		;ENTER COMMON CODE

; COMMON OPTION CODE
OPTCOM:	DMOVE	T1,ARGS		;GET CALLER'S ARGUMENTS
	SKIPL	T1		;RANGE
	CAILE	T1,OPTMAX	; CHECK
	POPJ	P,		;NO
	PJRST	@OPTTAB(T1)	;CALL FUNCTION-SPECIFIC PROCESSOR

OPTTAB:	IFIW	.POPJ		;(0) CATCH RANDOM CALLERS
	IFIW	SETLOA		;(1) SET/CLEAR THE RMS "LOAD" MODE BIT
	IFIW	GETFBE		;(2) GET LAST FAB ERROR
	IFIW	GETRBE		;(3) GET LAST RAB ERROR
	IFIW	GETFIL		;(4) GET ADDRESS OF RETURNED FILESPEC BLOCK
OPTMAX==<.-OPTTAB>-1		;MAX LEGAL OPTION
; FUNCTION 1 - SET/CLEAR LOAD FLAG
;
; T2/	0 - SET NORMAL MODE, RECORDS WILL BE PLACED REGARDLESS OF FILL FACTORS
;	1 - SET LOAD MODE, FILL FACTOR WILL DETERMINE RECORD PLACEMENT
; MAY BE CALLED ANY TIME, REMAINS AS SET UNTIL CHANGED.
; SHOULD BE SET TO 1 WHEN MASS INSERTIONS ARE BEING DONE.  SUCH INSERTIONS
; SHOULD BE SORTED BY PPN TO MAXIMIZE BENEFIT.

SETLOA:	MOVEM	T2,LOAFLG	;SAVE THE REQUESTED STATUS
DOLOA:	JUMPE	R,.POPJ		;JUMP IF NO STREAM OPEN
	$FETCH	T1,ROP,0(R)	;GET CURRENT ROP FIELD
	SKIPN	LOAFLG		;LOAD MODE?
	TXZA	T1,RB$LOA	;NO, TELL RMS
	TXO	T1,RB$LOA	;YES, TELL RMS
	$STORE	T1,ROP,0(R)	;RETURN RESULT

	JUMPE	F,.POPJ		;JUMP IF NO FAB
	$FETCH	T1,FOP,0(F)	;GET CURRENT FOP FIELD
	SKIPN	LOAFLG		;LOAD MODE?
	TXZA	T1,FB$DFW	;NO, TELL RMS
	TXO	T1,FB$DFW	;YES, TELL RMS
	$STORE	T1,FOP,0(F)	;RETURN RESULT
	JRST	.POPJ1		;OK


; FUNCTION 2 - GET FAB ERROR STATUS
GETFBE:	JUMPE	F,.POPJ		;ERROR IF NO FAB
	$FETCH	T1,STS,0(F)	;GET STATUS
	$FETCH	T2,STV,0(F)	;AND STATUS VALUE
	DMOVEM	T1,ARGS		;SAVE RESULTS
	JRST	.POPJ1		;SUCCESS


; FUNCTION 3 - GET RAB STATUS
GETRBE:	JUMPE	R,.POPJ		;ERROR IF NO RAB
	$FETCH	T1,STS,0(R)	;GET STATUS
	$FETCH	T2,STV,0(R)	;AND STATUS VALUE
	DMOVEM	T1,ARGS		;SAVE RESULTS
	JRST	.POPJ1		;SUCCESS


; FUNCTION 4 - GET ADDRESS OF RETURNED FILESPEC BLOCK
GETFIL:	MOVE	T1,[2,,T2]	;SET UP UUO AC
	$FETCH	T2,JFN,0(F)	;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
	HRLZS	T2		;PUT IN LH
	HRRI	T2,.FOFIL	;FILOP. UUO FUNCTION CODE
	MOVE	T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
	FILOP.	T1,		;READ FILESPEC
	  POPJ	P,		;RETURN
	MOVEI	T1,.FOFMX	;LENGTH OF BLOCK
	MOVEI	T2,FFFIL	;POINT TO BLOCK
	DMOVEM	T1,ARGS		;SAVE RESULTS
	JRST	.POPJ1		;RETURN
;HERE AFTER EACH RMS OPERATION TO SEE IF THERE WAS AN ERROR
;RETURNS CPOPJ/CPOPJ1, IN EITHER CASE THE STS IS IN T1, THE STV IN T2.

ERRCKF:	SKIPA	T1,F		;POINT TO FAB AGAIN
ERRCKR:	MOVE	T1,R		;OR THE RAB
	$FETCH	T2,STV,0(T1)	;GET STATUS VALUE
	$FETCH	T1,STS,0(T1)	;AND ACTUAL STATUS
	CAIGE	T1,ER$MIN	;AN ERROR?
	AOS	(P)		;NO
	POPJ	P,		;RETURN
; CONTEXT SWITCH TO THE APPROPRIATE FILE
; THIS IS A CO-ROUTINE THAT MAY NOT BE CALLED RECURSIVELY
; TO SAVE 'N' SETS OF ACS.
; CALL:	PUSHJ	P,ENTA/ENTB/ENTC

; ALL
ENTX:	AOSE	SAVFLG		;ALREADY CONTEXT SWITCHED?
	POPJ	P,		;YES--THEN DO NOTHING
	MOVEM	0,SAVACS+0	;SAVE AC 0
	MOVE	0,[1,,SAVACS+1]	;SET UP BLT
	BLT	0,SAVACS+17	;SAVE ACS 1 - 17
	SETZB	F,R		;NO FAB OR RAB
	JRST	ENTCOM		;ENTER COMMON CODE


; FILE "A"
ENTA:	AOSE	SAVFLG		;ALREADY CONTEXT SWITCHED?
	POPJ	P,		;YES--THEN DO NOTHING
	MOVEM	0,SAVACS+0	;SAVE AC 0
	MOVE	0,[1,,SAVACS+1]	;SET UP BLT
	BLT	0,SAVACS+17	;SAVE ACS 1 - 17
	MOVEI	F,A.WFAB	;POINT TO FAB
	MOVEI	R,A.WRAB	;POINT TO RAB
	JRST	ENTCOM		;ENTER COMMON CODE


; FILE "B"
ENTB:	AOSE	SAVFLG		;ALREADY CONTEXT SWITCHED?
	POPJ	P,		;YES--THEN DO NOTHING
	MOVEM	0,SAVACS+0	;SAVE AC 0
	MOVE	0,[1,,SAVACS+1]	;SET UP BLT
	BLT	0,SAVACS+17	;SAVE ACS 1 - 17
	MOVEI	F,B.WFAB	;POINT TO FAB
	MOVEI	R,B.WRAB	;POINT TO RAB
	JRST	ENTCOM		;ENTER COMMON CODE


; FILE "C"
ENTC:	AOSE	SAVFLG		;ALREADY CONTEXT SWITCHED?
	POPJ	P,		;YES--THEN DO NOTHING
	MOVEM	0,SAVACS+0	;SAVE AC 0
	MOVE	0,[1,,SAVACS+1]	;SET UP BLT
	BLT	0,SAVACS+17	;SAVE ACS 1 - 17
	MOVEI	F,C.WFAB	;POINT TO FAB
	MOVEI	R,C.WRAB	;POINT TO RAB
;	JRST	ENTCOM		;ENTER COMMON CODE


; COMMON ENTRY/EXIT CODE
ENTCOM:	DMOVE	T1,SAVACS+1	;GET CALLER'S ARGUMENTS
	DMOVEM	T1,ARGS		;SAVE
	MOVE	T1,SAVACS+P	;GET OLD PDL POINTER
	XMOVEI	T1,@0(T1)	;GET CALLER'S ADDRESS
	MOVE	0,T1		;COPY ADDRESS
	MOVE	T1,SAVACS+T1	;RELOAD T1
	PUSHJ	P,@0		;CALL THE CALLER
	  TDZA	T1,T1		;INDICATE FALSE RETURN
	HRROI	T1,-1		;INDICATE TRUE RETURN
	MOVEM	T1,SAVACS+0	;SAVE IN AC 0
	DMOVE	T1,ARGS		;GET RESULTS
	DMOVEM	T1,SAVACS+1	;STORE FOR CALLER
	MOVE	0,[SAVACS+1,,1]	;SET UP BLT
	BLT	0,17		;RESTORE THE ACS
	MOVE	0,SAVACS+0	;RELOAD AC 0
	POP	P,(P)		;PRUNE STACK
	SETOM	SAVFLG		;RESET CONTEXT FLAG
	POPJ	P,		;RETURN
	LIT
	RELOC	0

SAVACS:	BLOCK	20		;AC STORAGE
SAVFLG:	BLOCK	1		;NON-ZERO IF ACS SAVED
ACTLCK::0			;ACCT FILE IS LOCKED FLAG
ARGS:	BLOCK	2		;CALLER'S ARGUMENTS
WLDNXT:	BLOCK	1		;ZERO IF SEARCHING FOR NEXT PROFILE
WLDCNT:	BLOCK	1		;COUNT OF RECURSIONS AND/OR CHARACTER MATCHES
SELBLK:	BLOCK	1		;COUNT OF SELECTION BLOCKS IN MESSAGE
SELPTR:	BLOCK	1		;AOBJN POINTER TO SELECTION DATA
SELFLG::BLOCK	1		;NON-ZERO IF SELECTION ANALYSIS IN PROGRESS
CMPINS::BLOCK	4		;COMPARE INSTRUCTIONS
BASNAM:	BLOCK	12		;BASE NAME FOR WILDCARD SEARCHES
TMPNAM:	BLOCK	.AANLW		;TEMP STG FOR UP-CASED USER NAME STRING(ASCIZ)
UPDNAM:	BLOCK	.AANLW		;TEMP STORAGE FOR USER NAME DURING UPDATE
LOAFLG:	BLOCK	1		;"LOAD MODE" FLAG
PROFIL:	BLOCK	.AEMAX		;INTERNAL PROFILE BLOCK
TEMP:	BLOCK	.AEMIN+$AEFLT	;ANOTHER INTERNAL PROFILE FOR UPDATES

; FILE "A" STORAGE
A.ZBEG:!			;START OF BLOCK TO ZERO
A.WFAB:	BLOCK	FA$LNG		;WORKING FAB
A.WRAB:	BLOCK	RA$LNG		;WORKING RAB
A.WXA1:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 1
A.WXA2:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 2
A.WXA3:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 3
A.WXK0:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 0
A.WXK1:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 1
A.ZEND:!			;END OF BLOCK TO ZERO

; FILE "B" STORAGE
B.ZBEG:!			;START OF BLOCK TO ZERO
B.WFAB:	BLOCK	FA$LNG		;WORKING FAB
B.WRAB:	BLOCK	RA$LNG		;WORKING RAB
B.WXA1:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 1
B.WXA2:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 2
B.WXA3:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 3
B.WXK0:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 0
B.WXK1:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 1
B.ZEND:!			;END OF BLOCK TO ZERO

; FILE "C" STORAGE
C.ZBEG:!			;START OF BLOCK TO ZERO
C.WFAB:	BLOCK	FA$LNG		;WORKING FAB
C.WRAB:	BLOCK	RA$LNG		;WORKING RAB
C.WXA1:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 1
C.WXA2:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 2
C.WXA3:	BLOCK	XA$SXA		;WORKING XAB FOR AREA 3
C.WXK0:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 0
C.WXK1:	BLOCK	XA$SXK		;WORKING XAB FOR KEY 1
C.ZEND:!			;END OF BLOCK TO ZERO

; XAB ADDRESS STORAGE FOR OPNINI
X.WXA1:	BLOCK	1		;ADDRESS OF WORKING XAB FOR AREA 1
X.WXA2:	BLOCK	1		;ADDRESS OF WORKING XAB FOR AREA 2
X.WXA3:	BLOCK	1		;ADDRESS OF WORKING XAB FOR AREA 3
X.WXK0:	BLOCK	1		;ADDRESS OF WORKING XAB FOR KEY 0
X.WXK1:	BLOCK	1		;ADDRESS OF WORKING XAB FOR KEY 1

; FILE FIXUP STORAGE
FFZBEG:!			;START OF BLOCK TO ZERO
FFFLG:	BLOCK	1		;NON-ZERO IF CALL TO OPNBLK SUCCESSFUL
FFFIL:	BLOCK	.FOFMX		;RETURNED FILESPEC BLOCK
FFFOP:	BLOCK	.FOMAX		;FILOP BLOCK
FFPTH:	BLOCK	.PTMAX		;PATH BLOCK
FFLKP:	BLOCK	.RBMAX+1	;LOOKUP BLOCK
FFREN:	BLOCK	.RBMAX+1	;RENAME BLOCK
FFZEND:!			;END OF BLOCK TO ZERO

RMS$$G::BLOCK	3K		;3 PAGES FOR RMS GLOBAL DATA

	PRGEND
TITLE	ACTPDF - PROFILE DEFAUTLING

	SEARCH	ACTPRM
	MODULE	(ACTPDF)

	ENTRY	A$PDEF

; THIS ROUTINE WILL CAUSE A USER PROFILE TO HAVE ITS DEFAULTED FIELDS
; FILLED IN FROM THE ALTERNATE PROFILE PROVIDED.  IT IS EXPECTED THAT
; THE CALLER RESERVED .AEMAX WORDS FOR THE USER PROFILE BLOCK.
; CALL:	MOVE	T1, USER PROFILE ADDRESS
;	MOVE	T2, DEFAULT PROFILE ADDRESS
;	PUSHJ	P,A$PDEF
;
; TRUE RETURN, PROFILE'S DEFAULT FIELDS COPIED.
; FALSE RETURN, SOMETHING WENT WRONG (NO ROOM FOR EXTENSIBLE BLOCK?).
;
; CLOBBERS ONLY S1 & S2.

A$PDEF::PUSHJ	P,.SAVE4		;PRESERVE SOME ACS
	$SAVE	<T1,T2,T3,T4>		;AND SOME MORE
	DMOVE	P1,T1			;SAVE THE ARGUMENTS
	MOVE	P3,[POINT 1,.AEMAP(P1)]	;EXAMINE THE USER'S DEFAULT MAP
	MOVSI	P4,-CHGLEN##		;FOR EXAMINING CHGTAB

PDEF.1:	MOVE	T4,CHGTAB##(P4)		;GET BITS FOR NEXT ENTRY
	ILDB	T3,P3			;AND USER'S PROFILE BIT
	JUMPE	T3,PDEF.5		;DON'T BOTHER IF NO DEFAULTING WANTED
	TXNE	T4,PD.CND		;CAN IT BE DEFAULTED?
	JRST	PDEF.4			;NO, CLEAR THE BIT
	TXNE	T4,PD.EXT		;IS THIS AN EXTENSIBLE BLOCK?
	JRST	PDEF.3			;YES, HANDLE DIFFERENTLY
	LOAD	T1,T4,PD.WRD		;NO, GET LENGTH OF SUB-BLOCK
	JUMPE	T1,PDEF.4		;SKIP THIS WORD IF IT'S NOT FOR REAL
	DMOVE	S1,P1			;COPY BLOCK ADDRESSES
	ADDI	S1,(P4)			;FORM OFFSET
	ADDI	S2,(P4)			;INTO EACH BLOCK

PDEF.2:	MOVE	T2,(S2)			;GET DEFAULT VALUE
	MOVEM	T2,(S1)			;STORE IN USER PROFILE
	SOJLE	T1,PDEF.5		;DIFFERENT OVERHEAD AT END OF BLOCK
	AOJ	S1,			;ADVANCE PROFILE POINTER
	AOJ	S2,			;BOTH PROFILES
	IDPB	T3,P3			;MAKE SURE DEFAULT BITS ARE CONSISTENT
	AOBJN	P4,PDEF.2		;ADVANCE CHGTAB POINTER AND LOOP
	$RETF				;SOMETHING'S WRONG IF IT WON'T FIT

PDEF.3:	DMOVE	T1,P1			;COPY PROFILE ADDRESSES
	ADDI	T2,(P4)			;POINT TO ENTRY IN DEFAULT BLOCK
	MOVE	T2,(T2)			;GET THE RELATIVE BLOCK POINTER
	HRRZ	T3,T2			;COPY THE OFFSET
	SKIPE	T3			;IF THERE'S REALLY A SUB-BLOCK,
	ADDI	T3,(P2)			;GET ITS ADDRESS (NOT OFFSET)
	HRRI	T2,(P4)			;HERE'S THE PROFILE OFFSET WE'RE AFTER
	SETO	T4,			;DEFAULT BIT IS ALREADY ON, LEAVE IT
	PUSHJ	P,A$EBLK##		;DIDDLE THE EXTENSIBLE BLOCK
	JUMPT	PDEF.5			;KEEP GOING IF ITS SUCCEEDS
	$RET				;PROPAGATE FAILURE

PDEF.4:	SETZ	T3,			;GET A ZERO BIT
	DPB	T3,P3			;THIS IS NOT EITHER A DEFAULTED FIELD

PDEF.5:	AOBJN	P4,PDEF.1		;LOOP OVER ALL OF CHGTAB
	$RETT				;IT WORKED!


	LIT

	PRGEND
TITLE	ACTBLK - PROFILE MEMORY MANAGEMENT

	SEARCH	ACTPRM
	MODULE	(ACTBLK)

	ENTRY	A$EBLK


; THIS ROUTINE WILL ALLOCATE, DEALLOCATE, AND SHUFFLE EXTENSIBLE
; DATA BLOCKS WITHIN A PROFILE.  IT IS EXPECTED THE CALLER HAS
; RESERVED .AEMAX WORDS FOR A PROFILE.
; CALL:	MOVE	T1, PROFILE ADDRESS
;	MOVE	T2, -LENGTH,,PROFILE OFFSET
;	MOVE	T3, ADDRESS OF BLOCK TO INSERT OR ZERO
;	MOVE	T4, FLAG
;	PUSHJ	P,A$EBLK
;
; FLAG:	-1 = DO NOT UPDATE .AEMAP
;	 0 = CLEAR .AEMAP BIT
;	 1 = SET .AEMAP BIT
;
; TRUE RETURN:	BLOCK INSERTED IF T3 NON-ZERO OR DELETED IF ZERO
; FALSE RETURN:	NO ROOM TO INSERT BLOCK

A$EBLK::PUSHJ	P,.SAVE4	;SAVE SOME ACS
	DMOVE	P1,T1		;COPY
	DMOVE	P3,T3		; ARGS
	HRRZ	T1,P2		;GET OFFSET
	MOVX	T2,PD.EXT	;BIT DENOTING EXTENSIBLE BLOCKS
	CAIGE	T1,.AEMIN	;IS IT IN THE RANGE OF VALID BLOCK TYPES?
	TDNN	T2,CHGTAB##(T1)	;AND IS IT EXTENSIBLE?
	$RETF			;NO, FAIL BEFORE WE DO DAMAGE
	JUMPE	P3,DELBLF	;GO DELETE IF NO BLOCK GIVEN

ADDBLK:	HRRZ	T1,P2		;GET OFFSET
	ADDI	T1,(P1)		;INDEX INTO PROFILE
	SKIPN	(T1)		;BETTER NOT BE IN USE
	JRST	ADDBL1		;IT'S NOT
	PUSHJ	P,DELBLK	;FIRST DELETE WHAT'S THERE
	HRRZ	T1,P2		;GET OFFSET AGAIN
	ADDI	T1,(P1)		;RESET INDEX INTO PROFILE

ADDBL1:	HRRZ	T3,P2		;GET OFFSET AGAIN
	LOAD	T3,CHGTAB##(T3),PD.WRD ;GET MAX. BLOCK SIZE
	MOVNS	T3		;NEGATE IT FOR COMPARISONS
	HLRE	T2,P2		;GET -LENGTH
	CAMGE	T2,T3		;BLOCK TOO LONG?
	MOVE	T2,T3		;YES, ONLY USE OUR MAX. LENGTH
	HRL	P2,T2		;UPDATE LENGTH
	MOVMS	T2		;MAKE POSITIVE
	HRRZ	T3,.AEVRS(P1)	;GET LENGTH OF PROFILE SO FAR
	ADDI	T2,(T3)		;COMPUTE LAST WORD IN PROFILE
	CAILE	T2,.AEMAX	;WILL NEW BLOCK FIT?
	$RETF			;NOPE
	HRRM	T2,.AEVRS(P1)	;UPDATE NEW PROFILE LENGTH
	HLLM	P2,(T1)		;STORE -WORD COUNT OF EXTENSIBLE BLOCK
	HRRM	T3,(T1)		;AND THE RELATIVE OFFSET IN PROFILE
	ADDI	T3,(P1)		;POINT TO END OF THE PROFILE NOW
	HRLI	T3,(P3)		;MAKE A BLT POINTER
	ADDI	T2,(P1)		;COMPUTE END OF BLT
	BLT	T3,-1(T2)	;COPY INTO THE PROFILE

EBLKRT:	JUMPL	P4,.RETT	;RETURN IF NO UPDATES TO .AEMAP WANTED
	MOVE	T1,P1		;GET PROFILE ADDRESS
	HRRZ	T2,P2		;GET PROFILE OFFSET FOR AOBJN POINTER
	MOVE	T3,P4		;GET SET/CLEAR BIT
	PJRST	A$BMAP##	;GO TOGGLE BIT AND RETURN
DELBLF:	PUSHJ	P,DELBLK	;DELETE THE BLOCK
	PJRST	EBLKRT		;DO COMMON RETURN CODE

DELBLK:	PUSHJ	P,.SAVE4	;PRESERVE ARGUMENTS
	MOVSI	T1,(P1)		;POINT TO PROFILE
	HRRI	T1,TEMP		;AND TO TEMP STORAGE
	BLT	T1,TEMP+.AEMAX-1 ;COPY PROFILE
	MOVEI	T1,.AEMIN	;MINIMUM LENGTH
	HRRM	T1,.AEVRS(P1)	;TRUNCATE ORIGINAL PROFILE
	MOVSI	T1,.AEMIN(P1)	;POINT TO END OF STATIC PROFILE
	HRRI	T1,.AEMIN+1(P1)	;MAKE A BLT POINTER
	SETZM	.AEMIN(P1)	;CLEAR FIRST WORD
	BLT	T1,.AEMAX-1(P1)	;ZERO OUT EXTENSIBLE DATA STORAGE
	MOVSI	P4,-EXTSIZ	;AOBJN POINTER

DELBL1:	MOVE	T1,EXTTBL(P4)	;GET PROFILE OFFSET
	ADDI	T1,(P1)		;INDEX INTO ORIGINAL PROFILE
	SETZM	(T1)		;ZERO EXTENSIBLE POINTER
	AOBJN	P4,DELBL1	;LOOP FOR ALL POINTERS
	MOVSI	P4,-EXTSIZ	;AOBJN POINTER
	HRRZ	T1,P2		;GET OFFSET OF POINTER TO BLOCK FOR DELETION
	PUSH	P,T1		;SAVE

DELBL2:	MOVE	T1,EXTTBL(P4)	;GET AN OFFSET
	CAME	T1,(P)		;FOUND BLOCK TO DELETE?
	SKIPN	P2,TEMP(T1)	;NO--GET OFFSET TO EXTENSIBLE DATA
	JRST	DELBL3		;THERE IS NONE
	HRRZ	P3,P2		;GET RELATIVE INDEX INTO PROFILE
	ADDI	P3,TEMP		;POINT DIRECTLY TO IT
	HRR	P2,T1		;WHERE TO STUFF NEW AOBJN POINTER
	PUSH	P,P4		;SAVE AOBJN POINTER
	MOVNI	P4,1		;IGNORE .AEMAP
	PUSHJ	P,ADDBLK	;RE-INSERT THE BLOCK
	POP	P,P4		;RESTORE AOBJN POINTER

DELBL3:	AOBJN	P4,DELBL2	;LOOP FOR ALL POSSIBLE DATA POINTERS
	POP	P,(P)		;PHASE STACK
	POPJ	P,		;RETURN

EXTTBL:	EXTDAT			;TABLE OF EXTENSIBLE DATA BLOCK OFFSETS
EXTSIZ==.-EXTTBL		;NUMBER OF ACTUAL ENTRIES IN TABLE


	LIT

	RELOC	0

TEMP:	BLOCK	.AEMAX		;TEMPORARY PROFILE

	PRGEND
TITLE	ACTBIT - SET/CLEAR BITS IN .AEMAP


	SEARCH	ACTPRM
	MODULE	(ACTBIT)

	ENTRY	A$BMAP

; ROUTINE TO TOGGLE BITS IN .AEMAP BIT MAP
; CALL:	MOVE	T1, PROFILE ADDRESS
;	MOVE	T2, PROFILE OFFSET
;	MOVE	T3, FLAG (-1 = CHECK, 0 = CLEAR, 1 = SET)
;	PUSHJ	P,A$BMAP##
;
; TRUE RETURN:	1. FUNCTION = CHECK AND BIT IS SET
;		2. FUNCTION = SET/CLEAR AND OFFSET IS LEGAL
; FALSE RETURN:	1. FUNCTION = CHECK AND BIT IS CLEAR
;		2. FUNCTION = SET/CLEAR AND OFFSET IS ILLEGAL
;
; ON EITHER RETURN, T1 AND T2 REMAIN UNCHANGED AND T3 HAS THE POSSIBLY
; UPDATED STATUS OF THE BIT BEING CHECKED/SET/CLEARED.  THIS IS SO THE
; CALLER MAY TURN AROUND AND IMMEDIATELY CHANGE THE STATUS OF THE BIT
; WITHOUT HAVING TO SETUP THE ACS AGAIN.

; THIS CODE WILL HAVE TO CHANGE IF EVER THERE IS A STATIC BLOCK WHICH IS
; DEFAULTABLE.

A$BMAP::CAIL	T2,.AEMIN	;WITHIN RANGE OF BLOCK OFFSETS?
	JUMPGE	T3,.RETF	;NO, AND CHANGING, FAIL NOW
	CAIL	T2,.AEMIN	;CHECK AGAIN
	JRST	BMAP1		;YES, AND CHECKING, IT'S DEFAULTED (FOR NOW)
	PUSH	P,T1		;SAVE T1
	PUSH	P,T2		;SAVE T2
	MOVE	T4,T3		;COPY CHECK/CLEAR/SET FLAG
	IDIVI	T2,^D36		;COMPUTE WORD OFFSET IN .AEMAP
	ADDI	T2,.AEMAP(T1)	;INDEX INTO BIT MAP
	MOVN	T1,T3		;NEGATE BIT POSITION
	MOVSI	T3,400000	;INITIAL BIT
	LSH	T3,(T1)		;POSITION
	JUMPGE	T4,BMAP2	;JUMP IF CHANGING STATUS
	MOVE	T4,T2		;COPY BIT MAP ADDRESS
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	TDNN	T3,(T4)		;CHECK BIT
BMAP0:	TDZA	T3,T3		;BIT IS CLEAR
BMAP1:	SKIPA	T3,[EXP 1]	;BIT IT SET
	$RETF			;RETURN
	$RETT			;RETURN

BMAP2:	ANDI	T4,1		;AVOID ILL MEM REFS
	XCT	[ANDCAM T3,(T2)
		 IORM   T3,(T2)](T4)
	MOVEI	T3,(T4)		;GET STATE OF BIT
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	$RETT			;RETURN


	PRGEND
TITLE	ACTCHG - SELECTION/CHANGE TABLE

	SEARCH	ACTPRM
	MODULE	(ACTCHG)

	ENTRY	CHGTAB

CHGTAB::
	DEFINE	AE(NAM,LEN,BTS,RTN),<
BITS==0!<BTS>
IFE <LEN>+1,<BITS==BITS!PD.MSK>
IFL <LEN>+1,<BITS==BITS!PD.EXT>
IFL <LEN>,<BITS==BITS!FLD(<-<LEN>>,PD.WRD)>
IFG <LEN>,<BITS==BITS!FLD(<LEN>,PD.WRD)>
IFNB<RTN>,<BITS==BITS!PD.RTN>
IF2,< IFNB<RTN>,< .IF RTN,NEEDED,<EXTERN RTN> > >
IFN <LEN>,< EXP BITS!RTN >
BITS==<BITS&PD.CND>!PD.NMD!PD.NSL
IFG <LEN>-1,< REPEAT <LEN>-1,< EXP BITS > >
>

	AEPROF
CHGLEN==:.-CHGTAB		;LENGTH OF THIS TABLE

IF1,< IFN CHGLEN-.AEMIN,<
PRINTX ? CHGTAB is wrong
>>

	PRGEND
TITLE	ACTSCD - SCDMAP.SYS ROUTINES

	SEARCH	ACTPRM
	MODULE	(ACTSCD)

	ENTRY	A$DSCD,	A$FSCD,	A$ISCD

	ND	SCDSIZ,^D128*2	;SIZE OF SCDMAP.SYS DATA

; OPEN SCDMAP.SYS AND READ IN THE MAPS
; CALL:	PUSHJ	P,A$ISCD
;
; TRUE RETURN:	SCDMAP.SYS IN CORE, S1 CONTAINS THE ADDRESS OF THE MAP
; FALSE RETURN:	FAILED

A$ISCD::SKIPE	SCDTBL		;POINTER THERE?
	$RETT			;YES, JUST RETURN
	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVEI	S1,FOB.MZ	;FOB SIZE
	MOVEI	S2,SCDFOB	;FOB ADDRESS
	PUSHJ	P,F%IOPN	;OPEN FOR INPUT
	$RETIF			;CHECK FOR ERRORS
	MOVE	P1,S1		;SAVE IFN
	MOVEI	S1,SCDSIZ	;SIZE OF SCDMAP FILE
	PUSHJ	P,M%GMEM	;GET CORE
	MOVEM	S2,SCDTBL	;POINT TO THE CORE WE GOT
	HRLI	S2,-SCDSIZ	;MAKE AN AOBJN POINTER
	MOVE	P2,S2		;COPY IT
	MOVE	S1,P1		;GET IFN BACK

ISCD1:	PUSHJ	P,F%IBYT	;GET A WORD
	JUMPF	ISCD2		;CHECK FOR ERRORS
	MOVEM	S2,(P2)		;PUT A WORD
	AOBJN	P2,ISCD1	;LOOP THROUGH FILE
	PUSHJ	P,ISCD3		;RELEASE THE CHANNEL
	$RETT			;RETURN

ISCD2:	PUSHJ	P,A$DSCD	;DELETE MAP

ISCD3:	MOVE	S1,P1		;GET IFN
	PUSHJ	P,F%RREL	;RELEASE THE CHANNEL
	$RETF			;RETURN
; DELETE SCDMAP.SYS DATA
; CALL:	PUSHJ	P,A$CSCD

A$DSCD::MOVEI	S1,SCDSIZ	;SIZE OF SCDMAP FILE
	MOVE	S2,SCDTBL	;ADDRESS OF MAP
	PUSHJ	P,M%RMEM	;RELEASE CORE
	SETZM	SCDTBL		;CLEAR POINTER
	$RETT			;RETURN
; GET SCHEDULER TYPE AND CLASS
; CALL:	MOVE	S1, PROFILE BLOCK ADDRESS
;	PUSHJ	P,A$FSCD

A$FSCD::PUSHJ	P,.SAVE3	;SAVE SOME ACS
	MOVE	P1,S1		;POINT TO ENTRY
	SKIPN	P2,SCDTBL	;FIND OUT IF WE HAVE SCHEDULAR DATA
	JRST	FSCD1		;NOPE, JUST GIVE THE RAW FILE DATA
	LDB	P2,[POINTR .AESCD(P1),AE.SCD] ;GET SCHEDULAR TYPE
	IDIVI	P2,4		;GET INDEX INTO TABLE
	ADD	P2,SCDTBL	;ADD TABLE BASE ADDRESS
	LDB	S1,BYTTAB(P3)	;GET TIMESHARING CLASS
	ADDI	P2,SCDSIZ/2	;POINT INTO BATCH END
	LDB	P2,BYTTAB(P3)	;GET BATCH CLASS
	DPB	S1,[POINTR P2,AE.SCT] ;TIMESHARING INFO

FSCD1:	HRRM	P2,.AESCD(P1)	;GET SCHEDULAR TYPE AND ENQ QUOTA
	$RETT

BYTTAB:	POINT	9,(P2),8	;BYTE PTR FOR REMAINDER=0
	POINT	9,(P2),17	;REMAINDER=1
	POINT	9,(P2),26	;REMAINDER=2
	POINT	9,(P2),35	;REMAINDER=3
SCDFOB:	$BUILD	(FOB.MZ)	;BLOCK SIZE
	  $SET	(FOB.FD,,SCDFD)	  ;FILE DESCRIPTOR
	  $SET	(FOB.CW,FB.PHY,1) ;PHYSICAL I/O
	  $SET	(FOB.CW,FB.BSZ,44);36-BIT BYTES
	$EOB			;END OF BLOCK

SCDFD:	$BUILD	(FDXSIZ)	;BLOCK SIZE
	  $SET	(.FDLEN,FD.LEN,FDXSIZ) ;BLOCK LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT) ;NATIVE TOPS-10 FILE
	  $SET	(.FDSTR,,'SYS   ');DEVICE
	  $SET	(.FDNAM,,'SCDMAP');FILE NAME
	  $SET	(.FDEXT,,'SYS   ');EXTENSION
	$EOB			;END OF BLOCK


	LIT

	RELOC	0

SCDTBL:	BLOCK	1		;POINTER TO SCDMAP DATA

	PRGEND
TITLE	ACTSUM - GENERATE SUMMARY TEXT

	SEARCH	ACTPRM
	MODULE	(ACTSUM)

	ENTRY	A$SWLD


; GENERATE SUMMARY TEXT FOLLOWING CALLS TO FETCH A PROFILE
; CALL:	MOVE	T1, WILDCARD MESSAGE BLOCK
;	MOVE	T2, BYTE POINTER TO ACK TEXT
;	MOVE	T3, TEXT
;	MOVE	T4, SUCCESS-COUNT,,FAILURE-COUNT
;	PUSHJ	P,A$SWLD
;
; TRUE RETURN:	AT LEAST ON PROFILE FOUND
; FALSE RETURN:	NO PROFILES FOUND
;
; ON EITHER RETURN, S1 CONTAINS THE ADDRESS OF THE GENERATED TEXT

A$SWLD::PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,S1		;COPY TEXT TO INSERT
	SKIPG	UW$FND(T1)	;FOUND ANY MATCHES?
	JRST	SWLD1		;NO
	HLRZ	TF,T4		;GET SUCCESS COUNT
	MOVEI	S1,[ITEXT (<^D/T4,LHMASK/ users>)]
	CAIN	TF,0
	MOVEI	S1,[ITEXT (<no users>)]
	CAIN	TF,1
	MOVEI	S1,[ITEXT (<one user>)]
	HRRZ	TF,T4		;GET FAILURE COUNT
	MOVEI	S2,[ITEXT (<; there were ^D/T4,RHMASK/ failures>)]
	CAIN	TF,0
	MOVEI	S2,[ITEXT (<>)]
	CAIN	TF,1
	MOVEI	S2,[ITEXT (<; there was one failure>)]
	$TEXT	(<-1,,SUMTXT>,<A total of ^I/(S1)/ ^T/(P1)/^I/(S2)/^0>)
	MOVEI	S1,SUMTXT	;POINT TO TEXT
	$RETT			;RETURN

SWLD1:	MOVE	S1,UW$WST(T1)	;GET SEARCH TYPE
	CAIN	S1,1		;WILD NAME?
	JRST	SWLD2		;YES
	CAIN	S1,2		;NON-WILD NAME?
	JRST	SWLD3		;YES
	CAIG	S1,1		;WILD PPN OR NAM?
	MOVE	S1,UW$PPM(T1)	;GET PPN MASK
	AOJE	S1,SWLD3	;JUMP IF NOT WILD

SWLD2:	MOVEI	S2,[ITEXT (<No users matching ^Q/T2/>)]
	SKIPE	UW$SEL(T1)	;ANY SELECTION BLOCKS?
	MOVEI	S2,[ITEXT (<Users ^Q/T2/ rejected by constraints>)]
	JRST	SWLD4		;FINISH UP

SWLD3:	MOVEI	S2,[ITEXT (<No such user ^Q/T2/>)]
	SKIPE	UW$SEL(T1)	;ANY SELECTION BLOCKS?
	MOVEI	S2,[ITEXT (<User ^Q/T2/ rejected by constraints>)]

SWLD4:	$TEXT	(<-1,,SUMTXT>,<^I/(S2)/^0>)
	MOVEI	S1,SUMTXT	;POINT TO TEXT
	$RETF			;RETURN


	LIT

	RELOC	0

SUMTXT:	BLOCK	^D30		;ROOM FOR A LONG NAME + LOTS OF CRUFT

	END