/ WPPARS--PARSER FOR SPECIFICATION OF SEARCH AND SELECT
/
/	018	RCME	03-Jul-85	Re-program comparison of keywords
/					to give greater flexibility in
/					changing text for foreign versions
/	017	RCME	03-APR-85	Enable parsing of technical and
/					multinational characters. Fix dead
/					key blot substitution.
/
/  ----------------------- All below refer to V2.0 and earlier --------------
/
/	016	HLP	13-SEP-83	Delete PRLOCK,  DECmate is single user

/ WPPARS CONSTANTS

	CR=15			/ CARRIAGE RETURN
	LF=12			/ LINE FEED

	CDFMYF=CDFEDT		/ This routine runs in the EDITOR FIELD

	FIELD 3

	*100			/ FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM
DCAGPB=JMS I .;XDCAGP		/ Routine to access the GPBUF in LP field/a017
TADGPB=JMS I .;XTADGP		/ Routine to access the GPBUF in LP field/a017

ORPTR,	0
TOEFLG,	0
ERRCNT,	0
DISDKY,	0
DISCNT,	-121
NEGSPC, -40								/a017

PZERR,	ERR			/ GENERAL ERROR MESSAGE
PZNRM,	NOROOM			/ NO MORE ROOM MESSAGE
NUMFLD,	0			/ NUMERICAL FIELD FLAG  0=NOT A NUMERIC FIELD
				/ ELSE IS A NUMERIC FIELD

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE

/ PARSES A SPEC FILE AND LOADS THE RESULT INTO CORE.
PARSE,	XX
	CDFBUF			/ BUFFER FIELD HAS FILE NUMBERS
	CLA
	TAD I	(FORMNO)	/ GET FORM FILE NUMBER
	CDFMYF			/ SET DATA FIELD
	SNA CLA		/ 0, MEANING JUST TEST SPEC SYNTAX?
	AC7777			/ YES, SET FLAG TO TEST MODE
	DCA	TOEFLG		/ SET OR CLEAR FLAG

	CIFMNU			/ OVERLAY THE SELCT PROGRAM
	JMS I	OLAYCL		/ INTO FIELD 5
	7
	DCA	ERRCNT		/ CLEAR ERROR COUNT
	DCA	DISDKY		/ AND DEADKEY FLAG
	TAD	(-121)		/ SET LINE COUNTER FOR DISPLAY ROUTINE
	DCA	DISCNT
	JMS	CLS		/ CLEARS SCREEN AND HOMES CURSOR
	CDFBUF			/ STORED IN BUFFER FIELD
	TAD I	(SPCADR)	/ GET SPEC FILE NUMBER
	DCA	ORPTR		/ STORE ANY PLACE LOCAL
	TAD I	ORPTR		/ FOR INDIRECT
	CDFMYF			/ BACK HOME
	DCA	SPECNO
	TAD	SPECNO
	CIFFIO			/ OPEN FILE FOR READING
	FILEIO			/
	XRDFIN
	TAD	(SPECTB-1)	/ SET-UP SPEC TABLE PTR
	DCA	SPCPTR
	TAD	(SPCTBS+1)	/ AND COUNTER
	CIA
	DCA	SPCCNT
	TAD	(SYMTAB)	/ SET-UP SYMBOL TABLE PTR
	DCA	SYTPTR
	TAD	(SYTBSZ+1)	/ AND COUNTER
	CIA
	DCA	SYTCNT
	TAD	(CHRCOR-1)	/ SET-UP CHARACTER SPACE PTR
	DCA	CHRPTR
	TAD	(CHRCSZ+1)	/ AND COUNTER
	CIA
	DCA	CRCNT
	JMS	PSTSYM		/ STORE TRAILING 0 IN SYMBOL TABLE
	JMP I	PZNRM		/ NO ROOM
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <
	TAD	("P-200)	/ SEE IF CHAR IS 'P' ?
	>
	IFDEF ITALIAN <
	TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
	>
	JMS	PCMPAR		/ COMPARE
	JMP	PIF1		/ NO, MUST START WITH 'IF' THEN
	JMP	PTHEN1		/ YES, FINISH PARSE

PIF,	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
PIF1,	IFDEF ENGLSH <TAD ("I-200)>	/ SEE IF CHAR IS 'I' ?
	IFDEF ITALIAN<TAD ("S-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("F-200)>	/ SEE IF CHAR IS 'F' ?
	IFDEF ITALIAN<TAD ("E-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	TAD	(4001)		/ STORE -1 FOR IF TYPE
PAMLP,	JMS	PSTSPC
	JMP I	PZNRM		/ NO ROOM
	JMS	PRSFN		/ GO FIND AND STORE A FN IN THE SYM TAB
	JMP I	PZERR		/ PROBLEMS!!
	AC0001			/ STORE 1 FOR OR-COUNT
	JMS	PSTSPC
	JMP I	PZNRM		/ NO ROOM
	TAD	SPCPTR		/ GET LOCATION OF OR-COUNT
	DCA	ORPTR		/ AND SAVE IT
POR,	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("=-200)	/ SEE IF CHAR IS '=' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PRSTRG		/ GO STORE STRING (FIELD)
	JMP I	PZERR
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("O-200)	/ SEE IF CHAR IS 'O' ?
	JMS	PCMPAR		/ COMPARE
	JMP	PTHEN		/ NO MATCH RETURN, SEE IF THEN STATEMENT
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE

/ THE FOLLOWING 7 LINES WHERE MOVED HERE FROM ANOTHER PAGE
	IFDEF ENGLSH <
	TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	>
	CDFLP			/ ADD ONE TO OR-COUNT
	ISZ I	ORPTR
	CDFMYF
	JMP	POR		/ AND STORE STRING

SPECNO,	0			/ SPEC FILE NUMBER

ERRMTB,	S2NRM
	S1SYN
	S0NUM			/ 'ERROR IN NUMBER'

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


PTHEN,	TAD	THENST		/ GET THE FIRST CHARACTER TO COMPARE	/A018
	JMS	PCMPAR		/ COMPARE				/A018
	JMP	PBUTN		/ NO MATCH, SEE IF NOT COMMAND		/A018
	TAD	(THENST+1)	/ GET THE START OF THE STRING		/A018
	DCA	THENCT		/ SAVE IT IN THE COUNTER		/A018
PTHENL,	TAD I	THENCT		/ GET THE NEXT CHARACTER TO COMPARE	/A018
	SNA CLA			/ IS THIS THE END OF THE STRING?	/A018
	JMP	THENOK		/ YES, FINISHED COMPARE			/A018
	JMS	PGTCHR		/ GET A CHARCTACTER			/A018
	JMP I	PZERR		/ EOF					/A018
	MQL			/ SAVE FOR COMPARE			/A018
	TAD I	THENCT		/ GET THE OTHER CHAR BACK		/A018
	JMS	PCMPAR		/ NO, DO THE COMPARE			/A018
	JMP I	PZERR		/ NO MATCH FOUND			/A018
	ISZ	THENCT		/ INCRAMENT THE STRING POINTER		/A018
	JMP	PTHENL		/ GO ROUND FOR THE NEXT CHARACTER	/A018
THENOK,

/D018	PTHEN,	TAD	("T-200)	/ SEE IF CHAR IS 'T' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP	PBUTN		/ NO MATCH, SEE IF BUT NOT
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("H-200)	/ SEE IF CHAR IS 'H' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("N-200)	/ SEE IF CHAR IS 'N' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("P-200)	/ SEE IF CHAR IS 'P' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN

PTHEN1,	TAD	(ROCEST)	/ GET THE ADDRESS OF THE COMPARISON STRING/A018
	DCA	PROCCT		/ SAVE IT				/A018
ROCESL,	TAD I	PROCCT		/ GET THE CHAR TO COMPARE AGAINST	/A018
	SNA CLA			/ IS THIS THE END OF THE COMPARISON?	/A018
	JMP	PROCOK		/ YES, EXIT COMPARE			/A018
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE			/M018
	TAD I	PROCCT		/ GET ORIGINAL CHARACTER BACK		/A018
	JMS	PCMPAR		/ COMPARE				/A018
	JMP I	PZERR		/ NO MATCH RETURN			/A018
	ISZ	PROCCT		/ MOVE TO NEXT CHARACTER		/A018
	JMP	ROCESL		/ AND LOOP				/A018

/D018		TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("O-200)	/ SEE IF CHAR IS 'O' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("C-200)	/ SEE IF CHAR IS 'C' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("S-200)	/ SEE IF CHAR IS 'S' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("S-200)	/ SEE IF CHAR IS 'S' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018	
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("C-200)	/ SEE IF CHAR IS 'C' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("O-200)	/ SEE IF CHAR IS 'O' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN
/D018		JMS	PGTCHR		/ GET A CHAR
/D018		JMP I	PZERR		/ EOF
/D018		MQL			/ SAVE FOR COMPARE
/D018		TAD	("D-200)	/ SEE IF CHAR IS 'D' ?
/D018		JMS	PCMPAR		/ COMPARE
/D018		JMP I	PZERR		/ NO MATCH RETURN

PROCOK,	JMS	PGTCHR		/ GET A CHAR
	JMP	PARDN		/ EOF, DONE SPEC
	MQL			/ SAVE FOR COMPARE
	TAD	(SPECTB-1)	/ SEE IF SPECTB IS EMPTY
	CIA
	TAD	SPCPTR
	SNA CLA
	JMP I	PZERR		/ NO, CAN ONLY HAVE 'PROCESS RECORD'
	JMP	PORIF		/ YES, SEE IF 'OR IF'

PROCCT,				/ COUNTER INTO ROCESS RECORD STRING	/A018
THENCT,	0			/ COUNTER INTO THEN STRING		/A018

THENST,	IFDEF ENGLSH <	"T-200; "H-200; "E-200; "N-200; "P-200; 0>	/A018
	IFDEF ITALIAN<
	"A-200; "L-200; "L-200; "O-200; "C-200; "A-200; "E-200; 0>

ROCEST,	IFDEF ENGLSH <	"R-200; "O-200; "C-200; "E-200; "S-200; "S-200;	/A018
	"R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0>	/A018
	IFDEF ITALIAN<
	"L-200; "A-200; "B-200; "O-200; "R-200; "A-200; "I-200; "L-200
	"R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0>

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


PORIF,	TAD	("O-200)	/ SEE IF CHAR IS 'O' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	IFDEF ENGLSH <
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("R-200)	/ SEE IF CHAR IS 'R'?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	>
	JMP	PIF		/ LOOP BACK TO BEGINNING


PBUTN,	IFDEF ENGLSH <TAD ("B-200)>	/ SEE IF CHAR IS 'B' ?
	IFDEF ITALIAN<TAD ("M-200)>
	JMS	PCMPAR		/ COMPARE
	JMP	PAND		/ NO MATCH RETURN, SEE IF AND TYPE
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("U-200)>	/ SEE IF CHAR IS 'U' ?
	IFDEF ITALIAN<TAD ("A-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("T-200)>	/ SEE IF CHAR IS 'T' ?
	IFDEF ITALIAN<TAD ("N-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("N-200)>	/ SEE IF CHAR IS 'N' ?
	IFDEF ITALIAN<TAD ("O-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("O-200)>	/ SEE IF CHAR IS 'O' ?
	IFDEF ITALIAN<TAD ("N-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("T-200)>	/ SEE IF CHAR IS 'T' ?
	IFDEF ITALIAN<TAD ("S-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	IFDEF ENGLSH <TAD ("I-200)>	/ SEE IF CHAR IS 'I' ?
	IFDEF ITALIAN<TAD ("E-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	IFDEF ENGLSH <
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD ("F-200)		/ SEE IF CHAR IS 'F' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	>
	TAD	(2003)		/ STORE 3 FOR BUT NOT IF TYPE
	JMP	PAMLP



PAND,	IFDEF ENGLSH <TAD ("A-200)>	/ SEE IF CHAR IS 'A' ?
	IFDEF ITALIAN<TAD ("E-200)>
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	IFDEF ENGLSH <
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("N-200)	/ SEE IF CHAR IS 'N' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("D-200)	/ SEE IF CHAR IS 'D' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	>
	TAD	(4002)		/ STORE -2 FOR AND TYPE
	JMP	PAMLP



/ LOAD WORD IN AC INTO SPEC TABLE USING SPCPTR AS A PTR.
/ SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM
PSTSPC,	XX
	ISZ	SPCCNT		/ ANY ROOM LEFT
	JMP	.+2
	JMP I	PSTSPC		/ NO, ERROR RETURN
	CDFLP			/ GET TO RIGHT FIELD
	DCA I	SPCPTR		/ STORE
	CDFMYF			/ BACK TO LEFT FIELD
	ISZ	PSTSPC		/ MAKE RETURN SUCCESSFUL
	JMP I	PSTSPC		/ RETURN

SPCCNT,	0


/ LOAD WORD IN AC INTO SYMBOL TABLE, DOES NOT INCREMENT SYTPTR
/ SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM
PSTSYM,	XX
	DCA	PSYMCR		/ SAVE CHAR
	ISZ	SYTCNT		/ ANY ROOM LEFT
	JMP	.+2
	JMP I	PSTSYM		/ NO, ERROR RETURN
	TAD	SYTPTR		/ YES, GET ADDR TO STORE INTO
	DCA	PSYMTP		/ SAVE FOR INDIRECT
	TAD	PSYMCR		/ GET BACK CHAR
	CDFLP			/ GET TO RIGHT FIELD
	DCA I	PSYMTP		/ STORE
	CDFMYF			/ BACK TO LEFT FIELD
PSTSYR,	ISZ	PSTSYM		/ MAKE RETURN SUCCESSFUL
	JMP I	PSTSYM		/ RETURN

PSYMCR,	0
PSYMTP,	0
SYTCNT,	0


/ LOAD WORD IN AC INTO CHARACTER CORE USING CHRPTR AS A PTR.
/ SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM
PSTCHR,	XX
	ISZ	CRCNT		/ ANY ROOM LEFT
	JMP	.+2
	JMP I	PSTCHR		/ NO, ERROR RETURN
	CDFLP			/ GET TO RIGHT FIELD
	DCA I	CHRPTR		/ STORE
	CDFMYF			/ BACK TO LEFT FIELD
	ISZ	PSTCHR		/ MAKE RETURN SUCCESSFUL
	JMP I	PSTCHR		/ RETURN

CRCNT,	0

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


/ READS A FIELD NAME, CHECKS TO SEE IF IT IS ALREADY IN THE SYMBOL TABLE, LOADS
/ IT INTO THE SYMBOL TABLE AND STORES A PTR TO THE ENTRY IN THE SPEC TABLE.
PRSFN,	XX
	CLA
	JMS	PGTCHR		/ GET A CHAR
	JMP I	PZERR		/ EOF
	MQL			/ SAVE FOR COMPARE
	TAD	("<-200)	/ SEE IF CHAR IS '<' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	TAD	(GPBUF-1)	/ SET-UP PTR IN AUTO-INDEX
	DCA	GPPTR
	TAD	(GPBSIZ+1)	/ SET-UP SIZE COUNTER
	CIA
	DCA	GPCNT

	AC7777
	JMS	PGTCHR		/ GET NEXT CHAR
	JMP I	PRSFN		/ EXIT IF END OF FILE
	DCA	PFNCHR		/ SAVE IT
	TAD	PFNCHR		/ IF CHAR=':'
	TAD	(-":+200)	/
	SNA CLA			/
	AC0001			/ THEN NUMFLD = 1 ( IS A NUMERIC FIELD)
	DCA	NUMFLD		/ ELSE NUMFLD = 0 (NOT A NUMERIC FIELD)
	JMP	LFNLP1		/  CONTINUE WITH NEXT CHARACTER

LFNLP,	AC7777			/ SET FLAG TO GET 'ALL' CHARS
	JMS	PGTCHR		/ GET NEXT CHAR
	JMP I	PRSFN		/ EOF
	DCA	PFNCHR		/ SAVE IT
LFNLP1,	TAD	PFNCHR
	TAD	(-76)		/ SEE IF '>'
	SNA
	JMP	LFNDN		/ YES, DONE FIELD
	TAD	(2)		/ SEE IF '<'
	SNA CLA
	JMP	ERR1		/ YES, NOT ALLOWED
	TAD	DISDKY		/ Check the dead key status		/a017
	SNA CLA			/ Are we processing a dead key sequence?/a017
	ISZ	GPCNT		/ NO, SEE IF ROOM
	JMP	.+2
	JMP	ERR2		/ NO, SO TELL USER
	TAD	PFNCHR		/ GET BACK CHAR
	DCAGPB			/ AND STORE IN STRING
	JMP	LFNLP		/ LOOP BACK FOR MORE

LFNDN,	TAD	GPCNT		/ GET COUNT OF WORDS USED
	TAD	(GPBSIZ+1)
	SNA
	JMP	NULL		/ EOR, JUST '<>' FOUND
	DCA	FNCNT		/ SAVE FN LENGTH
	DCAGPB			/ STORE TRAILING 0
	TAD	(SYMTAB-1)	/ GET SYMBOL TABLE ADR - 1
	DCA	SYTPTR		/ PUT IN AUTO-INDEX
SYTBLK,	CDFLP			/ GO TO WHERE THE TABLE IS
	TAD I	SYTPTR		/ GET AN ENTRY
	CDFMYF			/ COME BACK
	SNA
	JMP	PNFN		/ LAST ONE, SO MAKE A NEW ENTRY
	DCA	SYTSRC		/ OTHERWISE, STORE FOR COMPARE
	TAD	FNCNT		/ GET SIZE OF FN TO SEARCH
	JMS	XSCMP		/ SEE IF MATCHES
	GPBUF
SYTSRC,	XX
	CDFLP			/ FIELD OF SYMTAB FOR COMPARE
	SZA CLA
	JMP	POFN		/ YES, FOUND AN ENTRY
	ISZ	SYTPTR		/ NOPE, BUMP PTR
	JMP	SYTBLK		/ TRY NEXT ENTRY

POFN,	CDFLP			/ DON'T FORGET TO CHANGE FIELDS !
	TAD I	SYTPTR		/ GET ADDR FN POINTS TO
	CDFMYF			/ AND TO CHANGE FIELD BACK
	JMS	PSTSPC		/ STORE LINK IN SPEC TAB
	JMP I	PZNRM		/ NO ROOM
	TAD	SPCPTR		/ GET ADDR OF SPEC ENTRY
	JMS	PSTSYM		/ AND MAKE IT NEW FN PTR IN SYM TAB
	JMP I	PZNRM		/ NO ROOM
	ISZ	PRSFN		/ NO ERRORS, RETURN
	JMP I	PRSFN

PNFN,	TAD	(GPBUF-1)	/ RESET GP PTR
	DCA	GPPTR
	AC0001			/ GET ADDR THAT FN WILL BE
	TAD	CHRPTR		/ IN CHR CORE
	JMS	PSTSYM		/ AND STORE AS PTR TO FN
	JMP I	PZNRM		/ NO ROOM
	ISZ	SYTPTR		/ BUMP PTR
PNFNLP,	TADGPB			/ GET A CHAR
	SNA			/ LAST ONE?
	JMP	PNFNDN		/ YES, STORE FINAL STUFF
	JMS	PSTCHR		/ NO, STORE CHARACTER
	JMP I	PZNRM		/ NO ROOM
	JMP	PNFNLP		/ BACK FOR MORE

PNFNDN,	JMS	PSTCHR		/ STORE TRAILING 0
	JMP I	PZNRM		/ NO ROOM
	JMS	PSTSPC		/ STORE 0 LINK
	JMP I	PZNRM		/ NO ROOM
	TAD	SPCPTR		/ GET ADDR OF SPEC ENTRY
	JMS	PSTSYM		/ STORE IN SYM TAB AS FN PTR
	JMP I	PZNRM		/ NO ROOM
	ISZ	SYTPTR		/ BUMP PTR
	AC7777			/ DON'T COUNT TRAILING ZERO
	TAD	SYTCNT		/ AS PART OF SYMBOL TABLE COUNTER
	DCA	SYTCNT
	JMS	PSTSYM		/ STORE FINAL 0
	JMP I	PZNRM		/ NO ROOM
	ISZ	PRSFN		/ NO ERRORS RETURN
	JMP I	PRSFN

NULL,	AC7777			/ -1 FOR EOR
	JMP I	PZERR

ERR2,	AC0001			/ 2FOR FIELD NAME TOO LARGE
ERR1,	IAC			/ 1FOR '<' FOUND BEFORE '>' IN FN
	JMP I	PZERR

FNCNT,	0
GPCNT,	0
PFNCHR,	0


	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


/ DOES A MATCH OF AN ASCII AND AN ASCIZ STRING.  RETURNS AC OF 0 IF FAILED
/ AND -1 IF MATCHES.  CALLED WITH AC EQUAL TO NUMBER OF CHARACTERS IN THE
/ 1ST STRING (ASCII) TO TRY TO MATCH
/	JMS XSCMP
/	ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD)
/	ADDR OF 2ND STRING -ASCIZ
/	FIELD FOR 2ND STRING
/	RETURN (TO THSFLD)

XSCMP,	XX
	CIA			/ MAKE NEGATIVE NUMBER OF CHARS TO SEARCH
	DCA	XSCNT
	AC7777
	TAD I	XSCMP		/ GET ADDR OF 1ST STRING
	DCA	TAI1		/ SET-UP AUTO-INDEX
	ISZ	XSCMP		/ MOVE TO NEXT ARG
	AC7777
	TAD I	XSCMP		/ ADDR OF SECOND STRING
	DCA	TAI2
	ISZ	XSCMP
	TAD I	XSCMP		/ GET CDF FOR STRINGS			/m017
	DCA	XSCLP		/ SET-UP TO EXECUTE
	TAD	XSCLP		/ Also for 1st string			/a017
	DCA	XS1CLP		/					/a017
	ISZ	XSCMP		/ MAKE SURE WE RETURN TO THE RIGHT PLACE
	TAD	XSCLP		/ GET THE CDF BACK
	DCA	XSCLP1		/ AND STORE CAUSE WE'LL NEED IT AGAIN
XSCLP,	XX			/ FOR THE CDF
	TAD I	TAI2		/ CHAR FROM 2ND STRING
	CDFMYF			/ BACK TO HOME FIELD
	SNA			/ SEE IF END OF STRING
	JMP I	XSCMP		/ YES, SO RETURN WITH 0 IN AC
	CIA			/ NO, NEGATE
XS1CLP,	XX			/ For the CDF				/a017
	TAD I	TAI1		/ CHAR FROM 1ST STRING
	CDFMYF			/ Back to home field			/a017
	SZA CLA		/ ARE THEY THE SAME?
	JMP I	XSCMP		/ NOPE, RETURN WITH A 0 IN AC
	ISZ	XSCNT		/ DID WE LOOK AT ENOUGH CHARS?
	JMP	XSCLP		/ NO, COMPARE SOME MORE
XSCLP1,	XX			/ YES, DO THE CDF
	TAD I	TAI2		/ MAKE SURE WE'RE AT THE END
	CDFMYF			/ BACK TO HOME FIELD
	SNA CLA		/ 0, FOR NOT AT THE END OF STRING
	AC7777			/ -1 FOR SUCCESS
	JMP I	XSCMP		/ RETURN

XSCNT,	0



/ READS IN A CHARACTER AND RETURNS IT IN THE AC
/ IF AC=0 THEN IGNORES ALL BLANKS, TABS, RULERS, ETC.
/ IF AC= -1 THEN ONLY DELETES RULERS, FUNNY SPACES AND LINE FEEDS
/ CALLED BY:
/	JMS	PGTCHR
/	EOF RETURN (AC UNDEFINED)
/	REGULAR RETURN (AC CONTAINS CHAR)

PGTCHR,	XX
	DCA	PGTDLA		/ SAVE FLAG
PGTLP,	JMS	RDNXCH		/ GET A CHAR
	JMP I	PGTCHR		/ EOF, GIVE RETURN
	DCA	SSCHAR		/ SAVE CHAR
	TAD	SSCHAR
	AND	P177		/ NO CONTROLS
	TAD	(-41)		/ SEE IF PRINTING CHAR
	SPA
	JMP	SSPCHR		/ NOPE, SPECIAL
	TAD	(41)		/ YES, GET CHAR BACK
	JMS	DISCHR		/ SHOW CHAR ON SCREEN
	ISZ	PGTCHR		/ MAKE RETURN NORMAL
	JMP I	PGTCHR		/ AND RETURN

SSPCHR,	TAD	(25)		/ NO, SEE IF A FF (14)
	SNA
	JMP	SSCPC		/ YES, NOW CHECK IF SPECIAL
	TAD	(-2)		/ NO, WHAT ABOUT START OF RULER (16)
	SNA CLA
	JMP	SSDLRR		/ YES, GO DELETE RULER
	TAD	SSCHAR		/ NO, GET CHAR BACK
	AND	(7600)		/ SEE IF HIGH PART ON
	SZA CLA
	JMP	PGTLP		/ YES, SO IGNORE IT
	TAD	SSCHAR		/ NO, GET CHAR ONCE MORE
	TAD	(-7)		/ SEE IF ^G (MODIFIED FLAG) ?
	SNA CLA
	JMP	PGTLP		/ YES, JUST IGNORE
PGTCRR,	TAD	SSCHAR		/ GET CHAR TO RETURN WITH
	JMS	DISCHR		/ SHOW CHAR ON SCREEN
	MQL			/ SAVE CHAR
	TAD	PGTDLA		/ CHECK DELETE 'ALL' FLAG
	SNA CLA
	JMP	PGTLP		/ YES, IGNORE CHARACTER
	MQA			/ NO, GET CHAR BACK
	ISZ	PGTCHR		/ BUMP RETURN
	JMP I	PGTCHR		/ RETURN

SSCPC,	TAD	SSCHAR		/ SEE IF START OF PRINTER CONTROL
	TAD	(-1014)
	SZA CLA		/ YES, GO SKIP ENTIRE THING
	JMP	PGTCRR		/ NO, MUST HAVE BEEN NORMAL FF
SSCPC1,	JMS	RDNXCH		/ GET A CHAR
	JMP I	PGTCHR		/ ERROR, EOF
	TAD	(-1414)		/ SEE IF END YET
	SZA CLA
	JMP	SSCPC1		/ NO, KEEP LOOKING
	JMP	PGTLP		/ YES, BACK TO NORMAL PROCESSING

SSDLRR,	JMS	RDNXCH		/ GET A CHAR
	JMP I	PGTCHR		/ ERROR
	TAD	(-17)		/ END OF RULER?
	SZA CLA
	JMP	SSDLRR		/ NO, KEEP LOOKING
	JMP	PGTLP		/ YES, BACK TO NORMAL PROCESSING

SSCHAR,	0
PGTDLA,	0


RDNXCH,	XX			/ SIMULATE RDFIL
	CLA
	CIFFIO			/
	FILEIO			/
	XRDFNC
	SZA
	ISZ	RDNXCH
	JMP I	RDNXCH

OUTCHR,	XX			/ OUTPUTS THE CHAR IN THE AC TO THE SCREEN
	AND	P377
	JMP	OUTCH2
OUTCH1,	CIFSYS			/ ++++
	JWAIT
OUTCH2,	CIFSYS			/ ++++
	TTYOU
	JMP	OUTCH1
	CLA
	JMP I	OUTCHR

	IFDEF FRENCH <
FS1SYN,				/ a"GRAV A" appears between the above and the below in french
	TEXT " PARTIR DE CE POINT" /L.A.E, L.G.A
	>
	IFDEF CANADA <
CS1SYN,				/ aL.G.A appears before this string (pretend)
	TEXT " PARTIR DU SIGNE ^."
	>

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


/	The GPBUF has been moved to Field 5 (the LP field) to allow	/a017
/	space to handle multinational and technical characters in field	/a017
/	names.								/a017
/
/d017	GPBUF,	ZBLOCK GPBSIZ+1

DISCHR,	XX			/ DISPLAYS CHAR IN AC ON SCREEN (WITH CR, LF SEQUENCES)
	DCA	DISSCR		/ SAVE CHAR
	TAD	DISSCR		/ CHECK FOR CR RIGHT AWAY
	TAD	(-15)
	SNA CLA
	JMP	DISLIV		/ YES, END OF DEADKEY
	TAD	DISDKY		/ SEE IF IN MIDDLE OF DEADKEY SEQUENCE
	SZA CLA
	JMP	INDEAD		/ YES, DEAL WITH CHARACTER		/M017
	TAD	DISSCR
	TAD	(-10)		/ BACKSPACE ?
	SNA
	JMP	DISDOA		/ YES, START OF DEADKEY
	TAD	(10-12)		/ SEE IF LF
	SZA CLA
	JMP	DISCH1		/ NO
	JMS	DISCLF		/ YES, OUTPUT A CR-LF
DISCH3,	TAD	DISSCR		/ GET CHAR BACK
	JMP I	DISCHR		/ AND RETURN

DISCH1,	ISZ	DISCNT		/ END OF LINE ANYWAY ?
	JMP	DISCH2		/ NO
	JMS	DISCLF		/ YES, OUTPUT CR-LF AND RESET COUNTER
	JMP	DISCH1		/ TRY AGAIN
DISCH2,	TAD	DISSCR		/ GET CHAR
DISOAL,	JMS	OUTCHR		/ OUTPUT IT				/M017
	JMP	DISCH3		/ AND RETURN

DISDOA,	AC7777			/ SET THE DEAD KEY FLAG
	DCA	DISDKY
/D017	JMS	OSTRG		/ GOTO OUTPUT STRING ROUTINE
/D017	ESC			/ START ESCAPE SEQUENCE TO SCREEN
/D017	"[-200			/ NEED "[" ONLY IN ANSI MODE
/D017	"F-200			/ "F" MEANS GOTO GRAPHIC CHARACTER SET
/D017	"G-140			/ DEADKEY SYMBOL
/D017	ESC			/ GO BACK TO ANSI CHARACTER SET
/D017	"[-200			/ NEAD "[" ONLY IN ANSI MODE
/D017	"G-200+4000		/ G (+4000 MEANS END OF STRING)

	JMP	DISCH3		/ GET CHAR BACK AND RETURN

DISLIV,	DCA	DISDKY		/ TURN OFF DEADKEY FLAG
	TAD	(17)		/ OUTPUT SI IF DEAD KEY FINISHED TO	/A017
				/ CLEAN UP AFTER LINE DRAWING SET MODE	/A017
	JMP	DISOAL		/ CHAR BACK AND RETURN			/M017

DISCLF,	XX			/ OUTPUTS A CR-LF AND RESETS DISCNT BACK TO A FULL LINE
	JMS	OSTRG		/ OUTPUT STRING ROUTINE
	CR			/ CARRIAGE RETURN
	LF+4000			/ LINE FEED (4000 MEANS END OF STRING)

	TAD	(-121)		/ RESET LINE COUNTER
	DCA	DISCNT
	JMP I	DISCLF		/ AND RETURN

DISDCH,	CLL RAL			/ Check that this is the 3rd character	/a017
	SNA CLA			/ Is this 3rd character?		/a017
	JMP	DISCH2		/ Yes, output it.			/a017
	JMP	DISCH3		/ No, accept and ignore it as is	/a017
				/ trailing rubbish.			/a017
GLDSPC,	AC4000			/ Deal with GOLD spaces. Is not dead key/a017
	DCA	DISDKY		/ sequence, so set flag to ignore rest.	/a017
	JMP	DISCH2		/ Display the space.			/a017


/****************************************************************************
/
/	The following code handles dead key sequences found in the	/a017
/	list processing document.  Technical and multinational		/a017
/	characters are now displayed using the correct character sets	/a017
/	and user dead key sequences are depicted by the conventional	/a017
/	blot rather than the +/- symbol previously used.		/a017
/
/****************************************************************************

INDEAD,	ISZ	DISDKY		/ This piece of code is used for each	/a017
				/ character within the dead key sequence/a017
				/ Is this the first character in sequence?/a017
	JMP	INDNOT1		/ No, deal with others			/a017
	ISZ	DISDKY		/ Yes, set the dead key flag again	/a017
	TAD	DISSCR		/ Get the character			/a017
	TAD	NEGSPC		/ Test for space character		/a017
	SNA CLA			/ Is it a space?			/a017
	JMP	DISCH3		/ Yes, accept and forget it		/a017
	JMS	OSTRG		/ Output the escape sequence to send a	/a017
	ESC			/ blob to the screen.			/a017
	"[-200			/ ESC [ F puts us into graphics mode	/a017
	"F-200			/					/a017
	"a-200			/ "a" in line drawing set is blob	/a017
	ESC			/ ESC [ G returns us to ASCII mode	/a017
	"[-200			/					/a017
	"G-200+4000		/ +4000 is the end of string marker	/a017

	AC4000			/ Set top bit of the dead key flag to	/a017
	DCA	DISDKY		/ indicate a user dead key that requires/a017
	JMP	DISCH3		/ no further processing			/a017

INDNOT1,TAD	DISDKY		/ Check the top bit of the flag for user/a017
	SPA			/ Is this a user dead key sequence?	/a017
	JMP	DISCH3		/ Yes, ignore all further characters.	/a017
	CLL RTR			/ No, test for the 2nd char in sequence	/a017
	SZA			/ Is this the 2nd character?		/a017
	JMP	DISDCH		/ No, its a later one.			/a017

	TAD	DISSCR		/ Yes, get it.				/a017
	TAD	NEGSPC		/ Test for a GOLD space			/a017
	SNA			/ Is it a GOLD space?			/a017
	JMP	GLDSPC		/ Yes, deal with it			/a017

	TAD	(-23)		/ No, test character set specifier	/a017
	SNA			/ Is it a technical character?		/a017
	JMP	DISDTC		/ Yes, go send a SS3			/a017

	IAC			/ Test for multinational character set	/a017
	SNA CLA			/ Is it multinational?			/a017
	JMP	DISDMC		/ Yes, output a SS2			/a017
	JMP	DISDLC		/ No, is line drawing, so output SO	/a017

DISDTC,	AC0001			/ Build value 217 for technical char	/a017
DISDMC,	TAD	(200)		/ Build value 216 for multinational char/a017
DISDLC,	TAD	(16)		/ Build value 16 for a line drawing char/a017
	JMP	DISOAL		/ Output the built value to the screen	/a017

DISSCR,	0


PARDN,	JMS	PSTSPC		/ STORE FINAL 0 IN SPEC TABLE
	JMP I	PZNRM		/ NO ROOM
	TAD	TOEFLG		/ TEST MODE?
	SZA CLA
	JMP	NOERRT		/ YES, RETURN TO MAIN MENU

	TAD	PARSE		/ NO, STORE AWAY RETURN ADDR
	CDFBUF
	DCA I	(RETADR)
	CDILP			/ NOW GET TO RIGHT FIELD
	JMP I	(SELINI)	/ AND JUMP TO START OF SELECT PROGRAM

XDCAGP,	XX			/ Routine to store AC to GPBUF in LP field/a017
	CDFLP			/ Change to LP data field		/a017
	DCA I	GPPTR		/ Save at the word pointed to		/a017
	CDFMYF			/ Back to home field			/a017
	JMP I	XDCAGP		/ And return				/a017

XTADGP,	XX			/ Routine to add word in GPBUF to AC	/a017
	CDFLP			/ Change to LP data field		/a017
	TAD I	GPPTR		/ Add word pointed to by GPPTR		/a017
	CDFMYF			/ Back to home field			/a017
	JMP I	XTADGP		/ Return				/a017

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


/ STORES A STRING IN CHAR CORE
/ CALLED BY:
/	JMS	PRSTRG
/	EOF RETURN
/	REGULAR RETURN

PRSTRG,	XX
	AC0001			/ GET PTR TO STRING IN CHR CORE
	TAD	CHRPTR
	JMS	PSTSPC		/ AND STORE IN STRING PTR WORD OF SPEC
	JMP I	PZNRM
	DCA	PSCNT		/ INIT S-COUNT
	DCA	PMCNT		/ M-COUNT
	DCA	PECNT		/ AND E-COUNT
	TAD	(ISZ PSCNT)	/ INIT ISZ WORD
	DCA	PCNTWD
	AC7775			/ AND NUMBER OF <*> ALLOWED
	DCA	PRWCNT
PRSTLP,	AC7777			/ SET FLAG TO GET 'ALL' CHARS
	JMS	PGTCHR		/ GET A CHAR
PRSTRT,	JMP I	PRSTRG		/ EOF, GIVE ERROR RETURN
	TAD	(-12)		/ SEE IF NEWLINE
	SNA
	JMP	PRSTDN		/ YES, END OF STRING
	TAD	(-62)		/ NO, SEE IF '<' ?
	SNA
	JMP	PRSTWC		/ YES, PARSE WILD CARDS AND NUMBERS
	TAD	(12+62)		/ NO, GET CHAR BACK
PRSTL1,	JMS	PSTORE		/ AND STORE IT AWAY
	JMP I	PZNRM		/ NO ROOM
	JMP	PRSTLP		/ BACK FOR MORE

PRSTWC,	AC7777			/ SET FOR 'ALL' CHARS
	JMS	PGTCHR		/ GET CHAR
	JMP I	PRSTRG		/ EOF, ERROR RETURN
	TAD	(-52)		/ SEE IF '*' ?
	SNA
	JMP	PRSTW1		/ YES, BUMP TO NEXT COUNT WORD
	TAD	(-25)		/ NO, SEE IF '?' ?
	SZA
	JMP	PRSTNM		/ MUST BE A NUMBER
PRSTW3,	AC7777
	JMS	PGTCHR		/ GET CHAR
	JMP I	PRSTRG		/ EOF, RETURN
	TAD	(-77)		/ SEE IF ANOTHER '?' ?
	SNA
	JMP	PRSTW2		/ YES, GO STORE IT
	IAC			/ NO, BETTER BE '>'
	SZA CLA
	JMP I	PZERR		/ NO, ERROR
	AC7777			/ YES, STORE CODE FOR ? WILD CARD
	JMP	PRSTL1

PRSTW1,	ISZ	PRWCNT		/ BUMP WILD CARD COUNT
	JMP	.+2
	JMP I	PZERR		/ TOO MANY <*> WILD CARDS
	AC7777
	JMS	PGTCHR		/ GET CHAR
	JMP I	PRSTRG		/ EOF, RETURN
	TAD	(-76)		/ BETTER BE '>'
	SZA CLA
	JMP I	PZERR		/ NO, ERROR
	ISZ	PCNTWD		/ MOVE COUNTER TO NEXT WORD
	JMP	PRSTLP		/ PROCESS REST OF LINE

PRSTW2,	AC7777			/ STORE CODE FOR ? WILD CARD
	JMS	PSTORE
	JMP I	PZNRM		/ NO ROOM
	JMP	PRSTW3		/ LOOK FOR MORE '?'

PRSTDN,	AC0001			/ SEE IF ANY WILD CARDS
	TAD	PRWCNT
	SZA
	JMP	PRSTD1		/ 0OR 1, GO HANDLE
PRSTD4,	TAD	PSCNT		/ 3, GET S-COUNT
	CIA			/ NEGATE CAUSE ALPHANUMERIC
PRSTD2,	JMS	PSTSPC		/ AND STORE IN SPEC S-COUNT
	JMP I	PZNRM		/ NO ROOM
	TAD	PMCNT		/ SAME FOR M-COUNT
	CIA
	JMS	PSTSPC
	JMP I	PZNRM
	TAD	PECNT		/ GET E-COUNT
	CIA
PRSTD5,	JMS	PSTSPC		/ AND STORE IT
	JMP I	PZNRM
	ISZ	PRSTRG		/ NORMAL RETURN
	JMP I	PRSTRG

PRSTD1,	IAC			/ DETERMINE IF ANY WILD CARDS
	SNA CLA
	JMP	PRSTD3		/ YES, 1, GO SWITCH COUNTS
	TAD	PSCNT		/ 0IF NULL SEARCH, COUNT IF PLAIN SEARCH
	DCA	PECNT		/ STORE IN E-COUNT
	AC0002			/ STORE -2 IN M-COUNT
	DCA	PMCNT
	AC0001			/ STORE +1 IN S-COUNT
	JMP	PRSTD2		/ GO STORE

PRSTD3,	TAD	PMCNT		/ DON'T REALLY WANT THIS IN M-COUNT
	DCA	PECNT		/ SO MOVE TO E-COUNT
	DCA	PMCNT		/ AND CLEAR M-COUNT
	JMP	PRSTD4		/ GO STORE COUNT WORDS

PSTORE,	XX			/ STORE CHAR AND BUMP THE RIGHT COUNTER
PCNTWD,	XX			/ FOR ISZ OF S, M, OR E COUNT
	JMS	PSTCHR		/ STORE CHAR
	JMP I	PZNRM		/ NO ROOM, ERROR RETURN
	ISZ	PSTORE		/ BUMP RETURN
	JMP I	PSTORE		/ RETURN

PRWCNT,	0

PSCNT,	0			/ ORDER IMPORTANT
PMCNT,	0
PECNT,	0

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


/ READS IN A CHARACTER FROM THE CURRENTLY OPEN FILE IGNORING ALL CHARACTERS
/ LESS THAN ASCII 41, EXCEPT FOR NEWLINE (ASCII 12).
/ CALLED BY:
/	JMS	PGTNMC
/	EOF RETURN
/	REGULAR RETURN (AC=0 MEANS NEWLINE
/	ELSE CHAR RETURNED IN AC)

PGTNMC,	XX
	AC7777			/ GET ALL CHARS
	JMS	PGTCHR
	JMP I	PGTNMC		/ EOF RETURN
	TAD	(-12)		/ SEE IF NEWLINE
	SNA
	JMP	PGTNM1		/ YES, RETURN WITH AC = 0
	TAD	(-27)		/ NO, LESS THAN 41 ASCII ?
	SPA
	JMP	PGTNMC+1	/ YES, IGNORE CHAR
	TAD	(12+27)		/ NO, GET CHAR BACK
PGTNM1,	ISZ	PGTNMC		/ AND RETURN WITH IT
	JMP I	PGTNMC


PRSNLP,	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YEP !
PRSNL1,	TAD	(-76)		/ SEE IF '>' ?
	SNA
	JMP	PRSNXT		/ YES, PARSE REST OF NUMBER
	TAD	(2)		/ NO, SEE IF '<' ?
	SNA
	JMP I	PZERR		/ YES, NOT ALLOWED
	TAD	(2)		/ NO, SEE IF ASCII 9 OR LESS
	SMA
	JMP	PRSNLP		/ NO, SKIP IT
	TAD	(12)		/ YES, SEE IF ASCII 0 OR MORE
PRSNSZ,	XX			/ MODIFIED TO IGNORE LEADING ZEROES
	JMP	PRSNLP		/ SKIP CHAR
	TAD	(60)		/ MAKE ASCII AGAIN
	ISZ	NUMSIZ		/ SEE IF TOO LARGE
	JMP	.+2
	JMP I	PZERR		/ YES
	JMS	PSTORE		/ NO, STORE CHAR
	JMP I	PZNRM		/ NO ROOM
	TAD	(SPA)		/ TURN OFF ZERO SUPRESSION
	DCA	PRSNSZ
	JMP	PRSNLP		/ GET ANOTHER CHAR

NUMSIZ,	0


PRSNXT,	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP	PRNMDN		/ YES, GO FINISH UP
	MQL			/ SAVE FOR COMPARE
	TAD	PRWCNT		/ SEE IF SECOND PART OF 'THRU'
	SZA CLA
	JMP I	PZERR		/ YES, SHOULDN'T BE HERE
	TAD	("O-200)	/ NO, SEE IF CHAR IS 'O' ?
	JMS	PCMPAR		/ COMPARE
	JMP	PTHRU		/ NO MATCH, SEE IF THRU
	IFDEF ENGLSH <
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	>
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	MOREST		/ SEE IF CHAR IS 'M' ?
	JMS	PCMPAR		/ COMPARE
	JMP	PLESS		/ NO MATCH, SEE IF LESS
	TAD	(MOREST+1)	/ GET THE START OF THE MORE STRING	/A018
	DCA	MORECT		/ SAVE IT IN THE COUNTER		/A018
MORELP,	TAD I	MORECT		/ GET THE NEXT CHAR TO COMPARE AGAINST	/A018
	SNA CLA			/ IS THIS THE END OF THE COMPARE?	/A018
	JMP	MOREOK		/ YES, ALL DONE				/A018
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE			/M018
	TAD I	MORECT		/ GET THE COMPARISON CHAR BACK		/A018
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	ISZ	MORECT		/ INCRAMENT THE COMPARISON STRING COUNT	/A018
	JMP	MORELP		/ AND GET THE PREVIOUS CHARACTER	/A018

/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN
/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN

MOREOK,	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SZA CLA		/ SEE IF NEWLINE ?
	JMP I	PZERR		/ NO
	JMP	PRNMD1		/ YES, GO FINISH UP

MORECT,	0			/ POINTER INTO MORE STRING		/A018

MOREST,	IFDEF ENGLSH <	"M-200; "O-200; "R-200; "E-200; 0 >
	IFDEF ITALIAN<
	"M-200; "A-200; "G-200; "G-200; "I-200; "O-200; "R-200; "E-200; 0 >
	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


PLESS,	TAD	LESSST		/ SEE IF CHAR IS 'L' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	TAD	(LESSST+1)	/ GET THE START OF THE MORE STRING	/A018
	DCA	LESSCT		/ SAVE IT IN THE COUNTER		/A018
LESSLP,	TAD I	LESSCT		/ GET THE NEXT CHAR TO COMPARE AGAINST	/A018
	SNA CLA			/ IS THIS THE END OF THE COMPARE?	/A018
	JMP	LESSOK		/ YES, ALL DONE				/A018
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE			/M018
	TAD I	LESSCT		/ GET THE COMPARISON CHAR BACK		/A018
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	ISZ	LESSCT		/ INCRAMENT THE COMPARISON STRING COUNT	/A018
	JMP	LESSLP		/ AND GET THE PREVIOUS CHARACTER	/A018

/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("E-200)	/ SEE IF CHAR IS 'E' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN
/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("S-200)	/ SEE IF CHAR IS 'S' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN
/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("S-200)	/ SEE IF CHAR IS 'S' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN

LESSOK,	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SZA CLA		/ SEE IF NEWLINE ?
	JMP I	PZERR		/ NO
	TAD	PECNT		/ YES, MOVE E-COUNT TO M-COUNT
	DCA	T1
	DCA	PECNT		/ AND ZERO E-COUNT
	TAD	T1
	JMP	PRNMD1		/ GO FINISH UP

PTHRU,	TAD	THROST		/ SEE IF CHAR IS 'T' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	TAD	(THROST+1)	/ GET THE START OF THE MORE STRING	/A018
	DCA	THROCT		/ SAVE IT IN THE COUNTER		/A018
THROLP,	TAD I	THROCT		/ GET THE NEXT CHAR TO COMPARE AGAINST	/A018
	SNA CLA			/ IS THIS THE END OF THE COMPARE?	/A018
	JMP	THROOK		/ YES, ALL DONE				/A018
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE			/M018
	TAD I	THROCT		/ GET THE COMPARISON CHAR BACK		/A018
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	ISZ	THROCT		/ INCRAMENT THE COMPARISON STRING COUNT	/A018
	JMP	THROLP		/ AND GET THE PREVIOUS CHARACTER	/A018

/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("H-200)	/ SEE IF CHAR IS 'H' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN
/D018	JMS	PGTNMC		/ GET A CHAR
/D018	JMP	PRSTRT		/ EOF
/D018	SNA			/ SEE IF NEWLINE ?
/D018	JMP I	PZERR		/ YES, OUT OF SYNC
/D018	MQL			/ SAVE FOR COMPARE
/D018	TAD	("R-200)	/ SEE IF CHAR IS 'R' ?
/D018	JMS	PCMPAR		/ COMPARE
/D018	JMP I	PZERR		/ NO MATCH RETURN

THROOK,	IFDEF ENGLSH <
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("U-200)	/ SEE IF CHAR IS 'U' ?
	JMS	PCMPAR		/ COMPARE
	JMP	POUGH		/ NO MATCH,SEE IF OTHER WAY TO SPELL THRU
	>
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("<-200)	/ SEE IF CHAR IS '<' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
PTHRU1,	AC7777			/ MOVE COUNT WORD BACK
	TAD	PCNTWD		/ TO ADD INTO M-COUNT
	DCA	PCNTWD
	ISZ	PRWCNT		/ SET FLAG FOR DONE 1ST HALF OF THRU
	TAD	(-GPBSIZ-1)	/ RE-INIT NUMBER SIZE COUNTER
	DCA	NUMSIZ
	TAD	NUMFLD		/ IF NUMERIC FIELD
	SZA CLA			/
	JMP	PTHRU2		/ THEN USE NEW NUMERIC ROUTINE
	TAD	(SPA SNA)	/ ELSE SET FOR LEADING ZERO SUPRESSION
	DCA	PRSNSZ		/
	JMP	PRSNLP		/     AND GET 2ND HALF OF THRU

PTHRU2,	TAD	(TOKVAL-1)	/ SET UP POINTER TO TOKVAL IN MATH FIELD
	DCA	TAI1		/
	JMP	PRSNL3		/


	IFDEF FRENCH <

/	FSPECL
/	Routine to process a special French string

FSPECL,	XX
	CLA			/ Clear the AC (insurance)
	TAD	ERRMES		/ Get the error message
	TAD	(-S1SYN)	/ Get the special message
	SZA CLA		/ Is it the special message?
	JMP I	FSPECL		/ No, continue as usual.
	TAD	(16)		/ Shift out (to alternate graphics)
	JMS	OUTCHR
	TAD	(141)		/ Print an "GRAV A"
	JMS	OUTCHR
	TAD	(17)		/ Shift back (to base character set)
	JMS	OUTCHR
	JMS	OUTSTR		/ Print the rest of the special string
	FS1SYN
	JMP I	FSPECL		/ Return to mainline

	>			/ END IFDEF FRENCH
	IFDEF CANADA <

/	FSPECL
/	Routine to process a special CANADA string

FSPECL,	XX
	CLA			/ Clear the AC (insurance)
	TAD	ERRMES		/ Get the error message
	TAD	(-S1SYN)	/ Get the special message
	SZA CLA		/ Is it the special message?
	JMP I	FSPECL		/ No, continue as usual.
	TAD	(16)		/ Shift out (to alternate graphics)
	JMS	OUTCHR
	TAD	(141)		/ Print an "GRAV A"
	JMS	OUTCHR
	TAD	(17)		/ Shift back (to base character set)
	JMS	OUTCHR
	JMS	OUTSTR		/ Print the rest of the special string
	CS1SYN
	JMP I	FSPECL		/ Return to mainline

	>			/ END IFDEF CANADA

THROCT,				/ POINTER INTO THRO STRING
LESSCT,	0			/ POINTER INTO LESS STRING		/A018

LESSST,	IFDEF ENGLSH < "L-200; "E-200; "S-200; "S-200; 0 >
	IFDEF ITALIAN<
	"M-200; "I-200; "N-200; "O-200; "R-200; "E-200; 0 >
THROST,	IFDEF ENGLSH <	"T-200; "H-200; "R-200; 0 >
	IFDEF ITALIAN<	"F-200; "I-200; "N-200; "O-200; "A-200; 0 >

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


POUGH,	TAD	("O-200)	/ SEE IF CHAR IS 'O' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("U-200)	/ SEE IF CHAR IS 'U' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("G-200)	/ SEE IF CHAR IS 'G' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("H-200)	/ SEE IF CHAR IS 'H' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YES, OUT OF SYNC
	MQL			/ SAVE FOR COMPARE
	TAD	("<-200)	/ SEE IF CHAR IS '<' ?
	JMS	PCMPAR		/ COMPARE
	JMP I	PZERR		/ NO MATCH RETURN
	JMP	PTHRU1		/ MATCHED, GO SET WORDS CORRECTLY

PRNMDN,	TAD	PRWCNT		/ SEE IF SECOND PART OF 'THRU' ?
	SZA CLA
	JMP	PRNMD2		/ YES, GET RIGHT WORD
	AC7777			/ NO, STORE -1 IN M-COUNT FOR PLAIN SEARCH
PRNMD1,	JMS	PSTSPC		/ STORE M-COUNT WORD IN SPEC
	JMP I	PZNRM		/ NO ROOM
	TAD	PECNT		/ GET E-COUNT
	JMP	PRSTD5		/ STORE AND RETURN

PRNMD2,	TAD	PMCNT		/ GET M-COUNT
	JMP	PRNMD1		/ AND STORE IT


PRSTNM,	IAC			/ MAKE SURE IT WASN'T JUST AN IMMEDIATE '>'
	SNA
	JMP I	PZERR		/ NOT ALLOWED
	TAD	(25+52-1)	/ GET CHAR BACK
	DCA	T1		/ AND SAVE IT
	AC0003			/ SEE IF ANY * WILD CARDS YET ?
	TAD	PRWCNT
	SZA CLA
	JMP I	PZERR		/ YES, CAN'T DO
	DCA	PRWCNT		/ SET COUNT TO 0
	TAD	PSCNT		/ MAKE SURE NO CHARS ALREADY STORED
	TAD	PMCNT
	TAD	PECNT
	SZA CLA
	JMP I	PZERR		/ CAN'T HAVE CHARS STORED YET
	AC0001			/ STORE +1 IN S-COUNT
	JMS	PSTSPC
	JMP I	PZNRM		/ NO ROOM
	ISZ	PCNTWD		/ SET TO BUMP E-COUNT
	ISZ	PCNTWD

	TAD	T1		/ GET CHAR BACK
	TAD	(-12)		/ MAKE SURE IT'S NOT A NEWLINE
	SNA CLA
	JMP I	PZERR		/ SHOULDN'T BE
	TAD	NUMFLD		/ IF NUMERIC FIELD NAME SPECIFIED
	SZA CLA
	JMP	PRSTN1		/       THEN SCAN FOR A REAL NUMBER

/ COME HERE FOR NON-NUMERIC FIELD
	TAD	(SPA SNA)
	DCA	PRSNSZ		/ SET FOR LEADING ZERO SUPPRESSION
	TAD	(-GPBSIZ-1)
	DCA	NUMSIZ		/ SET MAX NUMBER SIZE ALLOWED
	TAD	T1		/ GET BACK AGAIN
	JMP	PRSNL1

/ COME HERE FOR NUMERIC FIELD
PRSTN1,	TAD	(TOKVAL-1)	/ INITIALIZE POINTER INTO TOKVAL IN MATH
	DCA	TAI1		/ FIELD FOR ASCII NUMBER
	TAD	T1
	JMP	PRSNL2


PRSNL3,	JMS	PGTNMC		/ GET A CHAR
	JMP	PRSTRT		/ EOF
	SNA			/ SEE IF NEWLINE ?
	JMP I	PZERR		/ YEP !
PRSNL2,	TAD	(-76)		/ SEE IF '>' ?
	SNA
	JMP	PRSNL4		/ CALL ASCBCD ROUTINE
	TAD	(2)		/ NO, SEE IF '<' ?
	SNA
	JMP I	PZERR		/ YES, NOT ALLOWED
	TAD	(74)		/ MAKE ASCII AGAIN
	ISZ	NUMSIZ		/ SEE IF TOO LARGE
	JMP	.+2
	JMP I	PZERR		/ YES
	CDFMTH			/ NO, STORE CHARACTER IN
	DCA I	TAI1		/ TOKVAL IN MATH FIELD
	CDFMYF
	JMP	PRSNL3		/ GET ANOTHER CHAR

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE

/ HERE WE CALL ASCBCD ROUTINE IN MATH FIELD THEN MOVE PACKED BCD TO OUR
/ SYMBLE TABLE FOR LATER USE BY WPSELC.PA
PRSNL4,	CDFMTH
	DCA I	TAI1		/ STORE TRAILING ZERO IN TOKVAL
	CDFMYF
	CIFMTH
	JMS	ASCBCD		/ CONVERT TO PACKED BCD
	  TOKVAL		/ ASCII INPUT IS AT TOKVAL IN MATH FIELD
	  RESULT		/ PACKED BCD OUTPUT GOES TO RESULT IN
				/   MATH FIELD
	JMP	BADNUM		/ ERROR RETURN
	TAD	(RESULT-1)	/ GET ADDRESS OF PACKED BCD
	DCA	TAI1		/     AND PUT IN AUTO-INDEX COUNTER
	TAD	(-6)		/ GET SIZE OF PACKED BCD VALUE
	DCA	T1		/     AND USE T1 AS COUNTER
PRSNL5,	CDFMTH			/ LOOP
	TAD I	TAI1		/ | GET PACKED BCD VALUE
	CDFMYF			/ |
	JMS	PSTORE		/ | PUT IN SYMBLE TABLE
	JMP I	PZNRM		/ EXIT IF NO ROOM
	ISZ	T1		/ |
	JMP	PRSNL5		/ END_LOOP

	JMP	PRSNXT		/ LOOK FOR 'OR MORE'
				/          'OR LESS'
				/	   'THROUGH'
				/      OR  'THRU'


/ OUTPUT A SIXBIT STRING (TERMINATED WITH A ZERO BYTE) TO THE SCREEN.
/ Code will lowercase all alphabetic characters and perform the following
/ character mapping if FORIN is defined:
/	open square bracket  to open curly bracket
/	backslash	     to close square bracket
/	close square bracket to close curly bracket
/
/ CALLED WITH:
/	JMS	OUTSTR
/	ADDR OF STRING
/	RETURN (AC= 0)
/
/ MAPCON defines which of the first "x" characters, starting with SIXBIT "A"
/ whould be mapped into lowercase.
/
/ LCMAP is the mapping constant for the above mapping function. It should be
/ set to 140 to map UPPER to lower case and set to 0 to disable this mapping.
/
MAPCON=33 			/ Last SIXBIT character mapped into UPPERCASE
/IFNDEF ENGLSH < MAPCON=36 >	/ Foreign includes the square brackets
IFNDEF GERMAN < LCMAP=140 >	/ Map UPPER into lower case
IFDEF GERMAN < LCMAP=100 >	/ If German, do not perform this mapping

OUTSTR,	XX			/ return address
	AC7777			/ GET STRING ADDR - 1
	TAD I	OUTSTR
	DCA	TAI1		/ AND LOAD IN AUTO-INDEX
	ISZ	OUTSTR		/ BUMP FOR RETURN
OTSTLP,	TAD I	TAI1		/ GET A WORD
	DCA	IOTMP		/ SAVE IT
	TAD	IOTMP
	BSW			/ GET LEFT BYTE
	AND	(77)
	SNA			/ ZERO BYTE?
	JMP I	OUTSTR		/ YES, RETURN
	TAD	(-MAPCON)	/ NO, SEE IF needs mapping
	SPA			/ NO, LEAVE ALONE
	TAD	(LCMAP)		/ YES, Map it into lowercase (or whatever)
	TAD	(MAPCON)	/ GET CHAR BACK
	JMS	OUTCHR		/ AND OUTPUT IT
	TAD	IOTMP		/ GET WORD BACK
	AND	(77)		/ GET RIGHT BYTE
	SNA			/ ZERO?
	JMP I	OUTSTR		/ YES, RETURN
	TAD	(-MAPCON)	/ NO, SEE IF needs mapping
	SPA			/ NO, LEAVE ALONE
	TAD	(LCMAP)		/ YES, Map it into lowercase (or whatever)
	TAD	(MAPCON)	/ GET CHAR BACK
	JMS	OUTCHR		/ AND OUTPUT
	JMP	OTSTLP		/ GET NEXT WORD

IOTMP,	0



/ THIS ROUTINE OUTPUTS ASCII CHARACTERS STORED IN THE WORDS FOLLOWING THE CALL
/ LAST ENTRY SHOULD BE NEGATIVE (I.E. AND 4000 TO LAST CHARACTER)
OSTRG,	XX
	CLA
OSTRGL,	TAD I	OSTRG		/ PICK UP CHAR
	JMS	OUTCHR		/ OUTPUT CHAR
	TAD I	OSTRG		/ GET CHARACTER BACK
	ISZ	OSTRG		/ BUMP FOR NEXT
	SPA CLA			/ CHECK FOR END
	JMP I	OSTRG		/ END - RETURN
	JMP	OSTRGL		/ DO NEXT CHAR



/ THIS ROUTINE COMPARES THE CHARACTER IN THE AC WITH MQ AFTER CONVERTING THE
/ CHARACTER IN THE MQ TO UPPER CASE IF NECESSARY.  SKIP RETURNS ON MATCH.

PCMPAR,	XX
	CIA			/ NEGATE FOR COMPARE
	DCA	PCMTMP		/ AND SAVE IN TMP
	MQA			/ GET THE MQ
	TAD	(-173)		/ SEE IF >173
	SMA
	JMP	PCUOK		/ YES, DON'T CHANGE
	TAD	(173-141)	/ SEE IF LOWER CASE
	SMA
	TAD	(-40)		/ YES, MAKE UPPER
	TAD	(141-173)	/ GET CHAR BACK
PCUOK,	TAD	(173)
	TAD	PCMTMP		/ SEE IF CHARS EQUAL
	SNA CLA
	ISZ	PCMPAR		/ YES, SKIP RETURN
	JMP I	PCMPAR		/ RETURN

PCMTMP,	0

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


BADNUM,	AC0002			/ BAD NUMBER IN A NUMERIC FIELD <:NAME>
	JMP ERRR		/
NOROOM,	AC0000			/ NO ROOM LEFT
	JMP ERRR		/
ERR,	AC0001			/ NOT UNDERSTOOD AT THIS POINT

ERRR,	DCA	ERRTYP
	ISZ	ERRCNT		/ BUMP ERROR COUNT

	JMS	OSTRG		/ OUTPUT A STRING
	BELL			/ RING BELL
	LF			/ LINE FEED
	10			/ BACK SPACE
	"^-200			/ UP ARROW
	CR			/ CARRIAGE RETURN
	LF			/ LINE FEED

	IFDEF ENGLSH <
	"E-200
	"R-200
	"R-200
	"O-200
	"R-200+4000		/ +4000 MEANS END OF STRING
	>
	IFDEF ITALIAN <
	"E-200
	"R-200
	"R-200
	"O-200
	"R-200
	"E-200+4000		/ +4000 MEANS END OF STRING
	>
	IFDEF CANADA <
	"E
	"R
	"R
	"E
	"U
	"R+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF FRENCH <
	"E
	"R
	"R
	"E
	"U
	"R+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF GERMAN <
	"F
	"E
	"H
	"L
	"E
	"R+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF DUTCH <
	"F
	"O
	"U
	"T+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF NORWAY <
	"F
	"E
	"I
	"L+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF SWEDSH <
	"F
	"E
	"L+4000			/ +4000 MEANS END OF STRING
	>
	IFDEF DANISH <
	"F
	"E
	"J
	"L+4000			/ +4000 MEANS END OF STRING
	>

	TAD	(ERRMTB)	/ GET ADDR OF MESSAGE
	TAD	ERRTYP
	DCA	T1
	TAD I	T1
	DCA	ERRMES
	JMS	OUTSTR		/ DISPLAY TYPE OF ERROR MESSAGE
ERRMES,	XX
	IFDEF FRENCH <
	JMS	FSPECL		/ Special french processing
	>
	IFDEF CANADA <
	JMS	FSPECL		/ Special Canadian processing
	>

MENRET,	JMS	OSTRG		/ OUTPUT STRING
	CR			/ CARRIAGE RETURN
	LF			/ LINE FEED
	LF+4000			/ ANOTHER LINE FEED, 4000 MEANS END OF STRING
	JMS	OUTSTR		/ GOLD MENU MESSAGE
	SPACE
	IFDEF ENGLSH < TAD	("P-200) >
	IFDEF ITALIAN< TAD	("P-200) >
	IFDEF CANADA < TAD	("A) >
	IFDEF FRENCH < TAD	("A) >
	IFDEF GERMAN < TAD	("M) >
	IFDEF SCANDI < TAD	("T) >

	IFNDEF DUTCH <		/ "Press" not used in dutch
	JMS	OUTCHR
	JMS	OUTSTR
	RESS
	>


IFNDEF	ITALIAN <TAD	("G-200)>
IFDEF	ITALIAN <TAD	("O-200)>
	JMS	OUTCHR
	JMS	OUTSTR
	OLD

	TAD	("M-200)
	JMS	OUTCHR
	IFDEF ENGLSH <		/ In english this is all UPPERCASE
	TAD	("E-200)
	JMS	OUTCHR
	TAD	("N-200)
	JMS	OUTCHR
	TAD	("U-200)
	JMS	OUTCHR
	>
	IFDEF ITALIAN <		
	TAD	("E-200)
	JMS	OUTCHR
	TAD	("N-200)
	JMS	OUTCHR
	TAD	("U-200)
	JMS	OUTCHR
	>
	IFDEF SCANDI <
	TAD	("E)
	JMS	OUTCHR
	TAD	("N)
	JMS	OUTCHR
	IFDEF NORWAY < TAD	("Y) >
	IFDEF SWEDSH < TAD	("Y) >
	IFDEF DANISH < TAD	("U) >
	JMS	OUTCHR
	>			/ END IFDEF SCANDI

	IFNDEF ENGLSH <	/ In Foreign languages this is only Capitalized
	IFNDEF SCANDI <
	IFNDEF ITALIAN<
	JMS	OUTSTR
	ENU
	>>>
	JMS	OUTSTR
	TORECA
	IFNDEF CANADA <
	IFNDEF FRENCH <	/ If not french then "MAIN MENU"
	IFNDEF ITALIAN<
	IFDEF ENGLSH < TAD	("M-200) >
	IFDEF DUTCH  < TAD	("H) >
	IFDEF GERMAN < TAD	("H) >
	JMS	OUTCHR
	JMS	OUTSTR
	AIN
	IFDEF ENGLSH <	TAD	("M-200) >
	IFDEF DUTCH < TAD	("M) >
	IFDEF GERMAN < TAD	("M) >
	IFDEF SCANDI < TAD	("H) >
	>>>			/ End IFNDEF FRENCH, CANADA, ITALIAN

	IFDEF CANADA < TAD	("M) >
	IFDEF FRENCH < TAD	("M) >
	IFDEF ITALIAN< TAD	("M-200) >
	JMS	OUTCHR
	JMS	OUTSTR
	ENU

	IFDEF CANADA <
	JMS	OUTSTR
	AIN
	>
	IFDEF FRENCH <		/ Else "MENU MAIN"
	JMS	OUTSTR		/ "principal" not capitalized
	AIN
	>
	IFDEF ITALIAN <
	JMS	OUTSTR
	AIN
	>

	JMS	OSTRG		/ CALL OUTPUT STRING ROUTINE
	ESC			/ START DIRECT CURSOR ADDRESS
	"[			/ ESC [ PL ; PC H
	"2			/ LINE 23
	"3
	";			/ 1 IS DEFAULT
	"H+4000			/ 4000 INDICATES END OF STRING

	JMP	INPUT		/ WAIT FOR GOLD MENU
WAIT,	CIFSYS			/ ++++
	JWAIT
INPUT,	CIFSYS			/ ++++
	XLTIN			/ ++++
	JMP	WAIT
	TAD	(-EDMENU)
	SNA CLA
	JMP	XIT
	TAD	(7)		/ OUTPUT BELL
	JMS	OUTCHR
	JMP	INPUT		/ AND KEEP LOOKING

ERRTYP,	0

CLS,	XX			/ ROUTINE TO PUT CURSOR HOME AND CLEAR
				/ THE SCREEN
	JMS	OSTRG		/ OUTPUT STRING
	ESC			/ ESCAPE
	"[			/ NEED [ IF ANSI
	"H			/ HOME THE CURSOR
	ESC			/ ESCAPE
	"[			/ NEED [ IF ANSI
	"J+4000			/ CLEAR TO END OF SCREEN (4000 MEANS
				/ END OF STRING
	JMP I	CLS		/ RETURN

/ This message only comes up when there is an error in a numeric field
/ number, i.e. <:name>

S0NUM,	IFDEF ENGLSH <TEXT '-- INVALID NUMBER SPECIFIED.'>
	IFDEF ITALIAN<TEXT '-- NUMERO ERRATO.'>

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE


S1SYN,
	IFDEF ENGLSH <
	TEXT '-- SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.'
	>
	IFDEF ITALIAN<
	TEXT '-- SPECIFICA NON COMPRESSA A PARTIRE DA QUESTO PUNTO.'
	>
	IFDEF CANADA <
	TEXT "-- SP[CIFICATION INCOMPRISE "
	>
	IFDEF FRENCH <
	TEXT "-- SP[CIFICATION INCOMPR[HENSIBLE "
	>
	IFDEF DUTCH < TEXT "-- SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT." >
	IFDEF GERMAN < TEXT "-- SPEZIFIKATION AB DIESEM PUNKT UNVERST[NDLICH" >/L.U.A
	IFDEF NORWAY <
	TEXT "-- SPESIFIKASJONEN IKKE FORST]TT FRA DETTE PUNKT." /L.D.A
	>
	IFDEF SWEDSH <
	TEXT "-- SPECIFIKATIONEN F\RST]S INTE FR]N DENNA PUNKT." /L.U.O, L.D.A, L.D.A
	>
	IFDEF DANISH <
	TEXT "-- SPECIFIKATION IKKE FORST]ET FRA DETTE PUNKT." /L.D.A
	>

S2NRM,
	IFDEF ENGLSH < TEXT '-- SPECIFICATION TOO LARGE.' >
	IFDEF ITALIAN< 
	TEXT '-- TROPPE CONDIZIONI NELLA SPECIFICA DI SELEZIONE.' >
	IFDEF CANADA < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E
	IFDEF FRENCH < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E
	IFDEF DUTCH < TEXT "-- SPECIFICATIE TE GROOT." >
	IFDEF GERMAN < TEXT "-- SPEZIFIKATION ZU LANG" >
	IFDEF NORWAY < TEXT "-- SPESIFIKASJONEN FOR STOR." >
	IFDEF SWEDSH < TEXT "-- SPECIFIKATIONEN F\R STOR." > /L.U.O
	IFDEF DANISH < TEXT "-- SPECIFIKATION FOR STOR." >

SPACE,
	IFNDEF DUTCH < TEXT '     ' >
	IFDEF DUTCH < TEXT '       ' >

RESS,
	IFDEF ENGLSH < TEXT 'RESS ' >
	IFDEF ITALIAN< TEXT 'REMERE ' >
	IFDEF CANADA < TEXT "PPUYER SUR " >
	IFDEF FRENCH < TEXT "PPUYER SUR " >
	IFDEF DUTCH <>		/ Not used in the Dutch
	IFDEF GERMAN < TEXT "IT " >
	IFDEF NORWAY < TEXT "RYKK " >
	IFDEF SWEDSH < TEXT "RYCK P] " > /L.D.A
	IFDEF DANISH < TEXT "RYK " >

OLD,
	IFDEF ENGLSH < TEXT 'OLD ' >
	IFDEF ITALIAN< TEXT 'RO ' >
	IFDEF CANADA < TEXT "OLD " >
	IFDEF FRENCH < TEXT "OLD " >
	IFDEF DUTCH < TEXT "OUD " >
	IFDEF GERMAN < TEXT "OLD " >
	IFDEF NORWAY < TEXT "UL " >
	IFDEF SWEDSH < TEXT "UL " >
	IFDEF DANISH < TEXT "UL " >

TORECA,
	IFDEF ENGLSH < TEXT ' TO RECALL THE ' >
	IFDEF ITALIAN< TEXT ' PER RICHIAMARE IL ' >
	IFDEF CANADA < TEXT "POUR RAPPELER LE " >
	IFDEF FRENCH < TEXT "POUR RAPPELER LE " >
	IFDEF DUTCH < TEXT " INTOETSEN VOOR " >
	IFDEF GERMAN < TEXT " ZUR]CK ZUM " > /L.U.U
	IFDEF NORWAY < TEXT " FOR ] F] " > /L.D.A, L.D.A
	IFDEF SWEDSH < TEXT " F\R ATT F] " > /L.U.O, L.D.A
	IFDEF DANISH < TEXT " FOR AT F] " > /L.D.A

AIN,
	IFDEF ENGLSH < TEXT 'AIN ' >
	IFDEF ITALIAN< TEXT 'PRINCIPALE.' >
	IFDEF CANADA < TEXT "PRINCIPAL." >
	IFDEF FRENCH < TEXT "PRINCIPAL" >/Not capitalized in French
	IFDEF DUTCH < TEXT "OOFD " >
	IFDEF GERMAN < TEXT "AUPT " >
	IFDEF NORWAY < TEXT "OVED" >
	IFDEF SWEDSH < TEXT "UVUD" >
	IFDEF DANISH < TEXT "OVED" >

ENU,
	IFDEF ENGLSH < TEXT 'ENU.' >
	IFDEF ITALIAN< TEXT 'ENU ' >
	IFDEF CANADA < TEXT "ENU " >
	IFDEF FRENCH < TEXT "ENU " >
	IFDEF DUTCH < TEXT "ENU" >
	IFDEF GERMAN < TEXT "EN]" >/L.U.U
	IFDEF NORWAY < TEXT "MENYEN." >
	IFDEF SWEDSH < TEXT "MENYN." >
	IFDEF DANISH < TEXT "MENUEN." >


XIT,	TAD	PARSE		/ GET RETURN ADDR
	DCA	T1		/ MAKE IT LOCAL
	CDIMNU			/ AND GET THE RIGHT FIELD
	JMP I	T1		/ BYE, BYE


NOERRT,	TAD	(15)		/ CR
	JMS	OUTCHR
	TAD	(12)		/ LF
	JMS	OUTCHR
	TAD	(12)		/ LF
	JMS	OUTCHR
	JMS	OUTSTR
	SPACE
	IFDEF ENGLSH <
	TAD	("N-200)
	JMS	OUTCHR
	>
	IFDEF ITALIAN <
	>
	IFDEF CANADA <
	TAD	("A)
	JMS	OUTCHR
	>
	IFDEF FRENCH <
	TAD	("P)
	JMS	OUTCHR
	>
	IFDEF GERMAN < >	/ All of the message is in OERR
	IFDEF DUTCH <
	TAD	("G)
	JMS	OUTCHR
	>
	IFDEF SCANDI <
	TAD	("I)
	JMS	OUTCHR
	>
	JMS	OUTSTR
	OERR
	JMP	MENRET

OERR,
	IFDEF ENGLSH < TEXT 'O ERRORS IN SPECIFICATION' >
	IFDEF ITALIAN< TEXT 'ERRORI NELLA SPECIFICA: 0' >
	IFDEF CANADA < TEXT "UCUNE ERREUR DANS LA SP[CIFICATION" > /L.A.E
	IFDEF FRENCH < TEXT "AS D'ERREUR DANS LA SP[CIFICATION" > /L.A.E
	IFDEF DUTCH < TEXT "EEN FOUTEN IN SPECIFICATIE." >
	IFDEF GERMAN < TEXT "KEINE FEHLER IN DER SPEZIFIKATION" >
	IFDEF NORWAY < TEXT "NGEN FEIL I SPESIFIKASJONEN" >
	IFDEF SWEDSH < TEXT "NGA FEL I SPECIFIKATIONEN" >
	IFDEF DANISH < TEXT "NGEN FEJL I SPECIFIKATION" >

	X=.			/ INDICATE FIRST FREE LOCATION ON PAGE
/------------------
	PAGE