Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/ots-debugger/forfmt.mac
There are 11 other files named forfmt.mac in the archive. Click here to see a list.

	SEARCH	FORPRM
	TV	FORFMT	FORMAT PROCESSOR,7(3250)

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1983

;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 Revision History *****

\
	ENTRY	%IFSET,%OFSET

	EXTERN	%OBYTE,%IBYTE,%IBYTC,%IRECS,%OREC,%ORECS,%SETAV
	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
	EXTERN	%ABORT,%POPJ,%POPJ1
	EXTERN	FMT.LS,%FAREA,%FTSLB
	EXTERN	A.FMT,T.FMT,A.FMS
	INTERN	%FMTSV,%FMTCL,%IFORM,%OFORM
	INTERN	SCL.SV,USR.AD,USR.SZ,ENC.WD,ENC.W2,ENC.LR
	INTERN	W.PNTR,D.PNTR,X.PNTR
	INTERN	FMT.BG,FMT.BP,FMT.SZ

;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
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 (RH=LINK TO AFTER LOOP)
SCL.SV:	BLOCK	1	;SCALE FACTOR
ENC.AD:	BLOCK	1	;ADDRESS OF CURRENT ENCODED FORMAT
ENC.PT:	BLOCK	1	;FORMAT STACK POINTER
ENC.RP:	BLOCK	1	;LOOP EXECUTION REPEAT COUNT
ENC.LR:	BLOCK	1	;LOCAL REPEAT COUNT

;LOCAL VARIABLES - USED BY THE FORMAT ENCODER AND/OR AS TEMPS
;BY THE FORMAT EXECUTION
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
	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
	DRFLG+COLFMT		;:
	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

STAERR:	$ECALL	IRC,%ABORT
	$ECALL	IFW,%ABORT
	$ECALL	IFW,%ABORT
	$ECALL	IFW,%ABORT
;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:	SKIPA	T1,[JRST DATIN]		;SETUP FOR INPUT
%OFSET:	MOVE	T1,[JRST DATOUT]	;SETUP FOR OUTPUT
	MOVEM	T1,DATENT
	MOVEM	P,OTHERP		;SAVE THE CURRENT PDP
	MOVE	P,IOPDP			;GET A PRIVATE ONE FOR COROUTINE
	MOVE	T1,A.FMT		;GET ADDRESS OF FORMAT
	PUSHJ	P,%OVNUM		;AND LINK NUMBER
	DMOVEM	T1,USR.AD		;SAVE THEM
	MOVE	T2,T.FMT		;GET ARG TYPE
	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
	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
	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,
%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
	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,FMTER3		;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
	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,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?
	 $ECALL	ILF,%ABORT		;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:	HRRZ	P3,FMT.CT(P1)		;GET TABLE ADDR
	JUMPE	P3,FMTLP		;BACK IF NO DISPATCHES
	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
	 $ECALL	IFW,%ABORT
	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?
	 $ECALL	IRC,%ABORT		;NO. ILLEGAL REPEAT COUNT
	POPJ	P,			;YES. JUST IGNORE THE WHOLE THING

FMTOK:	PUSHJ	P,CHKWID		;CHECK ACCUMULATED WIDTH
FMTNC:	SKIPE	T1,FMT.FW		;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

;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,[-3,,0]		;LEAVE AT LEAST 3
	 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
	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
	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. 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
	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
	 $ECALL	IFW,%ABORT		;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,[1000000000.]	;PREVENT OVERFLOW
	 JRST	STAERR(T1)		;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
;IN THE LEFT HALF, AND THE ADDRESS OF A "LINK" IN THE RIGHT HALF.
;A "LINK" IS THE ADDRESS OF THE 1ST WORD ENCODED AFTER THE RIGHT
;PAREN CORRESPONDING TO THE CURRENT LEFT PAREN. 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 STACK ADDRESS IS THE
;BEGINNING OF THE FORMAT STACK, 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
	XMOVEI	T1,1(P4)		;GET REL ADDR OF PAREN WORD
	SUB	T1,ENC.AD
	PUSH	P,T1			;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
	PUSHJ	P,STKCHK		;CHECK IF ENOUGH ROOM ON THE STACK
	PUSHJ	P,FMTPRC		;RECURSIVE CALL
	POP	P,T2			;GET FORMAT LINK ADDR
	CAMN	T2,FMT.LK		;IF LINK ADDR IS START ADDR
	JRST	%POPJ1			;WE'RE DONE
	MOVEM	T2,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
	$ECALL	ILF,%ABORT		;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
	 $ECALL	ILF,%ABORT		;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 STACK.
HENC:	SKIPG	T1,FMT.RP		;GET THE REPEAT COUNT
;	IOERR	(IHC,,,?,Illegal Hollerith constant,,%ABORT)
	 $ECALL	IHC,%ABORT
	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


;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)		;WASTED LOCATIONS FOR 0 OFFSET
FMTENT	(COLFMT,%POPJ,COLEXE,FMTNC)
FMTENT	(SLHFMT,%IRECS,%ORECS,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,0,REFLAG)
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)
	<JRST	B>
	DEFINE	GENT(A,B,C,D,E,F)
	<JRST	B>
INTAB:	FMTTAB

	DEFINE	FMTENT(A,B,C,D,E,F)
	<JRST	C>
	DEFINE	GENT(A,B,C,D,E,F)
	<JRST	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:	$ECALL	UDT,%ABORT	;UNDEFINED DATA TYPE
;THIS IS THE CALL TO FORMAT EXECUTION, EXEPRC.

FMTEXC:	SETZM	ENC.RP			;CLEAR LOOP REPEAT COUNT
	SETZM	ENC.LR			;AND LOCAL REPEAT COUNT
	SETZM	FMT.LK			;AND LINK WORD
	SETZM	SCL.SV			;CLEAR SCALE FACTOR
	SETZM	FMT.IU			;CLEAR I/O LIST USED FLAG
	SETZM	IO.ADR			;WE HAVE NO DATA YET!
	MOVE	T2,FLAGS(D)		;T2= DDB flags
	TXZ	T2,D%SP+D%BZ		;Default is BN and SS
	LOAD	T1,BLNK(U)		;UNLESS SET OTHERWISE IN DDB
	CAIN	T1,BL.ZERO		;BLANK=ZERO?
	  TXO	T2,D%BZ			;YES, SET BZ
	MOVEM	T2,FLAGS(D)		;Set new DDB flags
	MOVE	T1,ENC.AD		;GET ENCODED FORMAT ADDR
	ADDI	T1,%FMTEN		;POINT TO 1ST FMT WORD
	MOVEM	T1,ENC.PT		;SAVE IN STACK PNTR
	PUSHJ	P,EXEPRC		;EXECUTE THE FORMAT

EXELP:	SKIPN	IO.ADR			;ANY I/O ADDR READY?
	 PUSHJ	P,%GETIO		;NO. GET ANOTHER I/O ADDR
	SKIPN	FMT.IU			;DATA USED BY LAST SCAN?
	 $ECALL	DLF,%ABORT		;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 BLOCK ADDR
	MOVE	T1,%FMTRP(T1)		;GET INDEF RPT PNTR
	MOVEI	T2,(T1)			;COPY IT
	ADD	T2,ENC.AD		;MAKE RELATIVE ABSOLUTE
	MOVEM	T2,ENC.PT		;FOR FORMAT STACK
	CAIE	T1,%FMTEN		;IF WE'RE NOT AT BEG OF FORMAT
	 MOVEM	T2,FMT.LK		;STORE A LINK
	SETZM	ENC.RP			;CLEAR LOOP REPEAT COUNT
	SETZM	ENC.LR			;AND LOCAL REPEAT COUNT
	SETZM	FMT.IU			;CLEAR I/O LIST ENTRY USED FLAG
	PUSHJ	P,EXEPRC		;GO EXECUTE FORMAT
	JRST	EXELP			;GO BACK FOR MORE
;EXEPRC - THE ENCODED FORMAT EXECUTIONER (SIMILAR TO
;LORD HIGH EXECUTIONER). THIS IS A TOTALLY RECURSIVE EXECUTION SEQUENCE.
;STARTING AT THE GIVEN FORMAT STACK POINTER, ENCODED WORDS ARE
;LOADED, AND DEPENDING ON THE FORMAT CODE, A DATA ITEM MAY BE RETRIEVED,
;AND THEN THE PROPER SUBROUTINE IS CALLED. THE FORMAT ENCODER HAS
;ENCODED LEFT PARENS AS WORDS WITH A NEGATIVE LEFT HALF (NEGATIVE REPEAT COUNT),
;AND A LINK TO THE FORMAT CODES AFTER THE LOOP IN THE RIGHT HALF. THE FIRST
;ENCODED LEFT PAREN HAS A ZERO LINK, AS THERE ARE NO FORMAT ITEMS AFTER
;ITS MATCHING RIGHT PAREN. HERE, WHEN A NEGATIVE ENTRY (AN ENCODED LEFT PAREN)
;IS ENCOUNTERED, THE EXECUTION SEQUENCE IS CALLED RECURSIVELY, SAVING
;THE CURRENT VALUE OF THE LOOP REPEAT COUNT AND CURRENT LEFT PAREN
;ADDRESS (REFFERED TO AS THE "LINK" ADDRESS) ON THE PUSHDOWN STACK.
;UPON RETURN, THE FORMAT STACK POINTER IS SET TO THE ADDRESS SPECIFIED BY
;THE ENCODED LEFT PAREN (IN FMT.LK).

EXEPRC:	SKIPL	T1,@ENC.PT		;PAREN?
	JRST	EXENRM			;NO. NORMAL EXECUTION
	PUSH	P,ENC.RP		;YES. SAVE OLD REPEAT COUNT
	PUSH	P,FMT.LK		;AND LINK ADDR
	MOVMM	T1,ENC.RP		;SAVE NEW REPEAT COUNT
	MOVE	T1,ENC.PT		;GET THE ADDR OF THE PAREN WORD
	MOVEM	T1,FMT.LK		;SAVE FOR LINK
	AOS	ENC.PT			;POINT TO NEXT ITEM
	PUSHJ	P,EXEPRC		;RECURSIVE CALL
	POP	P,FMT.LK		;RESTORE PREVIOUS LINK
	POP	P,ENC.RP		;AND REPEAT COUNT
	SKIPN	FMT.LK			;DO WE HAVE ANY MORE?
	 POPJ	P,			;NO. WE'RE DONE
	AOS	ENC.PT			;YES. PROCEED TO NEXT ITEM
	JRST	EXEPRC			;AND START AGAIN
EXENRM:	DMOVE	T1,@ENC.PT		;GET FORMAT WORDS
	JUMPE	T1,EXENLP		;HIT END OF LIST
	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
	SETOM	FMT.IU			;YES, SET I/O LIST ENTRY USED FLAG
	LDB	T1,RPTPNT		;GET NEW REPEAT COUNT
	MOVEM	T1,ENC.LR		;SAVE IT
DATLP:	SKIPN	IO.ADR			;DO WE HAVE ADDR ALREADY?
	 PUSHJ	P,%GETIO		;NO. GET ONE. (MAY NOT EVER RETURN...)
	HRRZ	T1,IO.ENT		;GET FORMAT INDEX
	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
	 $ECALL	FVF,%ABORT		;FORMAT/VARIABLE MISMATCH FATAL
	MOVE	T3,%SIZTB(T3)		;GET DATA SIZE
	XCT	GETINS(T3)		;GET THE DATA
	DMOVEM	T1,%UNFXD		;STORE AS UNFIXED RESULT
	$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
	SETZM	IO.ADR			;CLEAR I/O ADDR IF NONE LEFT
	JRST	DATLP			;AND 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

DATOUT:	HRRZ	T1,IO.ENT		;GET I/O ROUTINE OFFSET
	JRST	OUTAB(T1)		;DO IT

DATIN:	HRRZ	T1,IO.ENT		;GET I/O ROUTINE OFFSET
	PUSHJ	P,INTAB(T1)		;DO IT
	LDB	T1,WIDPNT		;FREE FORMAT?
	JUMPN	T1,%POPJ		;NO.
	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,

EXENLP:	SOSG	ENC.RP			;DECR REPEAT COUNT
	POPJ	P,			;END OF LIST OR COUNT EXHAUSTED
	MOVE	T1,FMT.LK		;GET ADDR BEFORE START
	ADDI	T1,1			;RESET PNTR
	MOVEM	T1,ENC.PT		;TO LOOP
	JRST	EXEPRC			;START AGAIN
;G-FORMAT I/O. USES THE DATA TYPE TO FIGURE OUT WHAT TO DO
GIN:	MOVE	T1,IO.TYP		;GET VARIABLE TYPE
	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
	MOVE	T1,GTAB(T1)		;GET I/O CONV ADDRESS
	MOVEI	T1,(T1)			;GET JUST INDEX INTO TABLE
	JRST	OUTAB(T1)		;DO IT

GETINS:	NOP			;0 - DON'T LOAD ANYTHING
	MOVE	T1,@IO.ADR	;1 - SINGLE
	DMOVE	T1,@IO.ADR	;2 - DOUBLE

;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,

;COLEXE - COLON FORMAT EXECUTION
;CALL %GETIO TO GET AN I/O LIST ENTRY (IF THERE ISN'T ONE ALREADY)
;AND LEAVE. NEVER RETURNS IF THERE IS NO MORE.
COLEXE:	SKIPN	IO.ADR			;ANY I/O ADDRESS?
	 PUSHJ	P,%GETIO		;NO. GET ONE (MAY NEVER RETURN)
	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
	MOVX	T0,D%BZ			;Assume not Z
	ANDCAM	T0,FLAGS(D)
	CAIN	T1,"Z"
	 IORM	T0,FLAGS(D)		;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 STACK. 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,SCL.SV		;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
	MOVX	T0,D%SP			;Assume not "P"
	ANDCAM	T0,FLAGS(D)
	CAIN	T1,"P"			;IS IT P?
 	 IORM	T0,FLAGS(D)		;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 STACK, 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?
	 $ECALL	RIC,%ABORT		;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


FMTER3:	$SNH

%EXCH:
%GETIO:	EXCH	P,OTHERP	;COROUTINE JUMP
	POPJ	P,

%IFORM:	SKIPN	T1,IO.ADR	;DO WE HAVE ANY DATA?
	 JRST	%SETAV		;NO. IT'S A FIN CALL
	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIN	T1,TP%CPX	;COMPLEX?
	 JRST	CPXSUB		;YES
	EXCH	P,OTHERP	;NO. JUST DROP BACK INTO FMTEXC
	POPJ	P,

%OFORM:	SKIPN	T1,IO.ADR	;DO WE HAVE ANY DATA?
	 JRST	FINOUT		;NO. FINISH OUTPUT
	SETZM	%FTSLB		;ALLOW LEADING BLANKS ON OUTPUT
	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIN	T1,TP%CPX	;COMPLEX?
	 JRST	CPXSUB		;YES
	EXCH	P,OTHERP	;NO. JUST DROP BACK INTO FMTEXC
	POPJ	P,

FINOUT:	PUSHJ	P,%OREC		;OUTPUT THE RECORD
	PJRST	%SETAV		;GO STORE ASSOC VAR

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
	EXCH	P,OTHERP	;THEN DROP BACK INTO FMTEXC
	POPJ	P,

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,%EXCH		;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	%EXCH		;GO DO I/O

IOSIZ==200
IOPDP:	IOWD	IOSIZ,IOPDL	;PRIVATE PDP

	SEGMENT	DATA

OTHERP:	BLOCK	1		;PLACE TO SAVE USER STACK
IOPDL:	BLOCK	IOSIZ		;PRIVATE STACK FOR FORMAT EXECUTION ONLY

IO.ADR:: BLOCK	1
IO.TYP:: BLOCK	1
IO.NUM:: BLOCK	1		;NUMBER OF ELEMENTS
IO.INC:: BLOCK	1
IO.INF:: 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

ILLEG.:: 0

	SEGMENT	CODE

	PURGE	$SEG$
	END