.TITLE	TPEXAM - EXAMPLE ON USING TPARS
	.SBTTL	DATA TABLES
;
;	THIS IS A NODDY EXAMPLE PROGRAM TO DEMONSTRATE HOW TO
;	USE TPARS.  WE WILL PARSE A STRING OF THE FORM:-
;
;	NAME  PRM1,PRM2,PRM3,PRM4,PRM5
;
;	WHERE:
;
;	EACH PRM1-PRM5 IS EITHER A POSITIONAL PARAMETER, OR A
;	KEYWORD PARAMETER OF THE FORM KEYWD,
;
;	AND, NAME IS THE STATEMENT NAME.
;
;	FOR THIS DEMO THE VALID STATEMENTS, KEYWORDS & ARGUMENTS ARE:-
;
;	NAME		KEYWORD		ARGUMENT TYPE
;	====		=======		=============
;
;	FRED		HOUSE=		6-BYTE ASCII	
;			SALARY=		5-DIGIT DECIMAL
;			TYPE=		'IDIOT' OR 'GENIUS'
;
;	GEORGE		PHONE=		NNNN-MMMMMM
;			CLASS=		[A,B]
;			STATUS=		'MARRIED' OR 'SINGLE'	*
;			IDCODE=		7-DIGIT OCTAL		*
;			ACCOUNT=	2-DIGIT OCTAL OR DECIMAL
;
;	CLARENCE	WIFE=		'DORA' OR 'MARY'	*
;			STATE=		HAPPY/RICH/SOBER...	*
;			AGE=		2-DIGIT DECIMAL		*
;			SALARY=		5-DIGIT DECIMAL		*
;
;	FIELDS MARKED WITH * ARE OPTIONAL.
;
	.MCALL	ISTAT$,STATE$,TRAN$
;
;
	ISTAT$	EXSTTB,EXKYTB
;
;	SPECIFY START OF STATE TABLE & IDENTIFY STATEMENT NAME
;
	.GLOBL	START
;
	STATE$	START
;
;	HERE WE FIND OUT WHICH STATEMENT IS BEING USED AND
;	SET FLAGS TO SAY WHICH OPTIONS ARE MANDATORY.
;
	TRAN$	"FRED",FRE1,FREHDR,TY.HOU!TY.SAL!TY.TYP,FLAGS
	TRAN$	"GEORGE",GEO1,GEOHDR,TY.PHO!TY.CLA!TY.ACC,FLAGS
	TRAN$	"CLARENCE",CLA1,CLAHDR
	TRAN$	"HELP",$EXIT,HELHDR
	TRAN$	$LAMDA,$EXIT,ILLSTA
;
;
	STATE$	FRE1
;
;	NOW WE START PARSING FRED - ALL OPTIONS MANDATORY
;	WE CHECK FOR KEYWORD DESIGNATION, VIA THE SUBROUTINE SET
;	CALLED FRESUB.  IF THAT FAILS, WE ASSUME IT IS A POSITIONAL
;	PARAMETER.
;	FINALLY WE TRAP ALL ERRORS FOR USER ACTION (SEE ROUTINE ERROR)
;
;
	TRAN$	!FRESUB,FRE2
	TRAN$	!HOUS1,FRE2
	TRAN$	$ANY,FRE2,ERROR
;
	STATE$	FRE2
;
;	WE WANT A SEPERATOR NOW, AND AS THIS WILL HAPPEN FREQUENTLY,
;	WE MIGHT AS WELL USE ANOTHER SUBROUTINE
;
;
	TRAN$	!SEP
;
	STATE$
;
;	AS BEFORE WE LOOK FOR KEYWORDS & IF NOT ASSUME POSITIONAL
;
	TRAN$	!FRESUB,FRE3
	TRAN$	!SALA1,FRE3
	TRAN$	$ANY,FRE3,ERROR
;
	STATE$	FRE3
;
	TRAN$	!SEP
;
	STATE$	
;
	TRAN$	!FRESUB,FRE4
	TRAN$	!TYPE1,FRE4
	TRAN$	$ANY,FRE4,ERROR
;
	STATE$	FRE4
;
;	FLAG ANY EXCESS CHARACTERS
;
	TRAN$	$ANY,FRE4,ERROR
;
;	GENERAL SUBEXPRESSION FOR VALID SUBROUTINES FOR FRED
;
	STATE$	FRESUB
;
;	FRED ALLOWS HOUSE, SALARY, & TYPE
;
	TRAN$	!HOUSE,$EXIT
	TRAN$	!SALAR,$EXIT
	TRAN$	!TYPE,$EXIT
;
;	SUBEXPRESSION TO STORE HOUSE
;
	STATE$	HOUSE
;
;	WE MUST HAVE A KEYWORD OF 'HOUSE'
;
	TRAN$	"HOUSE"
;
;	THEN WE NEED AN = (SEPERATE BECAUSE ILLEGAL IN KEYWORD)
;
	STATE$
;
	TRAN$	'=
;
	STATE$	HOUS1
;
;	NOW WE ALLOW ANY ALPHANUMERIC STRING FOR THE HOUSENAME
;
	TRAN$	$STRNG,$EXIT,HOUSTR,TY.HOU,PRESNT
;
;	SUBEXPRESSION TO STORE SALARY
;
	STATE$	SALAR
;
	TRAN$	"SALARY"
;
;
;	THEN WE NEED AN = (SEPERATE BECAUSE ILLEGAL IN KEYWORD)
;
	STATE$
;
	TRAN$	'=
	STATE$	SALA1
;
;	THE SALARY MUST BE DECIMAL, SO WE MATCH FOR IT
;
	TRAN$	$DNUMB,$EXIT,SALSTR,TY.SAL,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.SAL,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.SAL,ERRWRD
;
;	SUBEXPRESSION TO STORE TYPE
;
	STATE$	TYPE
;
	TRAN$	"TYPE"
;
;
;	THEN WE NEED AN = (SEPERATE BECAUSE ILLEGAL IN KEYWORD)
;
	STATE$
;
	TRAN$	'=
	STATE$	TYPE1
;
	TRAN$	"IDIOT",$EXIT,TYPSTR,TY.IDI!TY.TYP,PRESNT
	TRAN$	"GENIUS",$EXIT,TYPSTR,TY.TYP,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.TYP,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.TYP,ERRWRD
;
;	SUBEXPRESSION FOR SEPERRATOR
;
	STATE$	SEP
;
;	KEEP LOOKING TILL WE FIND A COMMA, REJECTING ALL ELSE
;
	TRAN$	<',>,$EXIT
	TRAN$	$ANY,SEP,ERROR
	STATE$	GEO1
;
	TRAN$	!GEOSUB,GEO2
	TRAN$	!PHON1,GEO2
	TRAN$	$ANY,GEO2,ERROR
;
	STATE$	GEO2
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!GEOSUB,GEO3
	TRAN$	!CLAS1,GEO3
	TRAN$	$ANY,GEO3,ERROR
;
	STATE$	GEO3
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!GEOSUB,GEO4
	TRAN$	!STAT1,GEO4
	TRAN$	$ANY,GEO4,ERROR
;
	STATE$	GEO4
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!GEOSUB,GEO5
	TRAN$	!IDCD1,GEO5
	TRAN$	$ANY,GEO5,ERROR
;
	STATE$	GEO5
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!GEOSUB,GEO6
	TRAN$	!ACCO1,GEO6
	TRAN$	$ANY,GEO6,ERROR
;
	STATE$	GEO6
;
	TRAN$	$ANY,GEO6,ERROR
;
	STATE$	CLA1
;
	TRAN$	!CLASUB,CLA2
	TRAN$	!WIFE1,CLA2
	TRAN$	$ANY,CLA2,ERROR
;
	STATE$	CLA2
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!CLASUB,CLA3
	TRAN$	!STTE1,CLA3
	TRAN$	$ANY,CLA3,ERROR
;
	STATE$	CLA3
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!CLASUB,CLA4
	TRAN$	!AGE1,CLA4
	TRAN$	$ANY,CLA4,ERROR
;
	STATE$	CLA4
;
	TRAN$	!SEP
;
	STATE$
;
	TRAN$	!CLASUB,FRE4
	TRAN$	!SALA1,FRE4
	TRAN$	$ANY,FRE4,ERROR
;
	STATE$	GEOSUB
;
	TRAN$	!PHONE,$EXIT
	TRAN$	!CLASS,$EXIT
	TRAN$	!STATU,$EXIT
	TRAN$	!IDCOD,$EXIT
	TRAN$	!ACCOU,$EXIT
;
	STATE$	CLASUB
;
	TRAN$	!WIFE,$EXIT
	TRAN$	!STTE,$EXIT
	TRAN$	!AGE,$EXIT
	TRAN$	!SALAR,$EXIT
;
	STATE$	PHONE
;
	TRAN$	"PHONE"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	PHON1
;
	TRAN$	$DNUMB,PHON2,PHOST1
	TRAN$	$STRNG,PHON2,ERROR,TY.PHO,ERRWRD
	TRAN$	$LAMDA,PHON2,,TY.PHO,ERRWRD
;
	STATE$	PHON2
;
	TRAN$	'-,PHON3
	TRAN$	$ANY,PHON3,ERROR,TY.PHO,ERRWRD
;
	STATE$	PHON3
;
	TRAN$	$DNUMB,$EXIT,PHOST2,TY.PHO,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.PHO,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.PHO,ERRWRD
;
;
	STATE$	CLASS
;
	TRAN$	"CLASS"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	CLAS1
;
	TRAN$	'[,CLAS2,CLAST1
	TRAN$	$LAMDA,CLAS2,,TY.CLA,ERRWRD
;
	STATE$	CLAS2
;
	TRAN$	$STRNG,CLAS3,CLAST2
	TRAN$	$STRNG,CLAS3,ERROR,TY.CLA,ERRWRD
	TRAN$	$LAMDA,CLAS3,,TY.CLA,ERRWRD
;
	STATE$	CLAS3
;
	TRAN$	<',>,CLAS4
	TRAN$	'],$EXIT,,TY.CLA,ERRWRD
	TRAN$	$ANY,CLAS3,ERROR,TY.CLA,ERRWRD
;
	STATE$	CLAS4
;
	TRAN$	$STRNG,CLAS5,CLAST3
	TRAN$	$STRNG,CLAS5,ERROR,TY.CLA,ERRWRD
	TRAN$	$LAMDA,CLAS5,,TY.CLA,ERRWRD
;
	STATE$	CLAS5
;
	TRAN$	'],$EXIT,CLAST4,TY.CLA,PRESNT
	TRAN$	$ANY,CLAS5,ERROR,TY.CLA,ERRWRD
;
;
;
	STATE$	STATU
;
	TRAN$	"STATUS"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	STAT1
;
	TRAN$	"MARRIED",$EXIT,STASTR,TY.STA!TY.MAR,PRESNT
	TRAN$	"SINGLE",$EXIT,STASTR,TY.STA,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.STA,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.STA,ERRWRD
;
;
;
	STATE$	IDCOD
;
	TRAN$	"IDCODE"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	IDCD1
;
	TRAN$	$NUMBR,$EXIT,IDCSTR,TY.IDC,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.IDC,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.IDC,ERRWRD
;
;
;
	STATE$	ACCOU
;
	TRAN$	"ACCOUNT"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	ACCO1
;
	TRAN$	$NUMBR,$EXIT,ACCSTR,TY.ACC,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.ACC,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.ACC,ERRWRD
;
;
;
	STATE$	WIFE
;
	TRAN$	"WIFE"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	WIFE1
;
	TRAN$	"DORA",$EXIT,WIFSTR,TY.DOR!TY.WIF,PRESNT
	TRAN$	"MARY",$EXIT,WIFSTR,TY.WIF,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.WIF,ERRWRD
	TRAN$	$LAMDA,$EXIT,,TY.WIF,ERRWRD
;
;
;
	STATE$	STTE
;
	TRAN$	"STATE"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	STTE1
;
	TRAN$	$STRNG,,STTSTR
;
	STATE$
;
	TRAN$	'/,STTE1
	TRAN$	$LAMDA,$EXIT,,TY.STT,PRESNT
;
;
;
	STATE$	AGE
;
	TRAN$	"AGE"
;
	STATE$
;
	TRAN$	'=
;
	STATE$	AGE1
;
	TRAN$	$DNUMB,$EXIT,AGESTR,TY.AGE,PRESNT
	TRAN$	$STRNG,$EXIT,ERROR,TY.AGE,PRESNT
	TRAN$	$LAMDA,$EXIT,,TY.AGE,ERRWRD
;
	.PAGE
	.SBTTL	ACTION ROUTINES
;
;	STORE THE ADDRESS AND LENGTH OF THE DESCRIPTIVE LINES FOR THE
;	STATEMENT TYPE.
;
FREHDR:
	MOV	#FREHED,HEDADD
	MOV	#FRELEN,HEDLEN
	RETURN
;
GEOHDR:
	MOV	#GEOHED,HEDADD
	MOV	#GEOLEN,HEDLEN
	RETURN
;
CLAHDR:
	MOV	#CLRHED,HEDADD
	MOV	#CLRLEN,HEDLEN
	RETURN
;
ILLSTA:
	MOV	#ILLHED,HEDADD
	MOV	#ILLLEN,HEDLEN
	RETURN
;
HELHDR:
	MOV	#HELMSG,HEDADD
	MOV	#HELMSL,HEDLEN
	RETURN
;
;	SET UP PARAMETERS DEFINING THE HOUSENAME.
;	WE FIRST CHECK THAT WE HAVE NOT ALREADY GOT THE HOUSENAME -
;	TREATING IT AS AN ERROR IF WE HAVE.
;	
HOUSTR:
	MOV	#HOUADD,R0	;ADDRESS FOR STORAGE
	MOV	#6,R1		;MAX PERMITTED LENGTH
	MOV	#TY.HOU,R2	;SET FLAG
	JMP	GENSTR		;PROCESS
;
SALSTR:
	MOV	#SALADD,R0	;ADDRESS
	MOV	#5,R1		;MAXIMUM LENGTH
	MOV	#TY.SAL,R2	;FLAG
	JMP	GENSTR
;
TYPSTR:
	CLR	R0		;NOTHING TO STORE
	CLR	R1		;NO SIZE LIMIT
	MOV	#TY.TYP,R2	;FLAG
	JMP	GENSTR
;
PHOST1:
	MOV	#PHOADD,R0	;ADDRESS
	MOV	#-4,R1		;EXACT LENGTH
	MOV	#TY.PHO,R2	;FLAG
	JMP	GENSTR
;
PHOST2:
	MOV	#PHOADD,R0	;ADDRESS
	MOV	#-6,R1		;MAXIMUM LENGTH
	MOV	#TY.PHO,R2	;FLAG
	JMP	GENSTR
;
CLAST1:
	MOV	#CLAADD,R0	;ADDRESS
	CLR	R1		;NO LENGTH CHECK
	MOV	#TY.CLA,R2	;FLAG
	JMP	GENSTR		;STORE ADDRESS
;
CLAST2:
	MOV	#CLAADD,R0	;ADDRESS
	MOV	#1,R1		;MAXIMUM LENGTH
	MOV	#TY.CLA,R2	;FLAG
	JMP	GENSTR
;
CLAST3:
	MOV	#CLAADD,R0	;ADDRESS
	MOV	#1,R1		;MAXIMUM LENGTH
	MOV	#TY.CLA,R2	;FLAG
	JMP	GENSTR
;
CLAST4:
	MOV	#CLAADD,R0	;ADDRESS
	CLR	R1		;NO LENGTH
	MOV	#TY.CLA,R2	;FLAG
	JMP	GENSTR		;
;
STASTR:
	CLR	R0		;NO ADDRESS
	CLR	R1		;NO SIZE
	MOV	#TY.STA,R2	;FLAG
	JMP	GENSTR
;
IDCSTR:
	MOV	.PSTPT,R0	;GET ADDRESS OF FIRST CHAR
	ADD	.PSTCN,R0	;SET TO JUST AFTER LAST CHAR
	CMPB	-(R0),#'.	;WAS INPUT DECIMAL?
	BNE	10$		;NO - INPUT VALID
	ADD	#2,(SP)		;SET FOR ERROR
	RETURN			;REJECT NUMBER
;
10$:
	MOV	#IDCADD,R0	;ADDRESS
	MOV	#7,R1		;MAXIMUM LENGTH
	MOV	#TY.IDC,R2	;FLAG
	JMP	GENSTR
;
ACCSTR:
	MOV	.PSTPT,R0	;GET ADDRESS OF FIRST CHAR
	ADD	.PSTCN,R0	;SET TO JUST AFTER LAST CHAR
	CMPB	-(R0),#'.	;WAS INPUT DECIMAL?
	BNE	10$		;NO - INPUT OK
	DEC	.PSTCN		;YES - IGNORE .
;
10$:
	MOV	#ACCADD,R0	;ADDRESS
	MOV	#9.,R1		;MAXIMUM LENGTH
	MOV	#TY.ACC,R2	;FLAG
	JMP	GENSTR
;
WIFSTR:
	CLR	R0		;NO ADDRESS
	CLR	R1		;NO SIZE
	MOV	#TY.WIF,R2	;FLAG
	JMP	GENSTR
;
STTSTR:
	MOV	#STTADD,R0	;ADDRESS
	CLR	R1		;NO LENGTH RESTRICTION
	MOV	#TY.STT,R2	;FLAG
	JMP	GENSTR
;
AGESTR:
	MOV	#AGEADD,R0	;ADDRESS
	MOV	#-2,R1		;MAXIMUM LENGTH
	MOV	#TY.AGE,R2	;FLAG
	JMP	GENSTR
;
;
;
GENSTR:
	BIT	R2,PRESNT	;ALREADY GOT IT?
	BEQ	10$		;IF NOT KEEP CHECKING
	BIS	R2,DUPLIC	;IF SO, SET DUPLICATE FLAG
	BR	40$		;AND EXIT
;
10$:
	TST	R1		;SIZE RESTRAINT?
	BEQ	20$		;IF EQ NO - OMIT CHECK
	BGT	15$		;IF GT THEN MAXIMAL CHECK
	NEG	R1		;ELSE SET R1 POSITIVE
	CMP	.PSTCN,R1	;AND DO EXACT MATCH CHECK
	BNE	30$		;REJECT IF WRONG
	BR	20$		;ELSE OK
;
15$:
	CMP	.PSTCN,R1	;ONLY A CERTAIN NUMBER OF CHARS ALLOWED
	BGT	30$		;IF GT ERROR - REJECT TRANSITION
;
20$:
	TST	R0		;ANYTHING TO STORE?
	BEQ	40$		;IF EQ NO - OMIT STORE
	TST	2(R0)		;ALREADY HAD SOME?
	BNE	23$		;IF NE YES - AMEND LENGTH
	MOV	.PSTPT,(R0)	;NO - GET ADDRESS OF NAME
	BR	26$		;AVOID LENGTH AMENDMENT
;
23$:
	MOV	.PSTPT,2(R0)	;GET NEW ADDRESS TO CALCULATE..
	SUB	(R0),2(R0)	;..TOTAL LENGTH SO FAR
;
26$:
	ADD	.PSTCN,2(R0)	;AND LENGTH
	BR	40$		;
;
30$:
	BIS	R2,ERRWRD	;FLAG ERROR IN PARAMETER
	ADD	#2,(SP)
;
40$:
	RETURN
;
;	FLAG AN ERROR BY UNDERLINING THE ILLEGAL CHARS
;
ERROR:
	MOV	.PSTPT,R0	;GET ILLEGAL CHARACTER ADDRESS
	MOV	.PSTCN,R1	;AND NUMBER OF CHARACTERS
	ADD	#ERRSTR-INBUF,R0	;RESET TO EQUIVALENT IN ERROR LINE
;
10$:
	MOVB	#'*,(R0)+	;FLAG ERROR
	SOB	R1,10$		;
	RETURN
;
	.PAGE
	.SBTTL	EXECUTABLE CODE
	.MCALL	QIOW$S,EXIT$S
;
BEGIN:
	MOV	#HELMSG,R1	;OUTPUT HELP MESSAGE
	MOV	#HELMSL,R2	;
	CLR	R3
	CALL	OUTPUT
;
BEG2:
	MOV	#CLEEND-CLESTA,R0	;SET COUNT OF AREA FOR CLEARING
	MOV	#CLESTA,R1	;SET START OF AREA TO BE CLEARED
;
5$:
	CLRB	(R1)+		;CLEAR A BYTE
	SOB	R0,5$		;AND SO ON
	MOV	#ERRSTR,R0	;GET ADDRESS OF ERROR STRING
	MOV	#300.,R1		;AND LENGTH
;
6$:
	MOVB	#40,(R0)+
	SOB	R1,6$
	MOV	#INBUF,R4	;INITIALISE BUFFER INPUT
;
7$:
	MOV	#PROMPT,R1	;OUTPUT PROMPT
	MOV	#PROMPL,R2
	CLR	R3
	CALL	OUTPUT
	QIOW$S	#IO.RLB,#5,#1,,#IOSB,,<R4,#80.>
				;GET REPLY
	MOV	IOSB+2,R2	;GET NUMBER OF INPUT CHARS
	BNE	10$		;IF NE SOME - CARRY ON
	EXIT$S			;ELSE EXIT
;
10$:
	ADD	R2,R4		;GET ADDRESS OF BYTE AFTER LAST
	CMPB	-(R4),#'+	;WAS LAST BYTE A PLUS?
	BEQ	7$		;IF EQ GET NEXT LINE
	SUB	#INBUF-1,R4	;ELSE GET LENGTH
	MOV	R4,IOSB+2	;PUT IN STORE
	MOV	R4,R2		;AND REGISTER
	MOV	#INBUF,R0	;GET INPUT BUFFER
	MOV	#INBUF,R1	;AND NEXT ONE
	CALL	$CVTUC		;CONVERT TO UPPER CASE
	MOV	#2000,R1	;ONLY FOUR CHARACTERS NEED MATCH
	MOV	#EXKYTB,R2	;POINTER TO KEYWORD TABLE
	MOV	IOSB+2,R3	;NUMBER OF CHARACTERS TO PARSE
	MOV	#INBUF,R4	;ADDRESS OF INPUT
	MOV	#START,R5	;FIRST STATE IN TABLE
	CALL	.TPARS		;PARSE THE STRING
;
;	NOW WE FORMAT AND OUTPUT THE RESULTS.
;
;	FIRST WE OUTPUT THE ERROR STRING
;
ERRPRT:
	MOV	#INPUT,R1	;OUTPUT INPUT FIRST
	MOV	IOSB+2,R2	;GET LENGTH
	ADD	#2,R2		;ALLOW FOR CONTROL CHARS
	CLR	R3		;
	CALL	OUTPUT
	MOV	#ERROUT,R1	;OUTPUT STRING
	CLR	R3
	CALL	OUTPUT
;
;	THEN WE OUTPUT THE DESCRIPTIVE HEADER.
;
HEAD:
	MOV	HEDADD,R1	;OUTPUT HEADER TEXT
	MOV	HEDLEN,R2
	CLR	R3
	CALL	OUTPUT
	MOV	#FLGNUM,R4	;GET MAXIMUM NUMBER OF FLAGS
;
;	NOW WE LOOP THROUGH FOR EACH FLAG TO SEE WHAT MESSAGES ARE NEEDED.
;	THE FLAG IS SET IN PRESNT IF THE VALUE WAS SPECIFIED
;	 "    "   "  "  "  ERRWRD "   "    "    "  IN ERROR
;	 "    "   "  "  "  DUPLIC "   "    "    "  DUPLICATED
;	 "    "   "  "  "  FLAGS  "   "    "    "  MANDATORY
;
	BIS	ERRWRD,PRESNT
LOOP:
	MOV	R4,R0		;SET FLAG NUMBER TO WORD OFFSET
	ASL	R0		;
	MOV	FLGTAB-2(R0),R5	;GET FLAG
	BIT	R5,PRESNT	;WAS THIS ONE SPECIFIED?
	BEQ	40$		;IF EQ NO - SEE IF IT SHOULD HAVE BEEN
	BIT	R5,ERRWRD	;WAS THE SPECIFICATION IN ERROR
	BNE	10$		;IF NE YES - OUTPUT ERROR MESSAGE
	CMP	#TY.TYP,R5	;IS THIS THE TYPE FLAG (SPECIAL CASE)
	BNE	5$		;IF NE NO - CARRY ON
	BIT	#TY.IDI,PRESNT	;HAVE WE ALREADY DONE IDIOT?
	BNE	20$		;IF NE YES - DON'T DO AGAIN
;
5$:
	CMP	#TY.WIF,R5	;IS THIS THE WIFE FLAG (SPECIAL CASE)
	BNE	6$		;IF NE NO - CARRY ON
	BIT	#TY.DOR,PRESNT	;HAVE WE ALREADY DONE DORA?
	BNE	20$		;IF NE YES - DON'T DO AGAIN
;
6$:
	CMP	#TY.STA,R5	;IS THIS THE STATUS FLAG (SPECIAL CASE)
	BNE	7$		;IF NE NO - CARRY ON
	BIT	#TY.MAR,PRESNT	;HAVE WE ALREADY DONE MARRIED?
	BNE	20$		;IF NE YES - DON'T DO AGAIN
;
7$:
	MOV	OKTTAB-2(R0),R1	;OUTPUT SUCCESS MESSAGE
	MOV	OKLTAB-2(R0),R2
	CLR	R3
	CALL	OUTPUT
	BIT	#TY.TYP!TY.WIF!TY.STA,R5	;SPECIAL CASE?
	BNE	20$		;IF NE YES - OMIT OUTPUT OF INPUT
	MOV	@TXTTAB-2(R0),R1	;GET ADDRESS OF INPUT
	MOV	@TXLTAB-2(R0),R2	;GET LENGTH OF INPUT
	CLR	R3
	CALL	OUTPUT
	BR	20$		;CHECK FOR DUPLEXITY
;
10$:
	MOV	#ERRMSG,R1	;OUTPUT SKELETON ERROR MESSAGE
	MOV	#ERRMSL,R2
	MOV	#1,R3		;WITH TYPE NAME
	CALL	OUTPUT
;
20$:
	BIT	R5,DUPLIC	;WAS FIELD SPECIFIED TWICE?
	BEQ	50$		;IF EQ NO - TRY NEXT ONE
	MOV	#DUPMSG,R1	;OUTPUT SKELETON DUPLICATION MESSAGE
	MOV	#DUPMSL,R2
	MOV	#1,R3		;WITH TYPE NAME
	CALL	OUTPUT
	BR	50$		;CARRY ON
;
40$:
	BIT	R5,FLAGS	;WAS TYPE ILLEGALLY OMITTED?
	BEQ	50$		;IF EQ NO - CARRY OM
	MOV	#OMIMSG,R1	;OUTPUT SKELETON OMISSION TEXT
	MOV	#OMIMSL,R2
	MOV	#1,R3		;WITH TYPE NAME
	CALL	OUTPUT
;
50$:
	DEC	R4		;GET NEXT FLAG
	BEQ	60$		;IF NO MORE, GET NEXT LINE
	JMP	LOOP		;
;
60$:
	JMP	BEG2		;GET THE NEXT ONE
;
OUTPUT:
	QIOW$S	#IO.WLB,#5,#1,,,,<R1,R2>
	TST	R3		;TYPE NAME AS WELL?
	BEQ	10$		;IF EQ NO - OMIT IT
	QIOW$S	#IO.WLB,#5,#1,,,,<TYPTAB-2(R0),TYLTAB-2(R0)>
;
10$:
	RETURN
	.PAGE
	.SBTTL	VARIOUS BUFFERS
	.NLIST	BEX
TY.IDI=1
TY.TYP=2
TY.HOU=4
TY.SAL=10
TY.PHO=20
TY.CLA=40
TY.MAR=100
TY.STA=200
TY.IDC=400
TY.ACC=1000
TY.DOR=2000
TY.WIF=4000
TY.STT=10000
TY.AGE=20000
CLESTA:				;START OF AREA FOR CLEARING
PRESNT:	.WORD			;FLAGS OF PARAMETERS SPECIFIED
DUPLIC:	.WORD			;FLAGS OF PARAMETERS DUPLICATED
ERRWRD:	.WORD			;FLAGS OF PARAMETERS IN ERROR
FLAGS:	.WORD			;FLAGS OF PARAMETERS THAT ARE MANDATORY
HEDADD:	.WORD			;ADDRESS OF HEADER STRING
HEDLEN:	.WORD			;LENGTH OF HEADER STRING
HOUADD:	.WORD			;ADDRESS OF HOUSE STRING
HOULEN:	.WORD			;LENGTH OF HOUSE STRING
SALADD:	.WORD			;ADDRESS OF SALARY STRING
SALLEN:	.WORD			;LENGTH OF SALARY STRING
PHOADD:	.WORD
PHOLEN:	.WORD
CLAADD:	.WORD
CLALEN:	.WORD
IDCADD:	.WORD
IDCLEN:	.WORD
ACCADD:	.WORD
ACCLEN:	.WORD
STTADD:	.WORD
STTLEN:	.WORD
AGEADD:	.WORD
AGELEN:	.WORD
CLEEND:				;END OF AREA TO BE CLEARED
INPUT:	.BYTE	12,15
INBUF: .BLKB	300.
ERROUT:	.BYTE	12,15		;
ERRSTR:	.REPT	300.
	.BYTE	40
	.ENDR
	.EVEN
FLGTAB:				;TABLE OF VALID FLAGS
	.WORD	TY.TYP		;TYPE
	.WORD	TY.IDI		;IDIOT
	.WORD	TY.SAL		;SALARY
	.WORD	TY.HOU		;HOUSE
	.WORD	TY.PHO		;PHONE
	.WORD	TY.CLA		;CLASS
	.WORD	TY.STA		;STATUS
	.WORD	TY.MAR		;MARRIED
	.WORD	TY.IDC		;IDCODE
	.WORD	TY.ACC		;ACCOUNT
	.WORD	TY.WIF		;WIFE
	.WORD	TY.DOR		;DORA
	.WORD	TY.STT		;STATE
	.WORD	TY.AGE		;AGE
FLGNUM=<.-FLGTAB>/2
OKTTAB:				;STRINGS FOR SUCCESSFUL PARAMETERS
	.WORD	TY2HED
	.WORD	TY1HED
	.WORD	SALHED
	.WORD	HOUHED
	.WORD	PHOHED
	.WORD	CLAHED
	.WORD	STAHED
	.WORD	MARHED
	.WORD	IDCHED
	.WORD	ACCHED
	.WORD	WIFHED
	.WORD	DORHED
	.WORD	STTHED
	.WORD	AGEHED
OKLTAB:				;LENGTHS FOR STRINGS IN OKTTAB
	.WORD	TY2HDL
	.WORD	TY1HDL
	.WORD	SALHDL
	.WORD	HOUHDL
	.WORD	PHOHDL
	.WORD	CLAHDL
	.WORD	STAHDL
	.WORD	MARHDL
	.WORD	IDCHDL
	.WORD	ACCHDL
	.WORD	WIFHDL
	.WORD	DORHDL
	.WORD	STTHDL
	.WORD	AGEHDL
TXTTAB:				;ADDRESS OF PARAMETER INPUT ADDRESSES
	.WORD	0
	.WORD	0
	.WORD	SALADD
	.WORD	HOUADD
	.WORD	PHOADD
	.WORD	CLAADD
	.WORD	0
	.WORD	0
	.WORD	IDCADD
	.WORD	ACCADD
	.WORD	0
	.WORD	0
	.WORD	STTADD
	.WORD	AGEADD
TXLTAB:				;ADDRESS OF INPUT LENGTHS
	.WORD	0
	.WORD	0
	.WORD	SALLEN
	.WORD	HOULEN
	.WORD	PHOLEN
	.WORD	CLALEN
	.WORD	0
	.WORD	0
	.WORD	IDCLEN
	.WORD	ACCLEN
	.WORD	0
	.WORD	0
	.WORD	STTLEN
	.WORD	AGELEN
TYPTAB:				;ADDRESS OF TYPE TEXTS
	.WORD	TYPTXT
	.WORD	TYPTXT
	.WORD	SALTXT
	.WORD	HOUTXT
	.WORD	PHOTXT
	.WORD	CLATXT
	.WORD	STATXT
	.WORD	STATXT
	.WORD	IDCTXT
	.WORD	ACCTXT
	.WORD	WIFTXT
	.WORD	WIFTXT
	.WORD	STTTXT
	.WORD	AGETXT
TYLTAB:				;LENGTHS OF TYPE TEXTS
	.WORD	TYPTXL
	.WORD	TYPTXL
	.WORD	SALTXL
	.WORD	HOUTXL
	.WORD	PHOTXL
	.WORD	CLATXL
	.WORD	STATXL
	.WORD	STATXL
	.WORD	IDCTXL
	.WORD	ACCTXL
	.WORD	WIFTXL
	.WORD	WIFTXL
	.WORD	STTTXL
	.WORD	AGETXL
IOSB:	.BLKW	2		;I/O STATUS BLOCK
;
FREHED: .ASCII <12><15>/	RIGHT! SO YOU'VE CHOSEN FRED, FOR WHOM:/
FRELEN=.-FREHED
GEOHED: .ASCII <12><15>/	SO YOU PREFER GEORGE DO YOU?  WELL, FOR HIM:/
GEOLEN=.-GEOHED
CLRHED: .ASCII <12><15>/	I THOUGHT YOU WERE A CLARENCE TYPE.  HIS STATISTICS:/
CLRLEN=.-CLRHED
ILLHED: .ASCII	<12><15>/	THAT'S NOT A VALID STATEMENT TYPE DUMMY/
ILLLEN=.-ILLHED
HOUHED: .ASCII <12><15>/  	HE LIVES IN A HOUSE CALLED /
HOUHDL=.-HOUHED
SALHED: .ASCII <12><15>/  	HE EARNS AN ANNUAL SALARY OF #/
SALHDL=.-SALHED
TY1HED: .ASCII <12><15>/  	HE'S A COMPLETE & UTTER IDIOT./
TY1HDL=.-TY1HED
TY2HED: .ASCII <12><15>/  	HE'S A GENIUS WITH AN IQ OF 26754!!!!!!/
TY2HDL=.-TY2HED
PHOHED:	.ASCII <12><15>/	HIS TELEPHONE NUMBER (EX-DIRECTORY) IS /
PHOHDL=.-PHOHED
CLAHED:	.ASCII <12><15>/	HE BELONGS TO THE CLASS /
CLAHDL=.-CLAHED
STAHED:	.ASCII <12><15>/	THE LUCKY FELLOW IS A BACHELOR./
STAHDL=.-STAHED
MARHED:	.ASCII <12><15>/	THE POOR GUY HAS GOT A WIFE./
MARHDL=.-MARHED
IDCHED:	.ASCII <12><15>/	HIS IDENTIFICATION CODE IS GEO-/
IDCHDL=.-IDCHED
ACCHED:	.ASCII <12><15>/	HIS SECRET SWISS BANK ACCOUNT NUMBER IS /
ACCHDL=.-ACCHED
WIFHED:	.ASCII <12><15>/	HE IS MARRIED TO OLD MARY, THE GROCER'S DAUGHTER./
WIFHDL=.-WIFHED
DORHED:	.ASCII <12><15>/	HE'S MARRIED TO ADORABLE DORA./
DORHDL=.-DORHED
STTHED:	.ASCII <12><15>/	HIS STATE OF BEING COULD BE DESCRIBED AS :-/
	.ASCII	<12><15>/	/
STTHDL=.-STTHED
AGEHED:	.ASCII <12><15>/	HE HAS REACHED THE MAGNIFICENT AGE OF /
AGEHDL=.-AGEHED
PROMPT: .ASCII <12><15>/  INPUT LINE >/
PROMPL=.-PROMPT
TYPTXT: .ASCII	/TYPE/
TYPTXL=.-TYPTXT
SALTXT: .ASCII	/SALARY/
SALTXL=.-SALTXT
HOUTXT: .ASCII	/HOUSE/
HOUTXL=.-HOUTXT
PHOTXT:	.ASCII	/PHONE/
PHOTXL=.-PHOTXT
CLATXT:	.ASCII	/CLASS/
CLATXL=.-CLATXT
STATXT:	.ASCII	/STATUS/
STATXL=.-STATXT
IDCTXT:	.ASCII	/IDCODE/
IDCTXL=.-IDCTXT
ACCTXT:	.ASCII	/ACCOUNT/
ACCTXL=.-ACCTXT
WIFTXT:	.ASCII	/WIFE/
WIFTXL=.-WIFTXT
STTTXT:	.ASCII	/STATE/
STTTXL=.-STTTXT
AGETXT:	.ASCII	/AGE/
AGETXL=.-AGETXT
ERRMSG:	.ASCII	<12><15>/	THERE IS AN ERROR IN THE FIELD - /
ERRMSL=.-ERRMSG
DUPMSG:	.ASCII	<12><15>/	YOU HAVE DUPLICATED THE FIELD - /
DUPMSL=.-DUPMSG
OMIMSG:	.ASCII	<12><15>/	YOU HAVE OMITTED THE FIELD - /
OMIMSL=.-OMIMSG
HELMSG:				;HELP MESSAGE
.ASCII <12><15> /	THIS IS A NODDY EXAMPLE PROGRAM TO DEMONSTRATE HOW TO/
.ASCII <12><15> /	USE TPARS.  WE WILL PARSE A STRING OF THE FORM:-/
.ASCII <12><15> /	NAME  PRM1,PRM2,PRM3,PRM4,PRM5/
.ASCII <12><15> /	WHERE:/
.ASCII <12><15> /	EACH PRM1-PRM5 IS EITHER A POSITIONAL PARAMETER, OR A/
.ASCII <12><15> /	KEYWORD PARAMETER OF THE FORM KEYWD=PRM/
.ASCII <12><15> /	AND NAME IS THE STATEMENT NAME./
.ASCII <12><15> /	FOR THIS DEMO THE VALID STATEMENTS, KEYWORDS & ARGUMENTS ARE:-/
.ASCII <12><15> /	NAME		KEYWORD		ARGUMENT TYPE/
.ASCII <12><15> /	====		=======		=============/
.ASCII <12><15> /	FRED		HOUSE=		UP TO 6-BYTE ASCII	/
.ASCII <12><15> /			SALARY=		UP TO 5-DIGIT DECIMAL/
.ASCII <12><15> /			TYPE=		'IDIOT' OR 'GENIUS'/
.ASCII <12><15> 
.ASCII <12><15> /	GEORGE		PHONE=		NNNN-MMMMMM (EXACT) /
.ASCII <12><15> /			CLASS=		[A,B]/
.ASCII <12><15> /			STATUS=		'MARRIED' OR 'SINGLE'	*/
.ASCII <12><15> /			IDCODE=		UP TO 7-DIGIT OCTAL		*/
.ASCII <12><15> /			ACCOUNT=	UP TO 9-DIGIT OCTAL OR DECIMAL/
.ASCII <12><15> //
.ASCII <12><15> /	CLARENCE	WIFE=		'DORA' OR 'MARY'	*/
.ASCII <12><15> \			STATE=		HAPPY/RICH/SOBER...	*\
.ASCII <12><15> /			AGE=		2-DIGIT DECIMAL		*/
.ASCII <12><15> /			SALARY=		UP TO 5-DIGIT DECIMAL		*/
.ASCII <12><15> //
.ASCII <12><15> /	FIELDS MARKED WITH * ARE OPTIONAL./
;
HELMSL=.-HELMSG
	.END	BEGIN