Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	MTHPRM,FORPRM
	TV	FORFMT	FORMAT PROCESSOR,11(4242)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


COMMENT \

***** Begin Revision History *****

1100	JLC	New

1164	CKS	27-Oct-80
	Prevent TL from going off left end of record

1207	JLC	19-Dec-80
	Prevent %%GETIO from substituting REAL for COMPLEX for
	list-directed I/O

1215	JLC	6-Jan-81
	SFDEL was dropping off the end into dollar format. Inserted a
	POPJ. Edit revhist actually inserted 9-Feb-81, was lost.

1230	JLC	20-Jan-81
	Increased size of repeat count to 9 bits, decreased size of
	exponent field to 3 bits.

1306	DAW	26-Feb-81
	New arg list format from %SAVE

1321	DAW	6-Mar-81
	More changes for extended addressing support.

1324	EDS	9-Mar-81	Q20-01396
	Add an encoding address for DOLLAR ($) and COLON (:) format
	so that ($10A5) is not treated as ($10,A5).  These should
	use the same encoding as SLASH (/) format.

1334	DAW	12-Mar-81
	Use new macros $BLDBP, $LODBP, $STRBP to clean up the code.

1416	JLC	10-Apr-81
	Q format must use IRBUF.

1464	DAW	12-May-81
	Error messages.

1467	CKS	18-May-81
	Change EXTADD to I.EXT, change TITLE to FORFMT to correspond to
	file name

1473	CKS	21-May-81
	Error message fixes.

1521	JLC	26-Jun-81
	Fix formatted EOF processing: in input loop, check if pending
	EOF. If so, toss rest of I/O list.

1532	DAW	14-Jul-81
	OPEN rewrite: Base level 1

1535	JLC	14-Jul-81
	Remove EOF handling from here, now handled in %DOIO.

1552	DMN	21-Jul-81
	Performance enhancements.

1562	DMN	28-Jul-81
	Performance enhancements.

1566	JLC	29-Jul-81
	Add error diagnostics for digits with no formats, any repeat
	count for $,/,Q, etc.

1575	JLC	05-Aug-81
	Edit 1566 was too all-inclusive, made repeat count of left
	paren break. Fix by making left paren not a delimiter,
	then check in left paren routine for previous format.

1600	DAW	11-Aug-81
	Allow "X" to mean "1X" (as it used to!)

1605	JLC	12-Aug-81
	Fix ambiguous (A419X) to be error. Fix T to be a delimiter.

1615	DAW	19-Aug-81
	Get rid of two word BP option.

1622	JLC	21-Aug-81
	Fix Q format encoding, was accumulating digits after it.
	Fix no-comma syntax, compile prev format if leftover
	format char.

1625	DAW	21-Aug-81
	Get rid of "DF".

1705	JLC	11-Sep-81
	Fixed serious T-format bug. Now send %SPOS position desired
	for next character (minimum 1) so that ORVIR in %OBYTE will
	never have zero for a positioning command.

1730	JLC	18-Sep-81
	Another bug fix for T-format. Sped up format encoding by
	eliminating FMTSS and using a local stack instead.

1775	JLC	9-Oct-81
	Fix X format. Was being truncated to 8 bits.

2033	JLC	15-Nov-81
	Make "Data in IO list but not in format" go to %ABORT.
	Fix A free format.

***** Begin Version 6A *****

2045	EGM	18-Mar-82
	Allow error ARC (Ambiguous repeat count in FORMAT) to continue.

***** Begin Version 7 *****

3006	AHM/JLC	29-Oct-81
	When storing the indefinite repeat pointer (%FMRPT) in LPRENC,
	use an XMOVEI to generate a global address.

3012	JLC	5-Nov-81
	Changes for new arg copier - A.FMS is an address of the
	size of the format.

3014	JLC	5-Nov-81
	Added flag (SKPFLG) to stop skipping for delimiters
	with free-format A. Simplified %%GETIO.

3023	JLC	15-Nov-81
	Make fatal error msg "Data in IO list but not in format" go
	to %ABORT.

3031	JLC	11-Dec-81
	Modify format encoder to get format size from word before format
	if there is no size in the arg block (i.e., if the address containing
	the value is zero).

3035	JLC	5-Feb-82
	Rework of arg passing mechanism. Coroutine now isolated to this
	module.

3056	JLC	23-Mar-82
	Implement 2-word encoded formats, along with encoding in a fixed
	area (expandable) and allocating separately. Implemented range-
	checking, and format/type checking (warning if minor conflict,
	hard error if character variable and other than A or G format).

3061	JLC	25-Mar-82
	Catch Hollerith and quoted string input to character formats -
	now illegal. Make sure the encoded list pntr can't overflow
	on left parens.

3064	JLC	26-Mar-82
	Implement new range-checking mechanism, simple one just would
	not do.

3065	JLC	26-Mar-82
	Fix format encoder to drop relative addresses in links and
	indefinite repeat pointer, as the encoded format is moved
	after it is encoded.

3077	JLC	5-Apr-82
	Fix format encoder to do all calculations involving indefinite
	repeat and links as relative addresses - recursive calls across
	format buffer expansions caused bad links.

3122	JLC	28-May-82
	Output warning message for Hollerith and quoted string input.

3131	JLC	11-Jun-82
	Fix Iw.m, was accumulating default value instead of clearing
	it upon getting period.

3136	JLC	26-Jun-82
	Give user value of bad variable for format/variable mismatch.
	Do some entry code optimization. Make ENC.LR available for
	alphabetic I/O optimization.

3175	JLC	8-Sep-82
	Fix SAVFMT, was not initializing FMT.BG.

3202	JLC	26-Oct-82
	Fix SAVFMT/CLRFMT so they don't use the descriptor address
	for hashing, since it can be a Q-temp.

3225	JLC	24-Nov-82
	Change SIXVRT so it converts tabs to spaces.

3231	JLC	14-Dec-82
	Fix type mismatch check so it catches TP%LIT going to
	other than alphabetic

3250	JLC	7-Jan-83
	Pay attention to number of args in SAVFMT.

***** End V7 Development *****

3266	JLC	11-Feb-83
	Allows FOROTS to be protected execute-only on TOPS-10.

3426	TGS	23-Apr-84	SPR:20-20087
	When diagnosing repeat count overlow at DIGENC, the wrong AC
	was being used to index off the state table.

3457	TGS	3-Jan-85	SPR:20-20501
	Using O-format with character variables is not allowed.  Add a
	better format/variable mismatch test for this case.


***** Begin Version 10 *****

4000	JLC	22-Feb-83
	Fix execute-only bug on -10. Enhance performance a bit.

4001	JLC	23-Feb-83
	Fix overlay program bug.

4004	JLC	24-Feb-83
	Fix bug in performance enhancements.

4005	JLC	28-Feb-83
	More code enhancements.

4010	JLC	19-Apr-83
	Clear temp flags for formatted I/O here instead of in FORIO.

4020	PLB	23-Jun-83
	Use global IOPDL if running in a non-zero section.

4023	JLC	29-Jun-83
	Use global constants for BZ and SP format, rather than flags
	in FLAGS.

4027	JLC	6-Jul-83
	Reinsert line to clear IO.ADR at FMTEXC. We have not yet
	removed the coroutine!

4044	JLC	19-Sep-83
	Added new function to deallocate all encoded formats and the
	format encoding area. Added new flag to avoid saving encoded
	formats.

4047	JLC	5-Oct-83
	Minor performance enhancements.

4051	JLC	6-Oct-83
	Fix edit 4047. Make colon format legal again.

4052	JLC	12-Oct-83
	Record format data type in %FMTSV. Code changes for formatted
	I/O performance enhancement.

4054	JLC	25-Oct-83
	Fix code change in edit 4052, was getting format size
	incorrectly.

4066	JLC	11-Jan-84
	Preparations for RMS.

4105	JLC	28-Feb-84
	Modify the calling sequence for error calls.

4111	JLC	16-Mar-84
	Modify the calling sequence for error calls again.

4122	JLC	2-May-84
	Fix a bug in %DEFMT, assumed there was always a %FAREA.

4131	JLC	12-Jun-84
	Add memory full non-skip return to %GTBLK and %MVBLK calls.

4146	MRB	11-Sep-84
	Insert code to perform compatibility flagging for the "G"
	format specifier. 

***** End V10 Development *****

4223	RJD	18-Sep-85
	Add code to flag for VAX incompatibility when formats with
	default widths are used.

4231	RJD	14-Nov-85
	Correction to edit 4223.  Change CALL to PUSHJ P because
	CALL on TOPS-10 no longer assembles as a PUSHJ P.

4233	RJD	18-Nov-85
	Check for a valid address for a format statement.

4242	RJD	21-Jan-86
	Correction to edit 4223.  Move the check for FORMAT 
	descriptors using default widths so other descriptors
	followed by a blank are not issued the warning.

***** End Revision History *****
\

	ENTRY	%IFSET,%OFSET,%DEFMT
	ENTRY	%FMTSV,%FMTCL,%IFORM,%OFORM

	EXTERN	%FLIDX,%OBYTE,%IBYTE,%IBYTC,%SETAV	;[4146]
	EXTERN	%RIPOS,%ROPOS,%SIPOS,%SOPOS,%CIPOS,%COPOS,%MVBLK
	EXTERN	%ALPHI,%ALPHO,%DIRT,%DOUBT,%ERIN,%EOUT,%FLIRT,%FLOUT
	EXTERN	%LINT,%LOUT,%GRIN,%GROUT,%INTI,%INTO,%RIGHI,%RIGHO
	EXTERN	%GLINT,%GLOUT,%GINTI,%GINTO,%GOCTI,%GOCTO
	EXTERN	%OCTI,%OCTO,%HEXI,%HEXO,%SIZTB,%UNFXD
	EXTERN	%GTBLK,%FREBL,%SAVE4,%IBACK,%OVNUM,%OVPRG
	EXTERN	%ABORT,%POPJ,%POPJ1
	EXTERN	FMT.LS,%FAREA,%FTSLB,%SPFLG,%BZFLG,%SVFMT
	EXTERN	A.FMT,A.FMS

	INTERN	%SCLFC,USR.AD,USR.SZ,ENC.WD,ENC.W2,ENC.LR
	INTERN	FMT.BG,FMT.BP,FMT.SZ
	INTERN	%FWVAL,%DWVAL,%XPVAL

;ENCODED FORMAT BLOCK PARAMS
%FMTNX==0			;NEXT ENCODED FORMAT ADDR
%FMTAD==1			;ACTUAL ADDR OF FORMAT STATEMENT
%FMTOV==2			;OVERLAY NUMBER
%FMTYP==3			;FORMAT TYPE
%FMTRP==4			;INDEFINITE REPEAT PNTR
%FMTEN==5			;FIRST WORD OF ENCODED FORMAT

DATFLG==1,,0			;DATA READ OR WRITTEN
FDFLG==2,,0			;FORMAT DELIMITER
REGFLG==4,,0			;REGISTER FORMAT CHARACTER
IGNFLG==10,,0			;IGNORE CHARACTER
IOLFLG==20,,0			;I/O LIST ENTRY NEEDED
SKPFLG==40,,0			;CALL SFDEL AFTER FREE-FORMAT INPUT
CNCFLG==100,,0			;COMPILE FORMAT IMMEDIATELY, NO WIDTH CHECK
DRFLG==FDFLG+REGFLG		;DELIMITER+REGISTER
DRIFLG==DRFLG+IOLFLG		;DELIMITER+REGISTER+I/O LIST ENTRY
DTIFLG==DATFLG+REGFLG+IOLFLG	;DATA+REGISTER+I/O LIST ENTRY
DTISFL==DTIFLG+SKPFLG		;DATA+REGISTER+I/O LIST ENTRY+CALL SFDEL

	SEGMENT	DATA

;FOR RECUSIVE I/O (I/O WITHIN I/O), THESE SHOULD BE
;DDB BLOCK VARIABLES - USED DURING EXECUTION
FMT.LK:	BLOCK	1	;PNTR TO ENCODED LEFT PAREN
%SCLFC:	BLOCK	1	;SCALE FACTOR
ENC.AD:	BLOCK	1	;ADDRESS OF CURRENT ENCODED FORMAT
ENC.PT:	BLOCK	1	;FORMAT LIST POINTER
ENC.LR:	BLOCK	1	;LOCAL REPEAT COUNT

;LOCAL VARIABLES - USED BY THE FORMAT ENCODER AND/OR AS TEMPS
;BY THE FORMAT EXECUTION
FMFRST:	BLOCK	1	;RELATIVE ADDR OF 1ST LEFT PAREN
FASIZE:	BLOCK	1	;FORMAT AREA SIZE
FMTSTA:	BLOCK	1	;ENCODING STATE
SAV.EF:	BLOCK	1	;ADDR OF LOC TO SAVE ADDR OF ENCODED FORMAT
RPT.PT:	BLOCK	1	;INDEFINITE REPEAT POINTER
FMT.BG:	BLOCK	1	;BYTE POINTER TO BEGINNING OF FORMAT
FMT.BP:	BLOCK	1	;FORMAT BYTE POINTER
FMT.IU:	BLOCK	1	;I/O LIST ENTRY USED FLAG
NUM.AD:	BLOCK	1	;DIGIT ACCUMULATOR PNTR

ENC.WD:	BLOCK	2	;ENCODED FORMAT WORDS
ENC.W2=ENC.WD+1


USR.AD:	BLOCK	2	;ACTUAL FORMAT ADDRESS, OVERLAY NUMBER
USR.OV=USR.AD+1		;OVERLAY NUMBER

USR.SZ:	BLOCK	1	;SIZE OF FORMAT IN CHARACTERS
FMT.CC:	BLOCK	1	;CURRENT FORMAT CHAR
FMT.PC:	BLOCK	1	;PREVIOUS CHAR
FMT.SZ:	BLOCK	1	;SIZE OF FORMAT IN CHARS

FMT.DB:			;ENCODING DATABASE - CLEARED BY FMTINT
GTDGFL:	BLOCK	1	;GOT DIGIT FLAG
FMT.SG:	BLOCK	1	;SIGN
FMT.CH:	BLOCK	1	;FORMAT CHARACTER (SIXBIT)

;THE NEXT FOUR MUST BE IN ORDER, AS THEY ARE REFERENCED BY STATE TABLE
FMTACC:
FMT.RP:	BLOCK	1	;REPEAT COUNT
FMT.FW:	BLOCK	1	;FORMAT WIDTH
FMT.DW:	BLOCK	1	;DECIMAL WIDTH
FMT.EW:	BLOCK	1	;EXPONENT WIDTH

FMT.EN==.-1		;END OF ENCODING DATABASE

;BROKEN-OUT FORMAT WIDTHS (GLOBAL)
%FWVAL:	BLOCK	1	;FIELD WIDTH
%DWVAL:	BLOCK	1	;DECIMAL WIDTH
%XPVAL:	BLOCK	1	;EXPONENT WIDTH

	SEGMENT	CODE

;BYTE POINTERS TO FORMAT ATTRIBUTES (WIDTH, DECIMAL WIDTH, ETC.)

W.PNTR:
WIDPNT:	POINT	18,ENC.W2,35	;TOTAL WIDTH OF FORMAT ELEMENT
FWMAX==777777

RPTPNT:	POINT	18,ENC.WD,35	;REPEAT COUNT
RPTMAX==777777

D.PNTR:
DECPNT:	POINT	6,ENC.WD,11	;DECIMAL WIDTH
DWMAX==77

X.PNTR:
EWPNT:	POINT	4,ENC.WD,5	;EXPONENT WIDTH
EWMAX==17			;AVOID BIT 0 SO IT WON'T BE NEGATIVE
				;AS NEGATIVE MEANS PAREN REPEAT

CODPNT:	POINT	6,ENC.WD,17	;FORMAT CODE (SIXBIT CHAR)

;THE FOLLOWING TABLE CONTAINS INFORMATION ON HOW TO TREAT
;EACH CHARACTER FOUND IN A FORMAT STATEMENT. THE
;TABLE IS ARRANGED SO THAT THE CHARACTER (TRANSLATED TO SIXBIT)
;CAN BE USED AS AN INDEX INTO THE TABLE. THE LEFT HALF OF EACH
;WORD CONTAINS THE FLAGS ASSOCIATED WITH THE CHARACTER (FOR INSTANCE,
;THE LEFT HALF OF THE ENTRY FOR 'A' HAS DTIFLG, WHICH IS A COMPOSITE
;OF FLAGS WHICH DIRECT THE FORMAT ENCODER TO REGISTER THE FORMAT,
;THAT IS, IT IS A "MAIN" FORMAT CHARACTER,
;AND THAT THIS FORMAT CHARACTER HAS AN ITEM OF DATA ASSOCIATED WITH IT).
;THE RIGHT HALF OF EACH ENTRY IS THE ADDRESS OF ANOTHER TABLE ENTRY
;WHICH CONTAINS THE ADDRESS OF ANY SPECIAL
;CODE TO EXECUTE FOR THE PROCESSING OF THE FORMAT CHARACTER.
FMT.CT:	IGNFLG			;SPACE
	0			;!
	0			;"
	0			;#
	DRFLG+DOLFMT		;$
	0			;%
	0			;&
	DRFLG+SQFMT		;'
	LPRFMT			;(
	FDFLG+RPRFMT		;)
	0			;*
	IGNFLG			;+
	FDFLG			;COMMA
	MINFMT			;-
	PERFMT			;.
	DRFLG+SLHFMT		;/
	DIGFMT			;0
	DIGFMT			;1
	DIGFMT			;2
	DIGFMT			;3
	DIGFMT			;4
	DIGFMT			;5
	DIGFMT			;6
	DIGFMT			;7
	DIGFMT			;8
	DIGFMT			;9
	DRIFLG+CNCFLG		;:
	0			;;
	0			;<
	0			;=
	0			;>
	0			;?
	0			;@
	DTIFLG+AFMT		;A
	DRFLG+BFMT		;B
	0			;C
	DTISFL+DFMT		;D
	DTISFL+EFMT		;E
	DTISFL+FFMT		;F
	DTIFLG+GFMT		;G
	REGFLG+HFMT		;H
	DTISFL+IFMT		;I
	0			;J
	0			;K
	DTISFL+LFMT		;L
	0			;M
	0			;N
	DTISFL+OFMT		;O
	REGFLG+PFMT		;P
	DRIFLG+QFMT		;Q
	DTISFL+RFMT		;R
	DRFLG+SFMT		;S
	DRFLG+TFMT		;T
	0			;U
	0			;V
	0			;W
	REGFLG+XFMT		;X
	0			;Y
	DTISFL+ZFMT		;Z
	0			;[
	0			;\
	0			;]
	0			;^
	0			;_

;THIS IS THE STATE TABLE. THERE ARE 4 STATES:
;
RPSTA==0	;COLLECTING A REPEAT COUNT
FWSTA==1	;COLLECTING A FORMAT WIDTH
DWSTA==2	;COLLECTING A DECIMAL WIDTH
EWSTA==3	;COLLECTING AN EXPONENT WIDTH


RPNOK==1
FWNOK==2
DWNOK==4
EWNOK==10
RPZOK==20
FWZOK==40
DWZOK==100
EWZOK==200
RPBOK==400
FWBOK==1000
DWBOK==2000
EWBOK==4000

STAMAX:	RPTMAX
	FWMAX
	DWMAX
	EWMAX

STANEG:	RPNOK
	FWNOK
	DWNOK
	EWNOK

STAZER:	RPZOK
	FWZOK
	DWZOK
	EWZOK

STABLK:	RPBOK
	FWBOK
	DWBOK
	EWBOK

STAVDX:	0				;[4242] VAX compatibility flagging
	AFLAG+REFLAG			;[4242] FORMATS which can have defaults
	0				;[4242]
	0				;[4242]

STAERR:	$ACALL	IRC
	$ACALL	IFW
	$ACALL	IFW
	$ACALL	IFW

;THERE ARE TWO STEPS INVOLVED HERE, FORMAT ENCODING AND FORMAT
;EXECUTION. FORMAT ENCODING INVOLVES CODING EACH "MAIN" FORMAT
;CHARACTER (SUCH AS A,E,I, ETC.) INTO A WORD (OR 2) CONTAINING
;THE FORMAT WIDTH, REPEAT COUNT, DECIMAL WIDTH, ETC. THIS ENCODING
;IS DONE BECAUSE STRAIGHT INTERPRETIVE EXECUTION OF FORMAT
;STATEMENTS IS SLOW AND AWKWARD (ESPECIALLY WITH INDEFINITE REPEAT).
;ONCE A FORMAT STATEMENT IS ENCODED, THE ENCODED VERSION IS SAVED
;FOR LATER USE. THERE IS SOME OVERHEAD SEARCHING FOR THE
;ENCODED VERSION, BUT THIS IS CUT DOWN BY HAVING FMTN DIFFERENT LINKED
;LISTS WHERE IT CAN RESIDE. (DIVIDING BY FMTN GIVES
;WHICH LIST TO SEARCH). FORMATS IN ARRAYS ARE ALSO ENCODED, BUT
;UNDER NORMAL CIRCUMSTANCES THE ENCODED VERSIONS ARE NOT SAVED;
;THE USER MAY FORCE FOROTS TO KEEP THEM, HOWEVER, WITH
;A SPECIAL SUBROUTINE CALL (FMTSAV).
;IN ORDER TO FACILITATE THE PROCESSING OF PARENS IN THE FORMAT
;STATEMENT, THE CODE FOR PROCESSING IS FULLY RECURSIVE. A PAREN
;IS ENCODED WITH AN ASSOCIATED COUNT AND A LINK
;TO THE ENCODED ENTRIES AFTER THE ASSOCIATED RIGHT PAREN. A
;RIGHT PAREN IS ENCODED AS A ZERO ENTRY. THIS STRUCTURE FACILITATES
;A SIMPLE RECURSIVE PROCEDURE FOR EXECUTION OF THE FORMAT
;AND ALSO FACILITATES THE PROCESSING OF INDEFINITE REPEAT. ITS
;DISADVANTAGE IS THAT THE STACK LENGTH RESTRICTS THE NUMBER
;OF IMBEDDED PARENS.
;THERE ARE SEVERAL PATHOLOGICAL CASES OF INTEREST.
;IF THE USER SPECIFIES A FORMAT IN AN ARRAY, S/HE MAY LEAVE OFF
;ONE OR BOTH PARENS. IF THE LEFT PAREN IS MISSING, AND THERE ARE
;NO LEFT PARENS IN THE REST OF THE FORMAT STATEMENT, THE ENCODER
;WILL NEVER BE CALLED RECURSIVELY; WHETHER OR NOT THE FORMAT ENDS
;WITH A RIGHT PAREN, AN "END PAREN" ENTRY (A ZERO WORD) WILL
;BE PLACED AT THE END OF THE ENCODED FORMAT, AND WILL THUS
;EXECUTE CORRECTLY. IF THERE ARE LEFT PARENS IMBEDDED IN THE FORMAT,
;THE ENCODER WILL BE CALLED CORRECTLY, RECURSIVELY. THE ENCODER
;WILL CONTINUE BEYOND THE MATCHING RIGHT PARENS UNTIL IT ENCOUNTERS
;EITHER AN UNMATCHED RIGHT PAREN OR THE END OF THE FORMAT; IN THIS CASE
;IT WILL ALSO EXECUTE CORRECTLY, AS IF THERE HAD BEEN A BEGINNING
;LEFT PAREN.
;INDEFINITE REPEAT IS HANDLED BY SAVING A POINTER TO THE LAST ENCODED
;LEFT PAREN IN THE FORMAT STATEMENT MATCHING THE
;NEXT TO LAST RIGHT PAREN (WHICH MAY BE THE INITIAL LEFT
;LEFT PAREN, OR IMPLIED LEFT PAREN IF THE USER FORGOT IT...). THUS,
;IN ACCORDANCE WITH THE ANSI-66 AND ANSI-77 STANDARDS, THE LOOP
;USED IS THE ONE PRECEDING THE FINAL RIGHT PAREN, OR THE ENTIRE
;FORMAT STATEMENT IF THERE IS NO INTERNAL LOOP.

;AN ENCODED FORMAT IS AS FOLLOWS:
;
;WORD			DESCRIPTION
;
;  0			ADDR OF NEXT ENCODED FORMAT IN THIS LIST
;  1			ADDR OR BYTE POINTER OF ACTUAL FORMAT
;  2			OVERLAY NUMBER
;  3			INDEFINITE REPEAT POINTER
;  4			ENCODED WORD 1
;  5			ENCODED WORD 2
;  .				.
;  .				.
;
;THERE ARE MANY SUCH LINKED LISTS OF ENCODED FORMATS, THE NUMBER
;DETERMINED BY THE FORPRM PARAMETER FMTN, WHICH SERVES AS A
;HASHING NUMBER - THE USER'S FORMAT ADDRESS IS DIVIDED BY THIS
;NUMBER, AND THE REMAINDER IS USED AS AN INDEX INTO THE ENCODED
;FORMAT LIST OF LISTS (FMT.LS). EACH ENTRY IN FMT.LS POINTS
;TO THE BEGINNING OF A LINKED LIST OF ENCODED FORMATS.
;
;PROVISION HAS BEEN MADE FOR THE USER TO SPECIFY THAT A FORMAT
;IN AN ARRAY SHOULD BE ENCODED AND STORED (UNDER NORMAL CIRCUMSTANCES
;THE ENCODED FORMAT FROM AN ARRAY IS THROWN AWAY). THIS FEATURE IS
;PROVIDED VIA TWO SPECIAL CALLS - FMTSAV & FMTCLR:
;
;	CALL FMTSAV (array name, number of array elements)
;
;		THIS CALL CALLS THE FORMAT ENCODER AND FORCES IT
;		TO SAVE THE ENCODED FORMAT. IF THIS ROUTINE IS
;		CALLED WITH AN ARRAY WHICH HAS ALREADY BEEN
;		ENCODED, THE OLD ENCODING WILL BE THROWN AWAY
;		AND A NEW ONE CREATED.
;
;	CALL FMTCLR (array name)
;
;		THIS CALL THROWS AWAY THE ENCODED FORMAT BY
;		DEALLOCATING THE CORE AND RELINKING THE
;		OTHER ENCODED FORMATS IN THE LIST.
;
;THE IMPLEMENTATION OF THESE SUBROUTINES MAKES IT NECESSARY TO
;SEARCH THE LISTS OF ENCODED FORMATS WHETHER OR NOT THE FORMAT IS
;IN AN ARRAY. HOWEVER, SINCE THE LISTS HAVE BEEN HASH-CODED, THIS
;SHOULD NOT SLOW PROCESSING SIGNIFICANTLY.

;%IFSET AND %OFSET ARE THE FORMAT CALLS FROM FOROTS. WE FIRST SEARCH FOR
;THE FORMAT IN THE LIST OF ENCODED FORMATS. IF IT EXISTS,
;WE GO ON TO FORMAT EXECUTION. OTHERWISE, WE ENCODE IT AND THEN
;EXECUTE IT.

%IFSET:	XMOVEI	T1,%IFORM	;SETUP FOR FORMAT EXECUTION
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,%SETAV	;SETUP FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	XMOVEI	T1,DATIN	;SETUP FOR INPUT
	MOVEM	T1,DATENT
	SETZM	%BZFLG		;ASSUME BLANK=NULL
	LOAD	T1,BLNK(U)	;UNLESS SET OTHERWISE IN DDB
	CAIN	T1,BL.ZERO	;BLANK=ZERO?
	 SETOM	%BZFLG		;YES. SET FLAG
	JRST	COMSET

%OFSET:	XMOVEI	T1,%OFORM	;SETUP FOR FORMAT EXECUTION
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,DATOUT	;SETUP FOR OUTPUT
	MOVEM	T1,DATENT
	SETZM	%SPFLG		;NO PLUS SIGN UNTIL FORMAT SAYS SO
	SETZM	%FTSLB		;ALLOW LEADING BLANKS ON OUTPUT
COMSET:	MOVX	T1,D%CLR	;CLEAR TEMP FLAGS
	ANDCAM	T1,FLAGS(D)
	XMOVEI	T1,@A.FMT	;GET ADDRESS OF FORMAT
	CAMG	T1,[MAXSEC,,-1]	;[4233]
	 CAIG	T1,.JBDA	;[4233] IS THIS AN ADDRESS?
	  $ACALL IFT		;[4233] NO
	SKIPE	T2,%OVPRG	;OVERLAY PROGRAM?
	 PUSHJ	P,%OVNUM	;YES. GET LINK NUMBER
	DMOVEM	T1,USR.AD	;SAVE THEM
	LDB	T2,[POINTR A.FMT,ARGTYP] ;GET ARG TYPE
	MOVEM	T2,T.FMT	;SAVE IT FOR LATER
	CAIE	T2,TP%CHR	;TYPE CHARACTER?
	 JRST	FNCHR		;NO

	SKIPN	T3,A.FMS	;ANY SIZE SPECIFIED?
	 SKIPA	T3,1(T1)	;NO. GET IT FROM DESCRIPTOR
	  MOVE	T3,@T3		;YES. GET IT
	MOVEM	T3,USR.SZ	;SAVE IT
	MOVE	T3,(T1)		;GET THE ACTUAL BP
	MOVEM	T3,FMT.BG	;SAVE IT
	JRST	GOTSIZ

FNCHR:	SKIPN	T3,A.FMS	;ANY SIZE SPECIFIED?
	 SKIPA	T3,-1(T1)	;NO. GET IT FROM FORMAT ITSELF
	  MOVE	T3,@T3		;YES. GET IT
	IMULI	T3,5		;GET # CHARS
	MOVEM	T3,USR.SZ	;SAVE IT
	$BLDBP	T1		;Make 7-bit byte ptr.
	MOVEM	T1,FMT.BG	;SAVE IT

GOTSIZ:	PUSHJ	P,FMTSRH	;SEARCH FOR ENCODED FORMAT
	MOVEM	T1,ENC.AD	;SAVE THE ADDR FOUND
	JUMPN	T1,FMTEXC	;GO EXECUTE IF ALREADY ENCODED

	PUSHJ	P,FMTENC	;ENCODE THE FORMAT
	SKIPN	%SVFMT		;DID USER TELL US NOT TO SAVE FORMATS?
	 JRST	FMTEXC		;YES. DON'T SAVE IT
	MOVE	T1,T.FMT	;GET FORMAT TYPE
	CAIN	T1,TP%LBL	;LABEL?
	 PUSHJ	P,BLTFMT	;YES. SAVE IT SOMEWHERE
	JRST	FMTEXC		;EXECUTE IT

BLTFMT:	XMOVEI	T1,1(P4)	;GET TOP+1 OF ENCODED FORMAT
	SUB	T1,ENC.AD	;GET # WORDS IN IT
	PUSHJ	P,%GTBLK	;GET A BLOCK THAT SIZE
	 $ECALL	MFU,%ABORT	;[4131] CAN'T
	MOVEM	T1,@SAV.EF	;SAVE ITS ADDRESS AND LINK IT
	HRRI	T2,(T1)		;PREPARE FOR MOVING IT
	HRL	T2,ENC.AD
	XMOVEI	P4,(P4)		;GET TOP, EXTENDED
	SUB	P4,ENC.AD	;GET # WORDS-1
	ADDI	P4,(T1)		;GET LAST ADDRESS
	BLT	T2,(P4)		;TRANSFER IT
	POPJ	P,

;ROUTINE TO DEALLOCATE ALL ENCODED FORMATS AND THE FORMAT ENCODING AREA.
%DEFMT:	SKIPE	T1,%FAREA	;IF WE ALLOCATED FORMAT ENCODING AREA
	 PUSHJ	P,%FREBLK	;DEALLOCATE IT
	XMOVEI	T1,FMT.LS	;GET ADDRESS OF LINKED LISTS
	MOVEM	T1,FMTPTR	;SAVE FOR LOOP
	MOVEI	T1,FMTN		;GET COUNT
	MOVEM	T1,FMTCNT	;SAVE FOR LOOP
DFLP1:	MOVE	T1,@FMTPTR	;GET ADDRESS OF 1ST ENTRY
	MOVEM	T1,FMTADR	;SAVE IT
DFLP2:	SKIPN	T1,FMTADR	;GET ADDRESS OF ENTRY
	 JRST	DFEN2		;END OF LIST. GO TO NEXT ENTRY
	MOVE	T2,%FMTNX(T1)	;GET ADDRESS OF NEXT ENTRY
	MOVEM	T2,FMTADR	;SAVE IT
	PUSHJ	P,%FREBLK	;DEALLOCATE THE BLOCK
	JRST	DFLP2		;LOOP UNTIL NONE LEFT IN THIS LIST

DFEN2:	AOS	FMTPTR		;INCREMENT LIST POINTER
	SOSLE	FMTCNT		;DECR COUNT
	 JRST	DFLP1		;LOOP
	POPJ	P,

%ADR==0				;USER ARRAY ADDRESS
%SIZ==1				;USER ARRAY SIZE (IN ARRAY ELEMENTS)

;THIS IS THE FAMOUS ARRAY FORMAT ENCODER.  IT ALLOWS THE USER
;TO HAVE FOROTS SAVE AWAY THE ENCODED VERSION OF THE FORMAT IN AN ARRAY.
;IF IT HAS ALREADY BEEN ENCODED, THE OLD ENCODING IS THROWN AWAY
;AND THE NEW ONE IS INSERTED AT THE END OF THE APPROPRIATE LINKED
;ENCODED FORMAT LIST.
%FMTSV:	XMOVEI	T1,@%ADR(L)		;GET ARRAY ADDR
	PUSHJ	P,%OVNUM		;GET LINK NUMBER ALSO
	DMOVEM	T1,USR.AD		;SAVE THEM
	LDB	T2,[POINTR %ADR(L),ARGTYP];GET ARRAY TYPE
	MOVEM	T2,T.FMT		;SAVE FOR LATER
	CAIE	T2,TP%CHR		;TYPE CHARACTER?
	 JRST	SVNCHR			;NO

	MOVE	T3,(T1)			;GET ACTUAL BYTE PNTR
	MOVEM	T3,USR.AD		;SAVE IT AS USER ADDRESS
	HLRE	T3,-1(L)		;GET ARG COUNT
	AOJE	T3,NOCSZ		;IF ONLY 1, NO ARRAY SIZE
	SKIPN	T3,@%SIZ(L)		;ANY SIZE SPECIFIED?
NOCSZ:	 SKIPA	T3,1(T1)		;NO. GET IT FROM DESCRIPTOR
	  IMUL	T3,1(T1)		;YES. MULTIPLY BY ENTRY SIZE
	MOVEM	T3,USR.SZ		;SAVE IT
	MOVE	T3,(T1)			;GET THE ACTUAL BP
	MOVEM	T3,FMT.BG		;SAVE IT
	JRST	SVGOT

SVNCHR:	HLRE	T3,-1(L)		;GET ARG COUNT
	AOJE	T3,%POPJ		;IF NONE, CALL IS A NOP
	SKIPG	T3,@%SIZ(L)		;ANY SIZE SPECIFIED?
	 POPJ	P,			;ERROR SOMEDAY, NOP FOR NOW
	IMUL	T3,%SIZTB(T2)		;GET # WORDS
	IMULI	T3,5			;GET # CHARS
	MOVEM	T3,USR.SZ		;SAVE IT
	$BLDBP	T1			;Make 7-bit byte ptr.
	MOVEM	T1,FMT.BG		;SAVE IT

SVGOT:	PUSHJ	P,FMTSRH		;SEARCH FOR THE FORMAT
	JUMPE	T1,GOENC		;IF NOT FOUND, GO ENCODE IT
	PUSHJ	P,FMTDEL		;FOUND. DELETE IT
	PUSHJ	P,FMTSR1		;SEARCH AGAIN
	JUMPN	T1,[$SNH]		;BETTER NOT BE THERE AGAIN!
GOENC:	PUSHJ	P,FMTENC		;ENCODE THE FORMAT
	PJRST	BLTFMT			;SAVE IT AWAY

;AND THIS IS THE FAMOUS ENCODED FORMAT DEALLOCATOR, WHICH
;IS HERE MAINLY FOR SYMMETRY (OR FOR THE USER WHO REALLY CARES
;ABOUT THE EXTRA FEW WORDS OF CORE ALLOCATED FOR THE ENCODED
;FORMAT).
%FMTCL:	XMOVEI	T1,@%ADR(L)		;GET ARRAY ADDR
	PUSHJ	P,%OVNUM		;AND OVERLAY NUMBER
	LDB	T3,[POINTR %ADR(L),ARGTYP] ;GET ARGUMENT TYPE
	CAIN	T3,TP%CHR		;CHARACTER?
	 MOVE	T1,(T1)			;YES. GET ENTIRE BYTE POINTER
	DMOVEM	T1,USR.AD		;SAVE FOR SEARCH
	PUSHJ	P,FMTSRH		;SEARCH FOR THE FORMAT
	JUMPE	T1,%POPJ		;NOT FOUND. JUST LEAVE
;	PJRST	FMTDEL			;DELETE IT

;SUBROUTINE TO DELETE AN ENCODED FORMAT FROM A LINKED LIST.
;T1 POINTS TO THE ENCODED FORMAT TO BE DELETED, SAV.EF POINTS
;TO THE PREVIOUS ENCODED FORMAT.
FMTDEL:	MOVE	T2,(T1)			;GET ADDR OF NEXT FORMAT
	MOVEM	T2,@SAV.EF		;RELINK THE LIST
	PJRST	%FREBL			;FREE THE ALLOCATED CORE

;THIS IS THE FORMAT ENCODER SETUP. THE FORMAT IS ENCODED INTO A
;FIXED AREA OF MEMORY (%FAREA); WHEN THE FORMAT HAS BEEN SUCCESSFULLY
;ENCODED, IT IS MOVED TO AN AREA PRECISELY THE RIGHT SIZE.
;IF, DURING ENCODING, THE FIXED AREA DOES NOT HAVE ENOUGH ROOM,
;IT IS COPIED TO AN AREA TWICE AS LARGE AND THE OLD ONE IS
;DEALLOCATED.
FMTENC:	SKIPE	T1,%FAREA		;DO WE HAVE AN ENCODE AREA YET?
	 JRST	GOTFA			;YES
	MOVEI	T1,IFMTSZ		;NO. GET ONE
	MOVEM	T1,FASIZE		;SAVE ITS SIZE
	PUSHJ	P,%GTBLK
	 $ECALL	MFU,%ABORT		;[4131] CAN'T
	MOVEM	T1,%FAREA		;SAVE IT
GOTFA:	MOVEM	T1,ENC.AD		;SAVE IT
	SETZM	FMT.PC			;CLEAR PREV CHAR
	MOVE	T1,USR.SZ		;GET SIZE OF FORMAT STRING
	MOVEM	T1,FMT.SZ		;SAVE THE SIZE
	MOVN	P4,FASIZE		;GET NEG SIZE OF FORMAT AREA
	HRLI	P4,(P4)			;IN LEFT HALF
	HRR	P4,ENC.AD		;CREATE A FORMAT PNTR
	SUBI	P4,1			;MAKE IT A PUSH PNTR
	PUSH	P4,[0]			;CLEAR "NEXT LINK" ADDR
	PUSH	P4,USR.AD		;SAVE THE ENCODED FORMAT ADDR
	PUSH	P4,USR.OV		;SAVE OVERLAY NUMBER
	PUSH	P4,T.FMT		;SAVE FORMAT TYPE
	PUSH	P4,[0]			;CLEAR INDEF RPT PNTR
	XMOVEI	T1,1(P4)		;GET RELATIVE ADDR OF 1ST ENCODED WORD
	SUB	T1,ENC.AD
	MOVEM	T1,FMT.LK		;SAVE IT
	MOVEM	T1,FMFRST		;AND AGAIN
	MOVEM	T1,RPT.PT		;INIT INDEF RPT PNTR
	MOVE	T1,FMT.BG		;GET FORMAT POINTER
	MOVEM	T1,FMT.BP		;Store ptr to beginning of format
	PUSHJ	P,FMTPRC		;PROCESS FORMAT
	MOVE	T1,ENC.AD		;GET BLOCK ADDR
	MOVE	T2,RPT.PT		;GET INDEF RPT PNTR
	MOVEM	T2,%FMTRP(T1)		;SAVE IT IN BLOCK
	POPJ	P,

;FMTINT - INITIALIZE THE FORMAT PARAMETERS. THE DIGIT COLLECTOR
;IS SET UP TO POINT TO THE REPEAT COUNT, THE SIGN IS
;SET TO +, AND THE TEMP FMT DATABASE IS CLEARED.
FMTINT:	SETZM	FMT.DB			;CLEAR 1ST DATABASE WORD
	MOVE	T1,[FMT.DB,,FMT.DB+1]	;CLEAR REST WITH BLT
	BLT	T1,FMT.EN
	MOVEI	T1,1			;SET SIGN TO 1
	MOVEM	T1,FMT.SG
	SETZM	FMTSTA			;SET STATE TO "GETTING REPEAT"
	SETZM	ENC.WD			;CLEAR THE ENCODED WORDS
	SETZM	ENC.W2
	POPJ	P,

;FMTPRC - THIS IS THE FORMAT PROCESSOR OR ENCODER. EACH CHARACTER
;(OTHER THAN IN QUOTED STRINGS AND HOLLERITH CONSTANTS) ARE CONVERTED
;TO SIXBIT. THE RESULTING VALUE IS USED AS AN INDEX INTO A TABLE
;GIVING A SET OF FLAGS (LEFT HALF) AND POSSIBLY AN ADDRESS OF
;A WORD WHICH MAY HAVE THE ADDRESS OF A SPECIAL PROCESSING ROUTINE
;FOR THAT CHARACTER. FOR INSTANCE, THE TABLE ENTRY FOR LEFT PAREN
;HAS FDFLG IN THE LEFT HALF, WHICH INDICATES THAT ANY PREVIOUS DATA
;ENCOUNTERED SHOULD BE ENCODED INTO A FORMAT WORD AND REGISTERED INTO
;THE ENCODED FORMAT. IT HAS THE ADDRESS "RPRFMT" IN THE RIGHT HALF.
;"RPRFMT" IS THE OFFSET OF THE LEFT PAREN ENCODING SUBROUTINE - LPRENC.
;IF "REGFLG" IS ON IN THE LEFT HALF OF THE TABLE ENTRY, IT MEANS THAT
;THE CHARACTER IS A "MAIN" FORMAT CHARACTER, THAT IS, IT WILL EVENTUALLY
;BE ENCODED AS A WORD IN THE ENCODED FORMAT AFTER
;ITS WIDTH, DECIMAL WIDTH, EXPONENT WIDTH, AND REPEAT COUNT ARE COLLECTED.

FMTPRC:	PUSHJ	P,FMTINT		;INIT DATABASE
FMTLP:	SKIPG	FMT.SZ			;ANYTHING LEFT?
	JRST	REGRP			;NO. FAKE A RIGHT PAREN
	PUSHJ	P,GTFCHR		;GET A CHAR
	JUMPE	T1,FMTLP		;SKIP NULLS
	PUSHJ	P,SIXVRT		;CONVERT TO SIXBIT
	MOVEI	P1,(T1)			;COPY IT
	MOVEM	P1,FMT.CC		;SAVE AS CURRENT CHAR
	SKIPN	FMT.CT(P1)		;ANY STUFF?
	 $ACALL	ILF			;ILLEGAL CHAR IN FORMAT
	PUSHJ	P,ETEST			;SPECIAL TEST FOR E-FORMAT
	MOVE	P3,FMT.CT(P1)		;GET FLAGS
	TXNE	P3,FDFLG		;DELIMITER?
	 PUSHJ	P,FMTCMP		;YES. COMPILE PREV FORMAT
	TXNN	P3,REGFLG		;REGISTER THE CHAR?
	 JRST	NOREG			;NO
	SKIPE	FMT.FW			;IS THE FORMAT WIDTH ZERO?
	 $ECALL	ARC			;[2045] NO, AMBIGUOUS REPEAT COUNT
	SKIPE	FMT.CH			;ANY LEFTOVER FORMAT CHAR?
	 PUSHJ	P,FMTCMP		;YES. COMPILE PREV FORMAT
	MOVEM	P1,FMT.CH		;SAVE THE CHAR AWAY
	TXNN	P3,FDFLG		;WAS IT A DELIMITER?
	 PUSHJ	P,CHKWID		;NO. ACCUMULATE REPEAT, CHECK IT
	AOS	FMTSTA			;POINT TO COLLECTING FIELD WIDTH
	SETZM	GTDGFL			;CLEAR "GOT DIGIT" FLAG
NOREG:	TXNN	P3,CNCFLG		;WANT TO COMPILE IT NOW?
	 JRST	NOCNC			;NO
	PUSHJ	P,FMTNC			;YES. GO COMPILE IT
	JRST	FMTLP			;BACK FOR MORE

NOCNC:	HRRZ	P3,FMT.CT(P1)		;GET TABLE ADDR
	JUMPE	P3,FMTLP		;BACK IF NO DISPATCHES
GOCNC:	HRRZ	T1,ENCTAB(P3)		;GET ADDR OF DISPATCH
	JUMPE	T1,FMTLP		;BACK IF NO ADDR
	PUSHJ	P,(T1)			;IF ADDR, DO IT
	 JRST	FMTLP			;BACK FOR MORE
	POPJ	P,			;RECURSIVE RETURN
REGRP:	PUSHJ	P,FMTCMP		;COMPILE ANY INCOMPLETE FORMAT
	PUSHJ	P,RPRENC		;FAKE A RIGHT PAREN
	 JFCL				;ALWAYS SKIP RETURNS
	POPJ	P,

ETEST:	CAIE	P1,'E'			;IS IT AN 'E'?
	 POPJ	P,			;NO. LEAVE
	MOVE	T2,FMT.CH		;GET THE FORMAT CHAR
	CAIE	T2,'D'			;YES. IS IT A "D"
	 CAIN	T2,'E'			;OR AN 'E'?
	  JRST	ASMEXW			;YES. SET FOR EXPONENT WIDTH
	CAIE	T2,'G'			;SAME FOR 'G'
	 POPJ	P,			;NO. LEAVE
ASMEXW:	PUSHJ	P,CHKWID		;CHECK WIDTH
	AOS	T1,FMTSTA		;INCREMENT STATE
	CAIE	T1,EWSTA		;SHOULD NOW BE COLLECTING EXPONENT WIDTH
	 $ACALL	IFW
	SETZM	GTDGFL			;CLEAR "GOT DIGIT" FLAG
EXPLP:	SETZ	P1,			;MAKE THE CHAR A SPACE
	SKIPN	FMT.SZ			;ANY CHARS LEFT?
	 JRST	FMTCMP			;NO. COMPILE THE FORMAT
	PUSHJ	P,GTFCHR		;YES. GET ONE
	PUSHJ	P,SIXVRT		;CONVERT TO SIXBIT
	MOVEI	P1,(T1)			;COPY THE CHAR
	CAIG	P1,'9'			;IS IT A DIGIT?
	 CAIGE	P1,'0'
	  JRST	FMTCMP			;NO. GO USE AS NEXT CHAR
	PUSHJ	P,DIGENC		;YES. ACCUMULATE IT
	JRST	EXPLP			;AND GO BACK FOR MORE

;FMTSRH - SEARCHES FOR AN ENCODED FORMAT IN ONE OF THE
;LINKED LISTS (ADDR IN SAV.EF) MATCHING THE SPECIFIED
;USER'S FORMAT (ADDR IN USR.AD). RETURNS THE ADDR OF THE
;ENCODED FORMAT IN T1 IF FOUND, 0 IF NOT FOUND. ALSO, SAV.EF
;IS LEFT WITH THE ADDR OF THE FORMAT PREVIOUS TO
;ONE FOUND, OR THE ADDR OF THE LAST ENCODED FORMAT
;IN THE LINKED LIST, IF NOT FOUND. [NOTE: THE ORDER OF WHEN THE
;ADDRESS OF THE FORMAT IS SAVED IN SAV.EF (AFTER THE COMPARE
;AND EXIT) IS CRUCIAL FOR THE PROPER OPERATION OF FMTDEL,
;WHICH NEEDS THE ADDRESS PREVIOUS TO THE ONE MATCHED
;FOR RELINKING THE LIST.]

FMTSRH:	MOVM	T1,USR.AD		;GET FORMAT ADDR
	IDIVI	T1,FMTN			;HASH CODE...CHOOSE LIST
	XMOVEI	T1,FMT.LS(T2)		;GET ADDR OF PNTR TO BEG ENTRY
	MOVEM	T1,SAV.EF		;SAVE IT
FMTSR1:	MOVE	T1,SAV.EF		;GET ENC ADDR PNTR
	DMOVE	T2,USR.AD		;AND UNENCODED ADDR
FSLP1:	SKIPN	T1,%FMTNX(T1)		;GET NEXT ADDR, RETURN IF NO MORE
	 POPJ	P,
	CAMN	T2,%FMTAD(T1)		;ADDRESSES EQUAL?
	 JRST	CHKOV			;YES. GO CHECK OVERLAY NUMBER
	MOVEM	T1,SAV.EF		;NO. SAVE NEW ADDR
	JRST	FSLP1			;AND TRY AGAIN

CHKOV:	CAMN	T3,%FMTOV(T1)		;OVERLAY NUMBERS EQUAL?
	 POPJ	P,			;YES. MATCH
	MOVEM	T1,SAV.EF		;NO. SAVE NEW ADDR
	JRST	FSLP1			;AND TRY AGAIN

;FORMAT COMPILATION - THROWS TOGETHER THE VARIOUS PARAMETERS
;ASSEMBLED SO FAR FOR A FORMAT CODE AND ASSEMBLES IT INTO
;AN ENCODED FORMAT WORD. SPECIAL HANDLING IS USED FOR THE
;CURRENT CHARACTER BEING "E" - THE ANSI-77 STANDARD
;ALLOWS THIS CHARACTER TO BE USED FOR BOTH E FORMAT AND
;FOR THE EXPONENT PART OF SCIENTIFIC NOTATION. THEREFORE
;IF THE CURRENT CHARACTER IS "E", WE CHECK IF THE FORMAT ABOUT
;TO BE COMPILED IS D,E,F OR G. IF SO, WE DEFER COMPILATION
;UNTIL COLLECTING THE EXPONENT WIDTH.

XENC:	MOVEI	T1,1			;Incase "X" by itself
	SKIPN	FMT.RP
	 MOVEM	T1,FMT.RP		;"X" = "1X" (DEC extension)
	JRST	FMTNC			;DON'T CHECK WIDTH AGAIN

FMTCMP:	SKIPE	T1,FMT.CH		;ANY FORMAT CHAR YET?
	 JRST	FMTOK			;YES.
	SKIPE	FMT.RP			;NO. IS REPEAT COUNT ZERO?
	 $ACALL	IRC			;NO. ILLEGAL REPEAT COUNT
	POPJ	P,			;YES. JUST IGNORE THE WHOLE THING

FMTOK:	PUSHJ	P,CHKWID		;CHECK ACCUMULATED WIDTH
FMTNC:	SKIPE	T1,FMT.FW		;[4242] [4223] GET FORMAT WIDTH
	DPB	T1,WIDPNT		;RECORD IT
	SKIPE	T1,FMT.DW		;GET DECIMAL WIDTH
	DPB	T1,DECPNT
	SKIPE	T1,FMT.EW		;AND EXPONENT WIDTH
	DPB	T1,EWPNT
	SKIPE	T1,FMT.RP		;AND REPEAT COUNT
	DPB	T1,RPTPNT
	MOVE	T1,FMT.CH		;AND FORMAT CODE
	DPB	T1,CODPNT
	PUSH	P4,ENC.WD		;STORE WORDS ON STACK
	PUSH	P4,ENC.W2
	PUSHJ	P,STKCHK		;CHECK IF ENOUGH ROOM ON THE STACK
	JRST	FMTINT			;INITIALIZE THE DATABASE

DFLAG:	MOVEI	T2,VAXIDX		;[4223] Flag as a VAX incompatibility
	TDNE	T2,%FLIDX		;[4223] Any flags the same?
	 $ECALL	CFD			;[4223] Yes, Display the error message
	PJRST	%POPJ1			;[4223] End of Routine DFLAG

;HERE WE HAVE RUN OUT OF ROOM IN THE CURRENTLY ASSIGNED FORMAT
;ENCODING AREA. SO WE CALL %MVBLK TO ALLOCATE A NEW ONE TWICE
;AS LARGE, MOVE THE DATA OVER, SET THE PUSH PNTR (P4) APPROPRIATELY,
;AND TOSS THE OLD AREA.
STKCHK:	CAMG	P4,[-4,,0]		;LEAVE AT LEAST 4
	 POPJ	P,			;THAT'S ENOUGH FOR NOW
	MOVE	T1,%FAREA		;GET THE OLD ADDR
	MOVE	T2,FASIZE		;GET THE OLD SIZE
	MOVEI	T3,(T2)			;COPY IT
	LSH	T3,1			;DOUBLE IT
	PUSHJ	P,%MVBLK		;GET NEW ONE, BLT, TOSS OLD ONE
	 $ECALL	MFU,%ABORT		;[4131] CAN'T
	MOVEM	T1,ENC.AD		;SAVE FOR CURRENT ENCODING
	EXCH	T1,%FAREA		;SAVE NEW ADDR, GET OLD ONE
	SUB	T1,%FAREA		;GET OLD-NEW
	SUB	P4,T1			;FIXUP RH OF PUSH PNTR
	EXCH	T3,FASIZE		;SAVE NEW SIZE, GET OLD SIZE
	SUB	T3,FASIZE		;GET OLD-NEW
	HRLZI	T3,(T3)			;IN LEFT HALF
	ADD	P4,T3			;FIXUP LH OF PUSH PNTR
	POPJ	P,

CHKWID:	MOVE	T1,FMT.CH		;GET THE FORMAT CHARACTER
	HRRZ	T1,FMT.CT(T1)		;GET FORMAT INDEX
	MOVE	T1,CHKTAB(T1)		;GET THE FLAG CHECK TABLE
	MOVE	T2,FMTSTA		;GET THE CURRENT STATE
	SKIPL	T3,FMT.SG		;ANY SIGN?
	 JRST	NCKNEG			;NO. DON'T CHECK NEGATIVE LEGAL
	IMULM	T3,FMTACC(T2)		;ACCUMULATE IT
	TDNN	T1,STANEG(T2)		;CHECK IF NEGATIVE OK
	 JRST	STAERR(T2)
NCKNEG:	MOVM	T3,FMTACC(T2)		;GET THE ACCUMULATED WIDTH
	CAMLE	T3,STAMAX(T2)		;WITHIN RANGE?
	 JRST	STAERR(T2)		;NO
	JUMPN	T3,%POPJ		;NON-ZERO NEEDS NO MORE CHECKING
	SKIPN	GTDGFL			;ZERO. DID WE GET ANY DIGITS?
	 JRST	CKBLNK			;NO. GO CHECK IF BLANK IS OK
	TDNN	T1,STAZER(T2)		;CHECK IF ZERO OK
	 JRST	STAERR(T2)		;N.G.
	POPJ	P,

CKBLNK:	TDNN	T1,STABLK(T2)		;IS BLANK OK?
	 JRST	STAERR(T2)		;NO
	MOVEI	T2,VAXIDX		;[4242] Get VMS Compatibility Flags
	TDNN	T2,%FLIDX		;[4242] Are we doing VMS flagging?
	 POPJ	P,			;[4242] No
	MOVE	T2,FMTSTA		;[4242] Yes. Get state again
	TDNE	T1,STAVDX(T2)		;[4242] Are we defaulting?
	 $ECALL	CFD			;[4242] Yes, warn
	POPJ	P,

;SIXVRT - CONVERTS ASCII CHARACTERS FROM THE FORMAT STATEMENT
;TO SIXBIT.
SIXVRT:	CAILE	T1,140			;LOWER CASE?
	SUBI	T1,40			;YES. CONVERT TO UPPER
	SUBI	T1,40			;CONVERT TO SIXBIT
	JUMPG	T1,%POPJ		;OK
	SETZ	T1,			;NEGATIVE - TREAT AS SPACE
	POPJ	P,

;RIGHT PAREN ENCODER - A RIGHT PAREN IS TRANSLATED INTO A ZERO
;WORD DROPPED ONTO THE STACK, FOLLOWED BY THE
;RELATIVE ADDRESS OF THE MATCHING LEFT PAREN.
;SINCE THE FORMAT ENCODER IS RECURSIVE,
;THE RETURN FROM THIS SUBROUTINE IS ALWAYS A SKIP RETURN TO SPECIFY
;A RECURSIVE RETURN
RPRENC:	PUSH	P4,[0]			;DROP A ZERO ON THE STACK
	PUSH	P4,FMT.LK		;AND ADDR OF CURRENT LEFT PAREN
	PJRST	%POPJ1			;AND SKIP RETURN

;THIS ROUTINE IS CALLED BY I,O, AND Z FORMATS. THE ANSI STANDARD
;SPECIFIES THAT A FORMAT SUCH AS "I5.0" MEANS THAT NO DIGITS ARE
;PRINTED IF THE VALUE OF THE VARIABLE IS ZERO. THE DEFAULT FOR
;A FORMAT SUCH AS "I5" IS AT LEAST ONE DIGIT PRINTED. THUS THIS
;ROUTINE MUST BE CALLED TO SET THE DEFAULT NUMBER OF CHARACTERS
;PRINTED TO 1; WHEN A PERIOD IS ENCOUNTERED IT IS RESET TO ZERO
;TO PROPERLY COLLECT THE DIGITS.
MENC:	MOVEI	T1,1			;SET DEFAULT FOR I,O,Z TO 1
	MOVEM	T1,FMT.DW		;FOR DECIMAL WIDTH
	POPJ	P,

;PERIOD ENCODING - UPON ENCOUNTERING A PERIOD, THE DECIMAL WIDTH
;(POSSIBLY SET TO NON-ZERO DEFAULT) IS CLEARED, AND THE DIGIT
;COLLECTER IS SET TO POINT TO THE DECIMAL WIDTH
PERENC:	PUSHJ	P,CHKWID		;CHECK ACCUMULATED WIDTH
	AOS	T1,FMTSTA		;INCREMENT STATE
	CAIE	T1,DWSTA		;SHOULD BE NOW COLLECTING DECIMAL WIDTH
	 $ACALL	IFW			;NOT. BAD FORMAT
	SETZM	GTDGFL			;CLEAR "GOT DIGIT" FLAG
	SETZM	FMT.DW			;CLEAR PREVIOUS (DEFAULT) DEC WID
	POPJ	P,

;DIGENC - THE DIGIT ENCODER. NUM.AD POINTS TO THE CURRENT
;DIGIT COLLECTOR.
DIGENC:	MOVE	T2,FMTSTA		;GET CURRENT STATE
	MOVE	T1,FMTACC(T2)		;GET ACC NUM
	CAML	T1,[^D1000000000]	;[3426] PREVENT OVERFLOW
	 JRST	STAERR(T2)		;[3426] GIVE ILLEGAL WIDTH MESSAGE
	IMULI	T1,12			;MUL BY 10
	ADDI	T1,-20(P1)		;ADD IT IN
	MOVEM	T1,FMTACC(T2)		;SAVE IT AGAIN
	SETOM	GTDGFL			;SET "GOT DIGIT" FLAG
	POPJ	P,

;LPRENC - THE LEFT PAREN ENCODER. A LEFT PAREN IS
;ENCODED AS A WORD CONTAINING THE NEGATIVE OF ITS REPEAT COUNT,
;AND A ZERO WORD. THE LEFT PAREN
;INITIATES A RECURSIVE CALL TO THE FORMAT ENCODER, AND THE LINK
;IS ESTABLISHED AFTER THE RETURN FROM THIS RECURSIVE CALL.
;UPON RETURNING, WE MUST DO SOMETHING WHICH LOOKS RATHER CURIOUS - WE SAVE
;THE CURRENT LINK (THAT IS, LEFT PAREN) POINTER IN THE INDEFINITE REPEAT
;POINTER, UNLESS WE ARE AT THE TOP LEVEL. THIS HAS THE EFFECT OF POINTING
;TO THE LEFT PAREN WHICH MATCHES THE NEXT TO LAST RIGHT PAREN (WE AVOID
;RESETTING IT TO THE OUTERMOST PAREN (THE INITIAL SETTING) BY NOT SAVING
;THE NO-LINK ENTRY.
;IF, AFTER RETURNING, THE SAVED FORMAT LIST ADDRESS IS THE
;BEGINNING OF THE FORMAT LIST, WE HAVE REACHED THE END OF
;THE FORMAT, SO THE LINK IS SET TO ZERO. IN THIS CASE,
;WE ALSO SKIP RETURN, TO INDICATE A RECURSIVE
;RETURN, AND THUS THE END OF ENCODING.


LPRENC:	SKIPE	T1,FMT.CH		;ANY PREVIOUS FORMAT CHARACTER?
	 PUSHJ	P,FMTCMP		;YES. PROCESS IT
	PUSH	P,FMT.LK		;SAVE ADDR OF CURRENT LEFT PAREN
	XMOVEI	T1,1(P4)		;GET REL ADDR OF PAREN WORD
	SUB	T1,ENC.AD
	MOVEM	T1,FMT.LK		;SAVE IT
	SKIPN	T1,FMT.RP		;GET LATEST REPEAT COUNT
	 MOVEI	T1,1			;ASSUME COUNT OF 1 IF 0
	MOVN	T1,T1			;NEGATE IT
	PUSH	P4,T1			;SAVE ON STACK
	PUSH	P4,[0]			;PUT A ZERO WORD ON THE STACK ALSO
	PUSHJ	P,STKCHK		;CHECK IF ENOUGH ROOM ON THE STACK
	PUSHJ	P,FMTPRC		;RECURSIVE CALL
	MOVE	T1,FMT.LK		;GET CURRENT LEFT PAREN ADDR
	POP	P,FMT.LK		;RESTORE PREVIOUS LEFT PAREN ADDR
	CAMN	T1,FMFRST		;IF LINK ADDR IS START ADDR
	 JRST	%POPJ1			;WE'RE DONE
	MOVEM	T1,RPT.PT		;SAVE LOOP ADDR FOR INDEF RPT
	POPJ	P,

;BENC - THE B FORMAT ENCODER - BN FORMAT IS ENCODED AS A 'B' FOR
;THE FORMAT CHARACTER AND "N" FOR THE WIDTH. BZ IS ENCODED WITH
;A "Z" FOR THE FORMAT WIDTH.
BENC:	PUSHJ	P,GTFCHR		;GET FORMAT CHAR
	CAIE	T1,"N"			;N OR Z?
	CAIN	T1,"Z"
	  JRST	GOTNZ			;YES, OK
	$ACALL	ILF			;ILLEGAL CHAR IN FORMAT

GOTNZ:	MOVEM	T1,FMT.FW		;SAVE AS WIDTH FIELD
	PJRST	FMTNC			;COMPILE IT

;A MINUS IN THE FORMAT MERELY NEGATES THE SIGN.
MINENC:	MOVNS	T1,FMT.SG			;NEGATE THE SIGN
	JUMPL	T1,%POPJ		;OK IF NOW NEGATIVE
	 $ACALL	ILF			;ILLEGAL IF NOW POSITIVE

;SENC - FOR S,SS, &SP FORMATS. AN "S" OR "P" ARE ENCODED
;INTO THE WIDTH POSITION OF THE FORMAT WORD.
SENC:	PUSHJ	P,GTFCHR		;GET A FORMAT CHAR
	CAIE	T1,"S"			;IS IT AN S
	CAIN	T1,"P"			;IS IT A P
	JRST	MATPS			;YES
	MOVEM	T1,FMT.PC		;NO. SAVE AS PREVIOUS CHAR
	MOVEI	T1,"S"			;DEFAULT IS AN S
MATPS:	MOVEM	T1,FMT.FW		;SAVE AS WIDTH
	PJRST	FMTNC			;COMPILE IT

;HOLLERITH ENCODING - WE ARE ALLOWING ANY CHARACTERS WHATSOEVER
;IN HOLLERITH AND QUOTED STRINGS, SO WE USE THE ACTUAL BYTE
;PNTR INTO THE FORMAT STATEMENT TO RETRIEVE THE CHARS RATHER
;THAN THE SUBROUTINE GTFCHR. THE FORMAT WORD IS COMPILED AND THE
;BYTE POINTER IS SAVED AS A SECOND WORD IN THE FORMAT LIST.
HENC:	SKIPG	T1,FMT.RP		;GET THE REPEAT COUNT
;	IOERR	(IHC,,,?,Illegal Hollerith constant,,%ABORT)
	 $ACALL	IHC
	CAMLE	T1,FMT.SZ		;BEYOND THE FORMAT SIZE?
	 MOVE	T1,FMT.SZ		;YES. FOR NOW, TRUNCATE IT
	MOVNI	T2,(T1)			;GET NEGATIVE
	ADDM	T2,FMT.SZ		;DECREMENT THE LEFTOVER SIZE
	ADJBP	T1,FMT.BP		;CREATE NEW BYTE POINTER
	EXCH	T1,FMT.BP		;POINTING AFTER THE CONSTANT
	MOVEM	T1,ENC.W2		;SAVE THE OLD ONE
	PJRST	FMTNC			;COMPILE THE FORMAT

;SIMILAR TO HOLLERITH. IF A SINGLE QUOTE IS NOT
;FOLLOWED BY ANOTHER, IT IS THE END OF THE QUOTED STRING;
;HOWEVER, WE HAVE ALREADY RETRIEVED THE CHARACTER, SO WE HAVE TO
;SAVE IT FOR LATER.
SQENC:	SETZM	FMT.RP			;CLEAR REPEAT COUNT
	MOVE	T1,FMT.BP		;GET THE BYTE PNTR
	MOVEM	T1,ENC.W2		;SAVE FOR ENCODING
SQLP1:	SOSGE	FMT.SZ			;ANY CHARS LEFT?
	 JRST	SQEDON			;NO. CLOSE THE QUOTE
	ILDB	T1,FMT.BP		;NON-CHECKING SCAN
	CAIE	T1,"'"			;SINGLE QUOTE?
	JRST	NOTSQ			;NOPE
	SOSGE	FMT.SZ			;ANY CHARS LEFT?
	 JRST	SQEDON			;NO. CLOSE THE QUOTE
	ILDB	T1,FMT.BP		;GET THE NEXT CHAR
	CAIE	T1,"'"			;ANOTHER QUOTE?
	JRST	SQEDON			;NO. STOP
	AOS	FMT.RP			;YES. COUNT BOTH OF THEM
NOTSQ:	AOS	FMT.RP			;NO. INCR THE COUNT
	JRST	SQLP1			;AND TRY FOR MORE

SQEDON:	MOVEM	T1,FMT.PC		;NO. SAVE AS PREVIOUS CHAR
	PJRST	FMTNC			;COMPILE THE FORMAT

;T FORMAT - THE ANSI STANDARD HAS CREATED 2 MORE CONFUSING FORMATS -
;TR AND TL (TAB RIGHT AND TAB LEFT). SINCE WE ONLY HAVE A SIXBIT
;CHARACTER POSITION FOR THE FORMAT CHAR, WE STORE THE "R" OR "L"
;IN THE DECIMAL WIDTH PORTION OF THE FORMAT WORD.
TENC:	PUSHJ	P,GTFCHR		;GET NEXT CHAR
	CAIE	T1,"L"			;L OR R
	CAIN	T1,"R"
	JRST	GOTLR			;YES
	MOVEM	T1,FMT.PC		;NO. SAVE THE CHAR FOR LATER
	POPJ	P,

GOTLR:	PUSHJ	P,SIXVRT		;CONVERT TO SIXBIT
	MOVEM	T1,FMT.DW		;SAVE AS DECIMAL WIDTH
	POPJ	P,

;THIS IS THE LIST OF EXECUTION/ENCODING ADDRESSES.
;THERE ARE 6 TABLES OF ADDRESSES OR TRANSFER VECTORS.
;THE FIRST ENTRY IN EACH ENTRY OF FMTTAB IS THE OFFSET INTO
;EACH TABLE FOR THAT FORMAT. THE SECOND IS THE INPUT EXECUTION
;ADDRESS, THE THIRD IS THE OUTPUT EXECUTION ADDRESS, AND THE FOURTH
;IS THE ENCODING ADDRESS. THE FIFTH IS A MASK
;WHICH IS USED TO CHECK THE FORMAT AGAINST THE VARIABLE
;TYPE FOR A MISMATCH. THE SIXTH IS A RANGE CHECK FLAG WORD.

;THE WARNING MASK IS ASSEMBLED AS FOLLOWS: BIT 0 REPRESENTS VARIABLE
;TYPE 0 (UNKNOWN), BIT 1 REPRESENTS TYPE 1 (LOGICAL), ETC. THE BIT
;IS SET IF THE VARIABLE TYPE CONFLICTS WITH THE FORMAT IN QUESTION.
;FOR EXAMPLE, F-FORMAT CONFLICTS WITH
;INTEGER (2), DOUBLE INTEGER (11), AND CHARACTER (15).

FWARN==1B<TP%INT>+1B<TP%DPI>+1B<TP%CHR>+1B<TP%LIT>
IWARN==1B<TP%SPR>+1B<TP%DPR>+1B<TP%DPX>+1B<TP%CPX>+1B<TP%CHR>+1B<TP%LIT>
QWARN==IWARN
OWARN==1B<TP%CHR>+1B<TP%LIT>		;[3457]

;THE RANGE CHECKING FLAG WORD CONTAINS ONE OF 12 BITS, 3 EACH
;OF 4 STATES (REPEAT COUNT, FORMAT WIDTH, DECIMAL WIDTH
;EXPONENT WIDTH) TO CHECK FOR NEGATIVE OK, ZERO OK, AND
;NO DIGITS SPECIFIED OK.

REFLAG==RPBOK+FWBOK+DWZOK+DWBOK
AFLAG==RPBOK+FWBOK
PFLAG==RPZOK+RPNOK
XFLAG==RPBOK

	DEFINE	FMTTAB
<
FMTENT	(JNKFMT,NOEXEC,NOEXEC,0)
FMTENT	(SLHFMT,@IOREC(D),@IOREC(D),FMTNC)
FMTENT	(DOLFMT,NOCR,NOCR,FMTNC)
FMTENT	(MINFMT,NOEXEC,NOEXEC,MINENC)
FMTENT	(DIGFMT,NOEXEC,NOEXEC,DIGENC)
FMTENT	(LPRFMT,NOEXEC,NOEXEC,LPRENC)
FMTENT	(RPRFMT,NOEXEC,NOEXEC,RPRENC)
FMTENT	(PERFMT,NOEXEC,NOEXEC,PERENC)
FMTENT	(SQFMT,SQIN,SQOUT,SQENC)
FMTENT	(AFMT,%ALPHI,%ALPHO,0,0,AFLAG)
FMTENT	(BFMT,BNZ,BNZ,BENC)
FMTENT	(DFMT,%DIRT,%DOUBT,0,FWARN,REFLAG)
FMTENT	(EFMT,%ERIN,%EOUT,0,FWARN,REFLAG)
FMTENT	(FFMT,%FLIRT,%FLOUT,0,FWARN,REFLAG)
FMTENT	(GFMT,GIN,GOUT,0,0,REFLAG)
FMTENT	(HFMT,HIN,HOUT,HENC)
FMTENT	(IFMT,%INTI,%INTO,MENC,IWARN,REFLAG)
FMTENT	(LFMT,%LINT,%LOUT,0,0,REFLAG)
FMTENT	(OFMT,%OCTI,%OCTO,0,OWARN,REFLAG) ;[3457]
FMTENT	(PFMT,PFACT,PFACT,FMTNC,0,PFLAG)
FMTENT	(QFMT,QIN,QOUT,FMTNC,QWARN)
FMTENT	(RFMT,%RIGHI,%RIGHO,0,0,REFLAG)
FMTENT	(SFMT,SSP,SSP,SENC)
FMTENT	(TFMT,TIN,TOUT,TENC)
FMTENT	(XFMT,XIN,XOUT,XENC,0,XFLAG)
FMTENT	(ZFMT,%HEXI,%HEXO,0,0,REFLAG)

GENT	(GNONE,%GINTI,%GINTO,0)	;NO TYPE GIVEN
GENT	(GLOGIC,%GLINT,%GLOUT,0)	;LOGICAL
GENT	(GINTEG,%GINTI,%GINTO,0)	;INTEGER
GENT	(G3,NOEXEC,NOEXEC,0)		;UNDEFINED
GENT	(GREAL,%GRIN,%GROUT,0)		;REAL
GENT	(G5,NOEXEC,NOEXEC,0)		;UNDEFINED
GENT	(GOCTAL,%GOCTI,%GOCTO,0)	;OCTAL
GENT	(GLABEL,NOEXEC,NOEXEC,0)	;LABEL
GENT	(GDREAL,%GRIN,%GROUT,0)		;DOUBLE REAL
GENT	(GDINT,%GINTI,%GINTO,0)		;DOUBLE INTEGER
GENT	(GDOCT,%OCTI,%OCTO,0)		;DOUBLE OCTAL
GENT	(GDGFL,%GRIN,%GROUT,0)		;EXTENDED DOUBLE REAL
GENT	(GCPX,%GRIN,%GROUT,0)		;COMPLEX
GENT	(GALPHA,%ALPHI,%ALPHO,0)	;FORTRAN CHARACTER
GENT	(G16,NOEXEC,NOEXEC,0)		;BASIC STRING
GENT	(G17,NOEXEC,NOEXEC,0)		;ASCIZ
>
	FMTN==0
	DEFINE	FMTENT(A,B,C,D,E,F)
	<A==FMTN
	FMTN==FMTN+1>
	DEFINE	GENT(A,B,C,D,E,F)
	<A==FMTN
	FMTN==FMTN+1>

	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
	<IFIW	B>
	DEFINE	GENT(A,B,C,D,E,F)
	<IFIW	B>
INTAB:	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
	<IFIW	C>
	DEFINE	GENT(A,B,C,D,E,F)
	<IFIW	C>
OUTAB:	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
	<D>
	DEFINE	GENT(A,B,C,D,E,F)
	<>
ENCTAB:	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
<	IFNB <E>,<E>
	IFB <E>,<0>
>
	DEFINE	GENT(A,B,C,D,E,F)
	<>
WRNTAB:	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
<	IFNB <F>,<F>
	IFB <F>,<0>
>
	DEFINE	GENT(A,B,C,D,E,F)
	<>
CHKTAB:	FMTTAB


;G-FORMAT CONVERSION ROUTINE ADDRESS TABLE.
;LH=INPUT, RH=OUTPUT
GTAB:	SKPFLG+GNONE		;NO TYPE GIVEN
	SKPFLG+GLOGIC		;LOGICAL
	SKPFLG+GINTEG		;INTEGER
	G3			;UNDEFINED
	SKPFLG+GREAL		;REAL
	G5			;UNDEFINED
	SKPFLG+GOCTAL		;OCTAL
	GLABEL			;LABEL
	SKPFLG+GDREAL		;DOUBLE REAL
	SKPFLG+GDINT		;DOUBLE INTEGER
	SKPFLG+GDOCT		;DOUBLE OCTAL
	SKPFLG+GDGFL		;EXTENDED DOUBLE REAL
	SKPFLG+GCPX		;COMPLEX
	GALPHA			;FORTRAN CHARACTER
	G16			;BASIC STRING
	G17			;ASCIZ

NOEXEC:	$ACALL	UDT		;UNDEFINED DATA TYPE

;EXEPRC - THE ENCODED FORMAT EXECUTIONER (SIMILAR TO
;LORD HIGH EXECUTIONER). THIS IS A TOTALLY RECURSIVE EXECUTION SEQUENCE.
;STARTING AT THE GIVEN FORMAT LIST POINTER, ENCODED WORDS ARE
;LOADED, AND DEPENDING ON THE FORMAT CODE, A DATA ITEM MAY BE RETRIEVED,
;AND THEN THE PROPER SUBROUTINE IS CALLED. A LEFT PAREN IS ENCODED AS
;AS A NEGATIVE WORD (NEGATIVE REPEAT COUNT),
;AND A WORD RESERVED FOR THE CURRENT (UPDATED) REPEAT COUNT.
;A RIGHT PAREN IS ENCODED AS A ZERO WORD FOLLOWED BY ITS
;RESPECTIVE LEFT PAREN RELATIVE ADDRESS. THUS THE LAST RIGHT PAREN HAS THE
;RELATIVE BEGINNING OF THE ENCODED FORMAT (%FMTEN) AS ITS 2ND
;WORD. WHEN A NEGATIVE ENTRY (AN ENCODED LEFT PAREN)
;IS ENCOUNTERED, THE EXECUTION SEQUENCE IS CALLED RECURSIVELY.

FMTEXC:	SETZM	%SCLFC			;CLEAR SCALE FACTOR
	SETZM	FMT.IU			;CLEAR I/O LIST USED FLAG
	SETZM	IO.ADR			;WE HAVE NO I/O ADDR YET!
	MOVE	T1,ENC.AD		;GET ENCODED FORMAT ADDR
	ADDI	T1,%FMTEN		;POINT TO 1ST FMT WORD
	MOVEM	T1,ENC.PT		;SAVE IN LIST PNTR

EXEPRC:	DMOVE	T1,@ENC.PT		;GET FORMAT ENTRY
	JUMPG	T1,EXENRM		;NORMAL EXECUTION
	JUMPE	T1,EXENLP		;HIT END OF LIST
	MOVEI	T2,2			;INCR TO NEXT ITEM
	ADDB	T2,ENC.PT
	MOVMM	T1,-1(T2)		;SAVE POSITIVE REPEAT COUNT
	JRST	EXEPRC			;GO ON

;T2 NOW HAS THE RELATIVE ADDRESS OF THE LEFT PAREN
EXENLP:	CAIN	T2,%FMTEN		;END OF FORMAT?
	 JRST	EXEND			;YES.
	ADD	T2,ENC.AD		;NO. GET ADDRESS OF LEFT PAREN
	SOSG	1(T2)			;DECR REPEAT COUNT
	 MOVE	T2,ENC.PT		;EXHAUSTED. GET CURRENT ADDRESS
	ADDI	T2,2			;POINT TO NEXT ITEM
	MOVEM	T2,ENC.PT		;SAVE POINTER
	JRST	EXEPRC			;START AGAIN

EXEND:	SETZM	IO.ENT			;SET NO FORMAT
	SKIPN	IO.ADR			;YES. I/O ADDR ALREADY?
	 POPJ	P,			;NO. GO GET ONE OR NEVER RETURN

EXRPT:	SKIPN	FMT.IU			;DATA USED BY LAST SCAN?
	 $ACALL	DLF			;Data in IO list but not in format
	MOVEI	T1,SLHFMT		;EXECUTE EOL FOR EACH REPEAT
	MOVEM	T1,IO.ENT
	PUSHJ	P,@DATENT		;READ OR WRITE A RECORD
	MOVE	T1,ENC.AD		;GET ENCODED FORMAT ADDR
	MOVE	T2,%FMTRP(T1)		;GET INDEF RPT PNTR
	ADD	T2,ENC.AD		;MAKE RELATIVE ABSOLUTE
	MOVEM	T2,ENC.PT		;FOR FORMAT LIST POINTER
	SETZM	FMT.IU			;CLEAR I/O LIST ENTRY USED FLAG
	JRST	EXEPRC			;BACK TO LOOP

EXENRM:	DMOVEM	T1,ENC.WD		;SAVE FOR CODE RETRIEVAL
	LDB	T1,CODPNT		;GET FORMAT CHAR
	MOVE	T1,FMT.CT(T1)		;GET TABLE ENTRY
	MOVEM	T1,IO.ENT		;Save flags and table entry for later
	TXNN	T1,IOLFLG		;DO WE NEED I/O LIST ENTRY?
	 JRST	NODATA			;NO. GO DO INPUT OR OUTPUT
	LDB	T1,RPTPNT		;GET NEW REPEAT COUNT
	MOVEM	T1,ENC.LR		;SAVE IT
DATLP:	SKIPN	IO.ADR			;DO WE HAVE ADDR ALREADY?
	 POPJ	P,			;LEAVE TO GET I/O ADDR!

;ENTER HERE FROM IOLST CALL WITH I/O ADDRESS IN IO.ADR
EXENT:	HRRZ	T1,IO.ENT		;GET FORMAT INDEX
	JUMPE	T1,NXTFMT		;IF NO FORMAT, GO GET ONE
	SETOM	FMT.IU			;SET I/O LIST ENTRY USED FLAG
	SKIPN	T2,WRNTAB(T1)		;ANY FATAL OR WARNING TYPE MISMATCH?
	 JRST	FVOK			;NO. ANYTHING GOES
	MOVE	T3,IO.TYP		;GET DATA TYPE
	LSH	T2,(T3)			;MOVE THE WARNING BITS
	JUMPGE	T2,FVOK			;NG IF BIT 0 = 1
	CAIN	T3,TP%CHR		;BUT TYPE CHAR CONFLICTS ARE FATAL
	 $ACALL	FVF			;FORMAT/VARIABLE MISMATCH FATAL
	$ECALL	FVM			;ISSUE WARNING

FVOK:
DATLP1:	PUSHJ	P,@DATENT		;GO DO INPUT OR OUTPUT
	SKIPN	T1,IO.INC		;ADD OFFSET TO I/O ADDR
	 JRST	NOINC			;NO INCREMENT
	XCT	IO.INS			;DO THE INCREMENT INSTRUCTION
	MOVEM	T1,IO.ADR		;SAVE NEW PNTR
NOINC:	SOSG	ENC.LR			;DECR LOCAL REPEAT COUNT
	 JRST	NEWFMT			;GO ON TO NEXT FMT, BUT DECR IO.NUM
	SOSLE	IO.NUM			;DECR LOCAL DATA COUNT
	 JRST	DATLP1			;STILL SOME DATA
	POPJ	P,			;NO MORE. LEAVE TO GET MORE

NEWFMT:	SOSG	IO.NUM			;DECR LOCAL DATA COUNT
	 SETZM	IO.ADR			;CLEAR I/O ADDR IF NONE LEFT
	MOVEI	T1,2			;ON TO NEXT FORMAT PAIR
	ADDM	T1,ENC.PT
	JRST	EXEPRC			;AND BACK FOR MORE FORMAT

NODATA:	PUSHJ	P,@DATENT		;DO INPUT OR OUTPUT
	MOVEI	T1,2			;ON TO NEXT FORMAT
	ADDM	T1,ENC.PT
	JRST	EXEPRC

NXTFMT:	SKIPN	@ENC.PT			;ARE WE AT END OF FORMAT?
	 JRST	EXRPT			;YES. GO USE INDEFINITE REPEAT
	MOVEI	T1,2			;NO. GO ON TO NEXT ITEM
	ADDM	T1,ENC.PT
	JRST	EXEPRC

DATOUT:	LDB	T1,W.PNTR		;GET FIELD WIDTH
	MOVEM	T1,%FWVAL		;SAVE IT
	LDB	T1,D.PNTR		;GET DECIMAL WIDTH
	MOVEM	T1,%DWVAL		;SAVE IT
	LDB	T1,X.PNTR
	MOVEM	T1,%XPVAL		;SAVE IT
	HRRZ	T1,IO.ENT		;GET ENTRY INDEX
	JRST	@OUTAB(T1)		;DO IT

DATIN:	LDB	T1,W.PNTR		;GET FIELD WIDTH
	MOVEM	T1,%FWVAL		;SAVE IT
	LDB	T1,D.PNTR		;GET DECIMAL WIDTH
	MOVEM	T1,%DWVAL		;SAVE IT
	LDB	T1,X.PNTR
	MOVEM	T1,%XPVAL		;SAVE IT
	HRRZ	T1,IO.ENT		;GET ENTRY INDEX
	PUSHJ	P,@INTAB(T1)		;DO IT
	SKIPE	%FWVAL			;FREE FORMAT?
	 POPJ	P,			;NO. LEAVE
	MOVE	T1,IO.ENT		;Get flags and table entry
	TXNE	T1,SKPFLG		;SCAN FOR NEXT DELIMITER
	 PUSHJ	P,SFDEL			;YES. SCAN FOR NEXT DELIM
	POPJ	P,

;G-FORMAT I/O. USES THE DATA TYPE TO FIGURE OUT WHAT TO DO
GIN:	MOVE	T1,IO.TYP		;GET VARIABLE TYPE
	CAIN	T1,TP%CHR		;[4146]IS IT A CHARACTER VARIABLE TYPE?
	 CALL	GFLAG			;[4146] YES; FLAGGER IT!
	MOVE	T1,GTAB(T1)		;GET I/O CONV ADDRESS
	MOVEM	T1,GENTRY		;SETUP FOR I/O
	MOVEI	T1,(T1)			;GET JUST INDEX INTO TABLE
	PUSHJ	P,@INTAB(T1)		;DO IT
	LDB	T1,WIDPNT		;FREE FORMAT?
	JUMPN	T1,%POPJ		;NO.
	MOVE	T1,GENTRY		;Get flags and table entry
	TXNE	T1,SKPFLG		;SCAN FOR NEXT DELIMITER
	 PUSHJ	P,SFDEL			;YES. SCAN FOR NEXT DELIM
	POPJ	P,

GOUT:	MOVE	T1,IO.TYP		;GET VARIABLE TYPE
	CAIN	T1,TP%CHR		;[4146]IS IT A CHARACTER VARIABLE TYPE?
	 CALL	GFLAG			;[4146] YES; FLAGGER IT!
	MOVE	T1,GTAB(T1)		;GET I/O CONV ADDRESS
	MOVEI	T1,(T1)			;GET JUST INDEX INTO TABLE
	JRST	@OUTAB(T1)		;DO IT

;+
; Check to see if Compatibility Flagging is ON ! {If it is}
; then issue a warning message "G format used with Character I/O".
;-

GFLAG:	MOVEI	T2,VAXIDX+ANSIDX;[4146]Flag this as an incompatibility for both
	TDNE	T2,%FLIDX	;[4146]Any flags the same?
	 $ECALL	CFG		;[4146]Yes. Display the error message
	POPJ	P,		;[4146]End of Routine GFLAG


;
;SCAN FOR A DELIMITER - FOR "FREE-FORMAT" INPUT,
;WE HAVE TO SCAN UNTIL WE REACH A "DELIMITER" FOR THIS TYPE
;OF INPUT, TO AVOID GETTING FAKE NULL VALUES FOR SUCH THINGS
;AS <DATA><SPACES><COMMA><SPACES><DATA>. THE DELIMITERS FOR
;FREE-FORMAT ARE ANY NON-BLANK CHARACTERS AND END-OF-LINE.
;IF THE NON-BLANK CHARACTER IS NOT A COMMA, THE BYTE POINTER
;IS BACKED UP VIA A CALL TO %IBACK SO THAT THE NEXT CALL
;TO %IBYTE WILL GET IT.
SFDEL:	PUSHJ	P,%IBYTC		;GET CURRENT CHAR
	JRST	DELGOT			;SKIP NEW CHAR
SFDLP1:	PUSHJ	P,%IBYTE		;GET NEXT CHAR
DELGOT:	SKIPGE	IRCNT(D)		;END OF RECORD?
	 POPJ	P,			;YES
	CAIE	T1," "			;SKIP SPACES AND TABS
	CAIN	T1,"	"
	 JRST	SFDLP1
	CAIE	T1,","			;LEAVE ON COMMA
	 JRST	%IBACK			;ELSE PUSH THE POINTER BACK
	POPJ	P,

;DOLLAR SIGN EXECUTION (SOUNDS LIKE SOCIALISM OR SOMETHING)...
;CALL SPECIAL ROUTINE ON OUTPUT WHICH OUTPUTS
;THE RECORD WITHOUT A CARRIAGE RETURN FOR OUTPUT.
;RIGHT NOW, JUST SET THE FLAG FOR THIS, AND SET
;THE RECORD POSITION IF A VIRTUAL ONE EXISTS (THAT IS,
;IF AN X OR T FORMAT WAS DONE IMMEDIATELY BEFORE THE $),
;SO THAT THE SPACES AT THE END WILL ACTUALLY APPEAR.
NOCR:	MOVX	T0,D%STCR		;Suppress trailing CR
	IORM	T0,FLAGS(D)
	POPJ	P,

;BNZ - BN AND BZ FORMAT
;IF THE LETTER AFTER THE B WAS A "Z", TURN ON THE
;BZ FORMAT FLAG, WHICH FORCES BLANKS TO BE INTERPRETED
;AS ZEROES FOR FIXED FORMAT FIELDS. OTHERWISE TURN OFF
;THE BZ FORMAT FLAG
BNZ:	LDB	T1,WIDPNT	;GET ARG
	SETZM	%BZFLG		;ASSUME "N"
	CAIN	T1,"Z"
	 SETOM	%BZFLG		;WAS "Z". SET FLAG
	POPJ	P,

;H-FORMAT - THE BYTE POINTER TO THE HOLLERITH STRING HAS
;BEEN STORED IN THE NEXT ENTRY IN THE FORMAT LIST. THE
;NUMBER OF CHARACTERS IS IN THE REPEAT FIELD.
HOUT:	LDB	T2,RPTPNT		;GET # CHARS
	MOVE	T3,ENC.W2		;Get byte ptr
HOUTLP:	ILDB	T1,T3			;GET CHAR
	PUSHJ	P,%OBYTE		;OUTPUT IT
	SOJG	T2,HOUTLP		;BACK FOR MORE
	POPJ	P,

;Q FORMAT - FOR INPUT, RETURNS THE NUMBER OF CHARS LEFT IN THE RECORD
;INTO THE SPECIFIED VARIABLE (INTEGER!). FOR OUTPUT, RETURNS THE NUMBER
;OF CHARACTERS WRITTEN IN THE RECORD.
QIN:	SKIPGE	T1,IRCNT(D)		;GET # CHARS LEFT
	  SETZ	T1,			;PAST END OF RECORD, RETURN 0
	MOVEM	T1,@IO.ADR		;PUT INTO USER'S VARIABLE
	POPJ	P,

QOUT:	MOVE	T1,ORSIZ(D)		;GET OUTPUT BUFFER LENGTH
	SUB	T1,ORCNT(D)		;GET CURRENT POSITION (0=COL 1)
	CAMG	T1,ORLEN(D)		;.GT. LAST RECORDED LENGTH
	 MOVE	T1,ORLEN(D)		;NO. RETURN THE LENGTH
	POPJ	P,

;P FORMAT - SETS THE SCALE FACTOR. THE SCALE FACTOR
;HAS BEEN STORED AS IF IT WERE A REPEAT COUNT, SO WE
;HAVE TO DO SOME CONTORTIONS IN ORDER TO EXTEND THE SIGN
PFACT:	HRRE	T1,ENC.WD		;EXTEND REPEAT COUNT
	MOVEM	T1,%SCLFC		;SAVE IT
	POPJ	P,

;SSP - HANDLES S,SP, AND SS FORMATS.
;THE DEC IMPLEMENTATION OF THIS FORMAT MEANS THAT S FORMAT
;MEANS SS, SINCE WE DO NOT OUTPUT A PLUS SIGN
;UNDER NORMAL CIRCUMSTANCES. SO THERE IS A SINGLE FLAG, WHICH JUST
;SAYS WHETHER OR NOT TO FORCE A PLUS SIGN (AND THEN ONLY IF IT WILL
;FIT!), CORRESPONDING TO SP AND SS.
SSP:	LDB	T1,WIDPNT		;GET THE CODE
	SETZM	%SPFLG			;ASSUME NOT "P"
	CAIN	T1,"P"			;IS IT P?
	 SETOM	%SPFLG			;YES. SET FLAG
	POPJ	P,

;T FORMAT - POSITIONS RECORD POINTER.
;ARGUMENT IS IN WIDTH FIELD
TIN:	LDB	T2,DECPNT		;GET L OR R
	JUMPN	T2,ILRPOS		;GO PROCESS THEM IF THERE
	LDB	T1,WIDPNT		;GET VALUE
	PJRST	%SIPOS			;POSITION PNTR/COUNT

ILRPOS:	LDB	T1,WIDPNT		;GET FORMAT ARG
	CAIN	T2,'L'			;IS IT TAB LEFT?
	MOVNI	T1,(T1)			;YES. NEGATE TAB
	PJRST	%CIPOS			;GO CHANGE POSITION

TOUT:	LDB	T2,DECPNT		;GET L OR R
	JUMPN	T2,OLRPOS		;GO PROCESS THEM IF THERE
	LDB	T1,WIDPNT		;GET VALUE
	PJRST	%SOPOS			;GO SET POSITION

OLRPOS:	LDB	T1,WIDPNT		;GET FORMAT ARG
	CAIN	T2,'L'			;IS IT TAB LEFT?
	MOVNI	T1,(T1)			;YES. NEGATE TAB
	PJRST	%COPOS			;GO CHANGE POSITION

;X FORMAT - SIMILAR TO T FORMAT, BUT WITH REPEAT COUNT INSTEAD
;OF WIDTH FOR ITS VALUE
XIN:	LDB	T1,RPTPNT		;GET ARG OF X-FORMAT
	PJRST	%CIPOS			;GO CHANGE POSITION

XOUT:	LDB	T1,RPTPNT		;GET ARG OF X-FORMAT
	PJRST	%COPOS			;GO CHANGE POSITION

;SINGLE QUOTE OUTPUT - LIKE HOLLERITH, THE BYTE POINTER IS STORED
;AS THE NEXT (1 OR 2) WORD ON THE FORMAT LIST, AND THE CHARACTER COUNT IS
;STORED AS THE WIDTH. UNLIKE HOLLERITH, DOUBLE APOSTROPHES MUST BE
;TURNED INTO SINGLE APOSTROPHES.
SQOUT:	LDB	T2,RPTPNT		;GET THE # CHARS
	JUMPE	T2,SQODON		;DONE IF NO CHARS
	MOVE	T3,ENC.W2		;Get the byte ptr.
SQOLP:	ILDB	T1,T3			;GET CHAR
	CAIE	T1,"'"			;IS IT A QUOTE?
	JRST	PUTNSQ			;NO. GO OUTPUT IT
	SOJLE	T2,SQODON		;DECR AND LEAVE IF NO MORE
	IBP	T3			;INCR PAST THE NEXT CHAR
PUTNSQ:	PUSHJ	P,%OBYTE		;AND PRINT CHAR
	SOJG	T2,SQOLP		;BACK FOR MORE
SQODON:	POPJ	P,

;SINGLE QUOTE INPUT - ALLOWS THE USER TO OVERWRITE A QUOTED STRING
;IN THE FORMAT STATEMENT. DISALLOWED BY THE ANSI STANDARD, BUT WE
;DO IT ANYWAY.

;HOLLERITH INPUT - A STUPID WAY TO WRITE PROGRAMS, BUT ELLIOT
;ORGANICK USES IT AS AN EXAMPLE IN HIS INTRO TO FORTRAN! THE NUMBER
;OF CHARACTERS SPECIFIED IN THE FIELD ARE READ FROM THE INPUT RECORD
;AND WRITTEN INTO THE ORIGINAL FORMAT STATEMENT.
;BOTH OF THESE ARE LIKELY TO BE MADE ILLEGAL SOMEDAY, SO
;WE OUTPUT A WARNING. IT IS STRICTLY ILLEGAL FOR CHARACTER
;CONSTANTS SPECIFIED AS FORMATS, AND THEREFORE PRODUCES A
;FATAL ERROR.
SQIN:
HIN:	MOVE	T1,ENC.AD		;GET ENCODED ADDR
	MOVE	T1,%FMTYP(T1)		;GET THE FORMAT TYPE
	CAIN	T1,TP%CHR		;TYPE CHARACTER?
	 $ACALL	RIC			;YES. CAN'T READ INTO IT
	$ECALL	RIF			;NO. JUST ISSUE WARNING
	LDB	T2,RPTPNT		;GET # CHARS TO INPUT
	MOVE	T3,ENC.W2		;Get the byte ptr
HINLP:	PUSHJ	P,%IBYTE		;GET A CHAR
	IDPB	T1,T3			;DEPOSIT INTO FORMAT
	SOJG	T2,HINLP		;BACK FOR MORE
	POPJ	P,

;GTFCHR - GET THE NEXT CHARACTER IN THE FORMAT.
;EXCEPT FOR H-FORMAT AND QUOTED STRINGS, WE DO NOT WANT
;NULL CHARACTERS FROM THE FORMAT STATEMENT. ADDITIONALLY,
;PROVISION HAS BEEN MADE IF WE READ TOO FAR WE SAVE THE
;CHARACTER READ AS THE "PREVIOUS CHAR" AND RETRIEVE IT THE
;NEXT TIME GTFCHR IS CALLED.

GTFCHR:	SKIPE	T1,FMT.PC		;Is there a previous char?
	JRST	PREVCH			;Yes, go clear it
NOPREV:	SOSGE	FMT.SZ			;ANY CHARS LEFT?
	POPJ	P,			;NO. RETURN WITH NULL
	ILDB	T1,FMT.BP		;GET A CHAR
	JUMPE	T1,NOPREV		;SKIP NULLS
	CAILE	T1,140			;LOWER CASE?
	SUBI	T1,40			;YES. CONVERT TO UPPER
	POPJ	P,

PREVCH:	SETZM	FMT.PC			;IF ONE, NOW CLEAR IT
	POPJ	P,			;SO WE WON'T GET IT AGAIN

%IFORM:
%OFORM:	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIE	T1,TP%CPX	;COMPLEX?
	 JRST	EXENT		;NO. ENTER DATA LOOP

CPXSUB:	MOVEI	T1,TP%SPR	;SUBSTITUTE REAL
	MOVEM	T1,IO.TYP	;FOR THE DATA TYPE
	MOVE	T1,[ADD	T1,IO.ADR] ;SETUP INCR INST
	MOVEM	T1,IO.INS
	MOVE	T1,IO.SIZ	;GET DATA SIZE
	CAME	T1,IO.INC	;SAME AS INCREMENT?
	 JRST	CMPCPX		;NO. COMPLICATED COMPLEX
	IMULM	T1,IO.NUM	;YES. JUST MULTIPLY NUMBER ELEMENTS
	MOVEI	T1,1		;AND SUBSTITUTE 1 FOR SIZE
	MOVEM	T1,IO.SIZ
	MOVEM	T1,IO.INC	;AND FOR INCREMENT
	JRST	EXENT		;ENTER DATA LOOP

CMPCPX:	MOVE	T1,IO.NUM	;GET # ELEMENTS
	CAIN	T1,1		;ONLY ONE ELEMENT?
	 JRST	CPXONE		;YES.
	MOVEM	T1,FIONUM	;NO. SAVE LOCALLY
	MOVEI	T1,1		;SUBSTITUTE 1 FOR SIZE
	MOVEM	T1,IO.SIZ
	EXCH	T1,IO.INC	;AND FOR INCREMENT
	MOVEM	T1,FIOINC	;AND SAVE REAL INCREMENT LOCALLY
	MOVE	T1,IO.ADR	;SAVE DATA ADDRESS LOCALLY
	MOVEM	T1,FIOADR	;AS THE DATA LOOP CLEARS IT
CPXLP:	MOVEI	T1,2		;SUBSTITUTE 2 FOR
	MOVEM	T1,IO.NUM	;NUMBER OF ELEMENTS
	PUSHJ	P,EXENT		;DROP BACK TO FMTEXC
	MOVE	T1,FIOINC	;INCR THE DATA PNTR
	ADDB	T1,FIOADR
	MOVEM	T1,IO.ADR	;SETUP THE DATA ADDRESS AGAIN
	SOSLE	FIONUM		;DECR THE COMPLEX ENTRY COUNT
	 JRST	CPXLP		;BACK FOR MORE
	POPJ	P,		;DONE

CPXONE:	MOVEI	T1,1		;SET INCREMENT TO 1
	MOVEM	T1,IO.INC
	MOVEM	T1,IO.SIZ	;AS WELL AS SIZE
	MOVEI	T1,2		;AND SETUP FOR 2 ELEMENTS
	MOVEM	T1,IO.NUM
	PJRST	EXENT		;GO DO I/O

	SEGMENT	DATA


T.FMT:	BLOCK	1		;FORMAT ARG TYPE
FMTADR:	BLOCK	1		;ADDRESS OF ENTRY IN ENCODED LINKED LIST
FMTPTR:	BLOCK	1		;ENCODED LIST POINTER
FMTCNT:	BLOCK	1		;COUNT OF ENCODED LIST ENTRIES

IO.ADR:: BLOCK	1
IO.TYP:: BLOCK	1
IO.NUM:: BLOCK	1		;NUMBER OF ELEMENTS
IO.INC:: BLOCK	1
IO.SIZ:: BLOCK	1		;SIZE OF VARIABLE
IO.INS:: BLOCK	1		;INCREMENT INSTRUCTION

FIONUM:	BLOCK	1		;LOCAL DATA COUNT
FIOINC:	BLOCK	1		;LOCAL INCREMENT
FIOADR:	BLOCK	1		;LOCAL ADDRESS
IO.ENT:	BLOCK	1		;Save flags and table address in EXENRM
DATENT:	BLOCK	1		;INST TO EXECUTE AFTER %GETIO CALL
GENTRY:	BLOCK	1		;FLAGS AND INDEX FOR G-FORMAT

	SEGMENT	CODE

	END