.Title	Parse_tables	- TPARSE state tables for parsing

;
; This module contains TPARSE parse tables for parsing entities that
; UUCP mail needs.
;

	$TPADEF	GLOBAL		; Define TPA symbols

;
; These are the known field types.  These MUST correspond exactly to the
; Pascal declaration in UUCP_MAIL.PAS for the type KNOWN_FIELD_NAMES.
;
	fld_received = 0
	fld_date = 1
	fld_from = 2
	fld_to = 3
	fld_subject = 4
	fld_continuation = 5
	fld_unknown = 6
	fld_old_UUCP_from = 7
	error_line = 8			; Not really used in here...

;
; These global locations are where our caller picks up information
; after a successful parse.
;
parsed_field_name::	.long		; Magic field type number goes here
parsed_field_name_text::.quad		; Field name as it was in the header
parsed_field_body::	.quad		; Field body goes here
parsed_field_sp1::	.quad		; Field-specific textual information
parsed_field_sp2::	.quad		;   "       "       "         "
parser_status::		.long		; Place to return an extra status

;------------------------------------------------------------------------------
; TPARSE state table to parse RFC 822 style ARPA internet message headers.
; All legal header fields should parse successfully.  There are some that
; we recognize as being certain kinds of fields, and some that require
; returning field-specific information.  In all cases, we return a field
; type, the textual field name, and the textual field body.
;
; NB:  This parse should be run with BLANKS enabled (so our table sees them)
;      and abbreviations disabled.
;

right_bracket = ^A/>/
left_bracket = ^A/</

	$Init_state	header_field_state, header_field_key

	$State	start
	$Tran	TPA$_LAMBDA,, init_return_cells

	$State
	$Tran	!old_UUCP_from_exp, TPA$_EXIT,, -
			 fld_old_UUCP_from, parsed_field_name
	$Tran	!ARPA_field, TPA$_EXIT

	$State	ARPA_field
	$Tran	TPA$_BLANK, get_field_body,, fld_continuation,parsed_field_name
	$Tran	!field_name,,,, parsed_field_name_text

	$State
	$Tran	':'

	$State	get_field_body
	$Tran	TPA$_BLANK		; Trim leading blanks
	$Tran	TPA$_LAMBDA

	$State
	$Tran	!field_body, TPA$_EXIT,,, parsed_field_body

;
; Here we parse the field name.  This is everything up to, but not including
; a ":".  There can be no blanks in the field name either.  Certain field
; names are recognized.
;
	$State	field_name
	$Tran	'Received', TPA$_EXIT,, fld_received, parsed_field_name
	$Tran	'Date',	TPA$_EXIT,, fld_date, parsed_field_name
	$Tran	'From', TPA$_EXIT,, fld_from, parsed_field_name
	$Tran	'To', TPA$_EXIT,, fld_to, parsed_field_name
	$Tran	'Subject', TPA$_EXIT,, fld_subject, parsed_field_name
	$Tran	!unknown_field_name, TPA$_EXIT,, fld_unknown, parsed_field_name

	$State	unknown_field_name
	$Tran	':', TPA$_FAIL			; empty field is illegal
	$Tran	!read_field_name, TPA$_EXIT

	$State	read_field_name
	$Tran	!field_char, read_field_name
	$Tran	TPA$_LAMBDA, TPA$_EXIT

	$State	field_char
	$Tran	TPA$_BLANK, TPA$_FAIL
	$Tran	':', TPA$_FAIL
	$Tran	TPA$_ANY, TPA$_EXIT

;
; Here we parse a field body.  A body is just text up to the end of the string.
;
	$State	field_body
	$Tran	TPA$_EOS, TPA$_EXIT
	$Tran	TPA$_ANY, field_body

;------------------------------------------------------------------------------
; This parses the old-style UUCP "from blah ... remote from blech"
; routing information.
;

	$State	old_UUCP_from_exp
	$Tran	right_bracket, old_UUCP_from_exp	; Skip ">"'s
	$Tran	TPA$_LAMBDA

	$State
	$Tran	!get_old_UUCP_from_exp, TPA$_EXIT,,, parsed_field_body

	$State	get_old_UUCP_from_exp
	$Tran	'From'
	$Tran	'from'

	$State
	$Tran	TPA$_BLANK

	$State
	$Tran	!name,,,, parsed_field_sp1

	$State	skip_to_remote
	$Tran	'remote'
	$Tran	TPA$_ANY, skip_to_remote

	$State
	$Tran	TPA$_BLANK

	$State
	$Tran	'from'

	$State
	$Tran	TPA$_BLANK

	$State
	$Tran	!name, TPA$_EXIT,,, parsed_field_sp2

	$State	name
	$Tran	'"', quoted_string
	$Tran	TPA$_LAMBDA
;
; This is a little tricky...  We have to scan until see a blank, but we don't
; want to accept the damn thing 'cause then it ends up in the string.  So,
; we put in an extra little state that returns fail if it scans a blank.
; This causes the FA to fall through to the TPA$_LAMBDA transition, which
; exits this "subroutine" and accepts the string.  This rather disgusting
; hack comes from an example in the RTL manual...
;
	$State	read_until_blank_or_EOS
	$Tran	TPA$_EOS, TPA$_EXIT
	$Tran	!not_blank, read_until_blank_or_EOS
	$Tran	TPA$_LAMBDA, TPA$_EXIT

	$State	not_blank
	$Tran	TPA$_BLANK, TPA$_FAIL
	$Tran	TPA$_ANY, TPA$_EXIT

	$State	quoted_string
	$Tran	'"', TPA$_EXIT
	$Tran	TPA$_ANY, quoted_string

	$End_state

;------------------------------------------------------------------------------
; TPARSE state table to parse RFC 822 style ARPA internet "From" field bodies.
;
; NB:  This parse should be run with BLANKS enabled (so our table sees them)
;      and abbreviations disabled.
;

	$Init_state	from_field_state, from_field_key

	$State
	$Tran	TPA$_LAMBDA,, init_return_cells

	$State
	$Tran	!routed_address, TPA$_EXIT
	$Tran	!address, TPA$_EXIT,,, parsed_field_body

	$State	address
	$Tran	TPA$_EOS, TPA$_EXIT
	$Tran	TPA$_ANY, address

	$State	routed_address
	
	$Tran	TPA$_EOS, TPA$_FAIL
	$Tran	!escape_char, routed_address
	$Tran	!quote, routed_address
	$Tran	left_bracket
	$Tran	TPA$_ANY, routed_address

	$State
	$Tran	!address_string, TPA$_EXIT,,, parsed_field_body

;
; This uses the subexpression-fail mechanism to parse up to, but not
; including, a right-angle-bracket.  Other note is that we have to stick
; a failure status into the extra status return, since a simple FAIL
; will just cause the string to be rejected and the parser will fall through
; to another state.
;
	$State	address_string
	$Tran	TPA$_EOS, TPA$_EXIT,, 2, parser_status
	$Tran	!not_r_brack, address_string
	$Tran	TPA$_LAMBDA, TPA$_EXIT

	$State	not_r_brack
	$Tran	right_bracket, TPA$_FAIL
	$Tran	!escape_char, TPA$_EXIT
	$Tran	!quote, TPA$_EXIT
	$Tran	TPA$_ANY, TPA$_EXIT

	$State	escape_char		; Escape means eat any next char.
	$Tran	'\'

	$State
	$Tran	TPA$_ANY, TPA$_EXIT

	$State	quote			; Eat anything until another quote
	$Tran	'"'

	$State	quote_loop
	$Tran	'"', TPA$_EXIT
	$Tran	!escape_char, quote_loop
	$Tran	TPA$_ANY, quote_loop

	$End_state
;
; Only routine we need.  This clears out the variables in which we'll
; be returning info about the parse.
;

init_return_cells:
	.word	0
	clrl	parsed_field_name
	clrl	parser_status
	clrl	parsed_field_name_text
	moval	parsed_field_name_text, parsed_field_name_text + 4
	clrl	parsed_field_body
	moval	parsed_field_body, parsed_field_body + 4
	clrl	parsed_field_sp1
	moval	parsed_field_sp1, parsed_field_sp1 + 4
	clrl	parsed_field_sp2
	moval	parsed_field_sp2, parsed_field_sp2 + 4
	ret

	.End