Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/pscan.mac
There are 21 other files named pscan.mac in the archive. Click here to see a list.
; UPD ID= 756 on 1/14/83 at 9:30 AM by NIXON                            
TITLE	PSCAN FOR COBOL V13
SUBTTL	COBOL PICTURE SCANNER	AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL

;EDITS
;NAME	DATE		COMMENTS

;DMN	 1-Apr-82	[1347] Eliminate warning for PIC +,999 or -,999 caused by edit 1312.
;WTK	29-Jul-81	[1312] Warning for +,+++ or -,---
;DMN	25-Mar-81	[1124] Make PIC S(n) illegal.
;DMN	29-MAY-80	[1023] BACKUP TO PERIOD IN COPY REPLACING TEST.
;	30-JAN-76	[404] FIX COUNT OF ALLOWABLE CHARS IN EDITTED PICTURE
;	 9-DEC-76	[310] RE-INSERTED FIX ERROR CHECKING OF PIC CLAUSES.
;DBT	4/8/75		- DETECT  PIC +$++++..... AS ILLEGAL
;			- CHANGE ALL 9'S IN ALPHANUMERIC EDITED PICTURES
;			  INTO X'S
;DBT	4/14/75		- DETECT ZZZZ AS WELL AS ++++ AS BEING
;			  BLANK WHEN ZERO
;			- DETECT NON LEFT JUSTIFIED SIGN INSERT AS ILLEGAL
;DBT	6/6/75		- ALLOW +PPP999 AND 999PPPCR
;********************


;EDIT 211 ALLOW LC LETTERS IN A PICTURE CLAUSE

;A PICTURE IS CONVERTED INTO A MASK.
;INTERNAL SIZE, EXTERNAL SIZE AND DECIMAL LOCATIONS ARE CALCULATED.
;THE FEDIT, FSIGN, FBWZ AND CLASS FLAGS ARE SET IN "SW" AS APPROPRIATE.
;CONTENTS OF ALL OTHER ACCUMULATORS, EXCEPT LN & CP,  ARE SAVED.

;LN & CP ARE SET TO THE POSTION OF THE FIRST CHARACTER OF THE WORD.

ENTRY		PSCAN
EXTERNAL	GETKAR, GETCH, FATAL, FATALW
;THE VALIDITY OF THE MASK IS DETERMINED BY USING A
;  TRUTH TABLE. WHEN A CHARACTER IS PICKED UP, A
;  BIT IS SET IN ACCUMULATOR "TC" TO REPRESENT
;  ONE OF THE CONDITIONS SHOWN BELOW; AND ACCUMULATOR
;  "TA" IS SET TO POINT TO THE APPROPRIATE ENTRY IN
;  THE TRUTH TABLE. IF THAT ENTRY CONTAINS ANY BITS
;  MATCHING THOSE IN "PC", THE CHARACTER IS INVALID.
;"TC" IS THEN ORED INTO "PC".

;FLAGS FOR ACCUMULATOR "PC"
; 0 + OR - INSERT IS NOT LEADING	;18 P BEFORE 9,POINT
; 1 + FLOAT AFTER 9, POINT		;19 Z BEFORE 9, POINT
; 2 + INSERT AFTER 9, POINT		;20 * BEFORE 9, POINT
; 3 - FLOAT AFTER 9, POINT		;21 $ FLOAT BEFORE 9, POINT
; 4 - INSERT AFTER 9, POINT		;22 $ INSERT BEFORE 9, POINT
; 5 P AFTER POINT			;23 + FLOAT BEFORE 9, POINT
; 6 Z AFTER POINT			;24 + INSERT BEFORE 9, POINT
; 7 * AFTER POINT			;25 - FLOAT BEFORE 9, POINT
; 8 $ FLOAT AFTER POINT			;26 - INSERT BEFORE 9, POINT
; 9 $ INSERT AFTER POINT		;27 9
;10 + FLOAT BEFORE 9, AFTER POINT	;28 V
;11 + INSERT BEFORE 9, AFTER POINT	;29 S
;12 - FLOAT BEFORE 9, AFTER POINT	;30 A,X
;13 - INSERT BEFORE 9, AFTER POINT	;31 CR,DB
;14 + FLOAT AFTER 9, BEFORE POINT	;32 DECIMAL POINT
;15 + INSERT AFTER 9, BEFORE POINT	;33 COMMA
;16 - FLOAT AFTER 9, BEFORE POINT	;34 0
;17 - INSERT AFTER 9, BEFORE POINT	;35 B


;NON-STANDARD ACCUMULATORS USED
PC=3	;FLAGS REPRESENTING CHARACTERS ALREADY SEEN
PR=5	;CONTAINS REPEAT COUNTER
MP=6	;BYTE POINTER TO MASK WORDS
SP=7	;SAVE MP WHEN FIRST FLOATER SEEN
PICCNT=10	;COUNT NO. CHARACTERS IN PICTURE - 30 MAX
ST=11	;SAVE POINTER TO PICT2 TABLE

HI==TA	;HIGHEST ACCUMULATOR SAVED BY THIS ROUTINE

FOFF==FFLOAT!FSIGN!FCLAS1!FEDIT!FBWZ
PSCAN:	MOVEM	HI,SAVEAC+HI	;SAVE THE ACCUMULATORS
	MOVEI	HI,SAVEAC
	BLT	HI,SAVEAC+HI-1

	SWOFF	FOFF		;TURN OFF FLAGS
	SWON	FCLAS2;		;TURN ON ALPHABETIC FLAG
	MOVE	PC,[POINT 7,PICBUF##]
	MOVEM	PC,PICPTR##
	SETZM	PICBUF
	MOVE	PC,[PICBUF,,PICBUF+1]
	BLT	PC,PICBUF+6

	SETZB	PC,EXSIZE	;CLEAR COUNTERS
	SETZB	PR,INSIZE
	SETZM	DPSIZE
	MOVE	MP,MSKPTR
	SETZM	(MP)		;CLEAR SIGN AND FLOAT CHARACTERS, &
	MOVEI	PICCNT,^D30	;MAX NUMBER OF CHARACTERS IN PIC SOURCE
				;NO CHARACTERS TO REPEAT
	SETZM	FLOTBZ##
	TSWF	FREGCH		;[310] PASSED PIC TERMINATOR?
	JRST	PSCAN1		;[310] YES-OKAY SO FAR
	CAIE	CH," "		;[310] DID WE GET HERE VIA BLANK?
	JRST	PICERL		;[310] NO- THEN WE HAVE NO PICTURE

;SKIP OVER LEADING SPACES

PSCAN1:	PUSHJ	PP,GETCH	;GET A CHARACTER
	TSWF	FEOF;		;END OF INPUT?
	JRST	FINISH		;YES

	CAIN	CH," "		;NO--SPACE?
	JRST	PSCAN1		;YES--SKIP IT

	PUSHJ	PP,PCONVL	;[211] CONVERT LC-TO UPPER
	DMOVEM	LN,WORDLN

;CHECK FOR THE WORD "IS"

	CAIE	CH,"I"
	JRST	PSCN1B
	PUSHJ	PP,GETCPY
	CAIE	CH,"S"
	JRST	PICERD
	PUSHJ	PP,GETCPY
	CAIE	CH," "
	JRST	PICERD
PSCN1A:	PUSHJ	PP,GETCH
	CAIN	CH," "
	JRST	PSCN1A
	PUSHJ	PP,PCONVL	;[211] CONVERT LC-TO UPPER

PSCN1B:	MOVEM	CH,PICSAV	;SAVE CHARACTER
	DMOVEM	LN,SAVEAC+LN	;SAVE LN,CP
	DMOVEM	LN,WORDLN
	DMOVEM	LN,SAVLN1
	JRST	PSCN2A
;GET A PICTURE CHARACTER

PSCAN2:	MOVE	CH,PICSAV##	;RESTORE LOOKAHEAD CHARACTER
	PUSHJ	PP,GETCP0	;NOTE THAT WE ARE TAKING CHARACTER
	CAIE	CH," "		;END OF PICTURE?
	JRST	PSCN2A		;NO
	TSWF	FREGCH		;IF LOOKAHEAD IS ON (IT SHOULD BE)
	IDPB	CH,PICPTR	;STORE THE LOOKAHEAD CHAR, IT WILL BE REMOVED LATER
	JRST	FINISH		;GO TO END OF PIC STRING


PSCN2A:	TSWT	FEOF;		;END OF FILE?
	CAIN	CH,";"		;OR IS IT ";"
	JRST	FINISH		;YES

	CAIN	CH,","		;NO--IS IT ","
	JRST	PSCN2B		;YES
	CAIN	CH,"="		;COULD IT BE PSEUDO-TEXT?
	JRST	PSCAN3		;YES
	CAIE	CH,"."		;IS IT A PERIOD?
	JRST	PICS		;NO
	TSWF	FRTST		;[1023] ARE WE DOING A REPLACEMENT CHECK?
	PUSHJ	PP,SVPER	;[1023] YES, SAVE THE CURRENT INPUT BYTE PTR AND BYTE COUNT
				;[1023] SO WE CAN BACKUP TO JUST AFTER THE PERIOD
				;[1023] INCASE THERE WAS A CR-LF AFTER PERIOD

;IT IS PERIOD OR COMMA--SEE IF LAST CHARACTER

PSCN2B:	PUSHJ	PP,GETKAR	;LOOK AT NEXT CHARACTER
	CAIN	CH," "		;IS IT A SPACE?
	JRST	PSCAN4		;YES -- DONE
	TSWT	FEOF;		;NO--END OF FILE?
	JRST	PICS00

;TERMINATING CHARACTER SEEN

PSCAN4:	MOVE	CH,PICSAV	;GET CHAR BACK
	CAIE	CH,"."		;[1023] WAS IT PERIOD?
	JRST	FINISH		;[1023] NO
	SWON	FGTPER;		;YES--TELL GETWRD ROUTINE
	TSWT	FRTST		;[1023] ARE WE DOING A REPLACEMENT CHECK?
	JRST	FINISH		;[1023] NO
	MOVE	TE,R4BH0	;[1023] GET ORIGINAL BLOCK NUMBER
	CAMN	TE,RPLBLK	;[1023] SAME AS CURRENT?
	JRST	PSCN4A		;[1023] YES
	MOVEM	TE,RPLBLK	;[1023] THIS WILL SOON BE CURRENT
IFE TOPS20,<
	USETI	LIB,(TE)	;[1023] NO, RESET ON OLD BLOCK
	IN	LIB,		;[1023] AND READ IT IN
PSCN4A:	  SKIPA	TE,R4BH1	;[1023] OK, GET BYTE PTR
	JRST	GETLB9##	;[1023] ERROR
>
IFN TOPS20,<
	PUSHJ	PP,SFPLIB##	;SET FILE POINTER
	PUSHJ	PP,GETLBA##	;FILL BUFFER
PSCN4A:	MOVE	TE,R4BH1
>
	MOVEM	TE,LIBBH+1	;[1023] RESET IT
	MOVE	TE,R4BH2	;[1023]
	MOVEM	TE,LIBBH+2	;[1023] SAME FOR COUNT
	MOVE	CP,R4CPI	;[1023]
	MOVEM	CP,INPTCP	;[1023]
	MOVE	CP,R4CPO	;[1023] RESTORE CP
	MOVEM	CP,SAVECP	;[1023]
	MOVE	CH,[R4BH0,,L2BH0##]	;[1023] COPY INFO ABOUT PERIOD
	BLT	CH,L2CPI##	;[1023] TO WHERE INFO ABOUT NEXT SPACE IS STORED
	JRST	FINISH


PSCAN3:	SWON	FREGCH		;REGET = ON RETURN
	MOVEI	CH," "		;FAKE A SPACE
	JRST	FINISH		;AND GET OUT

;[1023] THIS ROUTINE IS SIMILAR TO SVPKAR IN GETITM
;[1023] IT SAVES THE LOCATION OF THE CHARACTER AFTER THE PERIOD
;[1023] IN CASE THAT IS A FAKE SPACE GENERATED BY A CR-LF

SVPER:	MOVE	CH,RPLBLK##	;[1023]	
	MOVEM	CH,R4BH0##	;[1023] SAVE CURRENT LIBRARY BLOCK #
	MOVE	CH,LIBBH##+1	;[1023] SAVE BYTE PTR AND COUNT
	MOVEM	CH,R4BH1##	;[1023]
	MOVE	CH,LIBBH+2	;[1023]
	MOVEM	CH,R4BH2##	;[1023]
	MOVE	CH,SAVECP	;[1023]
	ADDI	CH,1		;[1023] WE ACTUALLY WANT THE NEXT CHAR.
	MOVEM	CH,R4CPO##	;[1023] OUTPUT CHAR. POS.
	MOVE	CH,INPTCP##	;[1023]
	ADDI	CH,1		;[1023]
	MOVEM	CH,R4CPI##	;[1023] INPUT CHAR. POS.
	MOVE	CH,PICSAV	;[1023] JUST IN CASE IT MATTERS
	POPJ	PP,		;[1023]
;	WE HAVE A CHARACTER LETS LOOK AHEAD AND SEE IF THERE IS
;	A REPEAT FORTH COMMING

PICS:	PUSHJ	PP,GETKAR	;GET NEXT INPUT CHARACTER

;	ENTER HERE IF YOU ALREADY HAVE LOOKAHEAD CHARACTER

PICS00:	MOVEI	PR,1		;INITIALIZE REPEAT COUNT
	CAIN	CH,"("		;REPEAT???
	PUSHJ	PP,GETRP	;YES
	EXCH	CH,PICSAV	;SAVE LOOKAHEAD CHARACTER AND RESTORE CURRENT
;LOOK FOR CHARACTERS WITHOUT SPECIAL CHARACTERISTICS

	MOVSI	TA,-PICT1S	;SET UP IOWD TO SEARCH PICT1
PICS0:	HRRZ	TB,PICT1(TA)	;PICK UP CHARACTER FROM TABLE
	CAME	CH,TB		;DOES IT MATCH INPUT CHARACTER?
	AOBJN	TA,PICS0	;NO--LOOP UNTIL ALL OF TABLE SEEN

	JUMPG	TA,PICS1	;DID WE FIND ONE?
	HLRZ	TA,PICT1(TA)	;YES--RESET TA
	CAIE	CH,"A"		;IS IT "A"
	CAIN	CH,"B"		; OR "B"?
	 CAIA			;YES--THIS CHARACTER DOESN'T MAKE IT NON-ALPHABETIC
	SWOFF	FCLAS2;		;NO--RESET FLAG
	CAIE	CH,"*"		;IS IT "*"
	JRST	PICF		;NO
	PUSH	PP,TA		;SAVE IT
	SKIPN	TA,CURDAT##
	JRST	PICS01
	LDB	TA,DA.BWZ##	;SEE IF BLANK WHEN ZERO SET?
	SKIPE	TA		;WAS IT?
	EWARNW	E.701		;YES
PICS01:	POP	PP,TA
	JRST	PICF

;LOOK FOR "$" "," "."

PICS1:	SWOFF	FCLAS2;		;CANNOT BE ALPHABETIC
	MOVNI	TA,1
	CAMN	CH,DOLLR.##	;IS IT A CURRENCY SIGN?
	MOVEI	TA,16		;YES
	CAMN	CH,DCPNT.##	;NO--IS IT DECIMAL POINT?
	MOVEI	TA,07		;YES
	CAMN	CH,COMA.##	;NO--IS IT COMMA?
	MOVEI	TA,06		;YES
	JUMPG	TA,PICF		;WAS IT ANY OF THOSE?

;LOOK FOR "CR" OR "DB"

	CAIN	CH,"C"		;IS IT "C"?
	JRST	PICS2		;YES

	CAILE	PR,1		;REPEATING??
	JRST	PICERF		;YES -- ERROR
	CAIE	CH,"D"		;NO--IS IT "D"?
	JRST	PICERA		;NO--ERROR

	PUSHJ	PP,GETKAR	;YES--GET NEXT CHARACTER
	EXCH	CH,PICSAV	;SAVE IT AS LOOKAHEAD
	PUSHJ	PP,GETCP0	;NOTE THAT WE TOOK LAST CHAR
	CAIE	CH,"B"		;IS IT "B"?
	JRST	PICERF		;NO--ERROR
	MOVEI	TA,11		;YES--SET TABLE POINTER
	JRST	PICF

PICS2:
	CAILE	PR,1		;REPEATING??
	JRST	PICERF		;YES -- ERROR
	PUSHJ	PP,GETKAR	;IT IS "C"--GET NEXT CHARACTER
	EXCH	CH,PICSAV	;EXCHANGE WITH LOOKAHEAD
	PUSHJ	PP,GETCP0	;NOTE THAT WE TOOK IT
	CAIE	CH,"R"		;IS IT "R"?
	JRST	PICERF		;NO--ERROR
	MOVEI	TA,10		;YES--SET TABLE POINTER
;IT IS A PICTURE CHARACTER

PICF:	HLRZ	TB,PICT2(TA)	;GET BIT SETTINGS

	TRNN	TB,%P		;IS IT "P"?
	JRST	.+3		;NO
	SKIPN	INSIZE		;YES--ANY LEADING CHARACTERS?
	IORI	PC,%V		;NO--"V" IMPLIED

	SUBI	CH,40		;CONVERT CHARACTER TO SIXBIT


	MOVE	TC,TB

	TRNE	TB,%FLOAT	;CAN IT BE A FLOATER?
	PUSHJ	PP,FLOAT	;YES--GO SEE IF IT IS

	MOVE	ST,TA		;SAVE TABLE POINTER
	CAIN	TA,23		;CHECK FOR "/"
	MOVEI	TA,5		;AND HANDLE AS IF "0"

	TRNE	TB,%MINUS!%PLUS	;IS THIS A SIGN?
	TRNN	PC,%9		;YES--HAS 9 BEEN SEEN?
	JRST	PICF2		;NO
	LSH	TC,11		;YES--SHIFT BIT
	ADDI	TA,11		;ADD TO TABLE POINTER

PICF2:	TRNE	TB,%SPEC.	;IS THIS SPECIAL AFTER POINT?
	TRNN	PC,%.!%V	;YES--HAS POINT BEEN SEEN?
	JRST	PICF3		;NO
	LSH	TC,15		;YES--SHIFT BIT
	ADDI	TA,15		;ADD TO TABLE POINTER

PICF3:	TDNE	PC,PICT3(TA)	;IS CHARACTER LEGAL HERE?
	PUSHJ	PP,PICERB	;NO--ERROR
;IT IS A LEGAL CHARACTER IN THIS POSITION


	TDNN	TC,[%SB9]	;IS IT AN INSERT SIGN BEFORE  9
	JRST	PICF3A		;NO
	MOVE	TD,SAVCP1	;SAVE CHARACTER POS FOR FINISH: ERROR CHECK
	MOVEM	TD,SAVBCP	;BORROW SAVBCP TEMPORIARILY
	TDNE	PC,[%CHGEN]	;YES-- IS IT LEADING?
	TLO	PC,(%NOTLD)	;NO - SET FLAG

PICF3A:	IOR	PC,TC		;PUT FLAG IN PC

	TRNE	TB,%PLUS!%MINUS	;IS IT A SIGN?
	DPB	CH,MSKSYN	;YES--PUT IT IN SIGN POSITION

	TDNE	TC,[%FCHAR]	;NO--IS IT SUPPRESSION OR FLOAT?
	DPB	CH,MSKFLT	;YES--PUT IT IN FLOAT POSITION

	TRNN	TB,%S!%V!%P	;IS THIS S, P OR V?
	ADDM	PR,EXSIZE	;NO--ADD TO EXTERNAL SIZE

	TDNE	TC,[%CNTIN]	;DOES IT COUNT AS AN INTERNAL CHARACTER?
	ADDM	PR,INSIZE	;YES--ADD TO INTERNAL SIZE

	TRNE	PC,%.!%V	;IS IT AFTER DECIMAL POINT?
	TDNN	TC,[%CNTDP]	;IS IT A DECIMAL PLACE?
	JRST	.+2		;NO
	ADDM	PR,DPSIZE	;YES--ADD TO DECIMAL PLACES

	EXCH	PR,DPSIZE
	TRNE	TC,%PBP		;IS THIS A "P" BEFORE A "V"?
	SUB	PR,DPSIZE	;YES--DECREMENT DECIMAL PLACES
	EXCH	PR,DPSIZE

	TRNE	TB,%CRDB	;IS IT "CR" OR "DB"?
	AOS	EXSIZE		;YES--ADD TO EXTERNAL SIZE AGAIN

	MOVE	TE,EXSIZE	;PICTURE TOO LARGE?
	CAILE	TE,MAXWSS
	JRST	PICERC		;YES--ERROR

	TLNN	TC,%FAP		;NO--IS IT FLOAT OR SUPPRESS AFTER POINT?
	SKIPA	TE,PICT2(ST)	;NO--GET MASK BYTE FROM TABLE
	MOVEI	TE,PIC9		;YES--USE "9"
	TRNE	TB,%S!%P	;S AND P DON'T GO INTO MASK
	JRST	[		; CHECK FOR IMPLIED V AND IF SO PUT IN MASK
		TRNE	TB,%P		;IS IT P
		CAME	PR,INSIZE	;FIRST CHARACTER?
		JRST	PSCAN2		;NOT P OR NOT FIRST
					;HAVE IMPLIED V
		MOVEI	TE,PICV		;GET V MASK CODE
		MOVEI	PR,1		;BE SURE REPEAT IS 1
		JRST	.+1]
	; DO WE HAVE A REPEAT TO PUT IN
	CAIG	PR,1		;???
	JRST	PICF7		;NO REPEAT

	; INSERT REPEAT CODE
	; <REPEAT CODE><#BYTES FOR BINARY COUNT><BYTE 1>...

	TRNE	TE,NORPT	;CAN IT BE REPEATED???
	PUSHJ	PP,PICERB	;NO - ERROR

	MOVEI	TD,PICRPT	;REPEAT MASK CODE
	SOJL	PICCNT,PICERH	; [404] WILL IT FIT??
	IDPB	TD,MP		;OK - STORE IT

	PUSH	PP,TA		;SAVE A COUPLE REGS
	PUSH	PP,TB	
	MOVEI	TA,9		;MAX NO BYTES FOR BINARY NUMBER (4 BITS)
	MOVE	TB,[POINT 4,PR]	;POINTER TO NUMBER
PICF6:	ILDB	TD,TB		;GET A BYTE
	CAIN	TD,0		;IS IT NON-ZERO??
	SOJN	TA,PICF6	;NO - GET NEXT ONE

	;PUT COUNT OF BYTES IN
	SOJL	PICCNT,PICERJ	; [404] WILL IT FIT??
	IDPB	TA,MP		;OK  - STORE IT

	; NOW THE NUMBER ITSELF
PICF6A:
	SOJL	PICCNT,PICERJ	; [404] WILL BYTE FIT??
	IDPB	TD,MP		;OK - STORE IT
	ILDB	TD,TB		;GET ANOTHER
	SOJG	TA,PICF6A	;ANY LEFT??
	POP	PP,TB		;THATS ALL - RESTORE
	POP	PP,TA

	; STORE MASK CHARACTER CODE
PICF7:
	SOJL	PICCNT,PICERH	; [404] WILL IT FIT???
	IDPB	TE,MP		;OK - STORE IT
	JRST	PSCAN2		;TAKE IT FROM THE TOP
;ROUTINE TO GET AN INTEGER WITHIN PARENTHESES

GETRP:	PUSHJ	PP,GETCP0	;TAKE LOOKAHEAD CHARACTER
	MOVE	PR,PICSAV	;[1124] GET CURRENT CHARACTER
	CAIN	PR,"S"		;[1124] CHECK FOR COMMON ERROR (MISSING 9)
	EWARNW	E.647		;[1124] YES, TELL USER
	MOVEI	PR,0		;CLEAR RESULT

GETRP1:	PUSHJ	PP,GETCPY	;GET A CHARACTER
	CAIG	CH,"9"		;IS IT A DIGIT?
	CAIGE	CH,"0"
	JRST	GETRP2		;NO

	IMULI	PR,12		;YES--ADD TO RESULT
	ADDI	PR,-"0"(CH)

	CAIG	PR,MAXWSS	;IS IT > LIMIT?
	JRST	GETRP1		;NO--LOOP

	MOVEI	DW,E.316	;YES, GIVE ERROR
	DMOVE	LN,SAVLN1
	PUSHJ	PP,FATAL
	MOVEI	PR,1		;SET SIZE TO 1
GETRP4:	PUSHJ	PP,GETCPY	;GET A CHARACTER
	CAIG	CH,"9"		;IS IT A DIGIT?
	CAIGE	CH,"0"
	JRST	GETRP2		;NO
	JRST	GETRP4		;LOOP UNTIL WE GET OUT OF IT

GETRP2:	JUMPLE	PR,GETRP3	;ERROR IF SIZE NOT POSITIVE
	CAIN	CH,")"		;WAS TERMINATOR A RIGHT PAREN?
	PJRST	GETKAR		;YES, JUST TO GET IN SYNC

GETRP3:	POP	PP,(PP)		;RETURN TO CALLER'S CALLER.
	SETZM	PICSAV		;CLEAR OLD CHAR
	SKIPG	PR
	MOVEI	PR,1
	JRST	PICERA
;THIS ROUTINE DECIDES IF THIS CHARACTER IS A FLOATER.
;IF IT IS, APPROPRIATE ACTION IS TAKEN


FLOAT:	MOVEI	TE,%ALLSH	;HAS THIS FLOATER BEEN SEEN BEFORE?
	IMUL	TE,TB
	TDNN	PC,TE
	JRST	FLOAT5		;NO

FLOAT0:
	TSWFS	FFLOAT;		;YES--ARE WE ALREADY FLOATING?
	JRST	FLOAT4		;YES

	; CHECK FOR THE ILLEGAL CASE OF +$+++ 
	; AND CLEAR THE LEADING SIGN BIT WHILE YOU ARE AT IT

	TRNE	TB,%MINUS!%PLUS	;IS IT A SIGN?
	TLZE	PC,(%NOTLD)	;YES, CLEAR AND TEST NOT LEADING FLAG
	JRST	FLOAT1		;ITS NOT A LEADING SIGN
	TRNE	PC,%$		;LEADING- WAS THERE A $ INSERT
	JRST	PICERB		;YES-- ERROR

FLOAT1:	ANDCMI	PC,(TB)		;TURN OFF INSERT FLAG
	DPB	CH,MSKFLT	;PUT CHARACTER IN FLOAT POSITION


	TRNN	PC,%V!%.	;HAS DECIMAL POINT BEEN SEEN?
	CAIN	SP,0		;DO WE NEED TO SHIFT MASK
	JRST	FLOAT4		;YES--LEAVE MASK ALONE

;SHIFT MASK LEFT ONE POSITION TO GET RID OF FIRST FLOATER.

	MOVE	TD,SP		;GET POSITION OF FIRST FLOATER
	IBP	TD		;ADVANCE ONE BYTE

FLOAT2:	CAMN	TD,MP		;CURRENT POSITION?
	JRST	FLOAT3		;YES--DONE
	ILDB	TE,TD		;NO--MOVE A BYTE
	IDPB	TE,SP
	JRST	FLOAT2		;LOOP

FLOAT3:	MOVE	MP,SP		;RESET MP

FLOAT4:	LSH	TC,1		;SHIFT BIT
	AOJA	TA,CPOPJ##	;KICK UP TABLE POINTER AND SKIP

FLOAT5:	MOVE	SP,MP		;SAVE POINTER TO MASK POSITION

	CAIG	PR,1		;IN A REPEAT??
	POPJ	PP,		; N0 - RETURN
	AOS	EXSIZE		;ADD 1 TO MAKE UP FOR IT HERE
	MOVEI	SP,0		;CLEAR SO NO MASK SHIFT
	SOJA	PR,FLOAT0	;SUBTRACT 1 FOR FLOATER
;PICTURE HAS BEEN SCANNED

FINISH:	SKIPG	EXSIZE		;[310] DOES THIS PIC PRODUCE ANY SIZE?
	JRST	PICERK		;[310] NO - THEN WE HAVE NO PICTURE.
	;CHECK FOR SIGN IN MIDDLE WHICH COULD NOT BE CAUGHT BEFORE
	;LIKE 00+00

	TDNE	PC,[%SB9]	;SIGN INSERT BEFORE 9 ?
	TLNN	PC,(%NOTLD)	;YES - WAS IT LEADING?
	JRST	FINSHF		;[1312] OK - NO SIGN OR LEADING SIGN
	LDB	CH,MP		;NOT LEADING BUT IS IT TRAILING?
	CAIN	CH,PICIS	;CHECK LAST MASK CHARACTER AGAINST INSERT SIGN
	JRST	FINSHF		;[1312] OK - ITS TRAILING
	MOVE	CP,SAVBCP	;NAUGHTY NAUGHTY - GET SIGN POSITION
	MOVE	LN,SAVLN1
	MOVEI	DW,E.51		;INVALID PICTURE
	PUSHJ	PP,FATAL
	JRST	FINSH1		;[1312]

FINSHF:	LDB	CH,[POINT 8,MSKWRD,19]	;[1312] GET FIRST 2 MASK BYTES
	CAIN	CH,204		;[1312] IF SIGN AND COMMA,
	JRST	[LDB	CH,[POINT 4,MSKWRD,23]	;[1347] YES, GET NEXT CHAR
		CAIE	CH,10		;[1347] IS IT A FLOATING SIGN?
		JRST	FINSH1		;[1347] NO, ASSUME USE KNOWS WHAT HE IS DOING
		JRST	FIN0ER]		;[1347] YES, WARN USER OF STRANGE PICTURE
	LSH	CH,-4		;[1312] IF COMMA IS NOT FIRST
	CAIE	CH,4		;[1312]   AS IN +,+++ OR -,---
	JRST	FINSH1		;[1312]   ALL IS OK
FIN0ER:	MOVEI	DW,E.651	;[1312] OTHERWISE, WARN ABOUT NO SIG. DIGIT
	PUSHJ	PP,WARNW##	;[1312]  SPACE BEFORE COMMA

FINSH1:	SKIPN	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	JRST	FINSH0		;NO
	MOVE	CH,PICSAV	;GET TERMINATING CHAR
	CAIE	CH,","		;COMMA IS SPECIAL
	CAIN	CH,";"		;SO IS SEMI-COLON
	TRNA
	JRST	FINSH0		;NOT
	EXCH	LN,SAVLN1	;POINT TO TERMINAL CHARACTER
	EXCH	CP,SAVCP1	; NOT THE LOOKAHEAD ONE
	PUSHJ	PP,FLG.HI##	;TEST AT HIGH-INTERMEDIATE LEVEL
	EXCH	LN,SAVLN1
	EXCH	CP,SAVCP1
FINSH0:	MOVE	CH,SAVCP1	;GET CHARACTER POSITION OF LAST NON-BLANK
	ADDI	CH,1		;BUMP IT BY 1
	MOVEM	CH,SAVBCP	;THAT IS WHERE LAST BLANK WAS
	MOVE	CH,SAVLN1	;THIS IS WHERE
	MOVEM	CH,SAVBLN	;  LAST BLANK WAS

	MOVEI	CH,ENDPIC	;STASH A TERMINATOR IN MASK
	IDPB	CH,MP

	TSWF	FCLAS2;		;STILL ALPHABETIC?
	JRST	FINSH2		;YES

	TRNN	PC,%X		;NO--ANY "X" OR "A"?
	SWONS	FCLAS1;		;NO--IT IS NUMERIC
	SWOFFS	FCLAS1!FCLAS2	;YES--IT IS ALPHANUMERIC
	JRST	FINSH2		;FOR NUMERICS

;	FOR ALPHANUMERICS CHECK AND SEE IF THEY ARE EDITED AND THEN
;	CHANGE ALL 9'S TO X'S IF SO

	TDNN	PC,[%EDIT]	;HAVE WE SEEN ANY EDITING CHARACTERS?
	JRST	FINSH2		;NO

	MOVE	TA,MSKPTR	;GET STARTING MASK POINTER
	MOVEI	TB,PICXA	;SET UP X CODE
FINSH3:	ILDB	CH,TA		;GET MASK CHARACTER
	CAIE	CH,PICRPT	;REPEAT??
	JRST	FINSH4		;NO
	ILDB	CH,TA		;SKIP REPEAT - GET COUNT
	IBP	TA		;SKIP OVER IT
	SOJG	CH,.-1
	ILDB	CH,TA		;GET THE CHARACTER
FINSH4:	CAIN	CH,PIC9		;IS IT A 9 ??
	DPB	TB,TA		;YES - CHANGE IT TO AN X
	CAIE	CH,ENDPIC	; ARE WE DONE?
	JRST	FINSH3		;NOT YET


FINSH2:	TDNE	PC,[%SIGN]	;ANY SIGN?
	SWON	FSIGN;		;YES--SET FLAG

	TDNE	PC,[%FCHAR]	;ANY FLOAT OR SUPRESSION CHARS?
	SETOM	FLOTBZ		;SET POSSIBLE BLANK WHEN ZERO

	TRNE	PC,%9		;ANY 9'S SEEN?
	SETZM	FLOTBZ		;YES


	TDNE	PC,[%EDIT]	;ANY EDITING CHARACTERS?
	SWON	FEDIT;		;YES--SET FLAG

	MOVEM	SW,SAVEAC+SW	;SAVE SW

	MOVEI	TB,0
	LDB	TA,MSKSYN	;GET SIGN CHARACTER
	CAIN	TA,"-"-40	;IS IT MINUS?
	DPB	TB,MSKSYN	;YES--REPLACE WITH SPACE
	LDB	TA,MSKFLT	;GET FLOAT CHARACTER
	CAIE	TA,"-"-40	;IS IT MINUS?
	CAIN	TA,"Z"-40	;NO--IS IT "Z"?
	DPB	TB,MSKFLT	;YES--REPLACE WITH SPACE

	SUB	MP,MSKPTR	;COMPUTE MSKSIZ
	MOVEI	MP,1(MP)
	MOVEM	MP,MSKSIZ

	TSWT	FCLAS1		;IS IT NUMERIC?
	JRST	FINSH9		;NO
	MOVE	CH,INSIZE	;YES-- > 18 DIGITS?
	CAIG	CH,^D18
	JRST	FINSH5		;NO
	MOVEI	DW,E.330	;YES--ERROR
	PUSHJ	PP,FATALW
	MOVEI	CH,^D18		;JAM SIZE OF 18
	MOVEM	CH,INSIZE
	MOVE	CH,DPSIZE	;MORE THAN 18 DECIMAL PLACES, TOO?
	CAIG	CH,^D18
	JRST	FINSH9		;NO, OK NOW
	MOVEI	CH,^D18		;JUST QUIETLY STICK 18 IN HERE, TOO
	MOVEM	CH,DPSIZE	; 'CAUSE WE ALREADY COMPLAINED ABOUT IT
	JRST	FINSH9

FINSH5:	MOVE	CH,DPSIZE	;CHECK FOR TOO MANY DECIMAL PLACES IN ITEM
	CAIG	CH,^D18
	JRST	FINSH9		;NO, OK
	MOVEI	DW,E.602	; ?TOO MANY DECIMAL PLACES
	PUSHJ	PP,FATALW
	MOVEI	CH,^D18		;MAKE IT 18
	MOVEM	CH,DPSIZE
FINSH9:	MOVSI	HI,SAVEAC	;RESTORE ACCUMULATORS
	BLT	HI,HI-1
	MOVE	HI,SAVEAC+HI
	POPJ	PP,
;ERROR--INVALID PICTURE CHARACTER

PICERA:	MOVEI	DW,E.51
	JRST	PICER1

;ERROR--INVALID COMBINATION OF CHARACTERS

PICERB:	POP	PP,DW		;THROW AWAY A PP ENTRY
	MOVEI	DW,E.52
	JRST	PICER1

;ERROR--TOO LARGE A FIELD

PICERC:	MOVEI	DW,E.316

PICER1:	DMOVE	LN,SAVLN1
PICERR:	PUSHJ	PP,FATAL	;[310] PUT OUT A DIAGNOSTIC
PICER2:	MOVEM	CH,SAVEAC+CH	;SAVE THE CHARACTER
	SKIPN	CH,PICSAV	;LOOKAHEAD CHAR??
	PUSHJ	PP,GETCPY	;SCAN UNTIL SPACE SEEN
	SETZM	PICSAV		;DON'T LOOK AT THIS ANYMORE
PICER3:	CAIE	CH," "
	JRST	PICER2
	MOVE	CH,SAVEAC+CH	;GET BACK NEXT TO LAST CHARACTER
	CAIN	CH,"."		;WAS IT A PERIOD?
	SWON	FGTPER		;YES--SET "GET A PERIOD" FLAG
	JRST	FINSH1		;SKIP ERROR CHECK AT BEGINNING OF FINISH

;ERROR--WORD STARTED WITH "I" BUT WAS NOT "IS"

PICERD:	MOVEM	CH,SAVEAC+CH
	MOVEI	DW,E.182
	PUSHJ	PP,FATALW
	SETZM	PICSAV		;NO LOOKAHEAD CHARACTER
	JRST	PICERG



;ERROR--"C" OR "D" NOT FOLLOWED BY PROPER CHARACTER

PICERF:	DMOVE	LN,SAVLN1
	MOVEM	CH,SAVEAC+CH
	MOVEI	DW,E.51
	PUSHJ	PP,FATAL
PICERG:	MOVE	CH,SAVEAC+CH
	JRST	PICER3

;ERROR--PICTURE TOO LARGE

PICERJ:	POP	PP,TB		; [402] RESTORE PUSH DOWN POINTER
	POP	PP,TA		; [402] BEFORE GIVING ERROR
PICERH:	MOVEI	DW,E.72
	JRST	PICER1
; ERROR NO PICTURE - BECAUSE PIC DELIMITER NOT A SPACE - PROBABLY A PERIOD.
PICERL:	MOVEI	DW,E.220	;[310] PICTURE REQUIRED
	DMOVE	LN,SAVELN	;[310] GET SOURCE LINE & POSITION
	JRST	PICERR		;[310] PUT OUT DIAGNOSTIC

; ERROR NO PICTURE BECAUSE DESCRIPTION PRODUCED NO SIZE.
PICERK:	MOVEI	DW,E.220	;[310] PICTURE REQUIRED
	DMOVE	LN,SAVLN1	;[310] GET LINE & POSITION
	PUSHJ	PP,FATAL	;[310] GIVE FATAL ERROR.
	JRST	FINSH1		;[310] FINISH UP

;GET A CHARACTER, IF THE CHARACTER IS NOT A SPACE
;CONVERT TO UPPER CASE, SAVE LINE AND CHARACTER POSITION.

GETCPY:	PUSHJ	PP,GETKAR

;ENTRY TO SAY YOU HAVE TAKEN CHARACTER WHEN YOU ALREADY HAVE IT
GETCP0:	CAIN	CH," "
	POPJ	PP,

PCONVL:	IDPB	CH,PICPTR	;[211] STORE ACTUAL CHAR.
	CAIL	CH,"a"		;[211] CONVERT LC A-Z TO UC
	CAILE	CH,"z"	 	;[211]
	CAIA			;[211]
	TRZ	CH,40		;[211] CHANGE LC TO UPPER
	MOVEM	LN,SAVLN1
	MOVEM	CP,SAVCP1
	POPJ	PP,
;CONSTANTS USED BY ROUTINE

FLTIND=3			;THE MASK BYTE FOR A FLOAT
ENDPIC=17			;THE MASK BYTE FOR PICTURE TERMINATION
PICXA=00			;THE MASK BYTE FOR "X" OR "A"
PICIS=10			;THE MASK BYTE FOR SIGN INSERT
PIC9=01				;THE MASK BYTE FOR "9"
PICRPT=16			;REPEAT MASK CODE
PICV=14				;V MASK CODE
	
MSKPTR:	POINT	4,MSKWRD,11	;BYTE POINTER TO FIRST MASK BYTE
MSKSYN:	POINT	6,MSKWRD,5	;BYTE POINTER TO SIGN CHARACTER
MSKFLT:	POINT	6,MSKWRD,11	;BYTE POINTER TO FLOAT OR SUPPRESSION CHARACTER


EXTERNAL	INSIZE, EXSIZE, DPSIZE, MSKWRD, MSKSIZ, SAVEAC, MAXWSS
EXTERNAL	WORDCP, WORDLN, SAVCP1, SAVLN1, SAVBCP, SAVBLN, SAVELN, SAVECP
;THE FOLLOWING ARE BITS SET BY THE SCANNER

%NOTLD=1B0	;IF SET THE FIXED INSERT SIGN BEFORE 9 OR . IS NOT LEADING
%P=1B18		;FOR "P"
%Z=1B19		;FOR "Z"
%STAR=1B20	;FOR "*"
%$=1B22		;FOR CURRENCY SIGN
%PLUS=1B24	;FOR "+"
%MINUS=1B26	;FOR "-"
%9=1B27		;FOR "9"
%V=1B28		;FOR "V"
%S=1B29		;FOR "S"
%X=1B30		;FOR "X" AND "A"
%CRDB=1B31	;FOR "CR" AND "DB"
%.=1B32		;FOR "."
%COMMA=1B33	;FOR ","
%0=1B34		;FOR "0"
%B=1B35		;FOR "B"

;THE FOLLOWING ARE USEFUL COMBINATIONS

%ZSTAR=%Z!%STAR			;THE SUPPRESSION CHARACTERS
%FLOAT=%PLUS!%MINUS!%$		;THE FLOATING CHARACTERS
%SPECI=%B!%0!%COMMA		;SPECIAL INSERTION CHARACTERS
%SPEC.=%ZSTAR!%FLOAT!%P		;TREATED DIFFERENTLY AFTER DECIMAL POINT

;SOMETIMES THE BITS ARE SHIFTED BY FOLLOWING AMOUNTS

SHIFTF=2			;WHEN A FLOAT CHARACTER
SHIFT9=1000			;WHEN AFTER A "9"
SHIFT.=20000			;WHEN AFTER THE DECIMAL PLACE
%ALLSH=<SHIFT.+1>*<SHIFTF+1>	;POSSIBLE SHIFTS FOR FLOATER

;MORE USEFUL COMBINATIONS

%SB9=<%PLUS!%MINUS>*<1!SHIFT.>	;SIGN BEFORE 9
%SA9=%SB9*SHIFT9		;SIGN AFTER 9
%SBP=<%PLUS!%MINUS>*SHIFTF	;SIGN FLOATED BEFORE DECIMAL POINT
%SAP=%SBP*SHIFT.		;SIGN FLOATED AFTER DECIMAL POINT
%ZBP=%Z!%STAR			;SUPPRESSION BEFORE DECIMAL POINT
%ZAP=%ZBP*SHIFT.		;SUPPRESSION AFTER DECIMAL POINT
%$BP=%$*SHIFTF			;CURRENCY SIGN FLOATING
%$AP=%$BP*SHIFT.		;CURRENCY SIGN FLOATING AFTER POINT (ILLEGAL)
%PAP=%P*SHIFT.			;"P" AFTER A DECIMAL POINT
%PBP=%P				;"P" BEFORE A DECIMAL POINT
%FCHAR=%ZBP!%ZAP!%SBP!%SAP!%$BP!%$AP	;A SUPPRESSION OR FLOAT CHARACTER
%FAP=<%SAP!%ZAP!%$AP>/1000000	;FLOATING OR SUPPRESSION AFTER POINT
%SIGN=%SB9!%SA9!%SBP!%SAP!%CRDB!%S	;ALL SIGNS
%EDIT=-1-<%PBP!%PAP!%9!%V!%S!%X>	;CHARACTERS WHICH CAUSE EDITING
%CNTIN=%9!%X!%FCHAR		;THESE COUNT AS INTERNAL CHARACTERS
%CNTDP=%9!%FCHAR!%PAP		;THESE COUNT AS DECIMAL PLACES
;%FB9AP=%FLOAT*SHIFT./1000000	;+, - OR $ BEFORE 9 BUT AFTER POINT
%CHGEN=-1-<%PAP!%PBP!%V!%S>	;THINGS WHICH DEFINE CHARACTERS IN DESTINATION FIELD
;A TABLE  OF ALLOWABLE CHARACTERS WITHOUT SPECIAL CHARACTERISTICS
;	LH IS RELATIVE POSITION OF ENTRY IN PICT2 AND PICT3.
;	RH IS THE CHARACTER IN ASCII

PICT1:	XWD	00,"X"	;X
	XWD	01,"9"	;9
	XWD	02,"V"	;V
	XWD	14,"-"	;-
	XWD	03,"S"	;S
	XWD	20,"Z"	;Z
	XWD	21,"*"	;*
	XWD	12,"+"	;+
	XWD	04,"B"	;B
	XWD	05,"0"	;0
	XWD	00,"A"	;A
	XWD	22,"P"	;P
	XWD	23,"/"	;/
PICT1S=.-PICT1


;A TABLE OF MASK VALUES AND INITIAL BIT SETTINGS
;	LH IS INITIAL BIT SETTING FOR "PC"
;	RH IS THE MASK VALUE FOR THE CHARACTER.

NORPT=1B18			;CHARACTER CANNOT BE REPEATED

PICT2:	XWD	%X,00		;X AND A
	XWD	%9,01		;9
	XWD	%V,14!NORPT	;V
	XWD	%S,00!NORPT	;S (NOT USED IN MASK)
	XWD	%B,05		;B
	XWD	%0,06		;0
	XWD	%COMMA,04	;COMMA
	XWD	%.,11!NORPT	;DECIMAL POINT
	XWD	%CRDB,12!NORPT	;CREDIT
	XWD	%CRDB,13!NORPT	;DEBIT
	XWD	%PLUS,10!NORPT	;+ INSERT
	XWD	0,FLTIND	;+ FLOATED
	XWD	%MINUS,10!NORPT	;- INSERT
	XWD	0,FLTIND	;- FLOATED
	XWD	%$,07!NORPT	;CURRENCY SIGN INSERT
	XWD	0,FLTIND	;$ FLOATED
	XWD	%Z,02		;Z
	XWD	%STAR,02	;*
	XWD	%P,00		;P (NOT USED IN MASK)
	XWD	%0,15		;/
VALAP==%PAP!%ZAP!%SAP!%$AP
VALBP==%PBP!%ZBP!%SBP!%$BP
VALS1==1+SHIFT.
VALS2==SHIFTF*VALS1
VALX1==%SPECI!%.!%$!%PAP!%V
VALX2==%SPECI!%.!%SB9!%PAP!%V

; THE TRUTH TABLE

DEFINE FALSE (A), <EXP A>			;THESE FLAGS ARE NOT ALLOWED

DEFINE TRUE (A),<EXP -1-A>			;THESE FLAGS ARE ALLOWED

DEFINE TPICT3,<
XLIST

TRUE  <%B!%0!%X!%9>				;X,A
FALSE <%SA9!%CRDB!%PBP!%ZAP!%SAP!%$AP!%NOTLD>	;9
FALSE <%.!%X!%PAP!%V!%ZAP!%SAP!%$AP>		;V
TRUE 0						;S
FALSE <%SA9!%CRDB!%PBP!%S>			;B
FALSE <%SA9!%CRDB!%PBP!%S>			;0
FALSE <%SA9!%CRDB!%X!%PBP!%S>			;COMMA
TRUE <%SPECI!%SB9!%$!VALBP!%9!%NOTLD>		;DECIMAL POINT
FALSE <%SIGN!%X>				;CR
FALSE <%SIGN!%X>				;DB
FALSE <%SIGN!%X>				;INSERT + BEFORE 9,.
TRUE  <%SPECI!%$!<%PLUS*SHIFTF>!%NOTLD>		;FLOAT + BEFORE 9,.
FALSE <%SIGN!%X>				;INSERT - BEFORE 9,.
TRUE  <%SPECI!%$!<%MINUS*SHIFTF>!%NOTLD>	;FLOAT - BEFORE 9,.
TRUE  <%SPECI!%SB9!%PAP!%V>			;INSERT $ BEFORE 9,.
TRUE  <%SPECI!%SB9!%$BP>			;FLOAT $ BEFORE 9,.
TRUE  <%SPECI!%SB9!%$!%Z>			;Z BEFORE POINT
TRUE  <%SPECI!%SB9!%$!%STAR>			;* BEFORE POINT
FALSE <%.!%X!%V!VALAP!%NOTLD>			;P BEFORE POINT
FALSE <%SIGN!%X>				;INSERT + AFTER 9, BEFORE .
TRUE 0						;FLOAT + AFTER 9, BEFORE .
FALSE <%SIGN!%X>				;INSERT - AFTER 9, BEFORE .
TRUE 0						;FLOAT - AFTER 9, BEFORE .
FALSE <%SIGN!%X>				;INSERT + BEFORE 9, AFTER .
TRUE	<VALX1!<%PLUS*VALS2>!%NOTLD>		;FLOAT + BEFORE 9, AFTER .
FALSE <%SIGN!%X>				;INSERT - BEFORE 9, AFTER .
TRUE	<VALX1!<%MINUS*VALS2>!%NOTLD>		;FLOAT - BEFORE 9, AFTER .
TRUE  <%SB9!%PAP!%V!%.>				;INSERT $ BEFORE 9, AFTER .
TRUE	<VALX2!%$BP!%$AP>			;FLOAT $ BEFORE 9, AFTER .
TRUE	<VALX2!%$!<%Z*VALS1>>			;Z AFTER POINT
TRUE	<VALX2!%$!<%STAR*VALS1>>		;* AFTER POINT
TRUE  <%PAP!%S!%V!%$!%PLUS!%MINUS>		;P AFTER POINT
FALSE <%SIGN!%X>				;INSERT + AFTER 9,.
TRUE 0						;FLOAT + AFTER 9,.
FALSE <%SIGN!%X>				;INSERT - AFTER 9,.
TRUE 0						;FLOAT - AFTER 9,.


LIST>

PICT3:	TPICT3;

END