Google
 

Trailing-Edge - PDP-10 Archives - AP-4172F-BM - 3a-sources/actgen.mac
There are 33 other files named actgen.mac in the archive. Click here to see a list.
;<3-UTILITIES>ACTGEN.MAC.15,  8-Nov-77 13:53:14, EDIT BY KIRSCHEN
;<3-UTILITIES>ACTGEN.MAC.14,  8-Nov-77 10:43:41, EDIT BY KIRSCHEN
;<3-UTILITIES>ACTGEN.MAC.13,  8-Nov-77 10:37:50, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>ACTGEN.MAC.12,  2-Nov-77 15:12:11, EDIT BY KIRSCHEN
;FIX BUG INDUCED BY DUPLICATE ACCOUNTS: P6 CLOBBERAGE DUE TO INCORRECT
;USE OF TRVAR/ASUBR.
;<3-UTILITIES>ACTGEN.MAC.11, 26-Oct-77 10:57:05, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>ACTGEN.MAC.9, 20-Oct-77 09:05:28, EDIT BY KIRSCHEN
;LEFT JUSTIFY SIXBIT NAMES OF LESS THAN 6 CHARACTERS
;<3-UTILITIES>ACTGEN.MAC.8, 29-Sep-77 21:21:31, EDIT BY OSMAN
;CHANGE RLJFN TO CLZFF SO OTHER PROCESS'S JFN'S AREN'T WIPED OUT
;<3-UTILITIES>ACTGEN.MAC.7,  8-Sep-77 16:12:46, EDIT BY HURLEY
;MAKE ACTGEN NOT PRINT PANIC LEVEL INTERRUPT ON SIMPLE FAILURES
;<3-UTILITIES>ACTGEN.MAC.6, 25-Aug-77 11:45:12, EDIT BY KIRSCHEN
;FIX VERSION NUMBERS FOR RELEASE 3
;<MACK>ACTGEN.MAC.347, 22-Aug-77 16:35:37, Edit by MACK
;CLEAR USER NAME BLOCK AFTER EACH USE
;<MACK>ACTGEN.MAC.346, 17-Aug-77 16:00:49, Edit by MACK
;<MACK>ACTGEN.MAC.344, 17-Aug-77 10:38:04, Edit by MACK
;<MACK>ACTGEN.MAC.341, 16-Aug-77 15:19:57, Edit by MACK
;WILDCARDING USER NAME STRINGS
;<MACK>ACTGEN.MAC.340, 11-Aug-77 13:21:39, Edit by MACK
;ADD ACTDAT DEFSTR'S TO ACTGEN
;<MACK>ACTGEN.MAC.336,  3-Aug-77 14:24:15, Edit by MACK
;<MACK>ACTGEN.MAC.335,  1-Aug-77 17:52:04, Edit by MACK
;ADDED ACTGEN HELP MESSAGE
;<MACK>ACTGEN.MAC.333, 28-Jul-77 14:17:30, Edit by MACK
;<MACK>ACTGEN.MAC.332, 28-Jul-77 14:08:26, Edit by MACK
;<MACK>ACTGEN.MAC.331, 28-Jul-77 11:49:48, Edit by MACK
;<MACK>ACTGEN.MAC.330, 28-Jul-77 10:38:59, Edit by MACK
;<MACK>ACTGEN.MAC.328, 28-Jul-77 08:20:19, Edit by MACK
;<MACK>ACTGEN.MAC.326, 27-Jul-77 14:05:41, Edit by MACK
;ADD INSTALL COMMAND
;<MACK>ACTGEN.MAC.324, 26-Jul-77 13:50:13, Edit by MACK
;COMND JSYS ERROR MSGS PRINTED WHEN THEY OCCUR
;<MACK>ACTGEN.MAC.323, 26-Jul-77 12:15:24, Edit by MACK
;<MACK>ACTGEN.MAC.322, 26-Jul-77 11:15:45, Edit by MACK
;<MACK>ACTGEN.MAC.321, 26-Jul-77 10:53:20, Edit by MACK
;POPDAT CHECKS TO SEE IF DATSTK IS EMPTY BEFORE POPPING
;<MACK>ACTGEN.MAC.320, 26-Jul-77 09:51:46, Edit by MACK
;<MACK>ACTGEN.MAC.319,  5-Jul-77 09:48:51, Edit by MACK
;<MACK>ACTGEN.MAC.318,  1-Jul-77 16:21:35, Edit by MACK
;<MACK>ACTGEN.MAC.317, 30-Jun-77 16:59:36, Edit by MACK
;<MACK>ACTGEN.MAC.316, 30-Jun-77 15:31:12, Edit by MACK
;<MACK>ACTGEN.MAC.315, 30-Jun-77 15:15:22, Edit by MACK
;ADJUST ACTBYT WHEN ERRORS IN .ACCT FOUND
;<MACK>ACTGEN.MAC.314, 30-Jun-77 10:03:51, Edit by MACK
;<MACK>ACTGEN.MAC.311, 29-Jun-77 11:10:27, Edit by MACK
;<MACK>ACTGEN.MAC.309, 27-Jun-77 14:55:21, Edit by MACK
;FIXED FREE STG MANAGER TO ZERO THE BLOCK
;<MACK>ACTGEN.MAC.306, 27-Jun-77 13:29:58, Edit by MACK
;ADDED CM%DWC TO .CMDAT OF .CMDIR FOR DIRECTORY-NAME WILDCARDING
;<MACK>ACTGEN.MAC.305, 27-Jun-77 08:36:12, Edit by MACK
;FIXED ACCOUNT LENGTH PROBLEM 
;<MACK>ACTGEN.MAC.304, 21-Jun-77 13:28:46, Edit by MACK
;<MACK>ACTGEN.MAC.301, 17-Jun-77 15:19:29, Edit by MACK
;<MACK>ACTGEN.MAC.300, 16-Jun-77 14:48:21, Edit by MACK
;ADDED CM%PO TO FDB FOR DIRECTORY AND USER NAMES
;<MACK>ACTGEN.MAC.299, 15-Jun-77 15:52:17, Edit by MACK
;<MACK>ACTGEN.MAC.298, 15-Jun-77 15:36:24, Edit by MACK
;<MACK>ACTGEN.MAC.297,  8-Jun-77 11:00:24, Edit by MACK
;ADDED CM%RAI TO .CMFLG OF COMND STATE BLOCK
;<MACK>ACTGEN.MAC.288, 16-May-77 10:47:59, Edit by MACK
;<MACK>ACTGEN.MAC.264, 10-May-77 11:01:15, Edit by MACK
;HASH ALGORITHM AND COLLISION RESOLUTION
;<MACK>ACTGEN.MAC.221, 26-Apr-77 17:19:57, Edit by MACK
;COSMETIC CODE CLEANUP
;<MACK>ACTGEN.MAC.212, 26-Apr-77 12:09:41, Edit by MACK
;<MACK>ACTGEN.MAC.205, 24-Apr-77 21:38:17, Edit by MACK
;REMOVED JSERR AFTER SOUTS
;<MACK>ACTGEN.MAC.199, 19-Apr-77 16:50:21, Edit by MACK
;BLKOUT AND ASSOCIATED ROUTINES ADDED
;<MACK>ACTGEN.MAC.194, 14-Apr-77 16:08:18, Edit by MACK
;REWRITE OF DATA POPPING/MERGING IN .ACCT AND AT EOF
;<MACK>ACTGEN.MAC.179, 11-Apr-77 10:23:18, Edit by MACK
;FIXED ERROR HANDLERS PRSERR AND PUTERR
;<MACK>ACTGEN.MAC.167,  6-Apr-77 13:41:46, Edit by MACK
;REMOVED CODE TO REINIT PDL-STACK AT PARSE1
;<MACK>ACTGEN.MAC.163,  5-Apr-77 11:53:57, Edit by MACK
;ROUTINES SAVCMD AND RESCMD PUSH AND POP COMND STATE BLOCK AND BUFFER
; ON CMDSTK
;<MACK>ACTGEN.MAC.159,  4-Apr-77 14:41:05, Edit by MACK
;<MACK>ACTGEN.MAC.158,  4-Apr-77 10:39:42, Edit by MACK
;ACTIVATE ALL CALLS TO PLBLK
;<MACK>ACTGEN.MAC.157,  4-Apr-77 10:20:43, Edit by MACK
;CELL TOTLEN KEEPS TRACK OF LENGTH OF DATA BLOCKS -  ULTIMATELY PUT
; IN DATASZ IN ACTHDR
;<MACK>ACTGEN.MAC.155, 31-Mar-77 10:29:44, Edit by MACK
;TWO CONTEXT STACKS: ONE FOR JFNS, ONE FOR PTRS TO ACCT VAL DATA
; IN FREE SPACE.  STACK PTRS ARE P2 FOR JFNSTK AND P3 FOR DATSTK
;<MACK>ACTGEN.MAC.153, 30-Mar-77 13:52:35, Edit by MACK
;.FSPTR IN LH OF ENTRY ON CONTEXT STACK MEANS ENTRY PTS TO FREE SPACE
;<MACK>ACTGEN.MAC.152, 30-Mar-77 11:16:43, Edit by MACK
;FREE SPACE HEADER CREATED AT ACTGEN INITIALIZATION
;<MACK>ACTGEN.MAC.145, 28-Mar-77 17:14:10, Edit by MACK
;EXPANDED PLBLK TO ASK FOR FREE SPACE FOR DATA BLOCKS
;<MACK>ACTGEN.MAC.141, 28-Mar-77 13:35:44, Edit by MACK
;ADDED ROUTINES GETFRE AND RELFRE TO MANAGE FREE STORAGE
;<MACK>ACTGEN.MAC.134, 24-Mar-77 11:18:32, Edit by MACK
;ALTERED "ACCOUNT" CODE
;<MACK>ACTGEN.MAC.130, 24-Mar-77 09:38:19, Edit by MACK
;CREATED F (AC6) - FLAG AC
;P3 IS POINTER TO CONTEXT STACK
;<MACK>ACTGEN.MAC.122, 10-Mar-77 09:24:17, Edit by MACK
;ADDITIONS TO USER NAME/ALL USERS ROUTINES
;<MACK>ACTGEN.MAC.114,  9-Mar-77 13:38:19, Edit by MACK
;DISABLE CALLS TO PLBLK TEMPORARILY
;<MACK>ACTGEN.MAC.110,  8-Mar-77 13:52:38, Edit by MACK
;<MACK>ACTGEN.MAC.107,  8-Mar-77 11:59:11, Edit by MACK
;<MACK>ACTGEN.MAC.104,  7-Mar-77 15:45:19, Edit by MACK
;REVISED .GROUP CODE
;<MACK>ACTGEN.MAC.100,  4-Mar-77 16:18:22, Edit by MACK
;<MACK>ACTGEN.MAC.95,  3-Mar-77 14:55:07, Edit by MACK
;CODE TO DO GTJFN/OPENF ON <SYSTEM>ACCOUNTS-TABLE.BIN
;<MACK>ACTGEN.MAC.89,  3-Mar-77 09:31:48, Edit by MACK
;ADDED PI SYSTEM INIT AND INTERRUPT HANDLERS
;CTRL/A IS ESCAPE CHR TO GET BACK TO ACTGEN COMMAND LEVEL
;<MACK>ACTGEN.MAC.86,  2-Mar-77 15:25:10, Edit by MACK
;PLDIR SEPARATES AND DEPUNCTUATES FIELDS IN THE STRING STR:<DIRNAME>
;<MACK>ACTGEN.MAC.78,  1-Mar-77 16:23:38, Edit by MACK
;ADDED ERROR HANDLERS PRSERR AND JSYSER
;<MACK>ACTGEN.MAC.65, 16-Feb-77 11:20:54, Edit by MACK
;ADDED ROUTINE GETFNC TO GET FBD FUNCTION CODE USED BY COMND
;<MACK>ACTGEN.MAC.61, 15-Feb-77 13:53:53, Edit by MACK
;REMOVED TAKTST CODE AND CALL TO IT FROM ENDCOM
;PLDIR DOES JSERR IF DIRST FAILS



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

TITLE ACTGEN

	SEARCH MONSYM, MACSYM
	.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		;PRESERVED
	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

; VERSION NUMBER DEFINITIONS

VMAJOR==3		;MAJOR VERSION OF ACTGEN
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==2		;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
CMSLEN==20*<.CMGJB+5+BUFSIZ> ;COMND STATE STACK DEPTH
DATLEN==^D200		;DATA STACK DEPTH
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 (DATASZ,2,35,36)		;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
SUBTTL MAIN ENTRY POINT AND INITIALIZATION

START:	SKIPE ACTJFN		;ACCOUNT FILE OPEN?
	CALL CLSACT		;YES, GO UNMAP AND CLOSE IT
	RESET			;RESET THE UNIVERSE
	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
	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:	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
	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
	TXNE F,EXPFLG		;EXPIRATION DATE SEEN?
	JRST ACCT3		;YES
	; ...
	; ...
	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
	STOR T2,XPDAT,(P1)	;PLACE DATE IN DATA BLOCK
	CALL ACCT7		;PLACE DATA BLOCK IN FREE SPACE
ACCT2:	TXZ F,EXPFLG		;GOOD RETURN, RESET FLAG
	CALL ENDCOM		;PARSE END-OF-ENTRY
	 RET			;ERROR RETURN
	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	;RESET FLAGS
	TXO F,BASFLG		;NOTE THAT A BAD ACCOUNT WAS SEEN
	RET			;RETURN TO PARSE NEXT ENTRY

;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
	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	;NO, RESET FLAG
		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
	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:	SETZM T2		;SAY THAT ENTRY NEVER EXPIRES
	STOR T2,XPDAT,(P1)	;PLACE IT IN ACCOUNT HEADER
	TXZ F,EXPFLG		;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	;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 P2,INJFN		;SAVE OLD JFN ON STACK
	MOVEM T1,INJFN		;SAVE NEW JFN
	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
SUBTTL DIRECTORY ENTRY

.DIREC:	MOVEI P1,DNMBLK		;GET ADDR OF DIRECTORY DATA BLOCK
	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>
	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
	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:	MOVEI P1,UNMBLK		;GET ADDR OF USER NAME DATA BLOCK
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMUSR,CM%PO,CM%DWC)]
	COMND			;PARSE "*" OR ANYTHING THAT LOOKS LIKE A USER NAME
	 ERJMP CMDERR		;ERROR, CHECK FOR EOF ON TAKE FILE
	TXNE T1,CM%NOP		;PARSED FIELD OK?
	JRST USRNX		;NO
	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:	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:	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:	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
	HRROI T1,ATMBFR		;POINTER TO GROUP NUMBER
	MOVEI T3,^D10		;TREAT IT AS A DECIMAL NUMBER
	NIN			;PLACE IT IN T2
	 JRST [	HRROI T1,[ASCIZ/? Cannot get directory group number, /]
	 	CALL PUTERR	;ERROR
		CALLRET RESUME]
	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
	HRROI T1,ATMBFR		;POINTER TO GROUP NUMBER
	MOVEI T3,^D10		;TREAT IT AS A DECIMAL NUMBER
	NIN			;PUT IT IN T2
	 JRST [	HRROI T1,[ASCIZ/? Cannot get user group number, /]
	 	CALL PUTERR	;ERROR
		RET]
	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
	MOVX T1,GJ%FOU+GJ%SHT+.GJDEF
	HRROI T2,[ASCIZ/PS:<SYSTEM>ACCOUNTS-TABLE.BIN/]
	GTJFN			;GET A JFN FOR THE <SYSTEM> FILE
	 JRST [	HRROI T1,[ASCIZ/? Cannot get a jfn for PS:<SYSTEM>ACCOUNTS-TABLE.BIN, /]
		CALL PUTERR	;ISSUE REST OF MESSAGE AND RETURN
		CALLRET RESUME]
	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

; 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:	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,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
	POP P2,INJFN		;GET JFN 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
	ADDM T1,BLKLEN		;LENGTH OF HDR PLUS ALL DATA BLOCKS
	MOVE T1,BLKLEN
	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
	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
	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>
	LOAD T3,BKLEN,(T2)	;GET BLOCK LENGTH
	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, >
	HRROI T1,ERRSTR		;PUT MESSAGE INTO A STRING
	HRLOI T2,.FHSLF		; AND REASON FOR PANIC
	SETZM T3
	ERSTR
	 JFCL			;IGNORE ERRORS FOR NOW
	SKIPA T1,[POINT 7,[ASCIZ/unknown error code/]]
	HRROI T1,ERRSTR		;NOW PRINT THE MESSAGE
	PSOUT
	MOVEI T1,.PRIOU
	DOBE			;WAIT FOR IT TO BE PRINTED
	CALLRET RESUME		;RETURN TO ACTGEN COMMAND LEVEL

; 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