;<PUP>SMXACC.MAC.6,  5-May-82 15:46:50, Edit by SCHOEN
; Add ERCAL to GET in $RNUAC
;<PUP>SMXACC.MAC;3		4/6/80		EDIT BY SCHOEN
; BLT in $VACCT to clear UACBLK was missing AC1 operand.  Caused
; PUPSRV to pages 1-16 of core...
;<PUP>SMXACC.MAC;1		3/21/80		EDIT BY RINDFLEISCH
; Code to simulate GDACC and VACCT JSYSs from SUBMIT in the batch system
; TENEX 131 does not have these JSYSs


	TITLE SMXACC -- GDACC/VACCT JSYS EMULATION
	SUBTTL T. C. Rindfleisch / March, 1980

	SEARCH STENEX,PUPDEF,PSVDEF

P==17

; Verify user/account pair
; Entry:   1 = USER # (-1 MEANS SELF (CONN DIR))
;	   2 = ACCT DESIGNATOR, 5B2+NUMBER OR DSP
; Call:    PUSHJ P,$VACCT
; Return:  +1	FAIL TO MATCH
;	   +2	USER/ACCT PAIR MATCH (or UACHK unrunnable)

$VACCT::MOVEM	P,UPDL		;SAVE THE USER'S STACK POINTER
	PUSH	P,1		;USER NUMBER
	PUSH	P,2		;ACCOUNT DESIGNATOR
	PUSH	P,3
	MOVEI	1,400000	;THIS FORK
	RPCAP
	TRNE	3,1B18+1B19	;WHEEL OR OP?
	 JRST  [POP P,3		;YES
		JRST $VACC2]	;SKIP RETURN
	POP	P,3
	MOVE	2,-1(P)		;GET USER NUMBER
	SETZM	UACBLK
	MOVE	1,[UACBLK,,UACBLK+1]
	BLT	1,UACBLK+17	;CLEAR AC ARG BLOCK (ejs,4/6/80 ac1 was missing)
	CAME	2,[-1]		;SELF?
	 JRST $VACC1		;NO
	PUSH	P,3
	PUSH	P,4
	GJINF			;GET JOB INFO CONN DIR IN 2
	POP	P,4
	POP	P,3
$VACC1:	HRROI	1,UACBLK	;FIRST 8 AC'S CONTAIN DIRST
	DIRST
	 JRST  [MOVEI 1,VACX1	; Error, no such user
		JRST $VAFXT]
	MOVE	1,0(P)		;GET ACCT DESG
	CAML	1,[500000,,0]
	CAMLE	1,[577777,,-1]	;IS IT NUMERIC?
	 JRST $VASTR		;NO STRING
	MOVEM	1,UACBLK+10	;NUMERIC DESIG IN AC10
	MOVEI	2,1		;START AT NUMERIC ENTRY POINT
	JRST $VACC3		; Run the fork

$VASTR:	MOVE	2,[POINT 7,UACBLK+10] ;POINT TO AC10-17 FOR ACCT STRING
	TLC	1,-1		;DSP?
	TLCN	1,-1		;SKIP IF NOT DSP
	HRLI	1,440700	;CONVERT TO STRING POINTER
	PUSH	P,3
	PUSH	P,4
	MOVNI	4,^D39		;WE ONLY TAKE 39 CHARS
$VALUP:	ILDB	3,1
	IDPB	3,2
	CAIE	3,0		;SKIP IF NULL BYTE
	 AOJL	4,$VALUP	;GET 39 CHARS MAX
	POP	P,4
	POP	P,3
	MOVEI	2,2		;ENTRY POINT FOR STRING
$VACC3:	MOVEI	1,UACBLK	;POINT TO ARG BLOCK
	PUSHJ	P,$RNUAC
	 JRST $VACC2		;FORK FAILED TO RUN
	CAIE	1,0		;FIND A MATCH?
	 SKIPA 1,[VACX2]	; No Match
$VACC2:	AOSA -2(P)		; OK, Skip return
$VAFXT:	MOVEM 1,-1(P)		; Error, install code - non-skip return
	POP P,2
	POP P,1
	POPJ P,


; Get default account for user
; Entry:   1 = E FOR STRING ACCT (DSP)
;	   2 = USER DIR # (-1 FOR SELF (CONN DIR))
; Call:    PUSHJ P,$GDACC
; Return:  +1	FAILURE
;	   +2	SUCCESS ACCOUNT STRING POINTER IN AC1
;
$GDACC::MOVEM	P,UPDL		;SAVE USER'S STACK POINTER
	PUSH	P,1		;DSP FOR ACCT
	PUSH	P,2		;USER NUMBER
	SETZM	UACBLK
	MOVE	1,[UACBLK,,UACBLK+1]
	BLT	1,UACBLK+17	;CLEAR AC ARG BLOCK
	CAME	2,[-1]		;SELF?
	 JRST $GDAC1		;NO
	PUSH	P,3
	PUSH	P,4
	GJINF			;GET CONN DIR NUM IN 2
	POP	P,4
	POP	P,3
$GDAC1:	HRROI	1,UACBLK	;POINT TO AC0-7	FOR DIRST
	DIRST
	 JRST  [MOVEI 1,GDACX1	; No go
		JRST $GDFXT]	;DO FAIL RETURN
	MOVEI	1,UACBLK	;POINT TO AC BLOCK
	SETZ	2,		;0 ENTRY POINT FOR DEFAULT
	PUSHJ	P,$RNUAC
	 JRST  [MOVEI 1,ACCTX1	;NON-SKIP IF FORK FAILED
		JRST $GDFXT]
	CAIE	1,0		;DID WE FIND DEFAULT?
	 JRST  [MOVEI 1,GDACX2	; No go
		JRST $GDFXT]
	PUSH	P,3
	PUSH	P,4
	MOVNI	3,^D39		;39 CHARS MAX
	HRRZ	2,UACBLK+2	;GET POINTER REL TO AC BLOCK
	ADD	2,[POINT 7,UACBLK] ;MAKE IT A USEFUL POINTER
	MOVE	4,-3(P)		;GET USERS POINTER
	HRLI	4,440700	;MAKE E A POINTER
$GDACL:	ILDB	1,2
	IDPB	1,4
	CAIE	1,0		;SKIP IF  A NULL
	AOJL	3,$GDACL
	JUMPE 3,[DPB 3,4	; MAKE SURE IT'S ASCIZ
		 JRST .+1]
	POP	P,4
	POP	P,3
	AOSA	-2(P)		;DO SKIP RETURN
$GDFXT:	MOVEM 1,-1(P)		; INSTALL THE ERROR CODE
	POP	P,2
	POP	P,1
	POPJ	P,


; Runs UACHK program for account lookup/check
; Entry:   1 = POINTER TO AC ARG BLOCK
;	   2 = ENTRY VECTOR OFFSET
;	   	0=GET DEFAULT, 1=NUMERIC CHECK, 2=STRING CHECK
; Call:    PUSHJ P,$RNUAC
; Return:  +1, failure
;	   +2, success

$RNUAC:	PUSH	P,1		;ARG POINTER
	PUSH	P,2		;ENTRY VECTOR
	MOVSI	1,(1B2+1B17)	;OLD FILE, SHORT FORM
	HRROI	2,[ASCIZ /<SYSTEM>UACHK.SAV/]
	GTJFN
	JRST [	POP	P,2
		POP	P,1
		POPJ	P, ]	;DO FAIL RETURN IF CANT FIND FILE
	PUSH	P,1		;JFN
$RNUA1:	MOVSI	1,(1B1)		;SET CAP DONT START
	CFORK
	 JRST  [MOVEI	1,^D1000
		DISMS		;TRY AGAIN IN 1 SEC
		JRST $RNUA1]
	PUSH	P,1		;FORK HANDLE
	MOVSI	1,0(1)		;MOVE HANDLE TO LH
$RNUA2:	HRR	1,-1(P)		;AND PUT JFN IN RH
	GET
	 ERCAL	$RNUAF
	MOVE	1,(P)
	MOVE	2,-3(P)		;GET POINTER TO ARG BLOCK
	SFACS			;LOAD ACS
	MOVE	2,-2(P)		;GET VECTOR OFFSET
	SFRKV			;START IT
	WFORK			;WAIT FOR IT
	FFORK			;FREEZE IT
	MOVE	2,-3(P)		;POINT TO ARG BLOCK
	RFACS			;COPY BACK THE ACS
	RFSTS			;GET FORK STATUS
	TLZ	1,(1B0)		;KILL THE FREEZE BIT
	CAME	1,[2,,0]
	 TLOA	2,-1		;INVOL TERMINATE
	TLZ	2,-1		;CLEAN HALT
	POP	P,1		;GET FORK HANDLE
	KFORK			;GET RID OF IT
	POP	P,1		;GET THE JFN
	RLJFN			;RELEASE IT
	 JFCL			;SHOULDNT HAPPEN!!??
	MOVE	1,-1(P)		;POINT TO BLOCK
	MOVE	1,1(1)		;WE WANT THE AC1
	CAIL	2,0		;INVOL TERMINATE?
	CAILE	1,0		;OR PROGRAM ERROR?
	 SOS	-2(P)		;DO NON-SKIP
	POP	P,2
	SUB	P,[1,,1]	;POP STACK AGAIN
	AOS	(P)
	POPJ	P,

; HERE ON ILLEGAL INSTRUCTION
$RNUAF: PUSH P,1
	PUSH P,2
	MOVEI 1,400000
	GETER
	MOVEI 2,(2)
	ELOG <$RNUAC: PSI due to %2J%/>
	CAIN 2,GETX2		; Special pages table full?
	 JRST [MOVE 1,-2(P)
	       MOVE 1,-1(1)	; Get the failing instruction
	       CAME 1,[GET]	; A get?
	       JRST .+1		; No, leave
	       MOVEI 1,^D1000	; Yes, wait and try again
	       DISMS		
	       POP P,2
	       POP P,1
	       SOS 0(P)		; Return to the failing instruction
	       POPJ P,]
	MOVE P,UPDL
	POPJ P,			;Ret +1 for perceived failure

; AC block for running UACHK
UACBLK:	BLOCK 20		; AC block for running lower fork
UPDL:	BLOCK 1			; User's stack pointer on entry
	END