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

	SEARCH	FORPRM
	TV	FORFMT	FORMAT PROCESSOR,6(2033)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

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

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

\

	ENTRY	%FORMT

	EXTERN	%OBYTE,%GETIO,%IBYTE,%IBYTC,%IREC,%ORECS,%RPOS,%SPOS
	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
	EXTERN	%GTBLK,%FREBL,%SAVE4,%IBACK,%OVNUM
	EXTERN	%ABORT,%POPJ,%POPJ1
	EXTERN	FMT.LS
	EXTERN	A.FMT,T.FMT,A.FMS
	EXTERN	I.EXT
	INTERN	%FMTSV,%FMTCL
	INTERN	SCL.SV,USR.AD,USR.TY,USR.SZ,ENC.WD
	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
%FMTRP==2			;INDEFINITE REPEAT PNTR
%FMTEN==3			;FIRST WORD OF ENCODED FORMAT

TP%LBL==7

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			;SKIP TO DELIM AFTER SCAN
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

;DDB BLOCK VARIABLES - USED DURING EXECUTION
FMT.LK:	0		;PNTR TO ENCODED LEFT PAREN (RH=LINK TO AFTER LOOP)
SCL.SV:	0		;SCALE FACTOR
ENC.AD:	0		;ADDRESS OF CURRENT ENCODED FORMAT
ENC.PT:	0		;FORMAT STACK POINTER
ENC.RP:	0		;LOOP EXECUTION REPEAT COUNT
ENC.LR:	0		;LOCAL REPEAT COUNT

;LOCAL VARIABLES - USED BY THE FORMAT ENCODER AND/OR AS TEMPS
;BY THE FORMAT EXECUTION
SAV.EF:	0		;ADDR OF LOC TO SAVE ADDR OF ENCODED FORMAT
RPT.PT:	0		;INDEFINITE REPEAT POINTER
FMT.BG:	0		;BYTE POINTER TO BEGINNING OF FORMAT
FMT.BP:	0		;FORMAT BYTE POINTER
FMT.IU:	0		;I/O LIST ENTRY USED FLAG
NUM.AD:	0		;DIGIT ACCUMULATOR PNTR
ENC.WD:	0		;ENCODED FORMAT WORD
USR.TY:	0		;FORMAT ARG TYPE
USR.AD:	0		;ACTUAL FORMAT ADDRESS
USR.SZ:	0		;SIZE OF FORMAT IN WORDS
FMT.CC:	0		;CURRENT FORMAT CHAR
FMT.PC:	0		;PREVIOUS CHAR
FMT.SZ:	0		;SIZE OF FORMAT IN CHARS

FMT.DB:			;ENCODING DATABASE - CLEARED BY FMTINT
FMT.SG:	0		;SIGN
FMT.WD:	0		;FORMAT WIDTH
FMT.DW:	0		;DECIMAL WIDTH
FMT.CH:	0		;FORMAT CHARACTER (SIXBIT)
FMT.EW:	0		;EXPONENT WIDTH (do not split FMT.EW and FMT.RP)
FMT.RP:	0		;REPEAT COUNT
FMT.EN==.-1		;END OF ENCODING DATABASE

	SEGMEN	CODE

;BYTE POINTERS TO FORMAT ATTRIBUTES (WIDTH, DECIMAL WIDTH, ETC.)
W.PNTR:
WIDPNT:	POINT	8,ENC.WD,8	;TOTAL WIDTH OF FORMAT ELEMENT
				;AVOID BIT 0 SO IT WON'T BE NEGATIVE
				;AS NEGATIVE MEANS PAREN REPEAT
RPTPNT:	POINT	12,ENC.WD,20	;REPEAT COUNT
D.PNTR:
DECPNT:	POINT	6,ENC.WD,26	;DECIMAL WIDTH
X.PNTR:
EWPNT:	POINT	3,ENC.WD,29	;EXPONENT WIDTH
CODPNT:	POINT	6,ENC.WD,35	;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
	DTISFL+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			;_

;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			LINK NUMBER ,, ADDR OF ACTUAL FORMAT
;  2			INDEFINITE REPEAT POINTER
;  3			ENCODED WORD 1
;  4			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.

;%FORMT IS THE FORMAT CALL 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.
%FORMT:	MOVE	T1,A.FMT		;GET ADDRESS OF FORMAT
	PUSHJ	P,%OVNUM		;GET LINK NUMBER ALSO
	MOVEM	T1,USR.AD		;SAVE IT
	MOVE	T2,A.FMS		;GET SIZE
	MOVEM	T2,USR.SZ		;SAVE IT
	MOVE	T1,T.FMT		;GET ARG TYPE
	MOVEM	T1,USR.TY		;SAVE IT
	PUSHJ	P,FMTSRH		;SEARCH FOR ENCODED FORMAT
	MOVEM	T1,ENC.AD		;SAVE THE ADDR FOUND
	JUMPN	T1,NOENC		;GO EXECUTE IF ALREADY ENCODED
	PUSHJ	P,FMTENC		;ENCODE THE FORMAT
	MOVE	T1,USR.TY		;GET FORMAT TYPE
	CAIN	T1,TP%LBL		;LABEL?
	JRST	SAVENC			;YES. GO SAVE IT
	PUSHJ	P,FMTEXC		;NO. EXECUTE THE FORMAT
	MOVE	T1,ENC.AD		;FREE THE CORE WE GOT
	PJRST	%FREBL			;FREE IT UP

SAVENC:	MOVE	T1,ENC.AD		;GET THE ENCODED ADDR
	MOVEM	T1,@SAV.EF		;SAVE IT ON LINKED LIST
NOENC:	PJRST	FMTEXC			;EXECUTE THE FORMAT

%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:	MOVEI	T1,@%ADR(L)		;GET ARRAY ADDR
	PUSHJ	P,%OVNUM		;GET LINK NUMBER ALSO
	MOVEM	T1,USR.AD		;SAVE IT
	LDB	T1,[POINTR %ADR(L),ARGTYP];GET ARRAY TYPE
	MOVE	T2,@%SIZ(L)		;GET # ARRAY ELEMENTS
	IMUL	T2,%SIZTB(T1)		;GET # WORDS
	MOVEM	T2,USR.SZ		;SAVE IT
	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
	MOVE	T1,ENC.AD		;AND LINK INTO THE LIST
	MOVEM	T1,@SAV.EF
	POPJ	P,

;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:	MOVEI	T1,@%ADR(L)		;GET ARRAY ADDR
	MOVEM	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 SIZE OF THE CORE WE ALLOCATE
;IS DETERMINED BY THE SIZE OF THE FORMAT STATEMENT OR ARRAY, IN
;CHARACTERS. WHILE THIS IS AN INEXACT MEASURE (USUALLY MUCH MORE
;THAN NECESSARY), IT IS AT LEAST SAFE, AND WE HAVE NO BETTER
;WAY TO DO IT OTHER THAN DOING A PRESCAN OF THE FORMAT.
FMTENC:	SETZM	FMT.PC			;CLEAR PREV CHAR
	MOVE	T1,USR.SZ		;GET SIZE OF FORMAT STRING
	IMULI	T1,5			;GET # CHARS
	MOVEM	T1,FMT.SZ		;SAVE THE SIZE
	ADDI	T1,%FMTEN+5		;PLUS A FEW FOR LINK, ADDR, & INDEF RPT
	MOVNI	P4,(T1)			;GET NEGATIVE SIZE
	HRLZI	P4,(P4)			;IN LEFT HALF FOR FORMAT LIST
	PUSHJ	P,%GTBLK		;GET SOME CORE
	HRRI	P4,-1(T1)		;CREATE A DECODED STACK PNTR
	MOVEM	T1,ENC.AD		;SAVE ADDR FOR EXECUTION
	PUSH	P4,[0]			;CLEAR "NEXT LINK" ADDR
	PUSH	P4,USR.AD		;SAVE THE ENCODED FORMAT ADDR
	PUSH	P4,[0]			;CLEAR INDEF RPT PNTR
	MOVEM	P4,FMT.LK		;SAVE THE CURRENT STACK PNTR
	MOVEI	T1,1(P4)		;GET ADDR FOR ENCODED CHARS
	MOVEM	T1,RPT.PT		;INIT INDEF RPT PNTR
	MOVE	T1,USR.AD		;GET FORMAT ADDR AGAIN
	$BLDBP	T1			;Make 7-bit byte ptr.
	MOVEM	T1,FMT.BP		;Store it in FMT.BP
	MOVEM	T1,FMT.BG		;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
	XMOVEI	T1,FMT.RP		;SET TO COLLECT REPEAT COUNT
	MOVEM	T1,NUM.AD
	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" CONTAINS THE ADDRESS 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
	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?
	JRST	FMTERR			;NO. BAD CHAR
	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.WD			;IS THE FORMAT WIDTH ZERO?
	 $ECALL	ARC,%ABORT			;NO, AMBIGUOUS REPEAT COUNT
	SKIPE	FMT.CH			;ANY LEFTOVER FORMAT CHAR?
	 PUSHJ	P,FMTCMP		;YES. COMPILE PREV FORMAT
	XMOVEI	T1,FMT.WD		;SET TO COLLECT FORMAT WIDTH
	MOVEM	T1,NUM.AD
	MOVE	T1,FMT.SG		;ACCUMULATE THE SIGN
	IMULM	T1,FMT.RP		;INTO THE REPEAT COUNT
	MOVEM	P1,FMT.CH		;SAVE THE CHAR AWAY
NOREG:	HRRZ	P3,FMT.CT(P1)		;GET TABLE ADDR
	JUMPE	P3,FMTLP		;BACK IF NO DISPATCHES
	HRRZ	T1,(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:	XMOVEI	T1,FMT.EW		;ROUTE DIGITS TO EXP WIDTH
	MOVEM	T1,NUM.AD
EXPLP:	SETZ	P1,			;MAKE THE CHAR A SPACE
	SKIPN	FMT.SZ			;ANY CHARS LEFT?
	PJRST	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'
	PJRST	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:	MOVE	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
	MOVE	T2,USR.AD		;AND UNENCODED ADDR
FSLP1:	SKIPE	T1,%FMTNX(T1)		;GET NEXT ADDR, RETURN IF NO MORE FORMATS
	CAMN	T2,%FMTAD(T1)		;ADDRESSES EQUAL?
	POPJ	P,			;YES. RETURN WITH ADDR IN T1
	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)
	SKIPG	FMT.RP			;X REPEAT COUNT MUST BE POSITIVE
	 $ECALL	IRC,%ABORT	;IOERR	(IRC,,,?,Illegal repeat count,,%ABORT)

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:	SETZM	ENC.WD			;CLEAR THE ENCODED WORD
	SKIPGE	T1,FMT.WD		;FIELD WIDTH MUST BE POSITIVE
	 $ECALL	IFW,%ABORT		;NEGATIVE IS FATAL
	DPB	T1,WIDPNT		;RECORD IT
	MOVE	T2,FMT.DW		;GET DECIMAL WIDTH
	DPB	T2,DECPNT
	DMOVE	T1,FMT.EW		;AND EXPONENT WIDTH AND REPEAT COUNT
	DPB	T1,EWPNT
	DPB	T2,RPTPNT
	MOVE	T1,FMT.CH		;AND FORMAT CODE
	DPB	T1,CODPNT
	PUSH	P4,ENC.WD		;STORE WORD ON STACK
	PJRST	FMTINT			;INITIALIZE THE DATABASE

;SIXVRT - CONVERTS ASCII CHARACTERS FROM THE FORMAT STATEMENT
;TO SIXBIT. CONVERTS ALL CRUD CHARACTERS (.LT.SPACE) TO SPACE.
SIXVRT:	CAILE	T1,140			;LOWER CASE?
	SUBI	T1,40			;YES. CONVERT TO UPPER
	CAIGE	T1,40			;CONTROL CHAR?
	MOVEI	T1,40			;YES. CONVERT TO SPACE
	SUBI	T1,40			;CONVERT TO SIXBIT
	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:	SETZM	FMT.DW			;CLEAR DEC WIDTH
	XMOVEI	T1,FMT.DW		;POINT DIGACC AT DEC WIDTH
	MOVEM	T1,NUM.AD
	POPJ	P,

;DIGENC - THE DIGIT ENCODER. NUM.AD POINTS TO THE CURRENT
;DIGIT COLLECTOR.
DIGENC:	MOVE	T1,@NUM.AD		;GET ACC NUM
	IMULI	T1,12			;MUL BY 10
	ADDI	T1,-20(P1)		;ADD IT IN
	MOVEM	T1,@NUM.AD		;SAVE IT AGAIN
	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
	PUSH	P,P4			;PUSH CURRENT STACK PNTR
	SKIPN	T1,FMT.RP		;GET LATEST REPEAT COUNT
	 MOVEI	T1,1			;ASSUME COUNT OF 1 IF 0
	MOVNI	T1,(T1)			;NEGATE IT
	HRLZI	T1,(T1)			;-REPEAT COUNT,,0 FOR NOW
	PUSH	P4,T1			;SAVE ON 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
	MOVEI	T1,1(P4)		;NEXT ADDR IS CONTINUATION
	ADDI	T2,1			;POINT TO THE REPEAT WORD
	HRRM	T1,(T2)			;SAVE IT IN LINK
	HRRZM	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
	JRST	FMTERR			;NO. ERROR

GOTNZ:	MOVEM	T1,FMT.WD		;SAVE AS WIDTH FIELD
	PJRST	FMTCMP			;COMPILE IT

;A MINUS IN THE FORMAT MERELY NEGATES THE SIGN. THIS ALSO ALLOWS
;FOR MULTIPLE NEGATIVE SIGNS TO CANCEL EACH OTHER, A RESULT I'M NOT
;SURE IS DESIRABLE...
MINENC:	MOVNS	FMT.SG			;NEGATE THE SIGN
	POPJ	P,

;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.WD		;SAVE AS WIDTH
	PJRST	FMTCMP			;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
	PUSH	P,FMT.BP		;SAVE THE BYTE PNTR
HENCLP:	IBP	FMT.BP			;INCR PAST H CONSTANT
	SOSL	FMT.SZ			;QUIT IF NO MORE FORMAT
	SOJG	T1,HENCLP
	MOVNI	T1,(T1)			;GET NEG LEFT OVER
	ADDM	T1,FMT.RP		;AND REDUCE SIZE
	PUSHJ	P,FMTCMP		;COMPILE THE FORMAT
	POP	P,T1			;GET THE BYTE PNTR AGAIN
	PUSH	P4,T1			;SAVE THE B.P. ON ENCODED STACK
	POPJ	P,

;SIMILAR TO HOLLERITH, EXCEPT THE COUNT MUST EXCLUDE THE
;EXTRA SINGLE QUOTES WHEN THEY ARE PAIRED TO OUTPUT A SINGLE
;QUOTE OR APOSTROPHE. ALSO, 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.WD			;CLEAR WIDTH
	PUSH	P,FMT.BP		;SAVE THE B.P.
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.WD			;YES. COUNT BOTH OF THEM
NOTSQ:	AOS	FMT.WD			;NO. INCR THE COUNT
	JRST	SQLP1			;AND TRY FOR MORE

SQEDON:	MOVEM	T1,FMT.PC		;NO. SAVE AS PREVIOUS CHAR
	PUSHJ	P,FMTCMP		;COMPILE THE FORMAT
	POP	P,T1			;GET THE BYTE PNTR
	PUSH	P4,T1			;STORE ON STACK
	POPJ	P,

;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. LH=EXECUTION ADDR,
;RH=ENCODING ADDR. IF THERE IS NO ENCODING ADDR, IT
;MEANS THERE IS NO SPECIAL ENCODING, AND IS HANDLED BY THE
;ENCODER DEFAULTING MECHANISMS AND THE FLAGS IN FMT.CT.

COLFMT:	COLEXE,,FMTCMP
SLHFMT:	SLHEXE,,FMTCMP
DOLFMT:	DOLEX,,FMTCMP
MINFMT:	MINENC
DIGFMT:	DIGENC
LPRFMT:	LPRENC
RPRFMT:	RPRENC
PERFMT:	PERENC
SQFMT:	SQEXEC,,SQENC
VARFMT:	VAREXE,,0
AFMT:	AEXEC,,0
BFMT:	BEXEC,,BENC
DFMT:	DEXEC,,0
EFMT:	EEXEC,,0
FFMT:	FEXEC,,0
GFMT:	GEXEC,,0
HFMT:	HEXEC,,HENC
IFMT:	IEXEC,,MENC
LFMT:	LEXEC,,0
OFMT:	OEXEC,,0
PFMT:	PEXEC,,FMTCMP
QFMT:	QEXEC,,FMTCMP
RFMT:	REXEC,,0
SFMT:	SEXEC,,SENC
TFMT:	TEXEC,,TENC
XFMT:	XEXEC,,XENC
ZFMT:	ZEXEC,,0

;EXECUTION TRANSFER VECTORS - THIS IS A TABLE OF
;ROUTINE ADDRESSES. THE LEFT HALF OF EACH WORD
;IS THE ADDRESS FOR INPUT, THE RIGHT FOR OUTPUT.
COLEXE:	NOEXEC,,CHKDAT
SLHEXE:	%IREC,,%ORECS
DOLEX:	NOCR,,NOCR
SQEXEC:	SQIN,,SQOUT
VAREXE:	GETVAR,,GETVAR
AEXEC:	%ALPHI,,%ALPHO
BEXEC:	BNZ,,BNZ
DEXEC:	%DIRT,,%DOUBT
EEXEC:	%ERIN,,%EOUT
FEXEC:	%FLIRT,,%FLOUT
GEXEC:	GIN,,GOUT
HEXEC:	HIN,,HOUT
IEXEC:	%INTI,,%INTO
LEXEC:	%LINT,,%LOUT
OEXEC:	%OCTI,,%OCTO
PEXEC:	PFACT,,PFACT
QEXEC:	QIN,,QOUT
REXEC:	%RIGHI,,%RIGHO
SEXEC:	SSP,,SSP
TEXEC:	TABREC,,TABREC
XEXEC:	POSREC,,POSREC
ZEXEC:	%HEXI,,%HEXO

;G-FORMAT CONVERSION ROUTINE ADDRESS TABLE.
;LH=INPUT, RH=OUTPUT
GTAB:	%GINTI,,%GINTO		;NO TYPE GIVEN
	%GLINT,,%GLOUT		;LOGICAL
	%GINTI,,%GINTO		;INTEGER
	NOEXEC,,NOEXEC		;UNDEFINED
	%GRIN,,%GROUT		;REAL
	NOEXEC,,NOEXEC		;UNDEFINED
	%GOCTI,,%GOCTO		;OCTAL
	NOEXEC,,NOEXEC		;LABEL
	%GRIN,,%GROUT		;DOUBLE REAL
	%GINTI,,%GINTO		;DOUBLE INTEGER
	%OCTI,,%OCTO		;DOUBLE OCTAL
	%GRIN,,%GROUT		;EXTENDED DOUBLE REAL
	%GRIN,,%GROUT		;COMPLEX
	NOEXEC,,NOEXEC		;BYTE STRING
	NOEXEC,,NOEXEC		;CHARACTER
	NOEXEC,,NOEXEC		;ASCIZ

NOEXEC:
GETVAR:	POPJ	P,

;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
	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
	SKIPN	ENC.PT			;WAS I/O ABORTED?
	POPJ	P,			;YES. LEAVE (NO INDEF RPT)
EXELP:	SKIPE	IO.ADR			;ANY I/O ADDR READY?
	 JRST	EXEOK			;YES
	PUSHJ	P,%%GETIO		;GET MORE I/O ADDR
	SKIPN	IO.ADR			;ANY MORE I/O LIST?
	 POPJ	P,			;NO. LEAVE
EXEOK:	SKIPN	FMT.IU			;DATA USED BY LAST SCAN?
	JRST	FMTER2			;NO. GIVE WARNING AND EXIT
	MOVEI	T1,SLHEXE		;EXECUTE EOL FOR EACH REPEAT
	PUSHJ	P,DOEXE
	MOVE	T1,ENC.AD		;GET ENCODED BLOCK ADDR
	MOVE	T1,%FMTRP(T1)		;GET INDEF RPT PNTR
	MOVEM	T1,ENC.PT		;FOR FORMAT STACK
	SETZM	ENC.RP			;CLEAR LOOP REPEAT COUNT
	SETZM	ENC.LR			;AND LOCAL REPEAT COUNT
	SETZM	FMT.LK			;CLEAR THE FORMAT LINK
	SETZM	FMT.IU			;CLEAR I/O LIST ENTRY USED FLAG
	PUSHJ	P,EXEPRC		;GO EXECUTE FORMAT
	JRST	EXELP			;GO BACK FOR MORE



FMTER2:	;IOERR	(DLF,,,%,Data in IO list but not in format,,%ABORT)
	$ECALL	DLF,%ABORT

USEIO:	SETZM	IO.ADR			;CLEAR LAST I/O ADDR
	PUSHJ	P,%%GETIO		;GET ANOTHER
	SKIPE	IO.ADR			;GOT ANOTHER?
	 JRST	USEIO			;YES. SCRAP IT
	SETZM	ENC.PT			;STOP EXECUTION, JUST IN CASE
	POPJ	P,			;NO. LEAVE

;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).
;AT THIS POINT, WE MUST DO SOMETHING WHICH LOOKS RATHER CURIOUS - WE SAVE
;THE CURRENT LINK (THAT IS, LEFT PAREN) POINTER IN THE INDEFINITE REPEAT
;POINTER, UNLESS THERE IS NO LINK (RH=0). 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).
;THE PATHOLOGICAL CASES "FALL OUT" FROM THIS PROCEDURE - IF THE
;INITIAL LEFT PAREN IS MISSING, FMT.LK, THE LINK, WILL BE ZERO WHEN
;THE MATCHING RIGHT PAREN (OR FAKE RIGHT PAREN PLACED THERE BY THE
;FORMAT ENCODER) IS EXECUTED. THIS HAS BEEN CODED TO END FORMAT EXECUTION.

EXEPRC:	SKIPN	ENC.PT			;IF PNTR IS 0
	POPJ	P,			;WE ABORTED I/O
	SKIPL	@ENC.PT			;PAREN?
	JRST	EXENRM			;NO. NORMAL EXECUTION
	PUSH	P,ENC.RP		;YES. SAVE OLD REPEAT COUNT
	PUSH	P,FMT.LK		;AND LINK ADDR
	HLRE	T1,@ENC.PT		;GET THE NEW REPEAT COUNT
	MOVN	T1,T1			;POSITIVE
	MOVEM	T1,ENC.RP		;SAVE IT
	MOVE	T1,ENC.PT		;GET THE PAREN WORD
	MOVEM	T1,FMT.LK		;SAVE FOR LINK
	AOS	ENC.PT			;INC THE FORMAT PNTR
	PUSHJ	P,EXEPRC		;RECURSIVE CALL
	SKIPN	ENC.PT			;DID WE STOP?
	JRST	ENDEXE			;YES. LEAVE
	MOVE	T1,FMT.LK		;GET THE LINK
	HRRZ	T2,(T1)			;GET THE ADDR
	JUMPE	T2,ENDEXE		;DON'T STORE ZERO!
	XMOVEI	T2,(T2)			;GET SECTION NUMBER ALSO
	MOVEM	T2,ENC.PT		;LINK THE PROCESSOR
ENDEXE:	POP	P,FMT.LK		;RESTORE PREVIOUS LINK
	POP	P,ENC.RP		;AND REPEAT COUNT
	JRST	EXEPRC			;AND START AGAIN

EXENRM:	SKIPN	T1,@ENC.PT		;GET FORMAT WORD
	JRST	EXENLP			;HIT END OF LIST
	MOVEM	T1,ENC.WD		;SAVE FOR CODE RETRIEVAL
	LDB	T1,CODPNT		;GET FORMAT CHAR
	MOVE	T1,FMT.CT(T1)		;GET TABLE ENTRY
	TXNN	T1,IOLFLG		;DO WE NEED I/O LIST ENTRY?
	 JRST	NODATA			;NO
	MOVEM	T1,IO.TBL		;Save flags and table entry for later
	SKIPLE	ENC.LR			;ANY LEFTOVER REPEAT COUNT?
	 JRST	LROK			;YES. USE IT
	LDB	T1,RPTPNT		;NO. GET IT FROM FORMAT WORD
	MOVEM	T1,ENC.LR		;SAVE IT
LROK:	SETOM	FMT.IU			;YES, SET I/O LIST ENTRY USED FLAG
DATLP:	SKIPN	IO.ADR			;DO WE HAVE ADDR ALREADY?
	 JRST	GETADR			;NO. GO GET IT
GOTADR:	HRRZ	T1,IO.TBL		;GET I/O ROUTINE PNTR
	HLRZ	T1,(T1)			;GET JUST EXEC ADDR
	MOVE	T0,FLAGS(D)		;Get DDB flags
	TXNN	T0,D%IO			;OUTPUT?
	 JRST	DATIN			;NO. GO DO INPUT
	HRRZ	T1,(T1)			;GET OUTPUT SUBR ADDR
	PUSHJ	P,(T1)			;DO IT
	 JRST	DATINC			;DID NOT END. GO INC DATA PNTR
	POPJ	P,			;WE HAVE BEEN TOLD TO STOP!

GETADR:	PUSHJ	P,%%GETIO		;NO. GET THE DATA ADDR
	SKIPE	IO.ADR			;DID WE GET IT?
	 JRST	GOTADR			;YES.
	SETZM	ENC.PT			;NO. END EXECUTION
	POPJ	P,

DATIN:	HLRZ	T1,(T1)			;GET INPUT SUBR ADDR
	PUSHJ	P,(T1)			;DO IT
	LDB	T1,WIDPNT		;FREE FORMAT?
	JUMPN	T1,DATINC		;NO.
	MOVE	T1,IO.TBL		;Get flags and table entry
	TXNE	T1,SKPFLG		;YES. DID WE ACTUALLY READ DATA?
	 PUSHJ	P,SFDEL			;YES. SCAN FOR NEXT DELIM

DATINC:	SKIPN	T1,IO.INC		;ADD OFFSET TO I/O ADDR
	JRST	CPXINC			;IF IT'S ZERO, ADD COMPLEX INCREMENT
DATIN2:	ADDM	T1,IO.ADR		;TO I/O ADDR
	SOSG	IO.NUM			;DECR LOCAL DATA COUNT
	 SETZM	IO.ADR			;CLEAR I/O ADDR IF NONE LEFT
	SOSLE	ENC.LR			;DECR LOCAL REPEAT COUNT
	 JRST	DATLP			;MORE TO GO
	AOS	ENC.PT			;ON TO NEXT FORMAT
	JRST	EXEPRC			;AND BACK FOR MORE FORMAT

CPXINC:	HRRE	T1,CP.INC		;GO TO IMAG PART OR NEXT ENTRY
	MOVSS	CP.INC			;AND PREPARE FOR NEXT TIME
	JRST	DATIN2			;BACK TO USUAL INCREMENT CODE

EXENLP:	SKIPE	T1,FMT.LK		;GET ADDR BEFORE START
	SOSG	ENC.RP			;DECR REPEAT COUNT
	POPJ	P,			;END OF LIST OR COUNT EXHAUSTED
	ADDI	T1,1			;RESET PNTR
	MOVEM	T1,ENC.PT		;TO LOOP
	JRST	EXEPRC			;START AGAIN

NODATA:	HRRZ	T1,T1			;GET I/O ROUTINE PNTR
	HLRZ	T1,(T1)			;GET EXECUTION TABLE PNTR
	PUSHJ	P,DOEXE			;DO IT
	AOS	ENC.PT			;ON TO NEXT FORMAT
	JRST	EXEPRC

DOEXE:	MOVE	T1,(T1)			;GET THE ADDR PAIR
	MOVE	T0,FLAGS(D)		;Get DDB flags
	TXNN	T0,D%IO			;OUTPUT?
	 HLRZ	T1,T1			;NO. GET THE INPUT ADDR
	HRRZ	T1,T1			;CLEAR OUT THE LEFT HALF
	PJRST	(T1)			;DO IT

;G-FORMAT I/O. USES THE DATA TYPE TO FIGURE OUT WHAT TO DO
GIN:	MOVE	T1,IO.TYP		;GET VARIABLE TYPE
	HLRZ	T1,GTAB(T1)		;GET I/O CONV ADDRESS
	PJRST	(T1)			;DO IT

GOUT:	MOVE	T1,IO.TYP		;GET VARIABLE TYPE
	HRRZ	T1,GTAB(T1)		;GET OUTPUT CONV ADDRESS
	PJRST	(T1)			;DO IT

;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:	MOVE	T0,FLAGS(D)		;Get DDB flags
	TXNE	T0,D%EOR		;REACH 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)...
;IGNORE IT ON INPUT, CALL SPECIAL ROUTINE ON OUTPUT WHICH OUTPUTS
;THE RECORD WITHOUT A CARRIAGE RETURN FOR OUTPUT.
NOCR:	MOVX	T0,D%STCR		;Suppress trailing CR
	IORM	T0,FLAGS(D)
	POPJ	P,

;COLON - FOR OUTPUT, IF THE I/O LIST IS DONE, CLEAR THE ENCODED STACK POINTER
;AS A SIGNAL TO THE FORMAT EXECUTION TO STOP.
CHKDAT:	SKIPN	IO.ADR			;DO WE HAVE I/O ADDR?
	 PUSHJ	P,%%GETIO		;NO. GET NEXT I/O ADDR
	SKIPE	IO.ADR			;DID WE GET IT?
	 POPJ	P,			;YES. EVERYTHING'S FINE
	SETZM	ENC.PT			;NO. END EXECUTION
	AOS	(P)			;AND SKIP 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 WIDTH FIELD.
HOUT:	AOS	ENC.PT			;INCR TO BYTE PNTR
	LDB	T2,RPTPNT		;GET # CHARS
	MOVE	T3,@ENC.PT		;Get byte ptr
HOUTLP:	ILDB	T1,T3			;GET CHAR
	PUSHJ	P,%OBYTE		;OUTPUT IT
	SOJG	T2,HOUTLP		;BACK FOR MORE
	POPJ	P,

;Q FORMAT - RETURNS THE NUMBER OF CHARS LEFT IN THE RECORD
;INTO THE SPECIFIED VARIABLE (INTEGER!).
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:	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:	LDB	T1,RPTPNT		;GET REPEAT COUNT
	TRNE	T1,400			;SIGN BIT ON?
	ORCMI	T1,777			;YES. TURN THE REST ON
	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
TABREC:	LDB	P3,DECPNT		;GET L OR R
	JUMPN	P3,LRPOS		;GO PROCESS THEM IF THERE
	LDB	T1,WIDPNT		;GET VALUE
	JUMPG	T1,%SPOS		;SEND REQUESTED POSITION
	MOVEI	T1,1			;IF LESS THAN 1, SET TO 1
	PJRST	%SPOS

LRPOS:	PUSHJ	P,%RPOS			;GET CURRENT POSITION
	LDB	T2,WIDPNT		;GET FORMAT ARG
	CAIN	P3,'L'			;IS IT TAB LEFT?
	MOVNI	T2,(T2)			;YES. NEGATE TAB
	ADD	T1,T2			;AND SET NEW POSITION
	JUMPG	T1,%SPOS		;SEND REQUESTED POSITION
	MOVEI	T1,1			;REQ COL 1 IF OFF LEFT OF RECORD
	PJRST	%SPOS

;X FORMAT - SIMILAR TO T FORMAT, BUT WITH REPEAT COUNT INSTEAD
;OF WIDTH FOR ITS VALUE
POSREC:	PUSHJ	P,%RPOS			;GET CURRENT RECORD POSITION
	LDB	T2,RPTPNT		;GET ARG OF X-FORMAT
	ADD	T1,T2			;ADD THE 2
	JUMPG	T1,%SPOS		;INCR TO POS WHERE WE WANT NEXT CHAR
	MOVEI	T1,1			;BUT IF NEG OR ZERO
	PJRST	%SPOS			;JUST SUPPLY 1

;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:	AOS	ENC.PT			;INCR TO BYTE PNTR
	LDB	T2,WIDPNT		;GET THE # CHARS
	JUMPE	T2,SQODON		;DONE IF NO CHARS
	MOVE	T3,@ENC.PT		;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.
SQIN:	AOS	ENC.PT			;INCR TO BYTE POINTER
	LDB	T2,WIDPNT		;GET # CHARS TO INPUT
	JRST	HIN0			;REST IS SAME AS HOLLERITH

;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.
HIN:	AOS	ENC.PT			;INCR TO BYTE PNTR
	LDB	T2,RPTPNT		;GET # CHARS TO INPUT
HIN0:	MOVE	T3,@ENC.PT		;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

FMTERR:	;IOERR	(ILF,,,?,Illegal character in format,,%ABORT)
	$ECALL	ILF,%ABORT


FMTER3:	$SNH



;ROUTINE TO CONVERT CALLING CONVENTIONS
;RETURN: IO.ADR = ADDRESS OF I/O ITEM
;	 IO.TYP = DATA TYPE
; ** WARNING: Smashes perm acs **

%%GETIO::
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNE	T0,D%EOI	;IO LIST ALREADY AT END?
	 POPJ	P,		;YES. RETURN
NIOEND:	PUSHJ	P,%GETIO	;NO, GO GET IT
	JUMPN	T1,GETIO1	;JUMP IF NOT END OF IO LIST
	MOVX	T0,D%EOI	;Flag it
	IORM	T0,FLAGS(D)
GETIO1:	SETZM	CP.INC		;CLEAR THE COMPLEX INCREMENT
	MOVEM	T1,IO.ADR	;STORE ADDRESS
	MOVE	T0,FLAGS(D)
	TXNN	T0,D%LSD	;LIST-DIRECTED?
	 CAIE	T2,TP%CPX	;No, COMPLEX?
	  JRST	NOTCPX		;LIST-DIRECTED OR NOT COMPLEX
	MOVEI	T2,TP%SPR	;YES. SUBSTITUTE REAL
	ASH	T3,1		;DOUBLE COUNT
	SUBI	T4,1		;PREPARE COMPLEX INCREMENT
	HRLI	T4,1
	MOVSM	T4,CP.INC	;[INCR-1,,1]
	SETZ	T4,		;AND ZERO STANDARD INCREMENT
NOTCPX:	MOVEM	T2,IO.TYP	;STORE TYPE
	DMOVEM	T3,IO.NUM	;AND COUNT AND INCREMENT
	POPJ	P,		;DONE


	SEGMENT	DATA

CP.INC:	BLOCK	1
IO.ADR:: BLOCK	1
IO.TYP:: BLOCK	1
IO.NUM:: BLOCK	1		;Do not split IO.NUM and IO.INC
IO.INC:: BLOCK	1
IO.INF:: BLOCK	1

IO.TBL:	BLOCK	1		;Save flags and table address in EXENRM

ILLEG.:: 0

	SEGMENT	CODE

	PURGE	$SEG$
	END