Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11i-bm_tops20_v7_0_atpch_1-22 - autopatch/actgen.x22
There are no other files named actgen.x22 in the archive.
; Edit= 37 to ACTGEN.MAC on 3-Mar-89 by WONG (TCO none)
;Make ACTGEN look for <SYSTEM>ACCOUNTS-TABLE.BIN in PS: or BS: depending if we
;are 4.1 or 7.0.
; Edit= 36 to ACTGEN.MAC on 25-Mar-88 by LOMARTIRE
;Bump edit number for 7.0 Autopatch 
; UPD ID= 48, RIP:<7.UTILITIES>ACTGEN.MAC.6,  19-Feb-88 17:46:05 by GSCOTT
;TCO 7.1236 - Edit 26, update copyright notice.
; UPD ID= 29, RIP:<7.UTILITIES>ACTGEN.MAC.3,  14-Dec-87 09:14:40 by BROOKS
;Increment version number for 7.0 ft1
; UPD ID= 24, RIP:<7.UTILITIES>ACTGEN.MAC.2,   4-Nov-87 15:50:05 by MCCOLLUM
;TCO 7.1112 - Write ACCOUNTS-TABLE.BIN to BS:<SYSTEM>.
; *** Edit 14 to ACTGEN.MAC by EVANS on 2-Jun-87, for SPR #21629
; Precede COMND% error message with "%" for those who want their batch jobs to
; stop
; *** Edit 13 to ACTGEN.MAC by EVANS on 17-Mar-86 (TCO none)
; Do not allow INSTALLation of a null ACCOUNTS-TABLE.BIN
;Edit 12 to ACTGEN.MAC by EVANS on Thu 20-Sep-84, for SPR #20333 - 
;		Change ANDI to ANDX and get both halves of word counter.
;Edit 11 to ACTGEN.MAC by EVANS on Wed 22-Aug-84
;		Be sure to POP from same stack we PUSHed onto (RE:edit 9)
;Edit 10 to ACTGEN.MAC by EVANS on Tue 14-Aug-84, for SPR #20299
;		Set ACTFLG when processing /EXPIRES on first account.
;Edit 9 to ACTGEN.MAC by EVANS on Tue 14-Aug-84, for SPR #20205
;		Add error character to PANIC message so batch job stops.
;;		Output PANIC errors directly (don't user ERSTR as LSTERR doesn't
;;		get set up if not a JSYS error).
;;		Increase DATSTK from 2000 to 5000 locations so no PDL overflow.
;;		Push flags on correct stack when processing subaccounts.
; UPD ID= 69, FARK:<5-1-WORKING-SOURCES.UTILITIES>ACTGEN.MAC.4,  29-Dec-82 13:51:11 by WEETON
;Edit 8 - Force all files to have at least one "ACCOUNT" command.
; UPD ID= 9, FARK:<5-WORKING-SOURCES.UTILITIES>ACTGEN.MAC.2,  23-Apr-82 14:13:05 by WEETON
;Edit 7 - Subaccounts without "ACCOUNT" first, cause duplicate account blocks
; UPD ID= 85, SNARK:<5.UTILITIES>ACTGEN.MAC.6,  26-Feb-82 14:16:33 by WEETON
;TCO 5.1647 - Fix /EXPIRES: switch at following USER command in ACCOUNTS.CMD
;<5.UTILITIES>ACTGEN.MAC.5, 13-May-81 13:37:41, EDIT BY GRANT
; UPD ID= 1886, SNARK:<5.UTILITIES>ACTGEN.MAC.4,  24-Apr-81 16:46:12 by SCHMITT
;TCO 5.1299 - Reset right flags when leaving ACCT8
; UPD ID= 1672, SNARK:<5.UTILITIES>ACTGEN.MAC.3,  11-Mar-81 22:21:28 by GRANT
;UPDATE COPYRIGHT
; UPD ID= 1652, SNARK:<5.UTILITIES>ACTGEN.MAC.2,   6-Mar-81 15:31:24 by BLOUNT
;change version number to 5
; UPD ID= 331, SNARK:<4.1.UTILITIES>ACTGEN.MAC.4,  14-Mar-80 10:50:27 by OSMAN
;tco 4.1.1109 - Fix .CLASS by saving class number.  Also, remove redundant NINs
;<4.1.UTILITIES>ACTGEN.MAC.3, 21-Feb-80 11:33:25, EDIT BY OSMAN
;Lengthen data stack (DATLEN)
; UPD ID= 291, SNARK:<4.1.UTILITIES>ACTGEN.MAC.2,  21-Feb-80 11:30:46 by OSMAN
;tco 4.1.1085 - Remove error about "bugchk will occur" and make so it won't,
; even if many users are put on an account.
;<4.UTILITIES>ACTGEN.MAC.31,  8-Oct-79 09:32:01, EDIT BY ENGEL
;TCO 4.2512 - ADD CODE TO CHECK FOR TRUNCATED RECORDS
;<4.UTILITIES>ACTGEN.MAC.30,  5-Oct-79 09:26:53, EDIT BY MILLER
;TCO 4.2222 AGAIN. HANDLE MORE THAN 36 CLASSES (CURRENT # IS 180)
;<4.UTILITIES>ACTGEN.MAC.29,  1-Oct-79 10:20:31, Edit by KONEN
;Clear string words before their use to avoid garbage
;<4.UTILITIES>ACTGEN.MAC.28, 26-Mar-79 17:44:50, EDIT BY MILLER
;TCO 4.2222. ADD /ALLOW SWITCH.
;<MILLER>ACTGEN.MAC.3, 26-Mar-79 17:25:33, EDIT BY MILLER
;<4.UTILITIES>ACTGEN.MAC.27, 26-Mar-79 15:56:34, EDIT BY MILLER
;FIX .CLASS TO INCREMENT CLASS NUMBER BEFORE RETURNING
;<4.UTILITIES>ACTGEN.MAC.26, 10-Mar-79 13:28:35, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>ACTGEN.MAC.25, 19-Oct-78 23:00:59, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.24, 28-Sep-78 15:40:42, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.23, 28-Sep-78 15:30:04, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.22, 27-Sep-78 15:12:41, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.21, 27-Sep-78 15:11:10, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.20, 21-Sep-78 20:36:58, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.19, 21-Sep-78 20:36:11, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.18, 21-Sep-78 20:07:53, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.17, 21-Sep-78 19:59:29, Edit by MCLEAN
;<2MCLEAN>ACTGEN.MAC.16, 21-Sep-78 19:57:37, Edit by MCLEAN

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.
	TITLE ACTGEN

	SEARCH MONSYM, MACSYM
	.CPYRT <<1976, 1988>>
	.REQUIRE SYS:MACREL
	SALL

; ACCUMULATOR DEFINITIONS

	F=0		;USED BY ACTGEN
	T1=1		;TEMPORARY
	T2=2		;TEMPORARY
	T3=3		;TEMPORARY
	T4=4		;TEMPORARY
	Q1=5		;PRESERVED
	Q2=6
	Q3=7		;PRESERVED
	P1=10		;USED BY ACTGEN
	P2=11		;USED BY ACTGEN
	P3=12		;USED BY ACTGEN
	P4=13		;USED BY ACTGEN
	P5=14		;[7]USED BY ACTGEN
	P6=15		;PRESERVED (CAUTION, USED BY SOME MACROS IN MACSYM)
	CX=16		;RESERVED FOR SUPPORT CODE
	P=17		;PUSH-DOWN POINTER

; LOCAL AC USAGE
;
; F/ FLAG AC
; P1/ START ADDRESS OF AN ACCOUNT DATA BLOCK
; P2/ POINTER TO JFN STACK
; P3/ POINTER TO DATA STACK
; P4/ POINTER TO COMND STATE BLOCK STACK
;	THESE STACKS ARE NORMAL PUSHDOWN LISTS
	Subttl	Table of Contents

;		     Table of Contents for ACTGEN
;
;				  Section		      Page
;
;
;    1. Version Number . . . . . . . . . . . . . . . . . . . .   4
;    2. MAIN ENTRY POINT AND INITIALIZATION  . . . . . . . . .   7
;    3. COMMAND PARSER AND DISPATCH  . . . . . . . . . . . . .   8
;    4. TAKE (COMMANDS FROM) FILE-SPEC . . . . . . . . . . . .  11
;    5. ACCOUNT ENTRY  . . . . . . . . . . . . . . . . . . . .  13
;    6. DIRECTORY ENTRY  . . . . . . . . . . . . . . . . . . .  32
;    7. USER ENTRY . . . . . . . . . . . . . . . . . . . . . .  38
;    8. GROUP ENTRY  . . . . . . . . . . . . . . . . . . . . .  44
;    9. GROUP SWITCHES . . . . . . . . . . . . . . . . . . . .  46
;   10. INSTALL COMMAND  . . . . . . . . . . . . . . . . . . .  49
;   11. HELP AND EXIT COMMANDS . . . . . . . . . . . . . . . .  52
;   12. COMMAND ERROR SUBROUTINES  . . . . . . . . . . . . . .  54
;   13. PARSING SUBROUTINES  . . . . . . . . . . . . . . . . .  59
;   14. GENERAL SUBROUTINES  . . . . . . . . . . . . . . . . .  61
;   15. FREE STORAGE MANAGER . . . . . . . . . . . . . . . . .  65
;   16. SCAN DATSTK  . . . . . . . . . . . . . . . . . . . . .  70
;   17. OUTPUT BLOCKS TO FILE  . . . . . . . . . . . . . . . .  79
;   18. CMDSTK MANIPULATION  . . . . . . . . . . . . . . . . .  81
;   19. INTERRUPT HANDLERS . . . . . . . . . . . . . . . . . .  83
;   20. CONSTANTS AND TABLES . . . . . . . . . . . . . . . . .  86
;   21. VARIABLE DATA STORAGE  . . . . . . . . . . . . . . . .  90
;   22. End of ACTGEN  . . . . . . . . . . . . . . . . . . . .  94
	SUBTTL Version Number

; VERSION NUMBER DEFINITIONS

VMAJOR==6		;[7.1112]MAJOR VERSION OF ACTGEN
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==VI%DEC+^D37	;EDIT NUMBER
VWHO==0			;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)

VACTGEN== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
NCHPW==5		;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200		;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ		;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2	;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2	;SIZE OF FUNCTION DESCRIPTOR BLOCK
KEYSIZ==.CMDEF+2	;DITTO
PDLEN==100		;PUSH-DOWN STACK DEPTH
JFNLEN==^D20		;JFN STACK DEPTH
AFFLEN==JFNLEN		;[7]ACCOUNT SEEN FIRST FLAG
CMSLEN==20*<.CMGJB+5+BUFSIZ> ;COMND STATE STACK DEPTH
DATLEN==5000		;[9] DATA STACK DEPTH - increase from 2000 to 5000
MAXLEN==^D39		;MAX # CHARACTERS IN ACCOUNT, USER, OR DIR NAME
HTBLEN==1000		;HASH TABLE SIZE - CURRENTLY ONE PAGE
HSHLEN==HTBLEN-1	;NUMBER OF HASH VALUES

HTBBLK==100000		;START OF HASH TABLE IN THIS FORK
HSHVAL==HTBBLK+1	;START OF HASH VALUES IN HASH TABLE

; FREE SPACE BOUNDS

MINFRE==HTBBLK+HTBLEN	;LOWER LIMIT STARTS AFTER HASH TABLE
MAXFRE==770000		;UPPER LIMIT 

STDECH=="A"-100		;STANDARD ESCAPE CHARACTER
STDESC==1B<STDECH>	;CHANNEL MASK FOR ESCAPE CHARACTER

; DATSTK ENTRIES

DEFSTR (ENTYP,0,17,18)	;TYPE OF ENTRY
DEFSTR (FSADR,0,35,18)	;ADDRESS OF DATA BLOCK IN FREE SPACE

;GENERAL PARAMETERS
; ALL BLOCKS HAVE THESE FIELDS - NULL BLOCK DOES NOT HAVE
; AN EXPIRATION DATE

DEFSTR (BKTYP,0,17,18)		;BLOCK TYPE
DEFSTR (BKLEN,0,35,18)		;BLOCK LENGTH
DEFSTR (XPDAT,1,35,36)		;EXPIRATION DATE
;HASH TABLE

;ACCOUNT HEADER

DEFSTR (ACCLS,2,8,9)		;JOB CLASS
DEFSTR (DATASZ,2,35,27)		;TOTAL LENGTH OF ACCOUNT DATA BLOCK
DEFSTR (ACPTR,3,35,36)		;POINTER TO NEXT ACCOUNT DATA BLOCK
DEFSTR (ACNAM,4,35,36)		;START OF ASCIZ ACCOUNT STRING NAME

;USER NAME 

DEFSTR (USRNM,2,35,36)		;START OF USER NAME STRING

;SXSTR - SIXBIT STRUCTURE NAME - IS COMMON TO ALL DIRECTORY ENTRIES

DEFSTR (SXSTR,2,35,36)		;SIXBIT STRUCTURE NAME

;DIRECTORY NAME

DEFSTR (DIRNM,3,35,36)		;START OF DIRECTORY NAME STRING

;USER GROUP

DEFSTR (USRGP,2,35,36)		;GROUP NUMBER

;DIRECTORY GROUP

DEFSTR (DIRGP,3,35,36)		;GROUP NUMBER

;BLOCK TYPES

	.TYHSH==:577001		;BLOCK TYPE OF HASH TABLE
	.TYACC==:577002		;BLOCK TYPE OF ACCOUNT STRING
	.TYUNM==:577003		;BLOCK TYPE OF USER NAME
	.TYUGP==:577004		;BLOCK TYPE OF USER GROUP
	.TYALU==:577005		;BLOCK TYPE OF "ALL USERS"
	.TYDNM==:577006		;BLOCK TYPE OF DIRECTORY NAME
	.TYDGP==:577007		;BLOCK TYPE OF DIRECTORY GROUP
	.TYALD==:577010		;BLOCK TYPE OF "ALL DIRECTORIES"
	.TYNUL==:577011		;BLOCK TYPE OF NULLS
	.TYWUS==:577012		;BLOCK TYPE OF WILD CARD USER NAME STRING

   DEFINE RETBAD (X)<
IFB <X>,<RET>
IFNB <X>,<JRST [MOVEI T1,X
		RET]>
   >
	SUBTTL MAIN ENTRY POINT AND INITIALIZATION

START:	SKIPE ACTJFN		;ACCOUNT FILE OPEN?
	CALL CLSACT		;YES, GO UNMAP AND CLOSE IT
	RESET			;RESET THE UNIVERSE
	SETZM	ACTFLG		;[7]MAKE SURE ACCOUNT SEEN FLAG IS OFF
	MOVEI T1,MAXMSK		;MAX WORDS IN MASK
	SETOM CLSMSK-1(T1)	;SET IT
	SOJG T1,.-1		;DO ALL OF MASK
	MOVX T1,.FHSLF		;GET CAPABILITIES FOR THIS PROCESS
	RPCAP
	TXNN T3,SC%WHL!SC%OPR	;PRIVILEGED USER?
	JRST [	TMSG <? WHEEL or OPERATOR capability required>
		HALTF
		JRST START]	;GO RESTART
	MOVX T1,.FHSLF		;INITIALIZE INTERRUPT SYSTEM
	DIR			;TURN IT OFF FIRST
	MOVE T2,[LEVTAB,,CHNTAB] ;SET UP PI SYSTEM
	SIR
	MOVX T1,.FHSLF		;GET OUR FORK HANDLE
	MOVEI T2,STDECH		;SET UP STANDARD ESCAPE CHARACTER
	MOVEM T2,TRPCHR	
	AIC			;ON CHANNEL 5
	HRLZ T1,TRPCHR		;ENABLE ESCAPE CHARACTER
	HRRI T1,TRPCHN		; ON ITS OWN CHANNEL
	ATI
	MOVX T1,.FHSLF
	MOVE T2,ONCHNS		;ACTIVATE ALL DESIRED CHANNELS
	AIC			
	MOVX T1,.FHSLF		;GET OUR FORK HANDLE
	EIR			;ENABLE PI SYSTEM
	;...
	SUBTTL COMMAND PARSER AND DISPATCH

	;...
START1:	MOVE P,[IOWD PDLEN,PDL]	;SET UP STACK
	MOVE P2,[IOWD JFNLEN,JFNSTK] ;SET UP JFN STACK
	MOVE P3,[IOWD DATLEN,DATSTK] ;SET UP DATA STACK
	MOVE P4,[IOWD CMSLEN,CMDSTK] ;SET UP COMND BLOCK STACK
	MOVE P5,[IOWD AFFLEN,AFFSTK] ;[7]SET UP ACCOUNT FOUND FIRST STACK
	SETZ F,			;RESET FLAGS
	TXO F,FTTFLG		;TURN ON FIRST-TIME-THROUGH FLAG
	CALL BLKBLT		;ZERO SOME STORAGE SPACE
	CALL FSHDR		;SET UP FREE SPACE HEADER
	MOVEI T1,ACTTAB
	MOVEM T1,CMDTAB
	MOVEM T1,CMDBLK+.CMRTY	;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,,OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
START2:	HRROI T1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM T1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	HRROI T1,PTRBUF		;GET POINTER TO NEXT FIELD TO BE PARSED
	MOVEM T1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVE T1,[CM%RAI+CM%XIF+PARSE1] ;CONVERT LOWERCASE TO UPPER, INDIRECT FILES NOT ALLOWED, REPARSE ADDRESS
	MOVEM T1,CMDBLK+.CMFLG	;SAVE REPARSE ADDRESS
	SETZM CMDBLK+.CMINC	;INITIALIZE # OF CHARACTERS AFTER POINTER
	MOVEI T1,BUFSIZ*NCHPW	;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM T1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI T1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI T1,ATMSIZ*NCHPW	;GET # OF CHARACTERS IN ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
PARSE:	HRROI T1,PROMPT		;GET POINTER TO PROGRAM'S PROMPT STRING
	CALL CMDINI		;OUTPUT THE PROMPT
PARSE1:	MOVE T1,[CZ%NCL+.FHSLF]	;RELEASE ALL NON-OPEN JFN'S OF OURSELF AND BELOW
	CLZFF
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK

	MOVEI T1,GJFBLK		;GET ADDRESS OF GTJFN BLOCK
	MOVEM T1,CMDBLK+.CMGJB	;STORE POINTER TO GTJFN BLOCK
PARSE3:	CALL SETFDB
	MOVEI T1,CMDBLK		;GET POINTER TO COMMAND STATE BLOCK
	COMND			;DO INITIAL PARSE
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;VALID COMMAND ENTERED ?
	JRST PARSE5		;YES, GO DISPATCH TO PROCESSING ROUTINE
	CALL TSTCOL		;TEST COLUMN POSITION, NEW LINE IF NEEDED
	TMSG <? ACTGEN: No such ACTGEN command as ">
	MOVE T1,CMDBLK+.CMABP	;GET POINTER TO ATOM BUFFER
	PSOUT			;OUTPUT STRING ENTERED BY USER
	TMSG <"
>				;OUTPUT END-OF-MESSAGE
	JRST PARSE		;GO TRY TO GET A COMMAND AGAIN

PARSE5:	HRRZ T1,(T2)		;GET DISPATCH ADDRESS
	TXNE F,BASFLG		;WAS A BAD ACCOUNT SEEN?
	JRST [	CAIE T1,.ACCT	;IS IT A NEW ACCOUNT ENTRY?
		JRST PARSE	;NO, IGNORE ENTRY AND PARSE NEXT ONE
		JRST PARSE6]	;GO PARSE ACCOUNT ENTRY
PARSE6:	CALL (T1)		;PERFORM REQUESTED FUNCTION
	JRST PARSE		;GO PARSE NEXT COMMAND
;TRAP CHARACTER HANDLER

TRAP:	MOVX T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	CFOBF			;CLEAR OUTPUT BUFFER
	TMSG <
>				;PRINT A CRLF
	MOVX T1,.PRIOU		;GET OUTPUT JFN AGAIN
	MOVX T2,"^"		;ECHO ESCAPE CHAR
	BOUT			; ON USER'S TERMINAL
	MOVE T2,TRPCHR		;GET THE TRAP CHAR
	TRO T2,100		;TURN IT INTO ITS ASCII COUNTERPART
	BOUT			;TYPE IT TO USER
	CALL TSTCOL		;GET NEW LINE IF NEEDED
	CALLRET RESUME		;CONTINUE

; ROUTINE TO ZERO SOME STORAGE LOCATIONS
;	CALL BLKBLT
; RETURNS: +1	ALWAYS
; CLOBBERS T1

BLKBLT:	SETZM STRUCT
	MOVE T1,[XWD STRUCT,STRUCT+1]
	BLT T1,STRUCT+ZBKLEN-1	;ZERO THE BLOCK
	RET
	SUBTTL TAKE (COMMANDS FROM) FILE-SPEC

.TAKE:	HRROI T2,[ASCIZ/COMMANDS FROM/] ;GET NOISE TEXT
	CALL SKPNOI		;GO PARSE NOISE FIELD
	RET			;FAILED, RETURN FAILURE
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK
	MOVX T1,GJ%OLD		;GET EXISTING FILE FLAG
	MOVEM T1,GJFBLK+.GJGEN	;STORE GTJFN FLAGS
	HRROI T1,[ASCIZ/ACCOUNTS/] ;GET DEFAULT FILE NAME
	MOVEM T1,GJFBLK+.GJNAM	;STORE DEFAULT FILE NAME
	HRROI T1,[ASCIZ/CMD/]	;GET DEFAULT FILE TYPE FIELD
	MOVEM T1,GJFBLK+.GJEXT	;STORE DEFAULT EXTENSION
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMFIL)] ;GET FDB ADDRESS
	COMND			;PARSE INPUT FILE SPEC
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;PARSED FILE-SPEC OK ?
	JRST TAKE5		;YES, GO ON AND SAVE INPUT JFN
	HRROI T1,[ASCIZ/? ACTGEN: Invalid file specification, /]
	CALL PUTERR		;ERROR
	CALLRET RESUME		;GO RESTART

; HERE ON A GOOD INPUT FILE SPEC

TAKE5:	SETZM	ACTFLG		;[7]ASSUME TOP OF FILE ON TAKE COMMAND
	HRRZM T2,INJFN		;SAVE INPUT JFN FOR COMMANDS
	TXON F,TAKFLG		;TAKE FILE BEING PROCESSED?
	JRST [	CALL ENDCOM	;NO, PARSE END OF COMMAND
		 RET		;RETURN, BAD CONFIRMATION
		JRST .+1]	;GOOD RETURN, CONTINUE
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK USED BY COMND JSYS
;PREVIOUS CALL MAY GO AWAY... LEAVE HERE FOR NOW
	SETZM NAMBUF		;INITIALIZE FILENAME BUFFER
	HRROI T1,NAMBUF		;GET POINTER TO PLACE TO PUT FILENAME
	MOVE T2,INJFN		;GET INPUT JFN
	MOVX T3,<FLD(.JSAOF,JS%NAM)> ;GET FLAG BITS SAYING OUTPUT NAME ONLY
	JFNS			;PUT FILENAME OF INPUT FILE IN BUFFER
	TXNN F,FTTFLG		;FIRST TIME THROUGH ACTGEN?
	JRST TAKE10		;NO, FILES ARE ALREADY OPEN
	MOVE T1,INJFN		;GET INPUT JFN
	MOVE T2,[7B5+OF%RD]	;7-BIT BYTES, READ ACCESS
	OPENF			;OPEN THE FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot open input file, /]
		CALL PUTERR	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]

;GET A JFN FOR OUTPUT FILE ACCOUNTS-TABLE.BIN

	MOVX T1,GJ%FOU+GJ%SHT+.GJDEF
	HRROI T2,[ASCIZ/ACCOUNTS-TABLE.BIN/]
	GTJFN			;GET A JFN FOR DATA FILE
	 JRST [	HRROI T1,[ASCIZ/ ? Cannot get jfn for file ACCOUNTS-TABLE.BIN, /]
		CALL PUTERR 	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]
	;...
	;...

;OPEN DATA FILE FOR WRITING

	MOVEM T1,ACTJFN		;SAVE JFN
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD+OF%WR> ;36-BIT BYTES, OPEN FOR WRITE AND READ
	OPENF			;OPEN THE FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot open output file, /]
		CALL PUTERR	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]
	HRLZ T1,ACTJFN		;OUTPUT FILE JFN
	MOVEI T2,HTBBLK		;START OF HASH TABLE
	IDIVI T2,HTBLEN		;PAGE # OF HASH TABLE IN THIS FORK
	HRLI T2,.FHSLF		;SAY THIS PROCESS
	MOVX T3,PM%RD+PM%WR	;READ/WRITE ACCESS
	PMAP			;MAP FILE PG. 0 TO THIS FORK
	SETZM HTBBLK		;ZERO HASH TABLE
	MOVE T1,[XWD HTBBLK,HTBBLK+1]
	BLT T1,HTBBLK+HTBLEN-1
	MOVEI P1,HTBBLK		;POINTER TO HASH TABLE
	MOVEI T1,.TYHSH		;HASH TABLE BLOCK TYPE
	STOR T1,BKTYP,(P1)	;STORE IN HEADER WORD
	MOVEI T1,HTBLEN		;TABLE LENGTH
	STOR T1,BKLEN,(P1)	;STORE IN HEADER
	MOVE T1,ACTJFN		;OUTPUT FILE JFN
	MOVEI T2,HTBLEN		;BYTE #1000
	MOVEM T2,BYTCNT		;SAVE AS # BYTES ALREADY WRITTEN OUT
	SFPTR			;MAKE FILE PTR POINT TO
				; TOP OF PAGE 1 FOR SUBSEQUENT I/O
				; TO FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot set file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;GO RESTART

;SAVE JFNS'S AND GO PARSE ENTRIES

TAKE10:	HRLZ T1,INJFN		;GET INPUT JFN
	HRRI T1,.NULIO		;OUTPUT JFN IS ALWAYS NULL I/O
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE NEW JFN'S
	MOVEI T1,TAKTAB		;POINTER TO FILE ENTRIES TABLE
	MOVEM T1,CMDTAB		;STORE TO SET UP FDB FOR "TAKE" ENTRIES
	JRST PARSE		;NO, CONTINUE TO PARSE FILE ENTRIES
	SUBTTL ACCOUNT ENTRY 

.ACCT:	TRVAR <BYTLEN>
	TXNN F,FTTFLG		;FIRST TIME THROUGH ACTGEN?
	CALL ACCT5		;NO, GO SEE IF A SUBACCOUNT WAS SEEN
	SETZM ALWMSO		;NOTHING IS THE ALLOW MASK
	MOVEI T1,MAXMSK		;WORDS IN MASK
	SETZM ALWMSK-1(T1)	;CLEAR IT
	SOJG T1,.-1		;DO IT ALL
	TXZ F,FTTFLG		;RESET FLAG
	SETZM TOTLEN		;RESET LENGTH OF ACCOUNT DATABLOCK
	SETZM BYTLEN		;RESET LENGTH IN BYTES OF NEW ACCT STRING
	SETZM ACTHDR		;CLEAR ACCOUNT HEADER
	MOVE T1,[XWD ACTHDR,ACTHDR+1]
	BLT T1,ACTHDR+12-1
	MOVEI P1,ACTHDR		;GET ADDRESS OF ACCOUNT HEADER
	MOVEI T1,CMDBLK		;GET ADDR OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMFLD)] ;ARBITRARY FIELD FOR ACCOUNT NAME
	COMND			;PARSE ACCOUNT STRING NAME
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST ACCTX		;NO, GO PROCESS ERROR
	MOVEI T1,4(P1)		;PLACE TO PUT ACCOUNT NAME
	HRLI T1,(<POINT 7,>)	;7-BIT BYTE POINTER
	HRROI T2,ATMBFR		;PTR TO ACCOUNT NAME FOUND
	MOVEI T3,MAXLEN+1	;MAX # CHARS IN ACCOUNT NAME PLUS TERMINATOR
	MOVEI T4,.CHNUL		;TERMINATE ON NULL BYTE
	SOUT			;SAVE ACCOUNT NAME IN DATA BLOCK
	LDB T2,T1		;GET LAST CHARACTER MOVED
	SKIPE T2		;IS IT THE TERMINATOR?
	JRST ACCTX1		;NO, ERROR
	SETZ T2,
	IDPB T2,T1		;PAD END OF ACCOUNT STRING QITH A NULL
	MOVEI T2,MAXLEN+1	;GET MAX # CHARS POSSIBLY MOVED
	SUB T2,T3		;COMPUTE # CHARS ACTUALLY IN THE STRING
	SOS T2			;SUBTRACT ONE FOR NULL COPIED
	CALL CHKACT		;SEE IF ACCT NAME LENGTH IS OK
	 JRST ACCTX1		;NO, RETURN ERROR
	MOVEM T2,BYTLEN		;SAVE LENGTH OF THIS ACCT STRING
	IDIVI T2,5		;COMPUTE # WORDS IN STRING + REMAINDER
	AOS T2			;CORRECT THE COUNT
	MOVEM T2,ACTLEN		;SAVE # WORDS IN ACCOUNT NAME
	ADDI T2,4		;LENGTH OF REST OF ACCOUNT HEADER
	STOR T2,BKLEN,(P1)	;SAVE IN ACCOUNT BLOCK
	MOVEM T2,TOTLEN		;KEEP TRACK OF BLOCK LENGTH SEEN SO FAR
	MOVEI T2,.TYACC		;TYPE OF DATA BLOCK
	STOR T2,BKTYP,(P1)	;SAVE BLOCK TYPE IN ACCOUNT HEADER
	
ACCT1:	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,ACTSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE A SWITCH OR CONFIRMATION CHAR
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST ACCTX		;NO, GO PROCESS ERROR
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST ACCT4		;NO, PARSED A CONFIRMATION CHAR
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	 JRST ACCTX0		;ERROR IN PARSING FIELD AFTER SWITCH
	TXZE F,ALWFLG		;DID ALLOW SWITCH?
	JRST ACCT1		;YES. DONE THEN
	TXZE F,CLASFL		;CHECK FOR CLASS FLAG
	JRST [	STOR T2,ACCLS,(P1) ;SAVE CLASS
		TXO F,CLASSF	;SET CLASS FLAG
		JRST ACCT1]	;TRY AGAIN
	TXNE F,EXPFLG		;EXPIRATION DATE SEEN?
	JRST ACCT3		;YES
	; ...
	; ...
ACCT9:	MOVEI T1,CMDBLK		;NO, MUST HAVE PARSED A SUBACCOUNT
	MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE EXPIRATION DATE SWITCH OR CONFIRMATION CHAR
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST ACCTX0		;NO, GO PROCESS ERROR
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST ACCT4		;NO, MUST HAVE SEEN A CONFIRMATION CHAR
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	 JRST ACCTX0		;ERROR IN PARSING FIELD AFTER SWITCH
	TXNE F,CLASFL		;CHECK FOR CLASS FLAG
	JRST [	TXNE F,CLASSF	;ALREADY HERE?
		JRST ACCTX0	;YES ERROR
		TXO F,CLASSF	;NO OK SET FLAG
		STOR T2,ACCLS,(P1) ;SAVE CLASS
		JRST ACCT9]
	STOR T2,XPDAT,(P1)	;PLACE DATE IN DATA BLOCK
	CALL ACCT7		;PLACE DATA BLOCK IN FREE SPACE
ACCT2:	TXZ F,EXPFLG!CLASSF!CLASFL ;GOOD RETURN, RESET FLAG
	CALL ENDCOM		;PARSE END-OF-ENTRY
	 RET			;ERROR RETURN
	SETOM	ACTFLG		;[7]SET ACCOUNT SEEN FIRST FLAG
	RET			;GOOD RETURN

;PARSING ERROR ENCOUNTERED IN ACCOUNT ENTRY

ACCTX0:	MOVE T1,ACTBYT		;LENGTH OF ACCOUNT STRING BEING FORMED
	SUB T1,BYTLEN		;SUBTRACT OFF LENGTH OF LOSING ACCOUNT
	MOVEM T1,ACTBYT		;AND SAVE ADJUSTED LENGTH
	HLRO T2,P2		;GET CURRENT JFN STACK DEPTH
	MOVNS T2		;MAKE IT POSITIVE
	CAIE T2,JFNLEN		;ANY PREVIOUS CONTEXTS ON STACK?
	SOS ACTBYT		;YES, CORRECT COUNT FOR DELIMITER
ACCTX: HRROI T1,[ASCIZ/? Incorrect field: /]
	CALL PRSERR		;SEND MSG TO USER
ACCTX2:	TXZ F,EXPFLG!SASFLG!CLASSF!CLASFL;RESET FLAGS
	TXO F,BASFLG		;NOTE THAT A BAD ACCOUNT WAS SEEN
	RET			;RETURN TO PARSE NEXT ENTRY
;[7]ACCOUNT NOT FIRST ENTRY IN FILE
ACCXNF:	HRROI	T1,[ASCIZ/?First command in file must be "ACCOUNT"/] ;[7]
	SKIPA			;[8]skip message
ACCXEF:	HRROI	T1,[ASCIZ/?Empty subaccount files not allowed/]	;[8]message
	CALL	ERRMES		;[7]WRITE ERROR MESSAGE
	SETO	T1,		;[7]PREPARE TO CLOSE ALL FILES
	CLOSF			;[7]CLOSE ALL POSSIBLE FILES
	 ERJMP	[CALL	TSTCOL	;[7]WRITE CR/LF IF NEEDED
		HRROI	T1,[ASCIZ/?Cannot close open files,/] ;[7]
		CALL	PUTERR	;[7]WRITE ERROR MESSAGE
		JRST	.+1]	;[7]CONTINUE
	CALLRET	RESUM2		;[7]CLOSE OUTPUT FILE

;ACCOUNT NAME TOO LONG, TELL USER

ACCTX1:	HLRO T1,P2		;JFN STACK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIN T1,JFNLEN		;ANY PREVIOUS CONTEXTS STACKED?
	JRST ACCTX3		;NO, GO PRINT MESSAGE
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? Subaccount >
	HRROI T1,ATMBFR		;SUBACCOUNT NAME
	PSOUT
	TMSG < in entry: >
	HRROI T1,BUFFER		;THIS ENTRY
	PSOUT
	TMSG <from file: >
	MOVX T1,.PRIOU
	MOVE T2,INJFN
	SETZM T3
	JFNS			;TELL USER FILE NAME
	TMSG <
 causes account name to exceed 39 characters

>
	JRST ACCTX2		;CONTINUE
ACCTX3:	HRROI T1,[ASCIZ/? Account name too long: /]
	CALL PRSERR		;TELL USER
	JRST ACCTX2		;AND CONTINUE

; ROUTINE TO SEE IF ACCOUNT NAME IS LEQ 39 CHARACTERS
; T2/ # CHARACTERS IN THIS ACCOUNT NAME
;	CALL CHKACT
; RETURNS: +1	ERROR, NAME TOO LONG
;	   +2	OK, ACTBYT UPDATED
; CLOBBERS T1, T4

CHKACT:	SAVEAC <T2>
	HLRO T1,P2		;GET CURRENT JFNSTK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIE T1,JFNLEN		;ANY PREVIOUS CONTEXTS ON STACK?
	AOS T2			;YES, ADD A BYTE FOR A DELIMITER
	MOVE T1,ACTBYT		;# CHARS IN ACCOUNT NAME SO FAR
	ADD T1,T2		;NEW LENGTH IF THIS ACCT IS ADDED
	CAILE T1,MAXLEN		;ACCEPTABLE LENGTH?
	RET			;NO, ERROR RETURN
	MOVEM T1,ACTBYT
	RETSKP
;EXPIRATION DATE SEEN AS FIRST SWITCH

ACCT3:	STOR T2,XPDAT,(P1)	;PLACE EXPIRATION DATE IN ACCOUNT HEADER
ACCT8:	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,SUBSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE SUBACCOUNT SWITCH OR CONFIRMATION CHAR
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	 JRST ACCTX0		;NO, GO PROCESS ERROR
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	 JRST [	TXZ F,EXPFLG!CLASSF!CLASFL;RESET FLAG
		SETOM ACTFLG	;[10] INDICATE "ACCOUNT" SEEN FOR THIS ACCOUNT
		CALL ACCT7	;PLACE DATA BLOCK IN FREE SPACE
		RET]		;AND RETURN
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	 JRST ACCTX0		;ERROR IN PARSING FIELD AFTER SWITCH
	TXZE F,ALWFLG		;ALLOW?
	JRST ACCT8		;YES. DONE THEN
	TXNE F,CLASFL		;CHECK FOR CLASS
	JRST [	TXO F,CLASSF
		STOR T2,ACCLS,(P1) ;SAVE CLASS
		JRST ACCT8]
	CALL ACCT7		;PLACE DATA BLOCK IN FREE SPACE
	JRST ACCT2		;NOW PARSE END-OF-ENTRY

;PARSED A CONFIRMATION CHARACTER AND EXPIRATION DATE NOT SEEN

ACCT4:	SETOM	ACTFLG		;[7]MARK THAT ACCOUNT WAS GIVENNN
	SETZM T2		;SAY THAT ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;PLACE IT IN ACCOUNT HEADER
	TXZ F,EXPFLG!CLASSF!CLASFL;RESET FLAG
	CALL ACCT7		;PLACE DATA BLOCK IN FREE SPACE
	RET			;RETURN TO PARSE NEXT ENTRY
; ROUTINE TO POP THIS LEVEL'S DATA OFF DATSTK 
;  AND RELEASE FREE SPACE FOR IT
; 	CALL POPDAT
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

POPDAT:	HLRO T1,P3		;GET DATSTK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIL T1,DATLEN		;STACK EMPTY?
	RET			;YES, RETURN NOW
	HLRO T1,P2		;GET JFN STACK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIN T1,JFNLEN		;ANY PREVIOUS CONTEXTS?
	JRST POPDT1		;NO, POP AND CHECK FOR EMPTY DATSTK
	HRRZI T1,FRSHDR		;FREE SPACE HEADER
	POP P3,T2		;GET TOP ITEM ON STACK
	JUMPE T2,POPDT3		;IS IT A DELIMITER?
	JRST POPDT2		;NO, ACCOUNT DATA
POPDT3:	POP P3,T2		;GET DATSTK ENTRY
	HLRZ T3,T2		;GET ENTRY TYPE
	CAIE T3,.FSPTR		;DOES IT POINT TO ACCT DATA?
	JRST [	PUSH P3,[0]	;NO, PUT DELIMITER BACK
		RET]		;ALL DONE, RETURN
POPDT2:	HRRZ T3,T2		;START OF BLOCK IN FREE SPACE
	LOAD T3,BKTYP,(T3)	;GET BLOCK TYPE
	CAIN T3,.TYACC		;IS IT AN ACCOUNT?
	CALL DECBYT		;YES, GO ADJUST ACTBYT
	CALL RELFRE		;RELEASE FREE SPACE FOR THE BLOCK
	 JRST POPDTX		;ERROR, CAN'T RELEASE FREE SPACE
	JRST POPDT3
;JFN STACK EMPTY - POP DATSTK TILL STACK IS EMPTY

POPDT1:	HRRZI T1,FRSHDR		;FREE SPACE HEADER
POPDT4:	POP P3,T2		;GET DATA ENTRY FROM STACK
	JUMPE T2,POPDT5		;IF DELIMITER, IGNORE AND CONTINUE
	HRRZ T3,T2		;GET FREE SPACE ADDRESS OF BLOCK
	LOAD T3,BKTYP,(T3)	;GET BLOCK TYPE
	CAIN T3,.TYACC		;IS IT AN ACCOUNT?
	CALL DECBYT		;YES, ADJUST BYTE COUNT
	CALL RELFRE		;RELEASE FREE SPACE FOR THE BLOCK
	 JRST POPDTX		;ERROR, CAN'T RELEASE FREE SPACE
POPDT5:	HLRO T2,P3		;NOW GET STACK DEPTH
	MOVNS T2		;MAKE IT POSITIVE
	CAIE T2,DATLEN		;STACK EMPTY?
	JRST POPDT4		;NO, POP SOME MORE DATA
	RET			;STACK EMPTY, RETURN
; ROUTINE TO PLACE ACCOUNT HEADER BLOCK IN FREE SPACE
; 	CALL ACCT7
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3, T4

ACCT7:	STKVAR <ACC1,ACC2,ACC3,ACC4>
	MOVEM T1,ACC1
	MOVEM T2,ACC2
	MOVEM T3,ACC3
	MOVEM T4,ACC4
	TXNE F,SASFLG		;SUBACCOUNT SEEN FOR THIS ACCOUNT?
	JRST ACC71		;YES, JUST PUT BLOCK IN FREE SPACE
	SETZM TMPBUF		;CLEAR A BUFFER
	MOVE T1,[XWD TMPBUF,TMPBUF+1]
	BLT T1,TMPBUF+ATMSIZ-1
	LOAD T4,BKLEN,(P1)	;LENGTH OF ACCOUNT HEADER
	SUBI T4,4		;LENGTH OF ACCOUNT NAME
	MOVNS T4
	HRLZ T1,T4
	HRRI T1,4(P1)		;START OF ACCOUNT NAME
	MOVEM T1,ACC1		;SAVE THIS AOBJN POINTER TO ACCT NAME
	CALL HSHNAM		;GET HASH VALUE FOR THIS ACCOUNT
	MOVEI T2,HSHVAL		;START OF HASH VALUES
	ADD T2,T1		;HASH VALUE IS INDEX INTO HASH TABLE
	MOVE T3,0(T2)		;GET THIS HASH TABLE ENTRY
	JUMPE T3,ACC71		;JUMP IF NO COLLISIONS ON THIS ENTRY
	MOVE T1,ACTJFN		;COLLISION - GET OUTPUT FILE JFN
	RFPTR			;GET CURRENT POSITION IN FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot read output file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;GO RESTART
	MOVEM T2,ACC2		;SAVE FILE PTR FOR NOW
	
ACC72:	MOVEM T3,ACC3		;SAVE POINTER TO ACCOUNT BLOCK IN FILE
	RIN			;GET FIRST WD OF ACCT BLK IN FILE
	 JUMPE T2,[HRROI T1,[ASCIZ/? EOF unexpectedly reached, /]
		   CALL PUTERR	;ERROR, TELL USER
		   CALLRET RESUME] ;GO RESTART
	; ...
	; ...
	HRRZ T3,T2		;GET BLOCK LENGTH
	MOVEM T3,ACC4		;SAVE FOR NOW
	BKJFN			;BACK UP FILE PTR TO PT TO HEADER WORD
	 JRST [	HRROI T1,[ASCIZ/? Cannot back up output file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;GO RESTART
	MOVEI T2,TMPBUF		;PLACE TO PUT ACCT BLK FROM FILE
	HRLI T2,(<POINT 36,>)
	MOVNS T3		;READ EVERY WORD IN ACCT BLOCK
	SIN			;GET ACCOUNT BLOCK IN FILE
	LOAD T1,BKLEN,(P1)	;BLOCK LENGTH OF COLLIDING ACCOUNT
	MOVE T3,ACC4		;BLOCK LENGTH OF ACCT BLK FROM FILE
	CAME T1,T3		;LENGTHS THE SAME?
	JRST ACC70		;NO, SEE IF ANOTHER ACCT BLK IS CHAINED TO THIS ONE
	MOVEI T3,TMPBUF+4	;POINT TO ACCOUNT NAME
	MOVE T1,ACC1		;ORIGINAL AOBJN PTR TO COLLIDING BLOCK
ACC73:	MOVE T4,(T3)		;GET WORD IN COLLIDING ACCT NAME
	CAME T4,(T1)		;ARE THE NAMES THE SAME SO FAR?
	JRST ACC70		;NO, GO CHECK FOR ANOTHER COLLISION
	AOBJP T1,ACC74		;SAME SO FAR - JUMP IF DONE
	AOS T3			;POINT TO NEXT WORD IN ACCT NAME IN FILE
	JRST ACC73		;CONTINUE SCAN

ACC70:	MOVE T3,ACC3		;GET PTR TO THIS BLOCK AGAIN
	ADDI T3,3		;PTR TO NEXT CHAINED BLOCK
	MOVE T1,ACTJFN
	RIN			;GET THE POINTER
	MOVE T3,T2
	JUMPE T3,[MOVE T2,ACC2	;GET NEW POINTER VALUE
		  CALL RESFPT	;ALL DONE, GO RESET FILE POINTER
		  JRST ACC71]	;PLACE ACCOUNT BLOCK IN FILE
	JRST ACC72		;CONTINUE CHECKING CHAINED ACCT BLKS
ACC71:	LOAD T3,BKLEN,(P1)	;GET NEW ACCOUNT BLOCK LENGTH
	HRLZS T3
	HRR T3,P1		;ADDRESS OF ACCOUNT BLOCK
	CALL PLBLK		;PLACE ACCT BLK IN FREE SPACE
	 JRST ACCXX		;ERROR
	MOVEM T1,ACTPTR		;SAVE FREE SPACE LOC WHERE ACCT BLK WAS PUT
	AOS ACTNUM		;ONE MORE GOOD ACCOUNT SEEN
	RET

ACC74:	HLRO T2,P2
	MOVNS T2		;JFN STACK DEPTH
	CAIE T2,JFNLEN		;ANY PREVIOUS CONTEXTS ON STACK?
	JRST ACC70		;YES, GO CHECK FOR FOR ANOTHER COLLISION
	HRROI T1,[ASCIZ/? Duplicate account: /]
	CALL PRSERR		;HAVE ALREADY SEEN THIS ACCT, TELL USER
	MOVE T2,ACC2		;GET NEW POINTER VALUE
	CALL RESFPT		;RESET FILE POINTER
	MOVE T1,ACTBYT
	SUB T1,BYTLEN		;IGNORE DUPLICATE ACCT IN CHAR COUNT
	MOVEM T1,ACTBYT		;SAVE NEW LENGTH
	HLRO T2,P2		;GET JFN STACK DEPTH
	MOVNS T2		;MAKE IT POSITIVE
	CAIE T2,JFNLEN		;ANY PREVIOUS CONTEXTS ON STACK?
	SOS ACTBYT		;YES, SUBTRACT ONE FOR DELIMITER
	TXZ F,EXPFLG!SASFLG!CLASSF!CLASFL ;RESET FLAGS
	TXO F,BASFLG
	RET			;RETURN TO PARSE NEXT ENTRY
; ROUTINE TO RESET OUTPUT FILE POINTER 
; CALLED LOCALLY FROM ACCT7 ONLY

RESFPT:	MOVE T1,ACTJFN		;OUTPUT FILE JFN
	SFPTR			;SET OUTPUT FILE PTR TO OLD VALUE
	 JRST [	HRROI T1,[ASCIZ/? Cannot set output file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;GO RESTART
	RET			;RETURN TO CALLER

; ROUTINE TO ADJUST ACTBYT WHEN POPPING AN ACCT BLK OFF DATSTK
; T2/ DATSTK POINTER TO ACCOUNT BLOCK
;	CALL DECBYT
; RETURNS: +1	ALWAYS
; CLOBBERS T3, T4

DECBYT:	SAVEAC <T1,T2>
	HRRZS T2
	ADDI T2,4		;START OF ACCT NAME IN FREE SPACE
	HRLI T2,(<POINT 7,>)	;TURN IT INTO A BYTE POINTER
	MOVEI T1,.NULIO		;THROW THE STRING AWAY
	MOVEI T3,MAXLEN		;MAX # CHARS IN ACCOUNT NAME
	MOVEI T4,.CHNUL		;STOP ON NULL BYTE
	SOUT
	AOS T3			;IGNORE THE NULL CHAR IN THE COUNT
	MOVEI T2,MAXLEN
	SUB T2,T3		;GET # CHARS IN ACCT NAME TO BE POPPED
	MOVE T3,ACTBYT		;GET # CHARS IN WHOLE ACCOUNT NAME
	SUB T3,T2		;DECREMENT BY # CHARS BEING POPPED
	MOVEM T3,ACTBYT		;AND SAVE FOR LATER
	HLRO T1,P2		;GET CURRENT JFNSTK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIE T1,JFNLEN		;ANY PREVIOUS CONTEXTS ON STACK?
	SOS ACTBYT		;YES, SUBTRACT ONE FOR DELIMITER
	RET			;AND RETURN

POPDTX:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? Cannot release free space block
>
	CALLRET RESUME		;GO RESTART

ACCXX:	HRROI T1,[ASCIZ/? Cannot place account block in free space/]
	CALL ERRMES		;TELL USER
	CALLRET RESUME		;GO RESTART
; ROUTINE TO CHECK TO SEE IF A SUBACCOUNT WAS SEEN
; IF YES, SAVE CURRENT STATE ON CONTEXT STACK AND GO PROCESS
;  ENTRIES IN SUBACCOUNT FILE
;	CALL ACCT5
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2

ACCT5:	TXZE F,BASFLG		;WAS A BAD ACCOUNT SEEN?
	RET			;YES, JUST CONTINUE WITH THIS ENTRY
	MOVE T1,TOTLEN		;LENGTH OF CURRENT ACCOUNT BLOCK
	MOVE T2,ACTPTR		;PTR TO CURRENT ACCOUNT HEADER IN FREE SPACE
	STOR T1,DATASZ,(T2)	;SAVE LENGTH IN ACCOUNT HEADER
	TXNN F,SASFLG		;SUBACCOUNT SEEN?
	JRST [	CALL SCNSTK	;NO, SCAN DATSTK
		CALL BLKOUT	;PLACE ACCOUNT DATA BLOCKS IN FILE
		CALL POPDAT	;POP CURRENT DATA BLOCK
		SOS ACTBYT	;ADJUST FOR NULL PADDED AT END OF COMPLETED ACCOUNT
		RET]		;CONTINUE WITH CURRENT ENTRY
	CALL SAVCXT		;SAVE CURRENT CONTEXT AND SET UP
				; TO HANDLE SUBACCOUNT
	CALL START2		;GO PROCESS SUBACCOUNT ENTRIES
	CALL POPDAT		;POP THIS ACCOUNT BLOCK
	RET			;CONTINUE WITH CURRENT ENTRY
; ROUTINE TO SAVE CURRENT ACCOUNT CONTEXT ON STACKS AND
;  OPEN SUBACCOUNT FOR PROCESSING
;	CALL SAVCXT
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

SAVCXT:	MOVX T1,GJ%OLD+GJ%SHT+.GJDEF
	HRROI T2,SUBBUF		;POINTER TO FILESPEC
	GTJFN			;GET A JFN FOR SUBACCOUNT
	 JRST [	TXZ F,SASFLG	;ERROR, RESET FLAG
		HRROI T1,[ASCIZ/? Invalid file specification, /]
		CALL PUTERR	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]
	MOVE T2,[7B5+OF%RD]	;7-BIT BYTES, READ ACCESS
	OPENF			;OPEN SUBACCOUNT FILE
	 JRST [	TXZ F,SASFLG	;ERROR, RESET FLAG
		HRROI T1,[ASCIZ/? ACTGEN: Cannot open input file, /]
		CALL PUTERR	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]
	PUSH P5,ACTFLG		;[7]SAVE OLD ACCOUNT FIRST FLAG
	SETZM ACTFLG		;[7]INDICATE ACCOUNT NOT SEEN FOR NEW FLAG
	PUSH P2,INJFN		;SAVE OLD JFN ON STACK
	MOVEI T2,MAXMSK		;WORDS IN THE MASK
	PUSH P5,CLSMSK-1(T2)	;[9] SAVE IT ON CONTEXT STACK
	SOJG T2,.-1		;DO THEM ALL
	MOVEM T1,INJFN		;SAVE NEW JFN
	SKIPN ALWMSO		;HAVE AN ALLOW MASK?
	JRST SAVCX0		;NO. SKIP MAKING THEM
	MOVEI T1,MAXMSK		;WORDS IN THE MASK
SAVCX2:	MOVE T2,ALWMSK-1(T1)	;GET A WORD
	ANDM T2,CLSMSK-1(T1)	;DO MASKING
	SOJG T1,SAVCX2		;DO THEM ALL
	MOVX T1,1B0
	IORM T1,CLSMSK		;CLASS 0 IS ALWAYS ALLOWED
SAVCX0:	PUSH P3,[0]		;NOTE THE END OF OLD CONTEXT DATA PTRS
	CALL SAVCMD		;SAVE OLD COMND STATE ON STACK
	 JRST SAVCX1		;ERROR, CAN'T SAVE OLD COMND STATE
	MOVE T1,INJFN		;GET NEW INJFN
	HRLS T1,T1		;PUT IT IN LH
	HRRI T1,.NULIO		;OUTPUT JFN IS NULL I/O
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE NEW JFNS FOR COMND
	SETZM NAMBUF
	HRROI T1,NAMBUF		;POINTER TO BUFFER FOR FILENAME
	MOVE T2,INJFN		;GET NEW JFN
	MOVX T3,<FLD(.JSAOF,JS%NAM)> ;SAY OUTPUT NAME ONLY
	JFNS			;PUT FILENAME IN BUFFER
	TXZ F,SASFLG		;RESET FLAG
	TXO F,FTTFLG		;FIRST TIME THROUGH FOR SUBACT
	RET			;AND RETURN

SAVCX1:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? Potential CMDSTK overflow
>
	CALLRET RESUME		;GO RESTART
; SUBACCOUNT ENTRY 
; RETURNS: +1	ERROR IN PARSING SUBACCOUNT FILE NAME
;	   +2	SUCCESS
; GTJFN BLOCK CLEARED IN .TAKE CODE BEFORE PARSING FILE ENTRIES

.SUBAC:	MOVX T1,GJ%OLD		;GET EXISTING FILE FLAG
	MOVEM T1,GJFBLK+.GJGEN	;STORE GTJFN FLAGS
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMFIL)] ;GET FDB ADDRESS
	COMND			;PARSE SUBACCOUNT FILESPEC
	 ERJMP CMDERR		;ERROR, GO CHECK EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FILESPEC OK?
	RET			;NO, ERROR

;SAVE SUBACCOUNT FILE NAME IN BUFFER

	HRROI T1,SUBBUF		;POINTER TO SUBACCOUNT BUFFER
	HRROI T2,ATMBFR		;POINTER TO SUBACCOUNT NAME FOUND
	MOVEI T3,.CHNUL		;TERMINATE ON NULL BYTE
	SOUT			;SAVE SUBACCOUNT NAME IN BUFFER
	TXO F,SASFLG		;NOTE THAT SUBACCOUNT WAS SEEN
	RETSKP
;EXPIRATION DATE GIVEN FOR AN ENTRY
; RETURNS: +1	ERROR IN PARSING DATE
;	   +2	SUCCESS, T2/ EXP DATE AND TIME IN INTERNAL FORMAT

.XPIRE:	MOVEI T1,CMDBLK		;GET ADDR OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMTAD,,CM%IDA!CM%ITM,,,<[FLDDB. (.CMTAD,,CM%IDA)]>)]
				;PARSE DATE-&-TIME OR JUST A DATE
	COMND			; AND CONVERT TO INTERNAL FORMAT
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	RET			;NO, ERROR
	TXO F,EXPFLG		;NOTE THAT A DATE WAS SEEN
	RETSKP			;GIVE GOOD RETURN
; CLASS FOR GIVEN ENTRY
;
; RETURNS: +1 ERROR IN PARSING NUMBER
; RETURNS: +2 SUCCESS T2/ CLASS

.CLASS:	TXNE F,CLASSF		;BEEN HERE YET?
	RETBAD ()		;YES. ERROR THEN
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNUM,,^D10)]
	COMND			;GET NUMBER
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	RET			;NO, ERROR
	MOVE T4,T2		;SAVE COPY OF CLASS
	CAIL T2,<MAXMSK*44>	;VALID CLASS?
	RETBAD (ARGX25)		;NO. ERROR THEN
	IDIVI T2,44		;GET WORD IN CLASS MASK
	MOVN T1,T3		;GET BIT IN WORD
	MOVX T3,1B0		;FORM MASK
	LSH T3,0(T1)		;FORM BIT
	TDNN T3,CLSMSK(T2)	;ALLOWED TO USE THIS CLASS
	RETBAD (ARGX25)		;NO
	TXO F,CLASFL		;SET CLASS FLAG
	MOVE T2,T4		;GET CLASS BACK AGAIN
	AOJA T2,RSKP		;GOOD. INCRMENT VALUE AND RETURN
;ALLOW SWITCH OF ACCOUNT

.ALLOW:	MOVEI T1,CMDBLK		;GET COMMAND BLOCK
	MOVEI T2,[FLDDB. (.CMNUM,,^D10)] ;GET A NUMBER
	COMND			;DO IT
	 ERJMP CMDERR		;IF ERROR ,GO HANDLE
	TXNE T1,CM%NOP		;GOOD PARSE
	RETBAD ()		;NO
	CAIL T2,<MAXMSK*44>	;VALID?
	RETBAD (ARGX25)		;NO
	IDIVI T2,44		;GET WORD AND BIT
	MOVN T1,T3		;GET NEG VALUE OF BIT
	MOVX T3,1B0
	LSH T3,0(T1)		;POSITION BIT
	IORM T3,ALWMSK(T2)	;SET IN THE ALLOW MASK
	AOS ALWMSO		;AND SAY DATA IS IN THE MASK
	MOVEI T1,CMDBLK		;DO ANOTHER PARSE
	MOVEI T2,[FLDDB. (.CMCMA)] ;DO A COMMA
	COMND			;DO IT
	 ERJMP CMDERR		;IF ERROR, GO PROCESS
	TXNN T1,CM%NOP		;DID IT?
	JRST .ALLOW		;YES. GET NEXT LIST ITEM THEN
	TXO F,ALWFLG		;DID ALLOW SUBCOMMAND
	RETSKP			;AND DONE
	SUBTTL DIRECTORY ENTRY

.DIREC:	SKIPN ACTFLG		;[7]ACCOUNT SEEN BEFORE THIS ENTRY?
	JRST ACCXNF		;[7]NO, WRITE MESSAGE, RETURN TO ACTGEN> LEVEL
	MOVEI P1,DNMBLK		;GET ADDR OF DIRECTORY DATA BLOCK
	SETZM DNMBLK		;CLEAR IT
	MOVE T1,[DNMBLK,,DNMBLK+1]
	BLT T1,DNMBLK+6+3-1
	MOVEI T1,CMDBLK		;GET ADDR OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMDIR,CM%PO,CM%DWC)]
	COMND			;PARSE ANYTHING THAT LOOKS LIKE A DIR NAME
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST DIRECX		;NO
	CALL PLDIR		;YES, GO SAVE IT IN DATA FILE
	 JRST DIRCX1		;ERROR, TELL USER

;PARSE FIELDS REMAINING AFTER DIRECTORY NAME

DIREC1:	MOVEI T1,CMDBLK		;START OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE A SWITCH OR CONFIRMATION
	 ERJMP CMDERR		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST DIRECX		;NO, GO PROCESS ERROR
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIN T1,.CMCFM		;CONFIRMATION CHARACTER?
	JRST DIREC2		;YES, SET EXPIRATION DATE AND RETURN
	HRRZ T1,(T2)		;NO, GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	 JRST DIRECX		;ERROR IN PARSING FIELD AFTER SWITCH
	STOR T2,XPDAT,(P1)	;SAVE EXPIRATION DATE IN DATA BLOCK
	CALL ENDCOM		;NEXT FIELD MUST BE END-OF-ENTRY
	 RET			;ERROR RETURN
	JRST DIREC3		;GOOD RETURN
;NO EXPIRATION DATE GIVEN IN THE ENTRY

DIREC2:	SETZ T2,		;NOTE THAT THIS ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;PLACE DATE IN DATA BLOCK
DIREC3:	TXZ F,EXPFLG		;RESET FLAG
	MOVEI T1,.TYDNM		;BLOCK TYPE FOR DIRECTORY NAME
	STOR T1,BKTYP,(P1)	;SAVE IT IN DIRECTORY DATA BLOCK
	MOVE T1,DIRLEN		;DIRECTORY NAME LENGTH IN WORDS
	ADDI T1,3		; + # WORDS IN REST OF BLOCK
	STOR T1,BKLEN,(P1)	;PUT BLOCK LENGTH IN DATA BLOCK
	ADDM T1,TOTLEN		;INCREASE # OF DATA ITEMS SEEN FOR THIS ACCOUNT
	HRLZ T3,T1		;GET LENGTH IN LEFT HALF
	HRR T3,P1		;ADDRESS OF DIRECTORY DATA BLOCK
	CALL PLBLK		;STORE DATA BLOCK AWAY
	 JRST DIRCXX		;ERROR
	RET			;RETURN TO PARSER

DIRECX: HRROI T1,[ASCIZ/? Incorrect field: /]
	CALL PRSERR		;TELL USER
	RET			;GO PARSE NEXT ENTRY IN FILE

DIRCXX:	HRROI T1,[ASCIZ/? Cannot place directory block in free space/]
	CALL ERRMES		;TELL USER
	CALLRET RESUME		;AND GO RESTART

DIRCX1:	HRROI T1,[ASCIZ/? Cannot convert ASCIZ structure name to SIXBIT/]
	CALL ERRMES
	RET			;GO PARSE NEXT ENTRY
;PLACE DIRECTORY NAME IN DATA BLOCK
; UPON ENTERING, T2/ 36-BIT DIRECTORY NUMBER
;
; RETURNS: +1	ERROR
;	   +2	SUCCESS

PLDIR:	ASUBR <PLDIR1>
	SETZM TMPBUF		;CLEAR ENOUGH OF TMPBUF FOR STR NAME
	SETZM TMPBUF+1
	HRROI T1,ATMBFR		;POINTER TO DIRECTORY NAME STRING
	HRROI T2,TMPBUF		;TEMP BUFFER FOR STORING STRING
	MOVEI T3,7		;6 CHARS FOR STRUCTURE NAME AND ONE FOR ":"
	MOVEI T4,":"		;READ TILL TERMINATOR SEEN
	SIN			;PUT STRUCTURE NAME IN TMPBUF
	MOVEM T1,PLDIR1		;SAVE UPDATED POINTER INTO ATMSAV
	SETZ T3,
	DPB T3,T2		;OVERWRITE ":" WITH A NULL
	MOVE T1,TMPBUF		;GET STRUCTURE NAME
	CAMN T1,[ASCIZ/DSK*/]	;IS IT ALL STRUCTURES?
	JRST [	SETO T2,	;YES, TAKE NOTE OF THIS
		JRST PLDR1]	;AND CONTINUE
	MOVEI T1,TMPBUF		;ADDRESS OF ASCIZ STRUCTURE NAME
	CALL ASCSIX		;CONVERT STRUCTURE NAME TO SIXBIT
	 RET			;ERROR RETURN 
PLDR1:	STOR T2,SXSTR,(P1)	;PUT STRUCTURE NAME IN DATA BLOCK
	SETZM TMPBUF		;CLEAR TMPBUF FOR DIR NAME
	MOVE T1,[TMPBUF,,TMPBUF+1]
	BLT T1,TMPBUF+ATMSIZ-1
	MOVE T1,PLDIR1		;GET BACK POINTER INTO ATMSAV
	CALL GETDIR		;GO GET THE DIRECTORY STRING
	 RET			;FAILED, RETURN ERROR
	MOVEI T1,3(P1)		;PLACE TO PUT DIRECTORY NAME 
	HRLI T1,(<POINT 7,>)	;TURN IT INTO A BYTE POINTER
	HRROI T2,TMPBUF		;POINTER TO DIRECTORY NAME STRING
	MOVEI T3,MAXLEN		;MAX # CHARS IN DIRECTORY NAME
	MOVEI T4,.CHNUL		;TERMINATE ON A NULL BYTE
	SOUT			;PUT DIRECTORY NAME IN DATA BLOCK
	MOVEI T2,MAXLEN		;GET MAX # CHARACTERS POSSIBLY MOVED
	SUB T2,T3		;COMPUTE # CHARS ACTUALLY IN THE STRING
	IDIVI T2,5		;COMPUTE # WORDS IN STRING + REMAINDER
	SKIPE T3		;DOES T2 HAVE EXACT # WORDS IN THE STRING?
	ADDI T2,1		;NO, CORRECT THE COUNT
	MOVEM T2,DIRLEN		;SAVE # WORDS IN DIRECTORY NAME STRING
	CAIE T2,1		;IS DIR NAME ONE WORD LONG?
	RETSKP			;NO, JUST RETURN
	LOAD T2,DIRNM,(P1)	;GET DIRECTORY NAME
	CAME T2,[ASCIZ/*/]	;IS IT ALL DIRECTORIES?
	RETSKP			;NO, RETURN
	SETO T2,		;NOTE THAT ALL DIRS ARE ALLOWED
	STOR T2,DIRNM,(P1)	;PUT THIS IN DATA BLOCK INSTEAD
	RETSKP
;GETDIR - ROUTINE TO REMOVE THE DIRECTORY STRING FROM THE ATOM BUFFER
;
;ACCEPTS IN T1/	POINTER TO START OF DIRECTORY STRING
;		CALL GETDIR
;RETURNS: +1	 FAILED
;	  +2	SUCCESS, WITH STRING NOW IN TMPBUF

GETDIR:	IBP T1			;SKIP OVER INITIAL BRACKET IN DIRECTORY STRING
	MOVE T3,[POINT 7,TMPBUF] ;SET UP DESTINATION POINTER
	MOVEI T4,MAXLEN		;GET MAX NUMBER OF CHARACTERS IN STRING
GTDR10:	ILDB T2,T1		;GET A CHARACTER FROM THE STRING
	CAIE T2,">"		;TERMINATING BRACKET OF
	CAIN T2,"]"		; EITHER VARIETY ?
	JRST GTDR20		;YES, GO TERMINATE STRING WITH NULL
	IDPB T2,T3		;DEPOSIT THE CHARACTER INTO DESTINATION
	SOJG T4,GTDR10		;GO GET NEXT CHARACTER FROM STRING

GTDR20:	MOVEI T2,.CHNUL		;GET TERMINATING CHARACTER
	IDPB T2,T3		;TERMINATE STRING WITH NULL
	RETSKP			;DONE, RETURN
	SUBTTL USER ENTRY

.USRNM:	TXZ	F,EX0FLG	;MAKE SURE /EXPIRES: SWITCH IS OFF
	SKIPN ACTFLG		;[7]ACCOUNT SEEN BEFORE THIS ENTRY?
	JRST ACCXNF		;[7]NO, WRITE MESSAGE, RETURN TO ACTGEN> LEVEL
	MOVEI P1,UNMBLK		;GET ADDR OF USER NAME DATA BLOCK
	SETZM UNMBLK		;CLEAR USER NAME BLOCK
	MOVE T1,[UNMBLK,,UNMBLK+1]
	BLT T1,UNMBLK+10-1
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMUSR,CM%PO,CM%DWC,,,<[FLDDB. (.CMSWI,,EXPSWI)]>)]
	COMND			;PARSE "*" OR ANYTHING THAT LOOKS LIKE A
				; USER NAME OR /EXPIRES:
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO
	TXNN	T1,CM%SWT	;WAS A SWITCH PARSED?
	JRST	USRNM0		;NO, GO PARSE A USER NAME
	HRRZ	T1,(T2)		;YES, GET DISPATCH ADDRESS
	CALL	(T1)		;GO DO FUNCTION (SHOULD ONLY BE /EXPIRES:)
	 JRST	USRNX		;ERROR, ABORT CURRENT LINE
	STOR	T2,XPDAT,(P1)	;PLACE EXPIRATION DATE IN DATE BLOCK
	MOVEM	T2,XP0DAT	;SAVE EXPIREATION DATE FOR FURTHER USER NAMES
	TXO	F,EXPFLG+EX0FLG	;SET EXPIRATION FLAG FOR LINE AND BLOCK
	MOVEI	T1,CMDBLK	;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI	T2,[FLDDB. (.CMCMA)] ;PARSE A COMMA
	COMND			;FORCE USER TO TYPE A COMMA NEXT
	 ERJMP	CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNN	T1,CM%NOP	;PARSED OK?
	JRST	USRNM2		;YES, GO PARSE A USER NAME
	JRST	USRNX		;NO, ERROR, ABORT CURRENT LINE

USRNM0:				;HERE IF USER NAME SEEN FIRST
	CALL CHKSTR		;WAS "*" SEEN AS THE ONLY ARGUMENT?
	 SKIPA			;NO, CONTINUE
	JRST USRNM8		;YES, CREATE "ALL USERS" ENTRY
	CALL PLUSR		;GO PUT USERNAME IN DATA BLOCK
USRNM1:	MOVEI T1,CMDBLK		;PARSE THE NEXT FIELD
	MOVEI T2,[FLDDB. (.CMCMA,,,,,<[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]>)]
	COMND			;PARSE COMMA, SWITCH, OR ACTION CHAR
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIN T1,.CMCMA		;PARSED A COMMA?
	JRST USRNM3		;YES, SEE IF EXPIRATION DATE WAS GIVEN
	CAIN T1,.CMSWI		;PARSED A SWITCH?
	JRST USRNM7		;YES, GO PERFORM SWITCH FUNCTION
	JRST USRNM5		;MUST HAVE BEEN .CMCFM - RETURN
;COMMA PARSED - TRY TO PARSE NEXT FIELD AS USERNAME

USRNM2:	MOVEI T1,CMDBLK		;GET ADDR OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMUSR,CM%PO,CM%DWC)] ;FDB FOR A USERNAME
	COMND			;PARSE A USERNAME
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO, GO PRINT ERROR MESSAGE
	CALL CHKSTR		;WAS "*" SEEN AS THE ONLY ARGUMENT?
	 SKIPA			;NO, CONTINUE
	JRST USRNX		;YES, RETURN ERROR
	CALL PLUSR		;PLACE USERNAME IN DATA BLOCK
	JRST USRNM1		;PARSE NEXT FIELD

USRNM3:	TXNN	F,EX0FLG	;EXPIRATION DATE SEEN AT BEGINNING OF LINE?
	JRST	USRN11		;NO, CHECK IF SEEN FOR THIS ENTRY
	MOVE	T2,XP0DAT	;YES, GET EXPIRATION DATE FOR THIS LINE
	STOR	T2,XPDAT,(P1)	;PLACE EXPIRATION DATE IN DATA BLOCK
	JRST	USRNM4		;GO PUT DATA BLOCK IN FREE AREA
USRN11:	TXZE F,EXPFLG		;EXPIRATION DATE SEEN?
	JRST USRNM4		;YES
	SETZM T2		;NO, ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;PLACE DATE IN DATA BLOCK
USRNM4:	CALL PLUS1		;PUT USER DATA BLOCK IN FREE AREA
	 JRST USRNMX		;ERROR, GO TELL USER
	JRST USRNM2		;GO PARSE ANOTHER USERNAME

USRNM5:	TXNN	F,EX0FLG	;EXPIRATION DATE SEEN AT BEGINNING OF LINE?
	JRST	USRN12		;NO, CHECK IF SEEN FOR THIS ENTRY
	MOVE	T2,XP0DAT	;YES, GET EXPIRATION DATE
	STOR	T2,XPDAT,(P1)	;PLACE EXPIRATION DATE IN DATA BLOCK
	JRST	USRNM6		;GO PUT DATA BLOCK IN FREE AREA
USRN12:	TXZE F,EXPFLG		;EXPIRATION DATE SEEN?
	JRST USRNM6		;YES, RETURN
	SETZM T2		;NO, ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;SAVE DATE IN DATA BLOCK
USRNM6:	CALL PLUS1		;PUT USER DATA BLOCK IN FREE SPACE
	 JRST USRNMX		;ERROR
	RET
;SWITCH PARSED - PERFORM SWITCH FUNCTION

USRNM7:	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION	
	 JRST USRNX		;ERROR IN PARSING FIELD AFTER SWITCH
	STOR T2,XPDAT,(P1)	;SAVE EXPIRATION DATE IN DATA BLOCK
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCMA,,,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE A COMMA OR END-OF-ENTRY
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIN T1,.CMCMA		;PARSED A COMMA?
	JRST USRNM3		;COMMA SEEN, PARSE NEXT FIELD
	JRST USRNM5		;NO, MUST HAVE SEEN END-OF-ENTRY

;"*" PARSED - PLACE IN FILE AND PARSE NEXT FIELD

USRNM8:	MOVEI P1,ALUBLK		;GET ADDRESS OF "ALL USERS" DATA BLOCK
	MOVEI T1,.TYALU		;BLOCK TYPE FOR "ALL USERS"
	STOR T1,BKTYP,(P1)	;SAVE IT IN DATA BLOCK
	MOVEI T1,2		;DATA BLOCK LENGTH
	STOR T1,BKLEN,(P1)	;SAVE IT IN DATA BLOCK
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE A SWITCH OR END-OF-ENTRY
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO, GO PRINT ERROR
	CALL GETFNC		;GET FUNCTION CODE ACTUALLY USED
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST USRNM9		;NO, RETURN
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	 JRST USRNX		;ERROR IN PARSING FIELD AFTER SWITCH
	STOR T2,XPDAT,(P1)	;SAVE DATE IN DATA BLOCK
	CALL ENDCOM		;GO PARSE END-OF-ENTRY
	 RET			;ERROR RETURN
	JRST USRN10		;GOOD RETURN

USRNM9:	TXZE F,EXPFLG		;EXPIRATION DATE SEEN?
	JRST USRN10		;YES, RETURN
	SETZM T2		;NO, ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;SAVE DATE IN DATA BLOCK
USRN10:	LOAD T1,BKLEN,(P1)	;GET BLOCK LENGTH
	ADDM T1,TOTLEN		;INCREASE # DATA ITEMS SEEN
	CALL PLALU		;PLACE DATA BLOCK IN FREE SPACE
	 JRST USRNXX		;ERROR, TELL USER
	RET			;RETURN
USRNX: HRROI T1,[ASCIZ/? Incorrect field: /]
	CALL PRSERR		;TELL USER
	RET			;GO PARSE NEXT ENTRY

USRNMX:	HRROI T1,[ASCIZ/? Cannot place user block in free space/]
	CALL ERRMES		;TELL USER
	CALLRET RESUME		;AND GO RESTART

USRNXX:	HRROI T1,[ASCIZ/? Cannot place "all users" block in free space/]
	CALL ERRMES
	CALLRET RESUME		;GO RESTART

; SEE IF A NAME STRING CONTAINS ANY WILDCARDS (% OR *)
; THIS ROUTINE IS CURRENTLY ONLY USED FOR USER NAMES
; CALL: T1/ ADDRESS OF STRING
;	CALL CHKWLD
; RETURNS: +1	NO WILDCARDS
;	   +2	WILDCARD SEEN
; CLOBBERS T1 AND T2

CHKWLD:	HRLI T1,(<POINT 7,>)	;BYTE POINTER TO STRING
CHKWL1:	ILDB T2,T1		;GET NEXT CHAR IN STRING
	JUMPE T2,R		;ALL DONE, NO WILDCARDS
	CAIN T2,"*"		;IS IT A *?
	RETSKP			;YES
	CAIN T2,"%"		;IS IT %?
	RETSKP
	JRST CHKWL1		;NO, CONTINUE SCAN

; SEE IF "*" ONLY WAS PARSED AS ARGUMENT TO USER ENTRY
;	CALL CHKSTR
; RETURNS: +1	"*" ONLY WASN'T SEEN
;	   +2	"*" ONLY WAS THE ARGUMENT
; CLOBBERS T1, T2

CHKSTR:	MOVEI T1,ATMBFR
	HRLI T1,(<POINT 7,>)	;BYTE PTR TO FIELD JUST PARSED
	ILDB T2,T1		;GET FIRST CHAR IN FIELD
	CAIE T2,"*"		;WAS A * SEEN?
	RET			;NO, RETURN NOW
	ILDB T2,T1		;GET NEXT CHARACTER
	JUMPE T2,RSKP		;IF A NULL, SKIP RETURN
	RET			;NEXT CHAR WASN'T A NULL
;PLACE "ALL USERS" DATA BLOCK IN FREE SPACE
; RETURNS: +1	ERROR
;	   +2	SUCCESS

PLALU:	LOAD T3,BKLEN,(P1)	;GET LENGTH OF DATA BLOCK
	HRLZS T3		;PUT IT IN LEFT HALF
	HRR T3,P1		;ADDRESS OF "ALL USERS" BLOCK
	CALL PLBLK		;SAVE BLOCK IN FREE SPACE
	 RET			;ERROR RETURN
	RETSKP			;GOOD RETURN

;PLACE USERNAME IN DATA BLOCK
; UPON ENTERING, ATMBFR/ USER NAME STRING

PLUSR:	MOVEI T1,2(P1)		;PLACE TO PUT USER NAME IN DATA BLOCK
	HRLI T1,(<POINT 7,>)	;TURN IT INTO A BYTE POINTER
	HRROI T2,ATMBFR		;SOURCE FOR USER NAME
	MOVEI T3,MAXLEN		;MAXIMUM LENGTH OF USER NAME
	MOVEI T4,.CHNUL		;TERMINATE ON A NULL BYTE
	SOUT			;WRITE STRING INTO DATA BLOCK
	MOVEI T2,MAXLEN		;GET MAXIMUM # CHARS POSSIBLY MOVED
	SUB T2,T3		;COMPUTE # CHARS ACTUALLY IN THE STRING
	IDIVI T2,5		;# WORDS IN STRING PLUS REMAINDER
	SKIPE T3		;DOES T2 HAVE EXACT # WORDS IN THE STRING?
	ADDI T2,1		;NO, CORRECT THE COUNT
	MOVEM T2,USRLEN		;STORE IT AWAY
	RET
;PLACE USER DATA BLOCK IN FREE SPACE
; RETURNS: +1	ERROR
;	   +2	SUCCESS

PLUS1:	MOVEI Q1,.TYUNM		;BLOCK TYPE OF USER NAME BLOCK
	MOVE T1,P1
	ADDI T1,2		;ADDRESS OF USER NAME IN THE BLOCK
	CALL CHKWLD		;NAME CONTAIN ANY WILDCARDS?
	SKIPA			;NO
	MOVEI Q1,.TYWUS		;YES, CREATE A WILD USER BLOCK
	STOR Q1,BKTYP,(P1)	;PUT BLOCK TYPE IN HEADER
	MOVE T1,USRLEN		;GET LENGTH OF USER NAME IN WORDS
	ADDI T1,2		;PLUS 2 WORDS FOR REST OF HEADER
	STOR T1,BKLEN,(P1)	;PUT IT IN HEADER BLOCK
	ADDM T1,TOTLEN		;INCREASE # OF DATA ITEMS SEEN FOR THIS ACCOUNT
	HRLZ T3,T1		;GET LENGTH IN LEFT HALF
	HRR T3,P1		;ADDRESS OF USER NAME DATA BLOCK
	CALL PLBLK		;STORE DATA BLOCK IN FREE SPACE
	 RET			;ERROR RETURN
	SETZM UNMBLK
	MOVE T1,[XWD UNMBLK,UNMBLK+1]
	BLT T1,UNMBLK+^D8-1	;CLEAR USER NAME BLOCK
	RETSKP			;AND GIVE GOOD RETURN
	SUBTTL GROUP ENTRY

.GROUP:	SKIPN ACTFLG		;[7]ACCOUNT SEEN BEFORE THIS ENTRY?
	JRST ACCXNF		;[7]NO, WRITE MESSAGE, RETURN TO ACTGEN> LEVEL
	HRROI T2,[ASCIZ/ON STRUCTURE/] ;POINTER TO NOISE WORDS
	CALL SKPNOI		;PARSE NOISE WORDS
	 RET			;ERROR, RETURN TO PARSE NEXT ENTRY
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMDEV,,,,,<[FLDDB. (.CMSWI,,GRPSWI)]>)]
	COMND			;PARSE A DEVICE NAME OR SWITCH
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO, GO TELL USER
	CALL GETFNC		;SEE WHAT KIND OF FIELD WAS PARSED
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST GROUP2		;NO, MUST BE A STRUCTURE
GROUP1:	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PERFORM SWITCH FUNCTION
	TXZ F,EXPFLG		;RESET EXPIRATION DATE FLAG
	SETZM STRUCT		;RESET STRUCTURE NAME CELL
	RET			;RETURN TO PARSE NEXT ENTRY

;PARSED A DEVICE NAME - FOR "/DIRECTORY:NNN" SWITCH

GROUP2:	HLRZ T1,T2		;GET DEVICE TYPE
	CAIE T1,.DVDES+.DVDSK	;IS IT A STRUCTURE?
	JRST GROUPX		;NO, RETURN ERROR
	MOVEM T2,STRUCT		;YES, SAVE STRUCTURE DESIGNATOR
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,GRPSWI)]
	COMND			;PARSE A MODIFYING SWITCH
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO, GO TELL USER
	JRST GROUP1		;OK, CONTINUE
; ROUTINE TO PLACE STRUCTURE NAME IN DIRECTORY GROUP DATA BLOCK
; CALL: T2/ 36-BIT STRUCTURE DESIGNATOR
;		CALL PLSTR
; RETURNS: +1	ERROR
;	   +2	SUCCESS

PLSTR:	HRROI T1,ATMSAV		;PLACE TO PUT ASCIZ STRUCTURE NAME
	DEVST			;TRANSLATE DESIGNATOR TO STRING
	 JRST [	HRROI T1,[ASCIZ/? Cannot convert structure designator, /]
	 	CALL PUTERR	;UNEXPECTED JSYS FAILURE
		CALLRET RESUME]	;GO RESTART
	MOVEI T1,ATMSAV		;GET ADDRESS OF STRUCTURE NAME STRING
	CALL ASCSIX		;CONVERT ASCIZ NAME TO SIXBIT
	 RET			;ERROR, NON-SIXBIT CHAR ENCOUNTERED
	STOR T2,SXSTR,(P1)	;PLACE STRUCTURE NAME IN DATA BLOCK
	RETSKP			;GOOD RETURN


GROUPX: HRROI T1,[ASCIZ/? Incorrect field: /]
	CALL PRSERR		;TELL USER
	RET			;GO PARSE NEXT ENTRY
	SUBTTL GROUP SWITCHES

;PARSED A DIRECTORY GROUP SWITCH

.DGPNM:	SKIPN STRUCT		;STRUCTURE NAME PARSED?
	JRST GROUPX		;NO, ERROR
	MOVEI P1,DGPBLK		;STARTING ADDR OF DATA BLOCK
	MOVE T2,STRUCT		;GET STRUCTURE DESIGNATOR
	CALL PLSTR		;PLACE IN DATA BLOCK
	 JRST DGPNMX		;ERROR, TELL USER
	MOVEI T2,.TYDGP		;BLOCK TYPE FOR DIRECTORY GROUP
	STOR T2,BKTYP,(P1)	;STORE IT IN GROUP DATA BLOCK
	MOVEI T2,4		;LENGTH OF DIRECTORY GROUP DATA BLOCK
	STOR T2,BKLEN,(P1)	;STORE IT IN DATA BLOCK
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNUM,,^D10)]
	COMND			;PARSE A DECIMAL GROUP NUMBER
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO, GO PRINT ERROR
	STOR T2,DIRGP,(P1)	;PLACE GROUP NUMBER IN DATA BLOCK
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE DATE SWITCH OR CONFIRMATION CHARACTER
	 ERJMP CMDERR
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO
	CALL GETFNC		;GET FUNCTION CODE
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST [	SETZM T1	;EXPIRATION DATE IS 0
		STOR T1,XPDAT,(P1) ;PLACE IN DATA BLOCK
		JRST DGPNM1]	;PLACE DATA BLOCK IN FILE AND RET
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PROCESS EXPIRATION DATE
	 JRST GROUPX		;ERROR IN PARSING FIELD AFTER SWITCH
	STOR T2,XPDAT,(P1)	;SAVE IT IN DATA BLOCK
	CALL ENDCOM		;NEXT FIELD MUST BE END-OF-ENTRY
	 RET			;ERROR RETURN
DGPNM1:	LOAD T1,BKLEN,(P1)	;GET BLOCK LENGTH
	ADDM T1,TOTLEN		;INCREASE # DATA ITEMS SEEN SO FAR
	MOVE T3,[4,,DGPBLK]	;LENGTH,,START ADDR OF GROUP DATA BLOCK
	CALL PLBLK		;PLACE DATA BLOCK IN FILE
	 JRST DGPNX1		;ERROR, TELL USER
	RET			;RETURN TO .GROUP CODE

DGPNMX:	HRROI T1,[ASCIZ/? Cannot convert ASCIZ structure name to SIXBIT/]
	CALL ERRMES		;TELL USER
	RET			;RETURN TO PARSE NEXT ENTRY

DGPNX1:	HRROI T1,[ASCIZ/? Cannot place directory group block in free space/]
	CALL ERRMES
	CALLRET RESUME		;GO RESTART
;PARSED A USER GROUP SWITCH

.UGPNM:	MOVEI P1,UGPBLK		;ADDR OF USER GROUP DATA BLOCK
	MOVEI T2,.TYUGP		;BLOCK TYPE OF USER GROUP DATA BLOCK
	STOR T2,BKTYP,(P1)	;SAVE IN DATA BLOCK
	MOVEI T2,3		;LENGTH OF USER GROUP DATA BLOCK
	STOR T2,BKLEN,(P1)	;STORE IT AWAY
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNUM,,^D10)]
	COMND			;PARSE A DECIMAL GROUP NUMBER
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO
	STOR T2,USRGP,(P1)	;PLACE GROUP NUMBER IN DATA BLOCK
	MOVEI T1,CMDBLK		;ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
	COMND			;PARSE DATE SWITCH OR CONFIRMATION CHARACTER
	 ERJMP CMDERR
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST GROUPX		;NO, GO PRINT ERROR
	CALL GETFNC		;GET FUNCTION CODE
	CAIE T1,.CMSWI		;PARSED A SWITCH?
	JRST [	SETZM T1	;EXPIRATION DATE IS 0
		STOR T1,XPDAT,(P1) ;PLACE IT IN DATA BLOCK
		JRST UGPNM1]	;AND RETURN
	HRRZ T1,(T2)		;GET SWITCH DISPATCH ADDRESS
	CALL (T1)		;PROCESS EXPIRATION DATE
	 JRST GROUPX		;ERROR IN PARSING FIELD AFTER SWITCH
	STOR T2,XPDAT,(P1)	;SAVE DATE IN DATA BLOCK
	CALL ENDCOM		;NEXT FIELD MUST BE END-OF-ENTRY
	RET			;RETURN TO PARSE NEXT ENTRY
UGPNM1:	LOAD T1,BKLEN,(P1)	;GET BLOCK LENGTH
	ADDM T1, TOTLEN		;INCREASE # DATA ITEMS SEEN SO FAR
	MOVE T3,[3,,UGPBLK]	;LENGTH,,START ADDR OF USER GROUP BLOCK
	CALL PLBLK		;PLACE DATA BLOCK IN FILE
	 JRST UGPNMX		;ERROR, TELL USER
	RET			;AND RETURN

UGPNMX:	HRROI T1,[ASCIZ/? Cannot place user group block in free space/]
	CALL ERRMES
	CALLRET RESUME		;GO RESTART
	SUBTTL INSTALL COMMAND

.INSTL:	STKVAR <SYSJFN,FILEN,WORDS>
	HRROI T2,[ASCIZ/NEW ACCOUNT VALIDATION DATA BASE/]
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;RETURN FAILURE
	CALL ENDCOM		;PARSE END OF COMMAND
	 RET			;RETURN, BAD CONFIRMATION
	HRROI T3,[ASCIZ/BS:<SYSTEM>ACCOUNTS-TABLE.BIN/]	;[37] Assume 7.0
	MOVE T1,[SIXBIT /MONVER/]  ;[37] This table is not in 4.1 monitors
	SYSGT%			;[37] Get monitor version
	SKIPN T2		;[37] Was the table found?
	HRROI T3,[ASCIZ/PS:<SYSTEM>ACCOUNTS-TABLE.BIN/]	;[37] No, so 4.1
	EXCH T2,T3		;[37] Get filespec string and save flag
	MOVX T1,GJ%FOU+GJ%SHT+.GJDEF
	GTJFN			;GET A JFN FOR THE <SYSTEM> FILE
	IFNSK.			;[37] Error!
	  HRROI T1,[ASCIZ/? Cannot get a JFN for BS:<SYSTEM>ACCOUNTS-TABLE.BIN, /] ;[37] Assume 7.0
	  SKIPN T3		;[37] 4.1 monitor?
	  HRROI T1,[ASCIZ/? Cannot get a JFN for PS:<SYSTEM>ACCOUNTS-TABLE.BIN, /] ;[37] It's 4.1
	  CALL PUTERR		;[37] Issue rest of message and return
	  CALLRET RESUME	;[37]
	ENDIF.			;[37]
	MOVEM T1,SYSJFN		;SAVE THE JFN
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%WR>
	OPENF			;OPEN THE FILE FOR WRITE
	 JRST [	HRROI T1,[ASCIZ/? Cannot open output file, /]
		CALL PUTERR
		CALLRET RESUME]
	SKIPN ACTJFN		;DO WE HAVE A JFN FOR IT?
	CALL GETJFN		;NO, GO GET ONE
	MOVE T1,ACTJFN		;JFN OF NEWLY CREATED DATA BASE FILE
	SIZEF			;GET LENGTH OF THE FILE IN WORDS
	 JRST [	HRROI T1,[ASCIZ/? Cannot get size of output file, /]
		CALL PUTERR
		CALLRET RESUME]
	MOVEM T2,FILEN		;SAVE # WORDS IN THE FILE
	SKIPN T2		;[13] EMPTY FILE?
	JRST [ TMSG <? INSTALL failure - New ACCOUNTS-TABLE.BIN is empty
>
	       CALLRET RESUME]	;[13] YES, ERROR
; COPY ACCOUNTS-TABLE.BIN TO <SYSTEM>ACCOUNTS-TABLE.BIN

INSTL0:	MOVE T1,ACTJFN
	MOVEI T3,HTBLEN		;PAGE SIZE
	CAMLE T3,FILEN		;AT LEAST ONE PAGE LEFT TO MOVE?
	MOVE T3,FILEN		;NO, COPY ONLY EXACT # WORDS LEFT
	MOVEM T3,WORDS		;SAVE # WORDS TO BE COPIED
	MOVNS T3
	MOVE T1,ACTJFN
	HRRI T2,NULBLK
	HRLI T2,(<POINT 36,>)
	SIN			;COPY A PAGE INTO NULBLK BUFFER
	MOVE T1,SYSJFN		;JFN OF <SYSTEM> FILE
	HRRI T2,NULBLK
	HRLI T2,(<POINT 36,>)
	MOVE T3,WORDS
	MOVNS T3
	SOUT			;COPY NULBLK STUFF TO <SYSTEM> FILE
	MOVE T1,FILEN		;# WORDS LEFT TO COPY ...
	SUB T1,WORDS		; ... MINUS # WORDS JUST COPIED
	JUMPLE T1,INSTL1	;ANYTHING LEFT TO COPY?
	MOVEM T1,FILEN		;YES, SAVE REMAINING WORD COUNT
	JRST INSTL0		;AND CONTINUE

; <SYSTEM>ACCOUNTS-TABLE.BIN HAS BEEN CREATED
; CLOSE ALL OPEN FILES AND ENABLE ACCOUNT VALIDATION

INSTL1:	CALL CLSACT		;UNMAP AND CLOSE ACCOUNTS-TABLE.BIN
	SETOM T1
	CLOSF			;CLOSE ALL OPEN FILES
	JRST [	HRROI T1,[ASCIZ/? Cannot close open files, /]
		CALL PUTERR
		CALLRET RESUME]
	HRRZI T1,.USENA
	USAGE			;ENABLE ACCOUNT VALIDATION
	 ERJMP [HRROI T1,[ASCIZ/? CANNOT INSTALL NEW ACCOUNT VALIDATION DATA BASE, /]
		CALL PUTERR
		CALLRET RESUME]
	RET			;GO PARSE NEXT COMMAND
; GET A JFN FOR ACCOUNTS-TABLE.BIN IN THE CONNECTED DIR
;	CALL GETJFN
; RETURNS: +1	ALWAYS

GETJFN:	MOVX T1,GJ%OLD+GJ%SHT+.GJDEF	;MUST BE AN OLD FILE
	HRROI T2,[ASCIZ/ACCOUNTS-TABLE.BIN/]
	GTJFN			;GET JFN FOR THE EXISTING FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot get a jfn for ACCOUNTS-TABLE.BIN, /]
		CALL PUTERR	;RETURN ERROR AND RESUME
		CALLRET RESUME]
	MOVEM T1,ACTJFN		;SAVE THE JFN
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD>
	OPENF			;OPEN THE FILE FOR READING
	 JRST [	HRROI T1,[ASCIZ/? Cannot open ACCOUNTS-TABLE.BIN, /]
		CALL PUTERR
		CALLRET RESUME]
	RET			;RETURN
	SUBTTL HELP AND EXIT COMMANDS

; HELP COMMAND

.HELP:	HRROI T2,[ASCIZ/WITH ACTGEN/] ;GET NOISE WORDS
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;FAILED, RETURN FAILURE
	CALL ENDCOM		;GO PARSE END OF COMMAND
	 RET			;BAD CONFIRMATION, RETURN
	HRROI T1,HLPMSG		;GET POINTER TO HELP MESSAGE
	PSOUT			;OUTPUT HELP MESSAGE
	RET			;GO PARSE NEXT COMMAND

; EXIT COMMAND

.EXIT:	HRROI T2,[ASCIZ/TO MONITOR/] ;GET NOISE PHRASE
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;FAILED, RETURN FAILURE
	CALL ENDCOM		;GO PARSE END OF COMMAND
	 RET			;BAD CONFIRMATION, RETURN
	SKIPE ACTJFN		;OUTPUT FILE OPEN?
	CALL CLSACT		;YES, GO CLOSE IT
	SETOM T1		;INDICATE ALL FILES SHOULD BE CLOSED
	CLOSF			;CLOSE ALL OPEN FILES
	 JRST [	HRROI T1,[ASCIZ/? Cannot close open files, /]
	 	CALL PUTERR	;UNEXPECTED ERROR
		JRST .+1]
	HALTF			;RETURN TO MONITOR
	CALLRET START		;IF CONTINUE'D, START OVER
; CLOSE OUTPUT FILE
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

CLSACT:	CALL UNMAP		;UNMAP HASH PAGE
	HRRZ T1,ACTJFN		;OUTPUT FILE JFN
	CLOSF			;CLOSE THE FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot close output file, /]
		CALL PUTERR	;ERROR, TELL USER
		RET]		;AND RETURN
	SETZM ACTJFN		;NOTE THAT THE FILE IS CLOSED
	RET

; UNMAP PAGE WITH HASH TABLE
;	CALL UNMAP
; RETURNS: +1	ALWAYS

UNMAP:	SETOM T1
	MOVEI T2,HTBBLK		;STARTING LOC OF HASH TABLE
	IDIVI T2,HTBLEN		;PAGE # WHERE HASH TABLE LIVES
	HRLI T2,.FHSLF		;SAY THIS PROCESS
	SETZM T3
	PMAP			;UNMAP THE HASH TABLE
	RET			;AND RETURN
	SUBTTL COMMAND ERROR SUBROUTINES

; INVALID END-OF-COMMAND

CFMERR:	CALL TSTCOL		;TEST COLUMN POSITION
	TMSG <? ACTGEN: Garbage at end-of-command
>				;OUTPUT ERROR MESSAGE
	RET			;RETURN TO WHENCE WE CAME ...


; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED

TSTCOL:	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT DESIGNATOR
	RFPOS			;READ FILE POSITION
	HRRZS T2		;KEEP JUST THE COLUMN POSITION
	JUMPE T2,R		;IF AT COLUMN 1 DO NOT OUTPUT CRLF
	TMSG <
>				;NO, OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME 

; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A JSYS
; T1/ POINTER TO FIRST PART OF ERROR MESSAGE
; 		CALL PUTERR
;
; RETURNS: +1	ALWAYS

PUTERR:	ASUBR <TEXT1>
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	MOVE T1,TEXT1		;GET TEXT BACK
	PSOUT
	MOVX T1,.PRIOU		;PRIMARY OUTPUT JFN
	HRLOI T2,.FHSLF		;OUR FORK, LAST ERROR CODE
	SETZM T3		;
	ERSTR			;OUTPUT ERROR STRING
	 JFCL			;IGNORE
	 JFCL			;IGNORE
	TMSG <
>				;OUTPUT NEW LINE
	TXNE F,TAKFLG		;COMMANDS COMING FROM A FILE?
	JRST [	POP P,T1	;YES, DON'T RETURN TO CALLER
		RET]		;RETURN TO PARSE NEXT ENTRY
	MOVE T1,[.PRIIN,,.PRIOU] ;RESET PRIMARY INPUT AND OUTPUT JFNS
	MOVEM T1,CMDBLK+.CMIOJ	; IN COMMAND STATE BLOCK
	MOVEI T1,ACTTAB		;RESET COMMAND TABLE VECTORS
	MOVEM T1,CMDTAB		; FOR ACTGEN COMMANDS
	RET			;RETURN TO CALLER
; ROUTINE TO PRINT ERROR MSG IF FIELD IN COMMAND CANNOT BE PARSED
;
; CALL:	T1/ POINTER TO FIRST PART OF ERROR MESSAGE
;		CALL PRSERR
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

PRSERR:	ASUBR <PRSER1>
	CALL TSTCOL		;TEST COLUMN POSITION
	MOVE T1,PRSER1		;GET TEXT BACK
	PSOUT			;TELL USER
	HRROI T1,ATMBFR		;GET LOSING FIELD
	PSOUT
	TMSG <	in entry: >
	HRROI T1,BUFFER		;GET ENTRY BEING PROCESSED
	PSOUT			;TELL USER
	TMSG <in file:	>
	MOVX T1,.PRIOU
	MOVE T2,INJFN		;JFN OF FILE BEING WORKED ON
	SETZM T3		;NOTHING SPECIAL
	JFNS			;TELL USER THE FILE NAME
	TMSG <

>
	RET			;RETURN TO CALLER
; ROUTINE TO PRINT ERROR MESSAGE
; T1/ POINTER TO TEXT TO BE PRINTED
;	CALL ERRMES
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

ERRMES:	ASUBR <ERRMS1>
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	MOVE T1,ERRMS1		;GET TEXT
	PSOUT			;TELL USER
ERRMS0:	TMSG <
from entry:	>
	HRROI T1,BUFFER		;PRINT FAILING ENTRY
	PSOUT
	TMSG <
in file:	>
	MOVX T1,.PRIOU
	MOVE T2,INJFN
	SETZM T3
	JFNS			;TELL USER THE FILE NAME
	TMSG <
>
	RET
;TYPATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PREFIX STRING TO BE TYPED
;		CALL TYPATM
;RETURNS: +1 ALWAYS

TYPATM:	ASUBR <ATOMPT>
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? ACTGEN: >	;OUTPUT INITIAL PART OF MESSAGE
	MOVE T1,ATOMPT		;RESTORE ATOM POINTER
	PSOUT			;OUTPUT THE STRING
	TMSG < ">		;OUTPUT PUNCTUATION
	HRROI T1,ATMBFR		;GET POINTER TO THE ATOM BUFFER
	PSOUT			;OUTPUT THE TEXT ENTERED
	TMSG <"
>				;OUTPUT END OF LINE
	RET			;RETURN

;SETFDB - CREATES .CMKEY DESCRIPTOR BLOCK FOR .TAKE COMMAND
;RETURNS +1 ALWAYS, 2/ADDRESS OF FDB

SETFDB:	MOVE T1,[KEYFDB,,KEYFDB+1]	;SET UP TO CLEAR FDB
	SETZM KEYFDB			;CLEAR FIRST WD OF BLOCK
	BLT T1,KEYFDB+KEYSIZ-1		;CLEAR FDB
	MOVX T1,.CMKEY			;FUNCTION TO PERFORM
	STOR T1,CM%FNC,KEYFDB		;STORE FUNCTION CODE IN FD
	MOVE T1,CMDTAB			;ADDR OF COMMAND TABLE
	MOVEM T1,KEYFDB+.CMDAT		;STORE ADDR OF KEYWORD TABLE IN FDB
	MOVEI T2,KEYFDB			;RETURN POINTER TO FDB
	RET				;RETURN
	SUBTTL PARSING SUBROUTINES

; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL:		CALL ENDCOM
; RETURNS: +1	 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
;	   +2	SUCCESS, COMMAND CONFIRMED

ENDCOM:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
	COMND			;PARSE CONFIRMATION
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	RETSKP			;SUCCESS, RETURN
	CALLRET CFMERR		;NO, ISSUE ERROR MESSAGE AND RETURN


; ROUTINE TO PARSE NOISE PHRASE
;
; CALL:	T2/ POINTER TO NOISE PHRASE
;		CALL SKPNOI
; RETURNS: +1	 ERROR, INVALID NOISE PHRASE
;	   +2 	SUCCESS, NOISE PHRASE PARSED OK

SKPNOI:	MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
	SETZM NOIFDB		;CLEAR FIRST WORD OF BLOCK
	BLT T1,NOIFDB+FDBSIZ-1	;CLEAR FUNCTION DESCRIPTOR BLOCK
	MOVX T1,.CMNOI		;GET FUNCTION TO PERFORM
	STOR T1,CM%FNC,NOIFDB	;STORE FUNCTION CODE IN FDB
	MOVEM T2,NOIFDB+.CMDAT	;STORE POINTER TO NOISE PHRASE IN FDB
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,NOIFDB		;GET ADDRESS OF FUNCTION BLOCK
	COMND			;PARSE NOISE WORD
	 ERJMP CMDERR		;error, go check for eof on take file
	TXNN T1,CM%NOP		;NOISE PHRASE PARSED OK ?
	RETSKP			;YES, RETURN SUCCESS
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	HRROI T1,[ASCIZ/Invalid guide phrase/]
	callret typatm		;output the text entered and return
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PROMPT STRING
;		CALL CMDINI
;RETURNS: +1 ALWAYS,	WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
;			CALL TO CMDINI.


CMDINI:	MOVEM T1,CMDBLK+.CMRTY	;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
	POP P,SAVRET		;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
	MOVEM P,SAVREP		;SAVE STACK POINTER TO BE RESET ON REPARSE
	MOVE T1,[CM%RAI+CM%XIF+REPARS]	;CONVERT LOWERCASE TO UPPER, NO INDIRECT FILES, ADDRESS OF REPARSE ROUTINE
	MOVEM T1,CMDBLK+.CMFLG	;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
	COMND			;INITIALIZE COMMAND SCANNER JSYS
	 ERJMP CMDERR		;ERROR, GO SEE IF END OF "TAKE FILE"
	JRST @SAVRET		;RETURN


; HERE TO PROCESS A REPARSE

REPARS:	MOVE P,SAVREP		;RESET STACK POINTER
	JRST @SAVRET		;RETURN TO CALLER OF CMDINI
	SUBTTL GENERAL SUBROUTINES

;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
;	  IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
;	  IS SIMPLY PROCESSED.  ELSE AN ERROR MESSAGE IS ISSUED AND
;	  THE PROGRAM IS RESTARTED.
;
; CALL:		JRST CMDERR

CMDERR:	TXNN F,TAKFLG		;PROCESSING A TAKE FILE ?
	JRST CMER10		;NO, GO ISSUE ERROR MESSAGE
	HLRZ T1,CMDBLK+.CMIOJ	;GET INPUT FILE JFN FOR TAKE FILE
	GTSTS			;GET THE FILE'S STATUS
	TXNN T2,GS%EOF		;AT END OF FILE ?
	JRST CMER10		;NO, GO ISSUE ERROR MESSAGE
	TXZE F,BASFLG		;BAD ACCOUNT ENTRY SEEN?
	JRST CMDER1		;YES, CONTINUE
	MOVE T1,TOTLEN		;EOF - GET LENGTH OF CURRENT ACCOUNT BLOCK
	MOVE T2,ACTPTR		;PTR TO ACCOUNT HEADER IN FREE SPACE
	STOR T1,DATASZ,(T2)	;STORE LENGTH IN ACCOUNT HEADER
	TXNE F,SASFLG		;SUBACCOUNT SEEN?
	JRST [	CALL SAVCXT	;YES, SAVE CURRENT CONTEXT
		CALL START2	;GO HANDLE SUBACCOUNT
		CALL POPDAT	;GET RID OF ACCOUNT BLOCK
		JRST CMDER1]	;AND CONTINUE
	CALL SCNSTK		;SCAN DATSTK ENTRIES
	CALL BLKOUT		;PUT COMPLETED ACCT BLOCKS IN OUTPUT FILE
	CALL POPDAT		;FLUSH THIS LEVEL'S ACCOUNT BLOCK
	SOS ACTBYT		;ADJUST COUNT FOR NULL PADDED AT END OF COMPLETED ACCOUNT
CMDER1:	SKIPN ACTFLG		;[8]ACCOUNT SEEN BEFORE THIS ENTRY?
	JRST ACCXEF		;[8]NO, WRITE MESSAGE, RETURN TO ACTGEN> LEVEL
	MOVE T1,INJFN		;MUST HAVE REACHED END OF THIS
				; CONTEXT'S ACCOUNT DATA
	CLOSF			;REACHED EOF ON THIS FILE - CLOSE IT
	 JRST [	HRROI T1,[ASCIZ/? Cannot close open file, /]
	 	CALL PUTERR	;ERROR
		CALLRET RESUME]
	HLRO T1,P2		;GET JFN STACK DEPTH
	MOVNS T1		;MAKE IT POSITIVE
	CAIE T1,JFNLEN		;STACK EMPTY?
	JRST CMDER2		;NO, RESTORE PREVIOUS COMND STATE
	MOVE T1,[.PRIIN,,.PRIOU] ;GET STANDARD PRIMARY JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;RESET INPUT AND OUTPUT JFN'S
	TXZ F,TAKFLG		;MARK THAT TAKE FILE NOT BEING PROCESSED
	TXO F,FTTFLG		;WILL BE FIRST TIME THROUGH AGAIN
	SKIPE ACTJFN		;OUTPUT FILE OPEN?
	CALL CLSACT		;YES, CLOSE OUTPUT FILE
	CALL BLKBLT		;RESET STORAGE LOCATIONS
	MOVEI T1,ACTTAB		;RESET COMMAND TABLE VECTOR 
	MOVEM T1,CMDTAB		; FOR ACTGEN COMMANDS
	RET			;GO PROCESS NEXT ACTGEN COMMAND
CMER10:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	HRROI T1,[ASCIZ/%/]	;[14] Get us a percent sign
	PSOUT			;[14] Output it
	HRROI T1,ERRSTR		;PUT MSG INTO A STRING
	HRLOI T2,.FHSLF		;MOST RECENT COMND JSYS ERROR
	SETZM T3
	ERSTR			;GET ERROR TEXT
	 JFCL			;IGNORE ERRORS FOR NOW
	SKIPA T1,[POINT 7,[ASCIZ/unknown error code/]]
	HRROI T1,ERRSTR
	PSOUT			;PRINT THE MSG
	CALL ERRMS0		;TELL USER WHERE THE ERROR CAME FROM
	MOVEI T1,.PRIOU
	DOBE			;WAIT FOR MSG TO BE PRINTED
	JRST ENTVEC+1		;AND GO SIMULATE A "REENTER"

CMDER2:	CALL RESCMD		;RESTORE PREVIOUS COMND STATE
	 JRST CMDER3		;ERROR, TELL USER
	MOVSI T1,-MAXMSK	;SET UP AOBJN WORD
	POP P5,CLSMSK(T1)	;[11]GET ONE - FROM AFFSTK
	AOBJN T1,.-1		;GET THEM ALL
	POP P2,INJFN		;GET JFN FOR PREVIOUS CONTEXT
	POP P5,ACTFLG		;[7]GET ACCOUNT SEEN FLAG FOR PREVIOUS CONTEXT
	RET			;CONTINUE WITH PREVIOUS CONTEXT'S ENTRIES

CMDER3:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? Potential CMDSTK underflow
>
	CALLRET RESUME		;GO RESTART
; ROUTINE TO GET FDB FUNCTION CODE USED BY COMND JSYS
;
; CALL: T3/ FDB ADDR GIVEN IN COMND CALL,,FDB ADDR ACTUALLY USED
;		CALL GETFNC
; RETURNS: +1	ALWAYS, FUNCTION CODE IN T1

GETFNC:	HRRZS T3		;GET ADDRESS OF FDB ACTUALLY USED
	MOVE T3,(T3)		;GET FIRST WORD OF FDB (.CMFNP)
	LDB T1,[POINTR T3,CM%FNC] ;GET FUNCTION CODE USED
	RET			;RETURN

; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL:		CALL CLRGJF
; RETURNS: +1 ALWAYS

CLRGJF:	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD OF BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR GTJFN BLOCK
	RET			;RETURN TO WHENCE WE CAME ...
; ROUTINE TO CONVERT 6-CHARACTER ASCII STRUCTURE NAME TO SIXBIT
; CALL: T1/ ADDRESS OF ASCII STRING
;		CALL ASCSIX
; RETURNS: +1	ERROR, NON-SIXBIT CHARACTER ENCOUNTERED
;	   +2	SUCCESS, T2/ SIXBIT STRING

ASCSIX:	SETZM T2		;CLEAR DESTINATION
	SETOM T4		;FORCE CHECKING THE FIRST CHARACTER
	MOVEI T3,6		;LOOP COUNTER- # OF SIXBIT CHARS/WORD
	HRLI T1,(<POINT 7,>)	;BYTE POINTER TO STRING
ASCSX1:	SKIPE T4		;DON'T GET MORE CHARACTERS IF LAST CHAR WAS NULL
	ILDB T4,T1		;GET NEXT BYTE IN STRING
	JUMPE T4,ASCSX2		;IF NULL ENCOUNTERED, ALL DONE
	CAIL T4,172		;NOT AN ASCII CHARACTER?
	RET			;YES, ERROR RETURN
	CAIL T4,140		;UPPER CASE CHARACTER?
	CAILE T4,172		;NO - LOWER CASE?
	SKIPA
	SUBI T4,40		;CONVERT LOWER CASE TO SIXBIT UPPER
	SUBI T4,40		;CONVERT TO SIXBIT
ASCSX2:	LSH T2,6		;SHIFT DESTINATION STRING 6 BITS
	IOR T2,T4		;INSERT CONVERTED CHARACTER
	SOJG T3, ASCSX1		;CONVERT NEXT CHARACTER
	RETSKP			;DONE, RETURN SUCCESS

; ROUTINE TO PLACE DATA BLOCK IN FREE SPACE
; CALL: T3/ LENGTH,,ADDRESS OF ASSEMBLED DATA BLOCK
;		CALL PLBLK
; RETURNS: +1	ERROR
;	   +2	SUCCESS, T1/ FREE SPACE LOCATION WHERE BLOCK WAS PLACED

PLBLK:	ASUBR <PLBLK1,PLBLK2,PLBLK3>
	HLRZ T2,T3		;GET BLOCK LENGTH
	HRRZI T1,FRSHDR		;ADDRESS OF FREE SPACE HEADER
	CALL GETFRE		;TRY TO GET SOME FREE SPACE FOR THE BLOCK
	 RET			;ERROR, NOT ENOUGH SPACE
	MOVE T3,PLBLK3		;GET ORIGINAL ARGUMENT BACK
	HLRZ T2,T3		;GET BLOCK LENGTH
	ADD T2,T1		;LENGTH + START ADDR OF WHERE TO PUT BLOCK IN FREE SPACE
	SUBI T2,1		;NOW HAVE LAST LOCATION OF WHERE BLOCK WILL GO
	MOVEM T1,PLBLK1		;SAVE FREE SPACE ADDRESS FOR NOW
	HRLI T1,.FSPTR		;NOTE THAT THIS PTS TO DATA IN FREE SPACE
	PUSH P3,T1		;STACK PTR TO DATA BLOCK IN FREE SPACE
	HRL T1,T3		;ADDRESS OF BLOCK GOES IN LH
	BLT T1,(T2)		;PLACE DATA BLOCK IN FREE SPACE
	MOVE T1,PLBLK1		;FREE SPACE ADDRESS OF BLOCK
	RETSKP			;RETURN TO CALLER
	SUBTTL FREE STORAGE MANAGER

; ROUTINE TO ASSIGN SPACE IN FREE STORAGE REGION
; CALL:	RH(T1)		;LOCATION OF FREE STORAGE HEADER
;	LH(T1)		;INDEX FIELD FOR REFERENCES TO T1 AND POINTERS
;			;I.E. @T1 REFERENCES FIRST WORD OF HEADER
;	T2		;SIZE OF BLOCK NEEDED
;	CALL GETFRE
; RETURNS: +1	ERROR, NOT ENOUGH SPACE
;	   +2	SUCCESS, T1/ LOCATION OF THE BLOCK
; CLOBBERS T1, T2, T3, AND T4
; FREE STORAGE HEADER FORMAT:
;	0		;LH POINTS TO FIRST FREE BLOCK
;	1		;SPACE COUNTER
;	2		;MOST COMMON BLOCK SIZE
;	3		;LH HAS MAX TOP OF FREE STORAGE,
;			; RH HAS MINIMUM BOTTOM
;	4		;TEMPORARY 2
;	5		;TEMPORARY 3

GETFRE:	CAMLE T2,1(T1)		;ANY POSSIBILITY OF SUCCESS?
	RET			;NO, RETURN IMMEDIATELY
	PUSH P,T2		;SAVE DESIRED BLOCK SIZE
	PUSH P,[0]		;BIGGEST BLOCK SEEN SO FAR
	HRLOI T2,377777
	MOVEM T2,4(T1)		;INITIAL BEST BLOCK SIZE
	SETZM 5(T1)		;INITIAL LOCATION OF BEST BLOCK
	MOVE T2,T1		;START WITH THE HEADER WORD
GETFR1:	HLRZ T3,0(T2)		;GET POINTER TO NEXT FREE BLOCK
	JUMPE T3,GETFR2		;NO MORE FREE BLOCKS TO EXAMINE
	HRRZ T4,0(T3)		;GET SIZE OF THE BLOCK
	CAMLE T4,0(P)	
	MOVEM T4,0(P)
	CAMN T4,-1(P)		;IS IT THE RIGHT SIZE?
	JRST GETFR3		;YES, USE IT
	CAML T4,-1(P)		;TOO SMALL?
	CAML T4,4(T1)		;OR BIGGER THAN THE BEST?
	JRST GETFR4		;YES, IGNORE IT
	MOVEM T4,4(T1)		;THIS ONE IS BETTER
	MOVEM T2,5(T1)
GETFR4:	MOVE T2,T3		;STEP TO THE NEXT BLOCK
	JRST GETFR1		;AND REPEAT
GETFR2:	SKIPN T2,5(T1)		;DID WE FIND ANYTHING?
	JRST [	POP P,T2	;NO, FLUSH TEMP
		POP P,T2	;MAKE TRANSPARENT TO T2 ON ERROR
		RET]
	MOVE T4,-1(P)		;GET DESIRED SIZE
	HLRZ T3,0(T2)		;GET POINTER TO BLOCK TO BE USED
	HRRM T4,0(T3)		;CONVERT TO DESIRED SIZE
	ADD T4,T3		;POINTER TO REMAINDER OF BLOCK
	HRLM T4,0(T2)		;POINT PREVIOUS TO REMAINDER
	HLLZ T2,0(T3)		;GET NEXT
	HLLM T2,0(T4)		;POINT REMAINDER TO IT
	MOVE T2,4(T1)	
	SUB T2,-1(P)		;SIZE OF REMAINDER
	HRRM T2,0(T4)		;TO HEADER OF REMAINDER
GETFR5:	SUB P,[1,,1]		;GET LOCATION BELOW TOP-OF-STACK
	MOVN T2,0(P)
	ADDM T2,1(T1)		;REDUCE COUNT OF SPACE LEFT
	MOVEI T1,0(T3)		;GET ORIGIN OF BLOCK
	HRROS (T1)		;SET LH TO ONES
	CAMN T2,[-1]		;IS THIS A BLOCK OF ONE WORD?
	JRST GETFR6		;YES, DON'T ZERO ANYTHING THEN
	HRRZ T2,(T1)		;GET RH
	HRRZI T3,2(T1)
	SETZM -1(T3)		;ZERO FIRST WORD BEFORE SETTING LEFT HALF INDEX
	HRLI T3,1(T1)
	ADD T2,T1
	HRRZS T2
	CAILE T2,(T3)
	BLT T3,-1(T2)		;ZERO THE BLOCK
GETFR6:	POP P,T2		;RESTORE T2
	RETSKP			;RETURN

GETFR3:	HLL T4,0(T3)
	HLLM T4,0(T2)		;POINT PREDECESSOR TO SUCCESSOR
	JRST GETFR5
; ROUTINE TO RELEASE FREE STORAGE BLOCK
; LIFTED FROM MONITOR MODULE FREE, ROUTINE RELFRE
; CALL:	T1/ LOCATION OF FREE STORAGE HEADER
;	T2/ LOCATION OF THE BLOCK TO BE RETURNED
;	CALL RELFRE
; RETURNS: +1	ERROR, CAN'T RELEASE THE BLOCK
;	   +2	SUCCESS, BLOCK RELEASED
; CLOBBERS T2, T3, AND T4

RELFRE:	PUSH P,T1		;SAVE LOCATION OF FREE STG HDR
	HRRZ T4,0(T1)
	HLRZ T4,3(T1)
	HRRZ T1,3(T1)
	CAILE T4,0(T2)
	CAILE T1,0(T2)
	JRST RLFRX1		;ERROR - OUT OF RANGE
	MOVE T1,0(P)
RELFR0:	PUSH P,T2		;SAVE LOCATION OF BLOCK TO FREE
	HRLI T2,0		;SOME FIX NEEDED HERE TO KEEP OUT OF SEC 0!!!!
	HLLM T2,0(P)
	MOVE T2,-1(P)
RELFR1:	HLRZ T3,0(T2)		;GET LOCATION OF NEXT BLOCK
	JUMPE T3,RELFR2		;END OF LIST
	CAML T3,0(P)
	JRST RELFR2		;OR ABOVE BLOCK BEING RETURNED
	MOVE T2,T3
	JRST RELFR1
RLFRX1:	POP P,T1		;ERROR, BLOCK OUT OF RANGE
	RET			;RETURN

RELFR2:	CAMN T3,0(P)		;RELEASING A BLOCK ALREADY RELEASED?
	JSP CX,RLFRX2		;YES, ERROR
	CAIN T1,0(T2)		;THIS FIRST BLOCK ON FREE LIST?
	JRST RELFR6		;YES
	HRRZ T4,0(T2)		;COMPUTE END OF PREVIOUS BLOCK
	ADD T4,T2
	CAMLE T4,0(P)		;PREVIOUS BLOCK OVERLAPS ONE BEING RELEASED?
	JSP CX,RLFRX2		;YES, ERROR
RELFR6:	JUMPE T3,RELFR7		;AT END OF FREE LIST?
	HRRZ T4,0(P)		;COMPUTE END OF THIS BLOCK
	ADD T4,@0(P)
	CAMLE T4,T3		;OVERLAPS NEXT BLOCK ON FREE LIST?
	JSP CX,RLFRX2		;YES, ERROR
RELFR7:	HRRZ T4,@0(P)
	ADDM T4,1(T1)		;AUGMENT COUNT OF REMAINING FREE SPACE
	ADD T4,0(P)		;GET END OF BLOCK BEING RETURNED
	CAIE T4,0(T3)		;SAME AS FOLLOWING BLOCK LOCATION?
	JRST RELFR3		;NO
	HRRZ T4,0(T3)		;GET LENGTH OF FOLLOWING BLOCK
	ADDM T4,@0(P)		;AUGMENT LENGTH OF BLOCK BEING RETURNED
	HLLZ T4,0(T3)		;GET LOC OF SUCCESSOR OF SUCCESSOR
	HLLM T4,@0(P)
RELFR5:	MOVE T3,0(P)
	HRLM T3,0(T2)
	HRRZ T4,0(T2)		;LENGTH OF PREDECESSOR
	ADD T4,T2		;END OF PREDECESSOR
	CAME T4,T3		;SAME AS NEW BLOCK
	JRST RELFR4		;NO, DONE
	MOVE T3,0(T3)
	HLLM T3,0(T2)
	HRRZS T3
	ADDM T3,0(T2)
RELFR4:	POP P,T2
	POP P,T1
	RETSKP			;GOOD RETURN

RELFR3:	HRLM T3,@0(P)		;POINT RETURNED BLOCK TO SUCCESSOR
	JRST RELFR5

RLFRX2:	POP P,T2		;ERROR, BAD BLOCK BEING RELEASED
	POP P,T1
	RET			;GIVE ERROR RETURN
; ROUTINE TO BUILD FREE SPACE HEADER AT ACTGEN INITIALIZATION
;  FOR CALLS TO GETFRE AND RELFRE
;
;	CALL FSHDR
; RETURNS: +1	ALWAYS

FSHDR:	MOVEI T1,MINFRE
	HRLOM T1,FRSHDR
	MOVEI T1,MAXFRE+1
	SUBI T1,MINFRE
	HRRZM T1,MINFRE
	MOVEM T1,FRSHDR+1
	MOVE T1,[MAXFRE,,MINFRE]
	MOVEM T1,FRSHDR+3
	RET
	SUBTTL SCAN DATSTK

; ROUTINE TO SCAN DATSTK, FLAGGING ACCOUNT AND DUPLICATE ENTRIES
; NEW ACCOUNT HEADER CREATED FOR DATA CURRENTLY ON STACK
;
;	BLKLEN - HOLDS SUM OF DATA BLOCK LENGTHS
;
;	CALL SCNSTK
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3, T4

SCNSTK:	ASUBR <BLKLEN>
	SETZM BLKLEN		;INITIALIZE BLOCK LENGTH COUNT
	SETZM TMPBUF		;CLEAR THIS BUFFER
	MOVE T1,[XWD TMPBUF,TMPBUF+1]
	BLT T1,TMPBUF+ATMSIZ-1
	MOVEI T1,TMPBUF		;PLACE WHERE NEW ACCOUNT HEADER IS GOING
	SETOM T2
	STOR T2,XPDAT,(T1)	;INIT EXPIRATION DATE TO -1 FIRST TIME THROUGH
	MOVEI T2,4(T1)
	HRLI T2,(<POINT 7,>)
	MOVEM T2,BUFPTR		;INIT PTR INTO TMPBUF WHERE ACCOUNT
				; NAME WILL GO
	MOVEI T1,DATSTK		;CHECK FIRST STACK ENTRY INITIALLY
	MOVEI T2,1(T1)		;START SCANNING STACK HERE INITIALLY
SCNST1:	MOVE T3,(T1)		;FIRST STACK ENTRY FOR THIS SCAN
	JUMPE T3,SCNST5		;SKIP THIS ENTRY IF IT'S A DELIMITER
	TXNE T3,ACNTRY		;IS IT AN ACCOUNT ENTRY?
	JRST [	MOVE T3,T1	;YES
		CALL MAKHDR	;ADD ACCOUNT NAME TO NEW HEADER
		JRST SCNST5]	;AND CONTINUE SCAN
	TXNE T3,DPNTRY		; OR A DUPLICATE ENTRY?
	JRST SCNST5		;YES, SKIP THIS KIND OF ENTRY TOO
	LOAD T3,BKTYP,(T3)	;TYPE OF DATA BLK BEING CHECKED
	CAIN T3,.TYACC		;IS IT AN ACCOUNT ENTRY?
	JRST [	MOVE T3,T1	;YES ADD TO NEW ACCT HEADER
		CALL MAKHDR
		MOVX T4,ACNTRY	;FLAG IT AS AN ACCOUNT ENTRY
		XORM T4,(T3)
		JRST SCNST5]	;AND CONTINUE THE SCAN
	LOAD T3,FSADR,(T1)	;GET BLOCK LENGTH
	LOAD T3,BKLEN,(T3)
	ADDM T3,BLKLEN		;ADD TO TOTAL
	CAILE T2,(P3)		;WILL SCAN START PAST TOP OF STACK?
	JRST SCNST6		;YES, ALL DONE SCANNING STACK THEN
SCNST2:	MOVE T3,(T2)		;START SCANNING STACK ENTRIES
	JUMPE T3,SCNST4		;SKIP THIS ENTRY IF IT'S A DELIMITER
	LOAD T3,FSADR,(T1)	;TYPE OF DATA BLK BEING CHECKED
	LOAD T3,BKTYP,(T3)
	LOAD T4,FSADR,(T2)	;TYPE OF DATA BLK BEING SCANNED
	LOAD T4,BKTYP,(T4)
	CAME T3,T4		;SAME BLOCK TYPE?
	JRST SCNST4		;NO, CONTINUE THE SCAN
	CAIN T4,.TYACC		;IS SCANNED ENTRY AN ACCOUNT BLOCK?
	JRST [	MOVE T3,T1	;YES, ADD TO NEW ACCOUNT HEADER
		CALL MAKHDR
		MOVX T4,ACNTRY	;FLAG IT AS AN ACCOUNT ENTRY
		XORM T4,(T3)
		JRST SCNST4]	;AND CONTINUE THE SCAN
	LOAD T3,FSADR,(T1)	;SAME TYPE - GET BLOCK LENGTHS
	LOAD T3,BKLEN,(T3)
	LOAD T4,FSADR,(T2)
	LOAD T4,BKLEN,(T4)
	CAME T3,T4		;SAME BLOCK LENGTH?
	JRST SCNST4		;NO, CONTINUE THE SCAN
	CALL DUPCHK		;SEE IF THEY ARE DUPLICATE ENTRIES
	JRST SCNST4		;NOT DUPLICATE, CONTINUE THE SCAN
	JUMPE T3,[MOVX T4,DPNTRY ;DUPLICATE - SAME EXP DATE?
		  XORM T4,(T2)	;FLAG LOWER ENTRY AS DUPLICATE
		  JRST SCNST4]	;AND CONTINUE
	CAME T3,T2		;LOWER ENTRY HAVE LATER EXP DATE?
	JRST [	PUSH P,T3	;SAVE FOR NOW
		LOAD T3,FSADR,(T3)
		LOAD T3,BKLEN,(T3) ;GET THIS BLOCK'S LENGTH
		MOVE T4,BLKLEN
		SUB T4,T3	   ;DON'T COUNT THIS LENGTH INTOTAL
		MOVEM T4,BLKLEN
		POP P,T3
		JRST .+1]
	MOVX T4,DPNTRY		;DIFFERENT EXPIRATION DATES
	XORM T4,(T3)		;FLAG APPROPRIATE ENTRY AS DUPLICATE

SCNST4:	AOS T2			;GET NEXT ENTRY TO SCAN
	CAIG T2,(P3)		;DONE SCANNING ALL STACK ENTRIES?
	JRST SCNST2		;NO, CONTINUE
SCNST5:	AOS T1			;YES, GET NEXT ENTRY TO CHECK
	CAIG T1,(P3)		;DONE CHECKING ALL STACK ENTRIES?
	JRST [	MOVEI T2,1(T1)	;NO, SCAN BEGINS HERE
		JRST SCNST1]	;CONTINUE SCANNING
; DONE SCANNING STACK HERE - FINISH CREATING NEW ACCOUNT HEADER

SCNST6:	SETZ T2,
	MOVE T1,BUFPTR
	IDPB T2,T1		;ALWAYS PAD END OF ACCT STRING WITH A NULL
	AOS ACTBYT		;AND ADJUST COUNT OF CHARS IN STRING
	MOVE T1,ACTBYT		;# CHARS IN ACCOUNT NAME
	IDIVI T1,5		;GET # WORDS IN ACCOUNT NAME
	SKIPE T2		;ANY CHARS SPILL OVER?
	AOS T1			;YES, INCREMENT TOTAL
	ADDI T1,4		;ACCT NAME LENGTH + 4 WD FOR REST OF HEADER
	MOVEI T2,TMPBUF		;START OF NEW ACCOUNT HEADER
	STOR T1,BKLEN,(T2)	;SAVE HEADER LENGTH
	ADDB T1,BLKLEN		;LENGTH OF HDR PLUS ALL DATA BLOCKS
	STOR T1,DATASZ,(T2)	;SAVE IN ACCOUNT HEADER
	SETZM T1
	STOR T1,ACPTR,(T2)	;INITIALIZE THIS TO 0
	MOVEI T1,.TYACC
	STOR T1,BKTYP,(T2)	;BLOCK TYPE OF ACCOUNT HEADER
	MOVE T3,T2		;HEADER ADDRESS GOES IN T3
	LOAD T3,BKLEN,(T3)	;LENGTH OF NEW ACCT HEADER
	HRLZS T3		;PUT IT IN LEFT HALF
	HRRI T3,TMPBUF		;START ADDRESS OF HEADER AGAIN
	CALL PLBLK		;PUT NEW HEADER IN FREE SPACE
	 JRST SCNSTX		;ERROR
	MOVEM T1,ACTPTR		;SAVE LOCATION WHERE HDR WAS PUT
	POP P3,T2		;THROW AWAY PTR THAT PLBLK STACKED
	RET

SCNSTX:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? Cannot place account header in free space
>
	CALLRET RESUME		;GO RESTART
; ROUTINE TO SEE IF TWO DATA BLOCKS ARE DUPLICATE
; T1/ DATSTK ADDRESS OF HIGHER-LEVEL BLOCK
; T2/ DATSTK ADDRESS OF LOWER-LEVEL BLOCK
;	CALL DUPCHK
; RETURNS: +1	BLOCKS NOT DUPLICATE
;	   +2	DUPLICATE, T3/ 0 => BLOCKS HAVE SAME EXPIRATION DATE
;			OR T3/ ENTRY WITH LATER EXPIRATION DATE
; CLOBBERS T3, T4

DUPCHK:	ASUBR <DUPCH1,DUPCH2,DUPCH3,DUPCH4>
	LOAD T3,FSADR,(T1)
	LOAD T3,BKLEN,(T3)	;BLOCK LENGTH
	SUBI T3,2		;# WORDS TO COMPARE IN BLOCK
	MOVNS T3
	HRROS T3		;MAKE IT A FULL-WORD NEGATIVE NUMBER
	MOVEM T3,DUPCH4		;SAVE AS LOOP INDEX
	LOAD T3,FSADR,(T1)	;START OF HIGHER-LEVEL BLOCK IN FREE SPACE
	MOVE T1,2(T3)		;PLACE TO START SCANNING FIRST BLOCK
	LOAD T4,FSADR,(T2)
	MOVE T2,2(T4)		;PLACE TO START SCANING LOWER-LEVEL BLOCK
DPCHK1:	CAME T1,T2		;BLOCK ENTRIES THE SAME?
	JRST [	DMOVE T1,DUPCH1	;NO, RESTORE ORIGINAL VALUES
		RET]		;AND RETURN IMMEDIATELY
	AOSL DUPCH4		;ANY MORE ENTRIES TO COMPARE?
	JRST EXPCHK		;NO, GO CHECK EXPIRATION DATES
	AOS T3
	MOVE T1,2(T3)		;GET NEXT ENTRY TO COMPARE
	AOS T4
	MOVE T2,2(T4)
	JRST DPCHK1		;CONTINUE COMPARING ENTRIES
; DUPLICATE ENTRIES SO FAR - COMPARE EXPIRATION DATES

EXPCHK:	DMOVE T1,DUPCH1		;RESTORE ORIGINAL CONTENTS
	LOAD T3,FSADR,(T1)
	LOAD T4,FSADR,(T2)
	LOAD T3,XPDAT,(T3)	;EXP DATE OF HIGHER-LEVEL BLOCK
	LOAD T4,XPDAT,(T4)	;EXP DATE OF LOWER-LEVEL BLOCK
	CAMN T3,T4		;SAME DATE?
	JRST [	SETZM T3	;YES, RETURN TO CALLER
		RETSKP]
	CAML T3,T4		;DATES NOT THE SAME
	JRST EXPCH1		;LOWER BLOCK HAS EARLIER DATE
	JUMPE T3,[MOVE T3,T1	;NOTE THAT HIGHER BLK HAS LATER DATE
		  RETSKP]	;AND RETURN
	MOVE T3,T2		;LOWER BLK HAS LATER DATE
	RETSKP

; LOWER BLOCK HAS EARLIER DATE

EXPCH1:	JUMPE T4,[MOVE T3,T2	;LOWER BLK REALLY HAS LATER DATE
		  RETSKP]
	MOVE T3,T1		;HIGHER BLK HAS LATER DATE
	RETSKP			;RETURN
; ROUTINE TO FORM NEW ACCOUNT HEADER FROM ACCT BLOCKS ON STACK
; T3/ DATSTK ADDRESS OF AN ACCOUNT BLOCK
;
;	ACTADR - HOLDS ADDRESS OF ACCOUNT BLOCK IN FREE SPACE
;
;	CALL MAKHDR
; RETURNS: +1	ALWAYS
; CLOBBERS T4

MAKHDR:	ASUBR <MKHDR1,MKHDR2,MKHDR3,ACTADR>
	LOAD T4,FSADR,(T3)
	MOVEM T4,ACTADR		;SAVE ADDR OF ACCT BLK IN FREE SPACE
	LOAD T3,BKLEN,(T4)	;GET ACCOUNT BLOCK LENGTH
	SUBI T3,4		;LENGTH OF ACTUAL ACCOUNT NAME IN WORDS
	MOVE T1,BUFPTR		;PTR INTO TMPBUF FOR  FORMING ACCT NAME
	MOVEI T3,TMPBUF
	MOVE T3,4(T3)		;GET FIRST WORD OF ACCOUNT NAME
	SKIPE T3		;ACCOUNT NAME ALREADY BEING FORMED?
	CALL INDLM		;YES, INSERT DELIMITER "."
	MOVE T2,ACTADR
	ADDI T2,4		;ADDRESS IN BLOCK WHERE ACCT NAME BEGINS
	HRLI T2,(<POINT 7,>)	;MAKE IT A BYTE POINTER
	MOVEI T3,MAXLEN		;MAX # CHARS IN ACCOUNT NAME
	MOVEI T4,.CHNUL		;TERMINATE ON NULL BYTE
	SOUT			;PUT ACCOUNT NAME IN NEW HEADER
	MOVEM T1,BUFPTR		;SAVE UPDATED PTR INTO TMPBUF
	MOVEI T1,TMPBUF		;START OF NEW ACCT HEADER
	MOVE T3,ACTADR		;GET ACCOUNT BLOCK ADDRESS
	LOAD T2,ACCLS,(T3)
	STOR T2,ACCLS,(T1)
	LOAD T2,XPDAT,(T1)	;GET CURRENT EXPIRATION DATE
	MOVE T3,ACTADR
	LOAD T3,XPDAT,(T3)	;GET THIS ACCOUNT'S EXP DATE
	SKIPGE T2		;FIRST TIME IN FORMING THIS ACCT?
	JRST [	STOR T3,XPDAT,(T1) ;YES, SAVE THIS ACCOUNT'S DATE
		JRST MAKHD1]	;RETURN
	CAMN T2,T3		;DATES THE SAME?
	JRST MAKHD1		;YES, JUST RETURN
	CAML T2,T3		;DOES NEW HDR ALREADY HAVE AN EARLIER DATE?
	JRST MAKHD2		;NO, THIS ACCT HAS AN EARLIER ONE
	JUMPE T2,[STOR T3,XPDAT,(T1) ;SAVE THIS ACCT'S DATE
				; IF SAVED DATE WAS 0
		  JRST MAKHD1]	;RETURN
MAKHD1:	DMOVE T1,MKHDR1		;RESTORE ORIGINAL VALUES
	MOVE T3,MKHDR3		
	RET			;KEEP CURRENT DATE AND RETURN

MAKHD2:	JUMPE T3,MAKHD1		;KEEP CURRENT DATE IF THIS DATE IS 0
	STOR T3,XPDAT,(T1)	;SAVE THIS ACCOUNT'S DATE
	JRST MAKHD1		;RETURN

; ROUTINE TO INSERT DELIMITER "." BETWEEN ACCOUNT NAMES
; T1/ POINTER INTO ACCOUNT NAME IN TMPBUF
;	CALL INDLM
; RETURNS: +1	ALWAYS
; CLOBBERS T3

INDLM:	MOVEI T3,"."
	DPB T3,T1		;INSERT THE "."
	RET
; ROUTINE TO HASH ACCOUNT STRING
; T1/ AOBJN POINTER TO ACCOUNT STRING (-LENGTH,,ADDRESS)
;	CALL HSHNAM
; RETURNS: +1	ALWAYS, T1/ HASH VALUE

HSHNAM:	ASUBR <HSHN1,HSHN2,HSHN3,HSHN4>
	STKVAR <HSHTMP>
	HLRZ T4,T1		;GET BLOCK LENGTH
	CAIN T4,-1		;IS ACCOUNT ONE WORD LONG?
	JRST [	MOVE T3,0(T1)	;YES, GET ACCOUNT STRING
		MOVEM T3,HSHTMP	;SAVE IT
		JRST HSHNM2]	;AND CONTINUE
	MOVE T3,0(T1)		;GET FIRST WORD OF STRING
	MOVEM T3,HSHTMP		;SAVE IT
	ADD T1,[1,,1]		;POINT TO NEXT WORD IN STRING
HSHNM1:	MOVE T3,0(T1)	
	XORM T3,HSHTMP
	AOBJP T1,HSHNM2		;HSHNM2 IF ALL DONE XOR'ING
	JRST HSHNM1		;CONTINUE XOR'ING

HSHNM2:	MOVE T1,HSHTMP		;GET FINAL VALUE
	TRZ T3,1		;CLEAR BIT 35 TO PARALLEL MONITOR
	XOR T1,RANDOM
	MUL T1,RANDOM
	MOVMS T1
	IDIVI T1,HSHLEN		;DIVIDE BY # OF POSSIBLE HASH VALUES
	MOVE T1,T2		;REMAINDER IS HASH VALUE
	DMOVE T2,HSHN2		;RESTORE ORIGINAL VALUES
	MOVE T4,HSHN4
	RET			;RETURN TO CALLER

RANDOM:	5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
; ROUTINE TO HASH ACCOUNT STRING AND FIX HASH TABLE
; T2/ ADDRESS OF ACCOUNT HEADER IN FREE SPACE
;	CALL HASHER
; RETURNS: +1	ALWAYS
; CLOBBERS T3, T4

HASHER:	ASUBR <HSHR1,HSHR2,HSHR3,HSHR4>
	MOVE T1,T2
	ADDI T1,4		;START OF ACCOUNT STRING IN HEADER
	LOAD T3,BKLEN,(T2)	;ACCOUNT HEADER LENGTH
	SUBI T3,4		;LENGTH OF ACCOUNT STRING
	MOVNS T3		;MAKE IT NEGATIVE
	HRL T1,T3		;MAKE AOBJN POINTER TO ACCOUNT STRING
	CALL HSHNAM		;GET HASH VALUE
	MOVEI T2,HSHVAL		;START OF HASH VALUES
	ADD T2,T1		;HASH VALUE IS OFFSET INTO HASH TABLE
	MOVE T3,0(T2)		;GET HASH TABLE ENTRY
	JUMPE T3,HASHR4		;JUMP IF NO COLLISIONS ON THIS ENTRY
	MOVE T1,ACTJFN		;COLLISION
	RFPTR			;GET FILE POINTER
	 JRST [	HRROI T1,[ASCIZ/? Cannot read output file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;GO RESTART
	MOVEM T2,HSHR3		;SAVE FILE POINTER FOR NOW
HASHR1:	ADDI T3,3		;GET ACPTR OF THIS ACCOUNT BLOCK
	RIN			;GET ITS VALUE
	JUMPE T2,HASHR3		;IF ZERO, NO MORE COLLISIONS
	MOVEM T2,T3		;COLLISION, CONTINUE SCANNING CHAIN
	JRST HASHR1

; NO MORE COLLISIONS - SAVE POINTER IN FILE TO NEW ACCOUNT HEADER

HASHR3:	MOVE T2,BYTCNT		;LOCATION IN FILE WHERE NEW
				; ACCOUNT HEADER WILL GO
	ROUT			;MAKE ACCT HDR AT END OF CHAIN POINT TO IT
	MOVE T2,HSHR3
	SFPTR			;RESET FILE POINTER
	 JRST [	HRROI T1,[ASCIZ/? Cannot set output file pointer, /]
		CALL PUTERR	;ERROR, TELL USER
		CALLRET RESUME]	;AND GO RESTART
	JRST HASHR5		;CLEAN UP AND RETURN

HASHR4:	MOVE T1,BYTCNT		;LOCATION IN FILE WHERE NEW ACCT HDR WILL GO
	MOVEM T1,0(T2)		;MAKE HASH TABLE ENTRY POINT TO IT
HASHR5:	DMOVE T1,HSHR1		;RESTORE ORIGINAL VALUES
	RET			;AND RETURN
	SUBTTL OUTPUT BLOCKS TO FILE

; ROUTINE TO PLACE NEW ACCOUNT HEADER AND DATA BLOCKS IN OUTPUT FILE
;	CALL BLKOUT
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

BLKOUT:	MOVE P1,ACTPTR		;POINTER TO ACCT HEADER IN FREE SPACE
	LOAD T3,DATASZ,(P1)	;LENGTH OF ALL ACCT DATA BLOCKS
	MOVE T1,BYTCNT		;GET # BYTES WRITTEN TO FILE SO FAR
	IDIVI T1,HTBLEN		;NUMBER OF PAGES WRITTEN SO FAR
	MOVEI T1,HTBLEN		; AND T2/ # BYTES WRITTEN ON CURRENT PAGE
	SUB T1,T2		;ROOM LEFT ON CURRENT PAGE
	CAMGE T1,T3		;ENOUGH ROOM TO PUT ACCT BLOCKS?
	CALL NULFIL		;NO, FILL REST OF PAGE WITH NULLS
	CALL OUTDAT		;PUT DATA BLOCKS IN FILE
	RET			;AND RETURN

; ROUTINE TO SOUT ACCOUNT DATA BLOCKS TO FILE
; P1/ POINTER TO ACCOUNT HEADER IN FREE SPACE
;	CALL OUTDAT
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

OUTDAT:	MOVE T1,ACTJFN		;OUTPUT FILE JFN
	MOVE T2,P1		;ADDR OF ACCT HEADER IN FREE SPACE
	CALL HASHER		;HASH ACCOUNT NAME AND FIX HASH TABLE
	HRLI T2,(<POINT 36,>)	;MAKE POINTER TO ACCOUNT HEADER
	LOAD T3,BKLEN,(P1)	;HEADER LENGTH
	ADDM T3,BYTCNT		;INCREASE # WORDS WRITTEN
	SOUT			;PUT ACCT HEADER IN FILE
	MOVE T2,P1		;GET FREE SPACE ADDRESS AGAIN
	MOVEI T1,FRSHDR		;FREE STORAGE HEADER
	CALL RELFRE		;RELEASE FREE SPACE FOR ACCT HEADER
	 JRST POPDTX		;ERROR, TELL USER
	MOVEI T1,DATSTK		;START OF DATA BLOCKS ON STACK
OUTDT1:	MOVE T2,(T1)		;GET PTR TO DATA BLOCK
	JUMPE T2,OUTDT3		;IF DELIMITER, JUST CONTINUE
	TXZN T2,ACNTRY		;ACCOUNT ENTRY?
	TXZE T2,DPNTRY		; OR DUPLICATE ENTRY?
	JRST [	MOVEM T2,(T1)	;YES, SAVE NEWLY UNFLAGGED ENTRY
		JRST OUTDT3]	;AND CONTINUE SCANNING STACK
	CALL SOUTDT		;PLACE DATA BLOCK IN FILE AND CONTINUE
OUTDT3:	AOS T1			;GET NEXT STACK ENTRY
	HRRZ T3,P3		;GET CURRENT TOP OF STACK
	CAMG T1,T3		;ALL DONE SCANNING STACK?
	JRST OUTDT1		;NO, CONTINUE
	RET
; ROUTINE TO SOUT DATA BLOCK TO FILE
; T2/ POINTER TO DATA BLOCK IN FREE SPACE
;	CALL SOUTDT
; RETURNS: +1	ALWAYS
; CLOBBERS T2, T3

SOUTDT:	ASUBR <SOUTD1,SD2>
	LOAD T3,BKLEN,(T2)	;GET BLOCK LENGTH
	MOVE T1,BYTCNT		;GET NUMBER OF BYTES WRITTEN SO FAR
	ADDI T1,1000		;ROUND UP TO NEXT PAGE NUMBER
	ANDX T1,-1000		;[12] GET BOTH HALVES OF THE WORD
	SUB T1,BYTCNT		;SEE HOW MANY MORE WORDS FIT ON THIS PAGE
	CAMGE T1,T3		;ROOM FOR ENTIRE DATA BLOCK?
	JRST [	CALL NULFIL	;NO, FILL REST OF PAGE WITH NULL BLOCK SO MONITOR IS HAPPY
		MOVE T2,SD2	;RESTORE ADDRESS OF DATA BLOCK
		LOAD T3,BKLEN,(T2)	;RESTORE BLOCK LENGTH
		JRST .+1]
	ADDM T3,BYTCNT		;ADD SOUT'ED BLOCK SIZE TO TOTAL
	HRRZS T2		;POINTER TO DATA BLOCK IN FREE SPACE
	HRLI T2,(<POINT 36,>)	;TURN IT INTO A BYTE POINTER
	MOVE T1,ACTJFN		;OUTPUT FILE JFN
	SOUT
	MOVE T1,SOUTD1		;RESTORE ORIGINAL VALUE
	RET			;AND RETURN

; ROUTINE TO PLACE NULL BLOCK IN FILE
; T1/ NULL BLOCK SIZE (# WORDS LEFT ON PAGE)
;	CALL NULFIL
; RETURNS: +1	ALWAYS
; CLOBBERS T1, T2, T3

NULFIL:	SAVEAC <P1>
	MOVEI P1,NULBLK		;GET NULBLK HEADER
	MOVEI T2,.TYNUL		;NULL BLOCK TYPE
	STOR T2,BKTYP,(P1)
	STOR T1,BKLEN,(P1)	;BLOCK LENGTH
	MOVE T3,T1
	ADDM T3,BYTCNT		;INCREASE # BYTES WRITTEN
	MOVE T1,ACTJFN		;NULBLK GOES TO OUTPUT FILE
	MOVE T2,P1		;BLOCK ADDRESS
	HRLI T2,(<POINT 36,>)	;TURN IT INTO A POINTER
	SOUT
	RET			;AND RETURN
	SUBTTL CMDSTK MANIPULATION

; ROUTINE TO SAVE CURRENT CONTEXT'S COMND STATE BLOCK
;  AND BUFFER ON CMDSTK
;
;	CALL SAVCMD
; RETURNS: +1	ERROR, SAVING BLOCK WILL CAUSE STACK OVERFLOW
;	   +2	SUCCESS
; CLOBBERS T1 AND T2

SAVCMD:	HRRZI T1,BUFSIZ+.CMGJB+5 ;SIZE OF BLOCK TO BE SAVED
	HRLS T1			;PUT IT IN BOTH HALVES
	ADD T1,P4		;ADD CURRENT STACK POINTER
	HLRZ T2,T1		;NEW STACK DEPTH
	HRROS T2		;MAKE IT A FULL-WORD NEGATIVE NUMBER
	JUMPGE T2,SAVCMX	;POTENTIAL OVERFLOW?
	MOVE T2,T1		;NO, SAVE IT IN T2
	MOVEI T1,CMDBLK		;ADDRESS OF BLOCK TO BE SAVED
	HRLS T1			;PUT IT IN LH
	HRRI T1,1(P4)		;TOP OF STACK IN RH
	BLT T1,0(T2)		;SAVE BLOCK ON STACK
	MOVEM T2,P4		;FIX UP STACK POINTER
	RETSKP			;GIVE GOOD RETURN

SAVCMX:	RET			;ERROR RETURN
; ROUTINE TO RESTORE PREVIOUS CONTEXT'S COMND STATE BLOCK
;  AND BUFFER FROM CMDSTK
;
;	CALL CMDSTK
; RETURNS: +1	ERROR, RESTORING BLOCK WILL CAUSE STACK UNDERFLOW
;	   +2	SUCCESS
; CLOBBERS T1, T2, T3

RESCMD:	HRRZI T1,.CMGJB+5+BUFSIZ ;SIZE OF BLOCK TO RESTORE
	HRLS T1
	MOVE T2,P4		;GET CURRENT STACK POINTER
	SUB T2,T1		;SEE WHAT POINTER WILL BE AFTERWARDS
	HLRZ T1,T2		;GET NEW STACK DEPTH
	HRROS T1		;MAKE IT A FULL-WORD NEGATIVE NUMBER
	CAIL T1,-1		;POTENTIAL UNDERFLOW?
	JRST RESCMX		;YES, GIVE ERROR RETURN
	MOVE T3,T2		;SAVE NEW POINTER IN T3
	MOVEI T1,CMDBLK		;PLACE TO RESTORE BLOCK TO
	HRLI T1,1(T2)		;START OF BLOCK ON STACK
	MOVEI T2,CMDBLK+BUFSIZ+.CMGJB+4 ;LAST ADDRESS TO RESTORE TO
	BLT T1,0(T2)		;RESTORE BLOCK AND BUFFER
	MOVEM T3,P4		;FIX UP STACK POINTER
	RETSKP			;GIVE GOOD RETURN

RESCMX:	RET
	SUBTTL INTERRUPT HANDLERS

; TRAP HERE FOR PANIC-LEVEL INTERRUPTS

PANIC:	TMSG <
? Panic-level interrupt occurred, > ;[9] OUTPUT ERROR CHARACTER WITH MESSAGE
	MOVE T1,ERRSTR		;[9] GET POINTER TO MESSAGE
	PSOUT			;[9] TELL 'EM WHAT HAPPENED
	MOVEI T1,.PRIOU		;[9] SET UP OUTPUT DEVICE FOR NOUT
	HRRZ T2,RETPC1		;[9] GET THE PANIC ERROR PC
	SUBI T2,1		;[9] SUBTRACT ONE TO GET THE RIGHT LOCATION
	MOVEI T3,10		;[9] WE WANT OCTAL
	NOUT			;[9] NOW TELL 'EM WHERE IT HAPPENED
	MOVEI T1,.PRIOU
	DOBE			;WAIT FOR IT TO BE PRINTED
	CALLRET RESUME		;RETURN TO ACTGEN COMMAND LEVEL


;[9]HERE TO PICK UP ERROR MESSAGES FOR PANIC-LEVEL INTERRUPTS

PDLO:	HRROI T1,[ASCIZ/PDL Overflow at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE

ILINST:	HRROI T1,[ASCIZ/Illegal Instruction at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE

ILREAD:	HRROI T1,[ASCIZ/Illegal Memory Read at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE

ILRITE:	HRROI T1,[ASCIZ/Illegal Memory Write at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE

ILLEX:	HRROI T1,[ASCIZ/Illegal Execute at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE

SIZEX:	HRROI T1,[ASCIZ/Machine Size Exceeded at /] ;[9]GET THE MESSAGE
	MOVEM T1,ERRSTR		;[9]STORE THE POINTER
	JRST PANIC		;[9]OUTPUT COMPLETE MESSAGE
; RESUME AFTER PANIC-LEVEL INTERRUPT

RESUME:	TXNE F,TAKFLG		;COMMANDS COMING FROM A FILE?
	JRST RESUM1		;YES, CLOSE ALL OPEN FILES
RESUM2:	SKIPE ACTJFN		;OUTPUT FILE OPEN?
	CALL CLSACT		;YES, GO CLOSE IT
	SETZM INJFN		;ZERO INPUT FILE JFN CELL
	SETZM OUTJFN		;ZERO OUTPUT FILE JFN CELL
	SETZM ACTJFN		;ZERO DATA FILE JFN CELL
	MOVEI T1,.PRIIN		;CLEAR TYPE-AHEAD
	CFIBF			; OF UNREAD CHARACTERS
	MOVEI T1,START1		;START FROM SCRATCH
	MOVEM T1,RETPC1		; AFTER DEBRK
	MOVEI T1,.FHSLF		;GET THE INTERRUPTS IN PROGRESS
	RWM
	JUMPE T2,START1		;IF NONE IN PROGRESS, JUST GO RESTART
	DEBRK

RESUM1:	HLRO T2,P2		;GET JFN STACK DEPTH
	MOVNS T2		;MAKE IT POSITIVE
	CAIN T2,JFNLEN		;ANYTHING ON STACK?
	JRST RESUM4		;NO, JUST CLOSE INPUT FILE
RESUM3:	POP P5,T1		;[7]CLEAR OFF THE STACK
	POP P2,T1		;GET A JFN
	CLOSF	
	 JRST [	HRROI T1,[ASCIZ/? Cannot close open files, /]
	 	CALL PUTERR
		JRST .+1]
	HLRO T2,P2		;GET NEW STACK DEPTH
	MOVNS T2
	CAIE T2,JFNLEN		;STACK EMPTY YET?
	JRST RESUM3		;NO, CONTINUE
RESUM4:	MOVE T1,INJFN
	CLOSF			;CLOSE CURRENT INPUT FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot close open files, /]
	 	CALL PUTERR
		JRST .+1]
	JRST RESUM2		;AND CONTINUE
; ROUTINE TO HANDLE END-OF-FILE INTERRUPTS

REPEAT 0,<
EOFINT:	MOVE T1,INJFN		;GET "TAKE" INPUT FILE JFN
	CLOSF			;CLOSE THE INPUT FILE
	 JRST [	CALL PUTERR	;UNEXPECTED ERROR
		RET]
	MOVE T1,OUTJFN		;OUTPUT FILE JFN
	CLOSF			;CLOSE THE OUTPUT FILE
	 JRST [	CALL PUTERR	;UNEXPECTED ERROR
		RET]
	MOVEI T1,START1		;RETURN ADDRESS
	MOVEM T1,RETPC1		;STORE RETURN ADDRESS
	DEBRK			;DISMISS INTERRUPT
	0
>
	SUBTTL CONSTANTS AND TABLES

DEFINE TB(RTN,TXT)
<	[ASCIZ/TXT/] ,, RTN
>

ACTTAB:	ACTSIZ-1,, ACTSIZ	;CURRENT,,MAX SIZE OF COMMAND TABLE
	TB (.EXIT,EXIT)		;EXIT TO MONITOR
	TB (.HELP,HELP)		;OUTPUT HELP MESSAGE
	TB (.INSTL,INSTALL)	;INSTALL NEW ACCOUNT VALIDATION DATA BASE
	TB (.TAKE,TAKE)		;TAKE (COMMANDS FROM) FILE-SPEC ...

	ACTSIZ== .-ACTTAB

;"TAKE" COMMANDS

TAKTAB:	TAKSIZ-1,,TAKSIZ	;CURRENT,,MAX SIZE OF TAKE TABLE
	TB (.ACCT,ACCOUNT)	;ACCOUNT STRING NAME
	TB (.DIREC,DIRECTORY)	;DIRECTORY NAME
	TB (.GROUP,GROUP)	;GROUP (USER OR DIRECTORY)
	TB (.USRNM,USER)	;USER NAME (SINGLE OR LIST)

	TAKSIZ== .-TAKTAB
;"ACCOUNT" MODIFIERS

ACTSWI:	ACCSIZ-1,,ACCSIZ	;CURRENT,,MAX SIZE OF ACCOUNT SWITCH TABLE
	TB (.ALLOW,ALLOW:)	;ALLOW SUBACCOUNT CLASSES
	TB (.CLASS,CLASS:)	;JOB CLASS
	TB (.XPIRE,EXPIRES:)	;EXPIRATION DATE
	TB (.SUBAC,SUBACCOUNT:)	;SUBACCOUNT

	ACCSIZ== .-ACTSWI

;SUBACCOUNT MODIFIER


SUBSWI:	SUBSIZ-1,,SUBSIZ		
	TB (.CLASS,CLASS:)	;CLASS
	TB (.SUBAC,SUBACCOUNT:)	;SUBACCOUNT

	SUBSIZ==.-SUBSWI

;"GROUP" MODIFIERS

GRPSWI:	GRPSIZ-1,,GRPSIZ
	TB (.DGPNM,DIRECTORY:)	;DIRECTORY GROUP NUMBER
	TB (.UGPNM,USER:)	;USER GROUP NUMBER

	GRPSIZ== .-GRPSWI

;EXPIRATION DATE MODIFIER

EXPSWI:	EXPSIZ-1,,EXPSIZ	;CURRENT,,MAX SIZE OF TABLE
	TB (.CLASS,CLASS:)	;CLASS
	TB (.XPIRE,EXPIRES:)	;EXPIRATION DATE

	EXPSIZ==.-EXPSWI

PROMPT:	ASCIZ /ACTGEN>/		;PROMPT STRING
; LEVEL TABLE FOR INTERRUPT SYSTEM

LEVTAB:	RETPC1
	RETPC2
	RETPC3

; ENTRY VECTOR DEFINITION

ENTVEC:	JRST START		;MAIN ENTRY POINT
	JRST START		;REENTER ENTRY POINT
	EXP VACTGEN		;VERSION OF ACTGEN PROGRAM
; HELP TEXT

HLPMSG:	ASCIZ /
	TOPS-20 ACTGEN

FUNCTION

	ACTGEN takes account validation data from text files
	and creates the corresponding data base in the file
	ACCOUNTS-TABLE.BIN.

COMMANDS

	EXIT (TO MONITOR)
	    leave this program

	HELP (WITH ACTGEN)
	    print this message on your terminal

	INSTALL (NEW ACCOUNT VALIDATION DATA BASE)
	    copy the file ACCOUNTS-TABLE.BIN to BS:<SYSTEM>
	    ACCOUNTS-TABLE.BIN (or PS:<SYSTEM>ACCOUNTS-TABLE.BIN 
            on 4.1 systems) and enable this new account validation 
            scheme immediately

	TAKE (COMMANDS FROM FILE) file specification
	    create the file ACCOUNTS-TABLE.BIN from
	    account validation data in the base file
	    and all files it points to

   control-A is the escape character to return to ACTGEN command level.

HINTS

	The default file specification for the TAKE command is
	    is named ACCOUNTS.CMD.

/				;[37]
	SUBTTL VARIABLE DATA STORAGE

;INTERRUPT CHANNELS

RADIX 5+5

CHNTAB:
	0			;ASSIGNABLE CHANNEL 0
	0			;ASSIGNABLE CHANNEL 1
	0
	0
	0
	1,,TRAP			;ESCAPE CHARACTER
TRPCHN==5			; ON CHANNEL 5
	0			;6 - ARITHMETIC OVERFLOW
	0			;7 - FLOATING OVERFLOW
	0			;8 - RESERVED
	1,,PDLO			;[9] 9 - PDL OVERFLOW
	0			;10 - END OF FILE
	0			;11 - DATA ERROR
	0			;12 - QUOTA EXCEEDED
	0			;13 - RESERVED
	0			;14 - TIME OF DAY (RESERVED)
	1,,ILINST		;[9] 15 - ILLEGAL INSTRUCTION
	1,,ILREAD		;[9] 16 - ILLEGAL MEM READ
	1,,ILRITE		;[9] 17 - ILLEGAL MEM WRITE
	1,,ILLEX		;[9] 18 - ILLEGAL EXECUTE
	0			;19 - INFERIOR FORK TERMINATION
	1,,SIZEX		;[9] 20 - MACHINE SIZE EXCEEDED
	0			;21 - TRAP TO USER (RESERVED)
	0			;22 - NONEXISTENT PAGE REFERENCED
	0			;ASSIGNABLE CHANNEL 23
	0			;ASSIGNABLE CHANNEL 24
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0

RADIX 8

ONCHNS:	1B<TRPCHN>+1B9+1B15+1B16+1B17+1B18+1B20
ACTFLG:	BLOCK 1			;[7]ACCOUNT SEEN AT BEGINNING OF FILE
SAVRET:	BLOCK 1			;RETURN ADDRESS OF CMDINI CALLER
SAVREP:	BLOCK 1			;SAVED STACK POINTER TO RESTORE ON REPARSE
RETPC1:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 1
RETPC2:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 2
RETPC3:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 3

; NOTE: BUFFER MUST ALWAYS FOLLOW CMDBLK IN STORAGE

CMDBLK:	BLOCK .CMGJB+5		;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER:	BLOCK BUFSIZ		;INPUT TEXT STORED HERE

PTRBUF:	BLOCK BUFSIZ		;PTR TO BEG OF NEXT FIELD TO BE PARSED
ATMBFR:	BLOCK ATMSIZ		;ATOM BUFFER FOR COMND JSYS
ATMSAV:	BLOCK ATMSIZ		;BUFFER TO HOLD CONTENTS OF ATOM BUFFER 
				; FOR PROCESSING IN DATA FILE
TMPBUF:	BLOCK ATMSIZ		;TEMPORARY BUFFER
GJFBLK:	BLOCK GJFSIZ		;GTJFN BLOCK FOR COMND JSYS
PDL:	BLOCK PDLEN		;PUSH DOWN POINTER
JFNSTK:	BLOCK JFNLEN		;STACK OF OPEN JFNS FOR ACCT VALIDATION DATA SOURCE FILES
AFFSTK:	BLOCK AFFLEN		;[7]STACK OF FILES WHERE ACCOUNT COMMAND IS FIRST
DATSTK:	BLOCK DATLEN		;STACK OF PTRS TO ACCT DATA BLOCKS IN FREE SPACE
CMDSTK:	BLOCK CMSLEN		;STACK OF COMND STATE BLOCKS AND BUFFERS
NOIFDB:	BLOCK FDBSIZ		;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
KEYFDB:	BLOCK KEYSIZ		;FDB FOR KEYWORDS
NAMBUF:	BLOCK 8			;BUFFER FOR NAME OF INPUT FILE
SUBBUF:	BLOCK 31		;BUFFER FOR SUBACCOUNT FILE SPEC
FRSHDR:	BLOCK 6			;FREE STORAGE HEADER
INJFN:	BLOCK 1			;INPUT JFN FOR TAKE COMMAND
OUTJFN:	BLOCK 1			;OUTPUT JFN FOR TAKE COMMAND
CMDTAB:	BLOCK 1			;CELL CONTAINING "ACTGEN" OR "TAKE" COMMAND TABLE POINTERS
TRPCHR:	BLOCK 1			;TRAP CHAR TO GET BACK TO ACTGEN CMD LEVEL
ERRSTR:	BLOCK 20		;BLOCK FOR ERSTR STRINGS
ACTLEN:	BLOCK 1			;# WORDS IN ACCOUNT STRING NAME
DIRLEN:	BLOCK 1			;# WORDS IN DIRECTORY NAME STRING
USRLEN:	BLOCK 1			;# WORDS IN DIRECTORY NAME STRING
TOTLEN:	BLOCK 1			;LENGTH OF ALL DATA BLOCKS FOR AN ACCOUNT
				;TOTLEN IS STORED IN DATASZ IN ACTHDR
; THE NEXT SEVEN LOCATIONS (STRUCT TO ACTBYT) ARE ALL SET
;  TO ZERO AT ACTGEN INITIALIZATION
;  NOTE: THESE LOCATIONS MUST ALWAYS REMAIN TOGETHER IN STORAGE

STRUCT:	BLOCK 1			;CELL FOR STRUCTURE DESIGNATOR
ACTBYT:	BLOCK 1			;# 7-BIT BYTES IN ACCOUNT NAME FORMED
ACTJFN:	BLOCK 1			;JFN FOR <SYSTEM>ACCOUNTS-TABLE.BIN
ACTNUM:	BLOCK 1			;COUNT OF GOOD ACCOUNT ENTRIES SEEN
ACTPTR:	BLOCK 1			;FREE SPACE ADDRESS WHERE ACCOUNT HEADER WAS PUT
BUFPTR:	BLOCK 1			;PTR INTO TMPBUF TO PUT ACCOUNT NAME
BYTCNT:	BLOCK 1			;COUNT OF BYTES WRITTEN TO OUTPUT FILE

ZBKLEN==.-STRUCT		;LENGTH OF BLOCK TO BE ZEROED

;ACCOUNTING DATA BLOCKS

ACTHDR:	BLOCK 4+6		;ACCOUNT HEADER PLUS 6 WORDS FOR ACCOUNT STRING NAME
UNMBLK:	BLOCK 2+6		;USER NAME HEADER PLUS 6 WDS FOR USER NAME
DNMBLK:	BLOCK 3+6		;DIRECTORY NAME HEADER PLUS 6 WDS FOR DIRECTORY NAME
UGPBLK:	BLOCK 3			;USER GROUP BLOCK
DGPBLK:	BLOCK 4			;DIRECTORY GROUP BLOCK
ALUBLK:	BLOCK 2			;ALL USERS
ALDBLK:	BLOCK 3			;ALL DIRECTORIES
NULBLK:	BLOCK HTBLEN		;NULL BLOCK
				;MAX NULBLK SIZE < ONE PAGE
MAXMSK==5			;WORDS IN CLSMSK AND ALWMSK
ALWMSO:	BLOCK 1			;SOMETHING IN ALLOW MASK
CLSMSK:	BLOCK MAXMSK		;ALLOWED CLASS MASK
ALWMSK:	BLOCK MAXMSK		;COMMAND MODIFIER OF CLSMSK

XP0DAT:	BLOCK	1		;EXPIRATION DATE IFF /EXPIRES: SWITCH USED
				; BEFORE ANY USER NAMES IN ACCOUNTS.CMD
;FLAGS IN F

EXPFLG==:1B0			;EXPIRATION DATE SEEN FOR AN ENTRY IF NONZERO
FTTFLG==:1B1			;FIRST-TIME-THROUGH-ACTGEN FLAG IF NONZERO
TAKFLG==:1B2			;NONZERO IF PROCESSING A TAKE FILE
SASFLG==:1B3			;SUBACCOUNT SEEN IN ACCOUNT ENTRY IF NONZERO
BASFLG==:1B4			;BAD ACCOUNT ENTRY SEEN IF NONZERO
CLASFL==:1B5			;CLASS FLAG
CLASSF==:1B6			;CLASS SEEN FLAG
ALWFLG==:1B7			;ALLOW SWITCH SEEN
EX0FLG==:1B8			;/EXPIRES SWITCH SEEN AT BEGINNING OF LINE

.FSPTR==:477777			;ENTRY ON DATSTK IS A FREE SPACE
				; POINTER IF .FSPTR IS IN LH
	DPNTRY==:1B1		;INDICATES A DUPLICATE ENTRY ON STACK
	ACNTRY==:1B2		;INDICATES AN ACCOUNT ENTRY ON STACK
	SUBTTL End of ACTGEN

	XLIST
	LIT
	LIST
	PRGEND==.

	END <3,,ENTVEC>