.PSECT	MAIL
	.TITLE	MAIL - MAIL FILE TO SPECIFIED USER
	.IDENT	/781114/
;
;    THIS CODE HAS BEEN DEVELOPED BY THE COMPUTING
;    GROUP OF THE ATMOSPHERIC SCIENCES DIVISION,
;    ALBERTA RESEARCH. THIS WORK FUNDED BY THE
;    ALBERTA WEATHER MODIFICATION BOARD.
;
;    THERE IS EXPLICITLY NO COPYRIGHT ON THIS SOFTWARE,
;    AND ITS DISTRIBUTION IS ENCOURAGED. NO RESPONSIBILITY
;    NOR GUARANTEE IS MADE OR ASSUMED BY THE AUTHOR, OR
;    BY ALBERTA RESEARCH.
;
;    SUGGESTIONS OR CHANGES ARE INVITED, AND WILL BE
;    DISTRIBUTED TO OTHER USERS OF THIS SOFTWARE THROUGH
;    THE DECUS IAS/RSX SPECIAL INTEREST GROUP.
;
;
; VERSION:	781020
; WRITTEN BY:	W. KORENDYK
; DATE WRITTEN:	29-OCT-78
; 
;	
;
; MODIFICATIONS:
;
; CODE		NAME		DATE
;

;+
;
; *** - MAIL -- ROUTINE TO TAKE THE MAIL FILE AND SEND TO
;	THE DESIRED PERSON.
;
; INPUTS:	ASSUMES 'INPFDB' IS PROPERLY SET UP FOR OPENING
;			OF THE INPUT (MAIL) FILE
;		R1 = POINTER TO THE SINGLE BYTE STRING LENGTH, FOLLOWED
;			BY THE STRING, OF THE NAME OR UIC OF THE PERSON
;			TO WHOM THE MAIL IS TO BE SENT.
;		R2 = POINTER TO AN EIGHT CHARACTER STRING WHICH IS TO
;			BE INCLUDED IN THE FIRST LINE (HEADER) OF THE
;			MAIL.
;
;
;-
	.DSABL	GBL
	.MCALL	ENTER,LEAVE
	.MCALL	TTYOUT,PSTR,GTIM$S,GTSK$S
	.MCALL	FCSMC$,FDOF$L,FCSBT$,DIR$,IOERR$,FILIO$
	.MCALL	MAIGBL,MAIDSF,MAIHED
	FCSMC$			;GET ALL FCS MACROS
	FDOF$L			;LOCALLY DEFINE OFFSETS
	FCSBT$			;	AND SYMBOLS
	FILIO$			;
	IOERR$			;
	MAIGBL			;DEFINE ALL MAIL GLOBALS.
	MAIHED			;AND HEADER RECORD OFFSETS
WTIME	=10.			; THE NUMBER OF ONE SECOND RETRIES
				; BEFORE GIVING UP ON OPENING MAIL BOX
;
; A BRIEF DESCRIPTION OF HOW THIS HERE SUBROUTINE WORKS:
;
;   1.	PARSE THE NAME, OR UIC, AS SPECIFIED AND ATTEMPT TO LOCATE
;	THAT NAME IN THE SYSTEM ACCOUNT FILE. IF NOT FOUND, THEN
;	ISSUE THE WARNING MESSAGE AND IGNORE THE REMAINDER OF THE
;	ROUTINE. THIS PROCESS SHOULD ALSO FILL IN THE UIC AND FILE
;	OF THE OUTPUT FILE (AT OUTFDB).
;
;   2.	ON THE OUTFDB FOR APPENDING THE NEW MAIL. IF IT DOESN'T
;	EXIST, THEN CREATE ONE.
;
;   3.	BUILD THE FIRST RECORD TO BE OUTPUT TO THE MAIL FILE.
;	THIS RECORD CONTAINS ALL THAT NIFTY INFO SUCH AS DATE,
;	TIME, WHO SENT THE MAIL, ALONG WITH THAT LITTLE STRING
;	WE GOT AS INPUT.
;
;   4.	SIMPLY COPY OVER ALL OF THE INPUT FILE TO THE OUTPUT FILE,
;	AND CLOSE THEM BOTH UP.
;
	.NLIST
	.IF DF	NOTIFY
	.LIST
SDTASK:	.RAD50	/MAI.../	;THE TASK WHICH NOTIFIES USERS OF MAIL
SDPACK:	.BLKW	13.		;AND THE DATA BLOCK TO USE
	.NLIST
	.ENDC
	.LIST

MAIL:	ENTER	R0,R1,R2,R3,R4		;SAVE A PARCEL OF REGISTERS
10$:	CALL	ACCNT			; PARSE THE ACCOUNT NAME
	BCC	11$			; PARSED OKAY
	CALL	SYNTAX			; ISSUE SYNTAX ERROR MESSAGE
	JMP	52$			; IGNORE REMAINDER OF ROUTINE
11$:	CALL	OPNACT			; OPEN THE ACCOUNT FILE
	BCC	12$			;
	JMP	52$			; IF CS, ACCOUNT FILE OPEN FAILURE
12$:	CALL	SEARCH			; LOCATE THE ACCOUNT ENTRY
	BCC	13$			; WE FOUND IT
	CALL	CLSACT			; CLOSE THE ACCOUNT FILE
	CALL	NOACCT			; ISSUE ACCOUNT NOT FOUND MESSAGE
	JMP	52$			; IGNORE REST OF ROUTINE
13$:	CALL	CLSACT			; CLOSE THE ACCOUNT FILE
	MAIDSF	UIC			; SET UP THE MAIL DSDS
	MOVB	MEM,FOWN		; SET UP FOR THE
	MOVB	GRP,FOWN+1		; OWNER OF THE MAIL FILE
	.NLIST
	.IF DF	NOTIFY
	.LIST
	MOVB	MEM,SDPACK		;THE TASK TO SEND TO SHOULD
	MOVB	GRP,SDPACK+1		;SHOULD BE TOLD OF THE UIC
	CLR	SDPACK+2		;ZERO NOTIFICATION COUNT
	.NLIST
	.ENDC
	.LIST
	CALL	OUTHED			; BUILD AN OUTPUT HEADER RECORD
	CLR	ERRCNT			; INITIAL ERROR COUNT OF 0
20$:	OPEN$A	#OUTFDB			; OPEN THE OUTPUT FILE
	BCC	25$			; THE OPEN WAS SUCCESSFUL
	CMPB	#IE.NSF,F.ERR(R0)	; WAS THERE A FILE?
	BNE	21$			; IF NE, THEN SOME OTHER ERROR
	CALL	CREATE			; CREATE A NEW MAIL FILE
	BR	25$			; AND CONTINUE
21$:	CMPB	#IE.WAC,F.ERR(R0)	; IS IT BEING WRITTEN TO?
	BEQ	22$			; IF EQ, THEN THAT IS IT
	CMPB	#IE.LCK,F.ERR(R0)	; HAS SOMEONE LOCKED IT?
	BEQ	22$			; IF EQ, WE MAY WAIT
	CALL	IOERR			; SOME OTHER ERROR
22$:	TST	ERRCNT			; ANY ERRORS YET?
	BNE	23$			; IF NE, THEN YES
	CALL	WACERR			; ISSUE THE FIRST WARNING
23$:	INC	ERRCNT			; INC ERROR COUNT
	CMP	#WTIME,ERRCNT		; TO MANY ERRORS?
	BGT	24$			; IF GT, THEN NOT YET
	CALL	ENDERR			; TELL HIM WE GIVE UP
	BR	52$			; AND DO IT
24$:	CALL	MRKTIM			; MARK TIME
	BR	20$			; AND TRY AGAIN
25$:	CALL	FN2FDB			; RESTORE FNB OF INPFDB
	FDRC$R	#INPFDB,,#LINBUF+1,#MAXLIN; PREPARE INPUT FDB
	OPEN$R	,,,,,,IOERR		; OPEN THE INPUT FILE
40$:	PUT$	#OUTFDB,#HEDBUF,R2,IOERR; OUTPUT HEADER RECORD
	MOVB	#11,LINBUF		; PRECEDE RECORD WITH A TAB
41$:	GET$	#INPFDB			; READ IN A LINE
	BCC	42$			; WENT OKAY
	CMPB	#IE.EOF,F.ERR(R0)	; WAS IT AN EOF?
	BEQ	44$			; YES IT WAS.
	CALL	IOERR			; IT WAS SOMETHING ELSE
42$:	INC	INPFDB+F.NRBD		; INCLUDE THE TAB IN THE COUNT
	PUT$	#OUTFDB,#LINBUF,INPFDB+F.NRBD,IOERR
	BR	41$			; READ ANOTHER RECORD
44$:					;
50$:	CALL	FDB2FN			; SAVE FNB OF INPFDB
	CLOSE$	#INPFDB			; CLOSE THE INPUT FILE
51$:	CLOSE$	#OUTFDB			; AND THE OUTPUT FILE
	CLR	R1			; MAKE SO THAT ANY MORE FILES
	CALL	.WFOWN			; ARE OWNED BY HE WHO CREATES
	.NLIST
	.IF DF	NOTIFY
	.LIST
	.MCALL	SDAT$S,RQST$S
	SDAT$S	#SDTASK,#SDPACK
	BCS	234$
	RQST$S	#SDTASK
234$:
	.NLIST
	.ENDC
	.LIST
52$:	LEAVE				;LEAVE, AND
	RETURN				;RETURN
ERRCNT:	.WORD	0			;

	.SBTTL	>ACCNT - PARSE STRING INTO NAME OR UIC
;
; ACCNT - TAKE THE INPUT STRING AND PARSE INTO A VALID ACCOUNT
;	NAME, OR INTO A SIX CHARACTER ASCII AND 2 WORD BINARY UIC.
;
; INPUTS:	R1 = POINTER TO THE INPUT STRING, THE FIRST BYTE OF
;			WHICH IS THE LENGTH OF THE REMAINING STRING.
;
; OUTPUTS:	IF NAMFLG = 0, THEN UIC, GRP, AND MEM ARE SET;
;				ELSE NAME IS SET.
;		CARRY SET IFF INVALID STRING (IE. SYNTAX ERROR)
;
;
ACCNT:	ENTER	R0,R1,R2,R3	;SAVE SOME WORK REGISTERS
	CLR	NAMFLG		; SET TO NO NAME SPECIFIED
	MOVB	(R1)+,R3	; GET LENGTH OF THE STRING
	MOV	#NAME,R0	; WHERE TO PUT THE NAME
	MOV	#14.,R2		; THE MAXIMUM NAME LENGTH
	CMP	R3,R2		; IS THE ONE WE'RE GIVEN LONGER?
	BGT	40$		; IF GT, THEN YES
20$:	MOVB	#40,(R0)+	; BLANK OUT THE NAME THAT IS THERE NOW
	SOB	R2,20$		;
	MOV	#NAME,R0	; POINT TO THE BUFFER
	MOV	R3,R2		; AND GET LENGTH OF THE STRING
21$:	MOVB	(R1)+,(R0)+	; MOVE IN THE NAME STRING GIVEN
	SOB	R2,21$		;
	MOV	#NAME,R0	; AND POINT TO THE START OF IT
	CMPB	#'[,(R0)	; PRECEEDED WITH "["?
	BNE	1$		; IF NE, THEN NO
	INC	R0		; WE DON'T CARE
1$:	CALL	$COTB		; CONVERT A NUMBER
	MOV	R1,GRP		; REMEMBER IT
	BEQ	10$		; IF EQ, TREAT THIS AS A NAME
				;
2$:	CMP	R1,#377		; A VALID GROUP NUMBER?
	BHI	10$		; IF HI, THEN NO
	CMPB	R2,#',		; A VALID DELIMITER?
	BEQ	3$		; IF EQ, THEN YES
	CMPB	R2,#'/		; LAST CHANCE HERE
	BNE	10$		; IS NO GOOD, TREAT AS NAME
3$:	MOV	R0,R1		; COPY THE POINTER
	SUB	#NAME,R1	; TO GET THE LENGTH OF THE
	SUB	R1,R3		; REMAINING STRING
	BLE	40$		; IF LE, THEN TOO MANY LESS
	CALL	$COTB		; CONVERT A NUMBER
	MOV	R1,MEM		; THIS BECOMES THE MEMBER
	BEQ	40$		; IT IS NO GOOD
	CMP	R1,#377		; IS IT A VALID MEMBER NUMBER?
	BHI	40$		; IF HI, THEN NO IT ISN'T
	MOV	R0,R1		; COPY THE POINTER
	SUB	#NAME,R1	; TO GET THE LENGTH OF THE
	SUB	R1,R3		; REMAINING STRING
	BLE	4$		; IF LE, THEN NO
	CMPB	#'],R2		; IT BETTER BE "]"
	BNE	40$		; IF NE, THEN IT AIN'T THAT
4$:	MOV	PC,R2		; SET FOR NO ZERO SUPPRESSION
	MOV	#UIC,R0		; WHERE TO PUT IT
	MOV	MEM,R1		; MEMBER FIRST
	CALL	$CBOMG		; CONVERT IT
	MOV	#UIC-3,R0	; THEN ON TOP OF THAT
	MOV	GRP,R1		; DO THE GROUP NUMBER
	CALL	$CBOMG		; ALL IN OCTAL
	BR	30$		; AND THAT IS ALL
				;
10$:	MOV	#NAME,R0	; POINT TO THE NAME
	INC	NAMFLG		; INDICATE THAT A NAME WAS GIVEN
25$:	MOVB	(R0)+,R2	; GET A CHARACTER
	CMPB	#40,R2		; IF A SPACE IS ENCOUNTERED,
	BEQ	30$		; THEN THE REST IS LEFT BLANKED OUT
	CALL	TSTCHR		; IS IT A VALID NAME CHARACTER?
	BCS	40$		; IF CS, THEN NO
	SOB	R3,25$		; FOR THE LENGTH OF THE IN STRING
30$:	CLC			; INDICATE A SUCCESSFUL OPERATION
	BR	50$		; AND LEAVE
40$:	SEC			; INDICATE FAILURE
50$:	LEAVE			;LEAVE, AND
	RETURN			;RETURN
;
;
GRP:	.WORD	0		; CURRENT GROUP NUMBER
MEM:	.WORD	0		; CURRENT MEMBER NUMBER
;
UIC:	.ASCII	/000000/	; CURRENT UIC (EXPANDED)
;
NAME:	.BLKB	14.		; THE CURRENT ACCOUNT NAME
;
NAMFLG:	.WORD	0		; NAME FLAG: 0=>UIC, 1=>NAME
;
ENTRY:	.WORD	0		; POINTER TO ACCOUNT ENTRY

	.SBTTL	>TSTCHR  - TEST CHARACTER FOR VALID SYMBOL
;
; TSTCHR  -  TEST CHARACTER FOR VALID SYMBOL IN NAME.
;		   VALID CAHARCTERS ARE A-Z, 0-9, $, ', !, AND .
;
; INPUT:
;	R2 - CHARACTER TO BE CHECKED
; OUTPUT:
;	R2 - UNCHANGED
;	CARRY CLEAR - GOOD
;	CARRY SET - ERROR
;-
TSTCHR:	CMPB	R2,#'A		; ALPHABETIC?
	BLO	10$		; NO
	CMPB	R2,#'Z		; MAYBE
	BLOS	40$		; YES
10$:	CMPB	R2,#'0		; NUMERIC?
	BLO	20$		; NO
	CMPB	R2,#'9		; MAYBE
	BLOS	40$		; YES
20$:	CMPB	R2,#'$		; NO, DOLLAR?
	BEQ	40$		; YES
	CMPB	R2,#''		; NO, APOSTROPHE?
	BEQ	40$		; YES
	CMPB	R2,#'!		; NO, EXCLAMATION
	BEQ	40$		; YES
	CMPB	R2,#'.		; NO, PERIOD?
	BEQ	40$		; YES
30$:	SEC			; NO, SET ERROR
	BR	50$		;
40$:	CLC			; SET SUCCESS
50$:	RETURN			;

	.SBTTL	>OPNACT - OPEN THE ACCOUNT FILE
;
; OPNACT - ROUTINE TO OPEN THE ACCOUNT FILE.
;
; OUTPUTS:	R0 = FDB ADDRESS OF ACCOUNT FILE
;		CARRY CLEAR IFF ACCOUNT FILE OPEN
;
OPNACT:	CLR	OPNERR		; SET NO OPEN ERROR
47$:	CALL	OPEN		; OPEN ACCOUNT FILE
	BCC	48$		; OPEN SUCCESSFUL
	CMP	OPNERR,#5	; FIVE FAILURES?
	BLT	472$		; NO
471$:	TTYOUT	#ERMSG,#LERMSG	; YES
	BR	ERR
472$:	CALL	MRKTIM		; NO, WAIT ONE SECONDS
	INC	OPNERR		; INCREMENT TIME TRIED
	BR	47$		; TRY AGAIN
48$:	RETURN
;
; AND CLOSE THE ACCOUNT FILE
;
CLSACT:	TST	FILOPN		; IS ACCOUNT FILE OPEN?
	BEQ	10$		; NO
	CLOSE$	#$ACTFL		; YES, CLOSE IT
	CLR	FILOPN		;
10$:	RETURN			; AND EXIT
;
;
ERR:	CALL	CLSACT		;CLOSE ACCOUNT FILE
	SEC
	RETURN
;
; OPEN  - OPEN FILE
;
OPEN:	OPNS$R	#$ACTFL,,,#FD.RWM	; OPEN FILE
	BCS	10$		; ERROR
	INC	FILOPN		; SET FILE IS OPEN
10$:	RETURN			;
;
OPNERR:	.WORD	0
FILOPN:	.WORD	0
;
	.NLIST	BEX
ERMSG:	.ASCII	<12>/MAIL - ACCOUNT FILE OPEN FAILURE/<15>
LERMSG	=.-ERMSG
;
	.EVEN
	.LIST	BEX

	.SBTTL	>SEARCH  - SEARCH FILE FOR ACCOUNT NUMBER
;
; SEARCH  -  SEARCH FILE FOR ACCOUNT NUMBER
;
; OUTPUT:
;	R0 - ADDRESS OF ACCOUNT ENTRY
;	CARRY CLEAR - ACCOUNT FOUND
;	CARRY SET - ACCOUNT NOT FOUND
;
SEARCH:	ENTER	R1,R2,R3,R4,R5
	MOV	#$ACTFL,R0	; GET ACCOUNT FILE FDB
	MOV	#1,VBN+2	; SET TO START AT VBN 1
	CLR	VBN		;
5$:	CALL	ACTRED		; READ NEXT BLOCK
	BCS	25$		; AN ERROR
	MOV	IOSTAT+2,R2	; GET COUNT OF WORDS READ
	BEQ	25$		; ZERO, NO WORDS READ
	MOV	#$ACTBF,R0	; GET BUFFER ADDRESS
10$:	TST	NAMFLG		; IS NAME SPECIFIED?
	BEQ	15$		; NO
	MOV	R0,ENTRY	; YES, SAVE ENTRY ADDRESS
	MOV	R1,-(SP)	; SAVE BYTES LEFT
	MOV	R2,-(SP)	;
	ADD	#A.LNM,R0	; GET ADDRESS OF LAST NAME
	MOV	#NAME,R1	; GET ADDRESS OF NAME ENTERED
	MOV	#14.,R2		; SET LENGTH OF NAME
12$:	CMPB	(R0)+,(R1)+	; NAMES THE SAME?
	BEQ	14$		; YES
	SEC			; NO
	BR	18$		;
14$:	DEC	R2		; SO FAR
	BGT	12$		; CONTINUE TILL END
	MOV	ENTRY,R0	; RESTORE ENTRY ADDRESS
	CALL	NAMNUM		; GET NUMBERS FROM NAME
	CLC			; INDICATE ALL IS COOL
	BR	18$		; NAME IS THE SAME
15$:	CMP	UIC,A.GRP(R0)	; GROUP CODES MATCH
	BNE	20$		; NO
	CMP	UIC+2,A.GRP+2(R0) ; MAYBE
	BNE	20$		; NO
	CMP	UIC+4,A.MBR+1(R0) ; YES, MEMBER CODES MATCH?
	BNE	20$		; NO
	MOV	R0,ENTRY	; SAVE ENTRY POINTER
	MOV	R1,-(SP)	; SAVE R1 AND R2
	MOV	R2,-(SP)	;
	CALL	NAMNUM		; GET NAME FROM NUMBERS
	CLC			; AND ALL IS COOL
18$:	MOV	(SP)+,R2	; RESTORE R1 AND R2
	MOV	(SP)+,R1	;
	MOV	ENTRY,R0	; RESTORE ENTRY POINTER
	BCC	40$		; PASSWORD CHECKS OUT
20$:	ADD	#A.LEN,R0	; POINT TO NEXT ENTRY
	SUB	#A.LEN,R2	; COMPUTE WORDS LEFT IN BUFFER
	BHI	10$		; LOOP, MORE LEFT
25$:	MOV	#$ACTFL,R0	; GET ACCOUNT FILE FDB
	CMPB	#IE.EOF,F.ERR(R0); END OF FILE?
	BEQ	30$		; YES
	TSTB	F.ERR(R0)	; ANY ERRORS?
	BMI	30$		; YES
	ADD	#$BFLEN/512.,VBN+2; NO, POINT TO NEXT VBN
	ADC	VBN		;
	BR	5$		; READ IN NEXT BUFFER
30$:	SEC			; ERROR, ACCOUNT NOT FOUND
40$:	LEAVE			;RESTORE THE REGISTERS
	RETURN			;
	.SBTTL	>ACTRED - READ A BLOCK FROM ACCOUNT FILE
;
; ACTRED - READ A BLOCK FROM THE ACCOUNT FILE
;
; INPUT:
;	R0 = ACCOUNT FILE FDB ADDRESS
;
; OUTPUT:
;	CARRY SET IFF AN ERROR OCCURRED
;
ACTRED:	READ$	R0,#$ACTBF,#$BFLEN,#VBN,,#IOSTAT
	BCS	1$
	WAIT$
1$:	RETURN			;
;
VBN:	.WORD	0		; BLOCK NUMBER
	.WORD	1
;
IOSTAT:	.BLKW	2		; THE I/O STATUS

	.SBTTL	>NAMNUM - CHANGE ACCOUNT NAME TO NUMBER
;
; NAMNUM - CHANGE ACCOUNT NAME TO NUMBER
;
; INPUTS: R0=ADDRESS OF ACCOUNT ENTRY
;
; OUTPUTS: REGISTERS NOT AFFECTED
;	   LOCATIONS UIC, GRP, MEM ARE SET
;
NAMNUM:	ENTER	R1,R2		;SAVE REGS FOR WORK
	MOV	R0,-(SP)	;AND PLAY
	MOV	#6,R2		;LOOP COUNT
	MOV	#UIC,R1		;AND WHERE TO
1$:	MOVB	(R0)+,(R1)+	; DO IT
	SOB	R2,1$
;
; NOW FILL IN GRP AND MEM, GRP FIRST
;
	MOV	(SP),R0		;GET BACK POINTER
	MOV	#3,R1		;DO 3 DIGITS AT ATIME
	CALL	NUMB		;DO IT
	MOV	R2,GRP
	CALL	NUMB
	MOV	R2,MEM
	MOV	(SP)+,R0	;RESTORE REGISTERS
	LEAVE
	RETURN
	.SBTTL	>NUMB - CONVERSION FROM OCTAL TO BINARY
;
; NUMB - CONVERSION FROM OCTAL TO BINARY
;
; INPUTS:  R0 = ADDRESS OF STRING TO CONVERT
;	   R1 = NUMBER OF DIGITS
;
; OUTPUTS: R0 = UPDATED
; 	   R1 = UNCHANGED
;	   R2 = CONVERTED NUMBER
;
; NOTE: THE NUMBER IS ASSUMED TO BE OCTAL, NO
;	CHECKING IS DONE IN THIS ROUTINE.
;
NUMB:	ENTER	R1,R3		;WORK REGISTERS
	CLR	R2		;PREPARE R2
1$:	ASH	#3,R2		;SHIFT FOR NEXT DIGIT
	MOVB	(R0)+,R3	;GET IT
	SUB	#60,R3		;MAKE INTO A NUMBER
	BISB	R3,R2		;INCLUDE IT
	SOB	R1,1$		;GET THE NEXT
	LEAVE			;DONE
	RETURN
	.SBTTL	>NUMNAM - GET ACCOUNT NAME FROM NUMBER
;
; NUMNAM - GET ACCOUNT NAME FROM THE ACCOUNT RECORD
;
; INPUTS:	R0 = ADDRESS OF THE ACCOUNT RECORD
;
; OUTPUTS:	NAME CONTAINS THE ACCOUNT NAME.
;
; THIS ROUTINE CORRUPTS R0, R1, AND R2.
;
NUMNAM:	ADD	#A.LNM,R0	;POINT TO THE LAST NAME
	MOV	#NAME,R1	;WHERE TO PUT IT
	MOV	#14.,R2		;AND ITS LENGTH
1$:	MOVB	(R0)+,(R1)+	;MOVE IT OVER
	SOB	R2,1$		;
	RETURN			;AND LEAVE

	.SBTTL	>CREATE - OPEN A NEW MAIL FILE
;
; CREATE -- ROUTINE TO CREATE THE POINTED TO FILE WITH FILE
;	PROTECTION AND OWNERSHIP TO THE LAST "SEARCHED" FOR USER.
;
; INPUT:	R0 = ADDRESS OF THE FILE FDB
;
; OUTPUT:	R0 = FDB ADDRESS OF THE NEW, OPEN FILE
;
CREATE:	ENTER	R1		;SAVE A WORK REGISTER
	CALL	.RDFFP		; GET DEFAULT FILE PROTECTION
	MOV	R1,-(SP)	; AND SAVE IT
	MOV	#114400,R1	; WORLD/GROUP WITH WE ACCESS
	CALL	.WDFFP		; FOR THE FILE
				;
	MOV	FOWN,R1		; GET THE SAVED UIC, AND
	CALL	.WFOWN		; MAKE HIM FILE OWNER
				;
	OPEN$W	,,,,,,IOERR	; OPEN THE NEW FILE
				;
	MOV	(SP)+,R1	; GET BACK OLD PROTECTION
	CALL	.WDFFP		; AND RESTORE IT
	LEAVE			;LEAVE AND,
	RETURN			;RETURN
;
;
FOWN:	.WORD	0		; FILE OWNER (SAVED BACK YONDER)

	.SBTTL	>OUTHED - BUILD AND OUTPUT HEADER RECORD
;
	.NLIST	BEX
NUMS:	.ASCII	/0123456789/
;
DAYS:	.ASCII	/SUNMONTUEWEDTHUFRISAT/
LDAY	=.-DAYS/7.
;
MONS:	.ASCII	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
LMON	=.-MONS/12.
	.EVEN
	.LIST	BEX
;
; OUTHED -- ROUTINE TO BUILD AND OUTPUT (TO OUTFDB) THE
;	FIRST RECORD OF THE OUTGOING MAIL WHICH INCLUDES
;	THE DATE, TIME, AND NAME OF PERSON SENDING THE MAIL.
;
; INPUT:	R2 = ADDRESS OF EIGHT CHARACTER STRING TO BE
;			INCLUDED IN THE RECORD.
;
;
; OUTPUT:	R2 = LENGTH OF THE COMPLETED HEADER
;		HEADER RECORD KEPT AT "LINBUF"
;
OUTHED:	ENTER	R0,R1,R3,R4,R5		;SAVE EVERYTHING WE DAMAGE
	MOV	#HEDBUF,R4		; BUFFER FOR THE OUTPUT STRING
	MOV	#BUF,R5			; BUFFER FOR TASK AND TIME INFO
	GTIM$S	R5			; GET THE TIME FIRST
	CALL	DAY			; GET THE DAY OF THE WEEK
	DEC	R0			; FROM 0-6 (0=SUNDAY)
	MUL	#LDAY,R0		; EACH DAY'S LENGTH
	ADD	#DAYS,R1		; POINT TO TODAY'S NAME
	.REPT	LDAY
	MOVB	(R1)+,(R4)+		; MOVE OVER THE DAY
	.ENDR
	MOVB	#40,(R4)+		; SPACE THINGS A BIT
	MOV	G.TIMO(R5),R0		; GET THE MONTH
	DEC	R0			; IN RANGE 0-11
	MUL	#LMON,R0		; BY STRING LENGTH OF EACH MON.
	ADD	#MONS,R1		; POINT TO THE CURRENT MONTH
	.REPT	LMON
	MOVB	(R1)+,(R4)+		; MOVE OVER THE MONTH
	.ENDR
	MOVB	#40,(R4)+		; SPACE THINGS A BIT
	MOV	G.TIDA(R5),R1		; GET DAY OF THE MONTH
	CALL	TWONUM			; PUT IN TWO DIGIT NUMBER
	MOVB	#'/,(R4)+		; THE DELIMITER
	MOV	G.TIYR(R5),R1		; GET THE YEAR
	CALL	TWONUM			; PUT IN TWO DIGIT NUMBER
	MOVB	#40,(R4)+		; SPACE THINGS A BIT
	MOV	G.TIHR(R5),R1		; GET THE HOURS
	CALL	TWONUM			; PUT IN TWO DIGIT NUMBER
	MOVB	#':,(R4)+		; THE DELIMITER
	MOV	G.TIMI(R5),R1		; GET THE MINUTES
	CALL	TWONUM			; PUT IN TWO DIGIT NUMBER
	MOVB	#40,(R4)+		; SPACE THINGS A BIT
	MOV	#10,R1			; LENGTH OF THE INPUTED STRING
1$:	MOVB	(R2)+,(R4)+		; MOVE THE PARAMETER STRING IN
	SOB	R1,1$			;
	MOVB	#40,(R4)+		; SPACE THINGS A BIT
	GTSK$S	R5			; NOW GET THE TASK INFO
	MOV	G.TSPC(R5),R3		; GET THE TASK DEFAULT UIC
	MOVB	R3,MEM			; REMEMBER IT
	SWAB	R3			; LOOK AT MEM NUM
	MOVB	R3,GRP			; AND REMEMBER IT
	SWAB	R3			; BRING BACK UIC
	MOV	R4,R2			; NEW PLACE FOR THE POINTER
	MOV	#1,R4			; NO SUPPRESSION
	CALL	.PPASC			; WHEN CONVERTING UIC
	MOVB	#40,(R2)+		; SPACE THE OUTPUT STRING
	MOV	R2,-(SP)		; AND REMEMBER THE POINTER
	MOV	#UIC,R2			; FAKE A UIC
	MOV	#3,R4			; SUPPRESSING THE DELIMITERS
	CALL	.PPASC			;
	CLR	NAMFLG			; FAKE A "NO-NAME" SPECIFIED
	CALL	OPNACT			; OPEN THE ACCOUNT FILE
	BCS	9$			; NO GO
	CALL	SEARCH			; WHEN SEARCHING THE ACCOUNT FILE
	BCC	10$			; THE ACCOUNT WAS FOUND
9$:	MOV	#MYST,R0		; USE MYSTERY NAME
	BR	11$			; CONTINUE
10$:	ADD	#A.LNM,R0		; POINT TO THE LAST NAME
11$:	MOV	R0,R1			; REMEMBER THE NAME
	CALL	CLSACT			; CLOSE THE ACCOUNT FILE
	MOV	(SP)+,R4		; GET BACK POINTER
	MOV	#14.,R3			; LENGTH OF THE NAME
12$:	MOVB	(R1)+,(R4)+		; TRANSFER OVER THE NAME
	SOB	R3,12$			;
	SUB	#HEDBUF,R4		; GET LENGTH OF THIS RECORD
	MOV	R4,R2			;
	LEAVE
	RETURN
;
HEDBUF:	.BLKB	MA.SIZ			;A BUFFER FOR THE HEADER
	.EVEN
	.NLIST	BEX
MYST:	.ASCII	/MYSTERY MAILER/
	.EVEN
	.LIST BEX
	.SBTTL	>TWONUM - CONVERT TO TWO DIGIT DECIMAL
;
; TWONUM -- CONVERT NUMBER TO TWO DIGIT DECIMAL NUMBER
;
; INPUT:	R1 = NUMBER TO CONVERT
;		R4 = WHERE TO PUT NEXT CHARACTER
;
; OUTPUT:	R1 = CORRUPTED
;		R4 = WHERE TO PUT NEXT CHARACTER
;
TWONUM:	MOV	R0,-(SP)	;SAVE
	CLR	R0		;PREPARE FOR DIVISION
	DIV	#10.,R0		;DIVIDE
	MOVB	NUMS(R0),(R4)+	;HI
	MOVB	NUMS(R1),(R4)+	;LO
	MOV	(SP)+,R0	;
	RETURN
;
LBUF	=16.
BUF:	.BLKW	LBUF	;GTSK BUFFER

;
; ERROR OUTPUT ROUTINES
;
; INPUT:	R1 = STRING IN ERROR (FIRST BYTE IS LENGTH
;			OF THE REMAINING STRING).
;
	.NLIST	BEX
SYNTAX:	JSR	R5,GO
	.WORD	1$
	INC	ACFOUN			;(SAVE THE LETTER)
	RETURN
1$:	.ASCIZ	<12>/MAIL - ACCOUNT NAME SYNTAX ERROR IN "%VA"/<15>
	.EVEN
;
NOACCT:	JSR	R5,GO
	.WORD	1$
	INC	ACFOUN			;(SAVE THE LETTER)
	RETURN
1$:	.ASCIZ	<12>/MAIL - ACCOUNT ENTRY FOR "%VA" NOT FOUND/<15>
	.EVEN
;
WACERR:	JSR	R5,GO
	.WORD	1$
	RETURN
1$:	.ASCIZ	<12>/MAIL - STANDING IN LINE TO MAIL TO "%VA"/<15>
	.EVEN
;
ENDERR:	JSR	R5,GO
	.WORD	1$
	INC	ACFOUN			;(SAVE THE LETTER)
	RETURN
1$:	.ASCIZ	<12>/MAIL - UNABLE TO MAIL TO "%VA"/<15>
	.EVEN
;
	.LIST	BEX
GO:	ENTER	R1,R2
	MOV	#BLOCK,R2
	MOVB	(R1)+,(R2)+
	CLRB	(R2)+
	MOV	R1,(R2)+
	MOV	#BLOCK,R2
	MOV	(R5)+,R1
	CALL	MESOUT
	LEAVE
	RTS	R5
;
BLOCK:	.BLKW	2
	.END