.PSECT	NAMSTR
	.TITLE	NAMSTR - PROCESS A STRING OF NAMES
	.IDENT	/781125/
;
;    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:	MARK JOHNSON
; DATE WRITTEN:	23-OCT-78
; 
; RELATED DOCUMENTATION:
;	NONE
;	
;
; ROUTINES USED:
;	MAIL
;	CSPARS
;	$CVTUC
;	
;
; MODIFICATIONS:
;
; CODE		NAME		DATE
;

;+
; *** - NAMSTR - PROCESS A STRING OF NAMES OR NAMELIST FILES
;
; INPUTS:
;	R1 - POINTS TO NAMESTRING (FIRST BYTE IS BYTECOUNT)
;
; OUTPUTS:
;	NONE
;
; SIDE EFFECTS:
;	USES "MAIL" TO SEND A COPY OF THE INPUT FILE TO
;	EACH NAME IN THE NAMELIST, OR IN ANY NAMELIST FILES.
;
;-
	.MCALL	ENTER,LEAVE
	.MCALL	OPEN$R,GET$,CLOSE$,NMBLK$,FDOF$L,FCSBT$
	FDOF$L
	FCSBT$
	.MCALL	MAIGBL
	MAIGBL
	.DSABL	GBL
	.NLIST	BEX
;
;SPECIAL CHARACTERS
SWCH='/		;USED TO INDICATE A SWITCH IS COMING
INDCH='@	;A MAILING LIST
BL=40		;A BLANK!
CR=15		;GOOD OL' CARRIAGE RETURN
ESC=33		;AND ESCAPE
HT=11		;HORIZONTAL TAB
;
NAME:	.BLKB	MAXLIN+1	;FIRST BYTE IS LENGTH
LABEL:	.ASCII	/ARC MAIL/
NOTE:	.ASCII	/>NOTICE</
	.EVEN
STRLEN:	.WORD	0		;LENGTH REMAINING IN NAMSTR
STRPTR:	.WORD	0		;POINTS TO NEXT NAMESTRING CHARACTER
;
INDDEF:	NMBLK$	MAILING,MLS,,SY,0	;DEFAULTS FOR MAILING LIST FILES
;
; TABLE OF TWO-LETTER SWITCHES
SWTAB:	.BLKW	30.		;NOTE THAT THEY ARE WORD-ALIGNED!

NAMSTR:	ENTER	R0,R1,R2,R3,R4,R5
	MOVB	(R1)+,R2
	MOV	R2,STRLEN	;GET LENGTH OF STRING
	MOV	R1,STRPTR	;SET UP INPUT POINTER
	MOV	R1,R0		;PARAMETERS FOR CONVERSION
	CALL	$CVTUC		;CONVERT TO UPPERCASE
;
; GET NEXT ELEMENT
;
GTNXEL:	MOV	#NAME+1,R3	;POINT TO PLACE TO BUILD NAME
	CLR	R4		;COUNT OF LENGTH OF NAME
	CALL	MOVNAM		;MOVE THE NAME FROM THE INPUT STRING
	TST	R4		;WAS THERE ANOTHER NAME IN THE STRING?
	BEQ	DONE		;0 LENGTH IMPLIES NO NAME
	CMPB	#INDCH,NAME+1	;IS IT AN INDIRECT NAME FILE?
	BNE	1$		;NOPE
	CALL	FILE		;YEP, LET THE SUBR. DO IT.
	BR	GTNXEL
;
; SIMPLE NAME
;
1$:	MOVB	R4,NAME		;INSERT LENGTH
	CALL	SEND		;SEND THE MESSAGE
	BR	GTNXEL		;AND PROCEED WITH REST OF STRING
;
DONE:	LEAVE
	RETURN

;
; NAMELIST FILE
;
FILE:	ENTER	R0,R1,R2,R3
	MOV	#NAME+2,R0	;POINT TO FILENAME
	MOV	#INDFDB,R2	;AND THE APPROPRIATE FDB
	CALL	CSPARS		;BUILD THE DSDS
	BCC	100$
	INC	ACFOUN		;SHOW A PROBLEM WITH THIS NAME.
	BR	FINFIL
;
100$:	CALL	SWBLD		;BUILD THE SWITCH TABLE HERE
;
	MOV	#INDDEF,F.DFNB(R2)		;ESTABLISH DEFAULT NAME AND...
	OPEN$R	R2,,,,#NAME+1,#MAXLIN,IOERR	;...OPEN FILE
;
; GET ONE NAME FROM FILE
;
GNAM:	GET$	R0		;READ A RECORD
	BCC	1$
	CLOSE$	R0,IOERR	;DONE, OR ERROR, PROCEED WITH REST OF STRING
	BR	FINFIL
;
1$:	MOV	F.NRBD(R0),R2	;GET LENGTH
	BEQ	GNAM		;IGNORE NULL LINES!
	MOV	R0,-(SP)	;SAVE THE FDB POINTER
	MOV	#NAME+1,R0	;GET ADDRESS
	MOV	R0,R1
	CALL	$CVTUC		;FORCE UPPER CASE ONLY
	MOV	(SP)+,R0	;RESTORE FDB POINTER
;
	MOV	#NAME+1,R2	;POINT AT THE LINE WE READ
	MOV	F.NRBD(R0),R1	;GET ITS LENGTH
	MOVB	#CR,NAME+1(R1)	;INSERT A TERMINATOR
2$:	CMPB	@R2,#BL	;LOOK FOR A BLANK
	BEQ	31$		;BRANCH WHEN WE FIND ONE
	CMPB	(R2)+,#HT	;ALSO USE TABS FOR SEPARATORS
	BEQ	3$
	SOB	R1,2$		;OTHERWISE LOOK THROUGH THE WHOLE LINE
	MOVB	F.NRBD(R0),NAME	;IF NO BLANK, LENGTH IS ENTIRE LINE
	TST	SWTAB		;WERE THERE SWITCHES?
	BNE	GNAM		;YES, THIS GUY LOSES
	BR	4$		;NO, SO SEND IT!
3$:	MOVB	#BL,-(R2)		;POINT AT THE BLANK
31$:	MOV	R2,R3		;END OF NAME
	SUB	#NAME+1,R3	;LENGTH OF NAME
	BEQ	GNAM		;NOTHING BUT BLANKS ARE IGNORED!
	MOVB	R3,NAME		;ESTABLISH LENGTH
	CALL	SWTST		;CHECK HIS QUALIFICATIONS
	BCS	GNAM		;HE LOSES!
4$:	CALL	SEND		;SEND THE MESSAGE TO THIS GUY
	BR	GNAM		;AND REST OF FILE.
;
FINFIL:	LEAVE
	RETURN

;
; SWBLD -SEE IF THERE ARE ANY QUALIFICATIONS ON THE FILENAME
;
; INPUTS:
;	R0 - POINTS TO CHARACTER FOLLOWING FILENAME
;
; SIDE EFFECTS:
;	SWTAB IS ESTABLISHED WITH A ZERO TERMINATING ENTRY
;
SWBLD:	ENTER	R0,R1
	MOV	#SWTAB,R1	;ADDRESS OF TABLE FOR CODES
	CMPB	(R0)+,#SWCH	;ARE THERE ANY SWITCHES?
	BNE	3$		;APPARENTLY NOT!
;
1$:	CMPB	@R0,#CR		;END OF THE LINE?
	BEQ	3$		;YES, END OF TABLE TOO
	MOVB	(R0)+,(R1)+	;FIRST BYTE OF SWITCH
	CMPB	@R0,#CR		;NOW AT THE END OF THE LINE?
	BEQ	2$		;YES, TIDY UP ODD TABLE!
	MOVB	(R0)+,(R1)+	;NO, SECOND SWITCH VALUE
	CMPB	(R0)+,#CR	;COULD END HERE?
	BEQ	3$		;YES IT DOES!
	BR	1$		;NO, IT DOESN'T
2$:	DEC	R1		;BACK TO WORD BOUNDARY
3$:	CLR	@R1		;SHOW TABLE END
;
	LEAVE
	RETURN

;
; SWTST - CHECK THE SWITCHES ON A NAME IN THE FILE
;
; INPUT:
;	R2 - POINTS TO FIRST CHARACTER FOLLOWING NAME
;
SWTST:	ENTER	R0,R1,R2
	TST	SWTAB		;ARE THERE ANY SWITCHES?
	BEQ	EXCC		;NO, EVERYBODY'S OK
	MOV	R2,R0		;POINT R0 INTO LINE
	DEC	R0		;BACK UP TO A CHARACTER
2$:	CALL	$GNBLK		;SCAN FOR A NON-BLANK
	BCS	EX		;WE FAILED!
	TST	R1		;DID WE SEE SOME BLANKS?
	BEQ	2$		;WE NEED A SEPARATOR FIRST
;
	CMPB	#'*,R2		;DOES THIS GUY GET EVERYTHING?
	BEQ	EXCC		;YES
	BIC	#177400,R2	;CLEAN UP THE OTHER BYTE
	SWAB	R2
	BISB	@R0,R2		;GET THE NEXT CHARACTER
	SWAB	R2		;PUT IN PROPER ORDER
;
	MOV	#SWTAB,R1	;POINT AT THE TABLE
1$:	CMP	R2,(R1)+	;DOES IT MATCH THIS ENTRY?
	BEQ	EXCC		;THIS IS SUCCESS
	TST	@R1		;MORE CODES?
	BNE	1$		;YES, HE'S STILL GOT A CHANCE
	BR	2$		;NO, SEE IF MORE CODES TO COME
;
EXCC:	CLC			;SUCCESS
	BR	EX
EXCS:	SEC			;FAILURE
EX:	LEAVE
	RETURN

;
; SEND THE MAIL USING THE FIELDS BUILT IN NAMSTR
;
SEND:	ENTER	R1,R2
	MOV	#NAME,R1	;POINT TO THE NAME
	TST	RSVP		;WHAT TYPE OF MAIL
	BEQ	1$		;0=> NOTICE, 
	MOV	#LABEL,R2	;1=> ORDINARY MAIL
	BR	2$
1$:	MOV	#NOTE,R2
2$:	CALL	MAIL
	LEAVE
	RETURN

;+
; *** - MOVNAM - MOVE A NAME (IGNORING LEADING DELIMITERS)
;	(NAMSTR SERVICE ROUTINE)
;
; INPUTS:
;	R3 - POINTER TO OUTPUT
;	R4 - SET TO CURRENT LENGTH OF OUTPUT (USUALLY 0)
;
; OUTPUTS:
;	R3 - POINTER TO OUTPUT
;	R4 - LENGTH OF OUTPUT
;
; SIDE EFFECTS:
;	STRLEN IS DECREMENTED APPROPRIATELY
;	STRPTR IS ADVANCED
;-
DELTAB:	.ASCIZ	<CR><ESC>/ /	;LIST OF LEGIT DELIMS (0 TERMINATOR)
	.EVEN
;
MOVNAM:	ENTER	R5
1$:	DEC	STRLEN		;ONE LESS CHARACTER IN INPUT
	BLT	2$		;NONE LEFT, BRANCH
	MOV	#DELTAB,R5	;GET ADDRESS OF DELIMITER TABLE
3$:	CMPB	@STRPTR,(R5)+	;CURRENT INPUT CHARACTER A DELIMITER?
	BEQ	4$		;EQ =>YES
	TSTB	@R5		;ARE THERE MORE DELIMITERS?
	BNE	3$		;YES, CHECK THEM TOO
	INC	R4		;COUNT THIS CHARACTER
	MOVB	@STRPTR,(R3)+	;MOVE THIS CHARACTER
	INC	STRPTR		;PASS THIS CHARACTER
	BR	1$		;AND CHECK THE NEXT ONE
;
; THE CURRENT INPUT CHARACTER IS A DELIMITER
;
4$:	INC	STRPTR		;MOVE PAST IT
	TST	R4		;STILL IN A STRING OF DELIMITERS?
	BEQ	1$		;YES, KEEP IGNORING THEM
2$:	MOVB	#CR,@R3		;BE SURE THERE'S AN OUTPUT
	LEAVE
	RETURN
	.END