	.TITLE	BCDIO
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.EJECT
/EDIT #048  14 FEB 73 TAM(46,47) *REF*(28):WAD:(29)*REF*(33):WAD:
/EDIT #049  05-MAY-75	R. K. BLACKETT  REMOVE 'AND'S WHICH STRIP BITS 0-2
/			  FROM T.V. ADDRESS.  THIS IS FOR XVM SYSTEMS.
/			  THIS CHANGE DOES NOT PRECLUDE ITS USE ON NON-XVM
/			  SYSTEMS.
/EDIT #050  06-MAY-75	R. K. BLACKETT  FIX THE 'LF' GLITCH  (AS DOCUMENTED IN
/			  SPRS 15-E951, 15-948, 15-960, ET. AL.)
/			  ADD NEW CONDITIONAL PARMS MSCC, LFTOSP
/			  MSCC (MASS STORAGE CARRIAGE CONTROL) IF DEFINED,
/			  CONVERT 1ST CHAR TO INTERNAL CC CHAR CODE
/			  LFTOSP (LINE FEED TO SPACE) IF DEFINED, CONVERT A LEADING
/			  LINE FEED TO A SPACE.
/			  REQUIRES USING FIOPS 036 OR LATER, AS FIOPS WAS
/			  MODIFIED TO SET BIT 3 OF .STAB ENTRY TO INDICATE
/			  A DIRECTORIED DEVICE.
/			  ALSO NEED RBCDIO 008 OR LATER, AS IT WAS CHANGED
/			  TO SET .MSDEV FOR ALL RANDOM ACCESS DEVICES, ON
/			  OUTPUT.  MODIFICATION WAS TO .RW SECTION OF RBCDIO.
/
/EDIT #051  23-JUL-75	R. K. BLACKETT  INSERT A SPECIAL TRANSFER VECTOR CALLED
/			  'CC1' WHICH CONTAINS THE POINTER TO THE FIRST WORD
/			  OF THE WORD PAIR WHICH CONTINS THE 'CURRENT CHARACTER'.
/			  THE OLDER EDITS USED 'CC' FOR THIS PURPOSE, BUT 'CC'
/			  ALSO CONTAINS THE CHARACTER WITHIN THE PAIR,
/			  CODED IN BITS 0-2.  THIS INTERFERES WITH XVM WIDE
/			  ADDRESSING MODES.  'CC' IS STILL PRESENT AND USED FOR
/			  ALL OF ITS PREVIOUS FUNCTIONS EXCEPT FOR FETCHING
/			  AND STORING CHARACTERS THRU AS AN INDIRECT POINTER.
/			  ALSO, REMOVE TWOS COMPLEMENT ROUTINE, SUBSITUTING
/			  'TCA' INTRUCTIONS.
/			  ALSO, CHANGE THE GLOBAL ROUTINE '.READ' TO BE NAMED
/			  'READ.' SO AS NOT TO CONFLICT WITH I/O MACRO BY SAME
/			  NAME.  THIS WAS DONE WITH EDITORS 'CONVERT' COMMAND,
/			  SO SOME COMMENTS MAY HAVE BEEN ALTERED.  IN ADDITION,
/			  THE MODIFIED LINES WERE NOT FLAGED WITH EDIT NUMBERS.
/ EDIT #052	20-AUG-75	M. HEBENSTREIT	DISCLAIMER
/
/
/ASSEMBLY PARAMETERS
/  DEFINE %FPP FOR FLOATING POINT PROCESSOR
/  DEFINE %V5A FOR ADSS SYSTEM, ELSE, DOS15 ASSUMED
/DEFINE RSX FOR RSX SYSTEM.
/  DEFINE LFTOSP AND MSCC AS FOLLOWS:
/	NEITHER DEFINED	= DOS XVM RSX XVM OR LATER SYSTEMS
/	LFTOSP=0	=   **ILLOGICAL CASE**
/	LFTOSP=0,MSCC=0	= DOS V3A,V3B RSX PLUS III V1A, V1B
/	MSCC=0		= DOS V1A, V2A  RSX PLUS  ADSS V5B AND EARLIER
	.IFUND	MSCC	/(RKB-050) CHECK FOR ILLEGAL COMB
	.IFDEF	LFTOSP	/(RKB-050)
	.END	*****ILLEGAL ASSEMBLY PARAMETER COMBINATION***
	.ENDC		/(RKB-050)
	.ENDC		/(RKB-050)
	.IFDEF RSX
%V5A=0
%V5A1=0
	.ENDC
	.IFUND %V5A
%V5A1=0
%DOS15=0
	.ENDC
	.IFDEF %DOS15
%V5A1=0
	.ENDC
/BCD I/O OBJECT-TIME PACKAGE.
/   INTERNAL GLOBALS--
	.GLOBL	.FA3		/** TO ALLOW LDNG. OF .GD CALL
	.GLOBL	.FA4		/** ALLOW JMP INTO .FA FR. .GE
       .GLOBL .FR	         /BCD READ
       .GLOBL .FW	         /BCD WRITE
       .GLOBL .FA	         /BCD ARRAY I/O
	.GLOBL	.RA	/* R.A. BCD ARRAY I/O
       .GLOBL .FE	         /BCD ELEMENT I/O
	.GLOBL	.RE	/* R.A. BCD ELEMENT I/O
       .GLOBL .FF	         /BCD I/O CLEANUP
	.GLOBL	.STEOR	/* STORE 'EOR' (S.A.) OR 'REOR' (R.A.)
	.GLOBL	.BFLOC	/* STORE '.FN' (S.A.) OR '.FNPTR' (R.A.)
	.GLOBL	.INILB	/* INIT. L.B.
	.GLOBL	.INIFD	/* INIT. FORMAT DECODER
	.GLOBL	.HILIM	/* HIGH LIMIT
	.GLOBL	.RAENT	/* R.A. ENTRY TO EOR
	.GLOBL	.D		/** DEC. FIELD WIDTH
	.GLOBL	.W		/** FIELD WIDTH
	.GLOBL	.S		/** FORMAT TYPE CODE
	.GLOBL	.SF		/** SCALE FACTOR
	.GLOBL	.PACK		/** PACK CHAR. IN L.B.
	.GLOBL	READ.		/** READ CHAR.
	.GLOBL	.CHAR		/** ASCII CHAR. READ FROM BUFFER
	.GLOBL	.NMTST		/** NUMBER TEST ROUTINE
	.GLOBL	.MPYTN		/** MULT. BY TEN
	.IFUND	MSCC	/(RKB-050)
	.GLOBL	.MSDEV	/(RKB-050) MASS STORAGE SWITCH (USED IN RBCDIO)
	.ENDC		/(RKB-050)
	.IFUND %FPP
	.GLOBL	.FAO		/** DOUBLE LOAD
	.GLOBL	.FAP
	.ENDC
	.GLOBL	.HIFLG		/** HIGH FLAG
	.GLOBL	.SCC		/** CHAR. CNTR.
	.GLOBL	.PBLKS		/** PACK BLANKS
	.GLOBL	.LBADD		/** L.B. ADDR.
	.GLOBL	.FSTFL		/** FIRST CHR. FLG.: =-1 IF ENCODE
	.GLOBL BCDIO
BCDIO=.
/   VIRTUAL GLOBALS--
       .GLOBL .FH	         /READ/WRITE FLAG.
       .GLOBL .FC	         /I/O DEVICE INITIALIZER.
       .GLOBL .FQ	         /LINE BUFFER TRANSFER ROUTINE.
       .GLOBL .FM	         /LINE BUFFER SIZE.
       .GLOBL .FN	         /LINE BUFFER.
       .GLOBL .ER	         /ERROR ROUTINE.
	.GLOBL .INISA	/INIT. FOR SEQ. ACC. ROUT.
	.IFUND RSX
	.GLOBL	.FC6		/**L.B. SIZE (FIOPS)
	.ENDC
	.IFDEF %V5A1
	.GLOBL	.RN	/R.A. FLAG.  =400000 IF RA. OR ELSE =0
	.GLOBL .STADD	/PTR. TO CURRENT ST. TAB. ENTRY (FIOPS)
	.ENDC
	.IFUND %FPP
       .GLOBL .AA	         /FLOATING AC--EXP
       .GLOBL .AB	         /FLOATING AC--M.S.
       .GLOBL .AC	         /FLOATING AC--L.S.
       .GLOBL .AG	         /REAL LOAD
       .GLOBL .AH	         /REAL STORE.
       .GLOBL .CC	         /GENERAL FLOATING ADD.
       .GLOBL .CD	         /NORMALIZE FLOATING AC.
       .GLOBL .CE	         /ANSWER SIGN.
       .GLOBL .CF	         /HOLD FLOATING AC.
       .GLOBL .CH	         /ROUND AND INSERT SIGN.
       .GLOBL .CI	         /GENERAL FLOATING DIVIDE.
	.ENDC
	.GLOBL	.ER4	/REINIT. LOCATION (OTSER)
	.IFDEF %DOS15
	.GLOBL .DSK,.FLRA,.FLTB1,.FLZW0
	.ENDC
/
/  CONDITIONALLY DEFINED MACROS
	.IFUND %FPP
	.DEFIN FLD%,A
	JMS*	A
	.ENDM
	.ENDC
	.IFDEF %FPP
FLD=713050
	.DEFIN FLD%
	FLD
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN URFST%,A
	JMS*	A
	.ENDM
	.ENDC
	.IFDEF %FPP
URFST=713650
	.DEFIN URFST%
	URFST
	.ENDM
	.ENDC
	.IFDEF %FPP
/ DIRECT ASSIGNS. FOR FPP PROCESSOR
DLD=713150
DST=713750
UNDST=713770
DRD=712540
FNG=713272
FAB=713271
FZR=711200
BZA=716601
BPA=716604
UNDMP=711560
URDDV=712050
BNA=716610
UNDLD=713170
URDRD=712550
DAD=716140
FNM=713250
DRD=712540
	.ENDC
/   CONSTANTS AND WORKING STORAGE--
C00003	.DSA	3	/ *** DDS FEB69 ***
C00005	.DSA	5	/ *** DDS FEB69 ***
C00006	.DSA 6
C00035	.DSA 43
K00002	.DSA	-2	/ *** DDS FEB69 ***
K00004	.DSA	-4
K00006	.DSA -6
K00010	.DSA	-12	/ *** DDS FEB69 ***
S00001	.DSA	1
S00004	.DSA	4
S00007	.DSA 7
S00010	10
S00012	.DSA 12
S00015	.DSA 15
S00017	.DSA 17
S00032	.DSA 32
S00040	.DSA 40
S00042	42
S00044	44
S00047	47
S00037	37
S00050 .DSA   50
S00051 .DSA   51
S00053 .DSA   53
S00054 .DSA   54
S00055 .DSA   55
S00056 .DSA   56
S00057 .DSA   57
S00060 .DSA   60
S00061 .DSA   61
S00077	.DSA	77
S00101 .DSA   101
S00110 .DSA   110
S00111 .DSA   111
S00114 .DSA   114
S00117	117
S00120 .DSA   120
S00122	122
S00124 .DSA   124
S00130 .DSA   130
S00170 .DSA   170
S00175 .DSA   175
S00177 .DSA   177
S02000 .DSA   2000
S17777	.DSA	17777	/ *** DDS FEB69 ***
S20100	.DSA	020100
S77776	.DSA	077776
/S77777 .DSA   77777	/(RKB-049) THIS LITERAL REMOVED, NO LONGER USED
T00000 .DSA   100000
T77777 .DSA   177777
U01004	.DSA	201004
V00002 .DSA   300002
V00000	300000
V40000	.DSA	340000
V77777 .DSA   377777
W00000 .DSA   400000
Z40000	.DSA	740000
Z77400 .DSA   777400
Z77600 .DSA   777600
Z77671 .DSA   777671
Z77706 .DSA   777706
Z77760	.DSA	777760
DBLONE .DSA   1
       .DSA   200000
       .DSA   0
CCNT   .DSA   0
STCON	0		/STR. CONST.
OCHR	0		/**OCTAL CHR.
TBNM	0		/**TAB NUM.
CCPTR	0		/** CHAR. PTR
VRTYP	0		/** VAR. TYPE
TEMP7	0		/**
TEMP8	0		/**
OCTL	0		/** OCTAL FLG.: =-1,OCTAL; =0, DEC.
IGCNT	0		/** IGNORE CHAR. CNT.
CNT2   .DSA   0
CNT    .DSA   0
DADD   .DSA   0
DELTA  .DSA   0
.HIFLG	.DSA   0
.HILIM	.DSA   0
.LBADD	.DSA   0
LIMIT  .DSA   0
	.IFDEF %FPP
FP5	0		/TEMP FILLER FOR FPP --DON'T MOVE!!!
/				CLOBBERED BY LOADING MS AND LS
	.ENDC
MS     .DSA   0
LS     .DSA   0
NUMFLG .DSA   0
.SCC	.DSA   0
SIGN   .DSA   0
SLOT   .DSA   0
SMS    .DSA   0
SLS    .DSA   0
.FSTFL .DSA   0
CRAMFL	0		/CR-ALTMODE FLAG RDEXT
	.IFDEF %FPP
FP1	0		/TEM.
FP2	0		/WORKING REGISTERS FOR FPP
FP3	0		/AC
FP4	0		/
FPH2	0		/HELD REGIS. FOR FPP
FPH3	0
FPH4	0
	.ENDC
LDEOR	.DSA	EOR	/* 
.STEOR	XX		/*
.BFLOC	XX		/*
	.IFUND	MSCC	/(RKB-050)
.MSDEV	XX	/(RKB-050) MASS STORAGE DEVICE SWITCH.
			/(RKB-050)  SET FOR WRITING ONLY:
			/(RKB-050)  SKP = NON-MASS STORAGE
			/(RKB-050)  NOP = MASS STORAGE
	.ENDC	/(RKB-050)
BCNT=CCNT
TEMP6=IGCNT		/**
DIG1=TVCC
DIG2   .DSA   0
DIG=.INIFD
DPOS=TVCC
FADDR=INCCC
FRFLG=CCA
NRZ=FNBCHR
OVFFLG=FMTFCH
POT=CCN
SDFLG=CC2
SEXP=.INIFD
SFFLG=CC2
SHCT=DSHR
TAC=INCP
TEMP1=NUMCHK
TEMP2=INCP
TEMP3=DECP
TMPFAC=SPLIT
TLS=DECP
TMS=GETCC
WD1=CCN
WD5=CCA
PKBLK2=NUMTS2
CHCT=BCNT
C00001=DBLONE		/ *** DDS FEB69 ***
	.TITLE	.FR  - -  BCD READ
/BCD READ
/CALLING SEQUENCE -- JMS	 .FR
/		 .DSA    ADDRESS OF SLOT NUMBER.
/		 .DSA    ADDRESS OF FORMAT STATEMENT OR ARRAY.
.FR    CAL    0
	JMS	.INISA	/* INIT. FOR SEQ. ACC.
       DZM*   .FH	         /SET READ/WRITE FLAG TO READ.
       LAC*   .FR	         /INITIALIZE INPUT DEVICE.
       JMS*   .FC
       DAC    SLOT		/SAVE SLOT NUMBER.
	.IFDEF %DOS15
	DAC FR3	/SET UP .SEEK
	JMS* .DSK	/A DISK?
	SNA
	JMP FR2	/NO
	LAC SLOT
	JMS* .FLRA	/FILE OPEN FOR RAND. ACC.?
	JMP FR2	/YES. 
FR7A	LAC SLOT	/NO.  .SEEK IF NO FILE ACTIVE
	JMS* .FLTB1
	JMP FR6	/RETURNS HERE IF FILE ACTIVE-ADDR. OF DIR. BUFFER
	DAC FR4	/HERE IF NO FILE ACTIVE-ADDRESS OF DIR. BUFFER
/ (RKB-050) DELETE THE FOLLOWING 5 LINES
/ (RKB-050)	LAC* .STADD	/ZERO SO .INIT WILL GO THRO IN .FC
/ (RKB-050)	DAC FW5	/FOR LEVEL OF INDIR.
/ (RKB-050)	DZM* FW5
/ (RKB-050)	LAC* .FR	/DAT SLOT
/ (RKB-050)	JMS* .FC	/INIT FOR INPUT
FR3	0		/DIR. ENTRY BUFFER INTO FR4
	3		/.SEEK
FR4	0		/BUFF ADDRESS
	.ENDC
FR2	  ISZ	 .FR
       LAC*   .FR	         /GET FORMAT ADDRESS.  IF A TRANSFER VECTOR,
       DAC    CC	         /   GO ONE MORE LEVEL OF INDIRECT.
	SPA
       LAC*   CC
       JMS    .INIFD	  /INITIALIZE FORMAT DECODER.
       JMS    EOR	         /READ FIRST RECORD.
       ISZ    .FR	         /EXIT.
       JMP*   .FR
	.IFDEF %DOS15
FR6	SPA			/IF AC POS., FILE ACTIVE FOR OUTPUT
/CLOSE OUTPUT FILE AND REOPEN IT FOR INPUT THRU FR7A
	JMP	FR2		/OK, FILE ACTIVE FOR INPUT (JUST CONT.)
	LAC	SLOT		/.DAT SLOT INTO AC
	DAC	FR7		/SET .CLOSE CAL
	JMS*	.FLZW0		/ZERO FILE ACTIVE WORD OF DIR. ENTRY
FR7	0			/.CLOSE
	6
	JMP	FR7A		/GO REOPEN FILE FOR INPUT
	.ENDC
	.TITLE	.FW  - -  BCD WRITE
/BCD WRITE
/  CALLING SEQUENCE -- JMS	 .FW
/		   .DSA  ADDRESS OF SLOT NUMBER.
/		   .DSA  ADDRESS OF FORMAT STATEMENT OR ARRAY
.FW    CAL    0
	JMS	.INISA	/* INIT. FOR SEQ. ACC.
       LAC    C00001	 /SET READ/WRITE FLAG TO WRITE.
       DAC*   .FH
       LAC*   .FW	         /INITIALIZE OUTPUT DEVICE.
       JMS*   .FC
       DAC    SLOT		/SAVE SLOT NUMBER.
	.IFUND	MSCC		/(RKB-050)
	LAC*	.STADD		/(RKB-050) TEST DEVICE FOR MASS STORAGE
	DAC	.MSDEV		/(RKB-050) RESOLVE ONE MORE LEVEL OF INDIRECTION
	LAC*	.MSDEV		/(RKB-050) TO GET TO CURRENT .STAB ENTRY
	AND	(40000)		/(RKB-050) BY CHECKING FOR 'DIRECTORIED' BIT
	SNA!CLA			/(RKB-050) SET UP BY FIOPS
	LAC	(1000)		/(RKB-050) MAKE SWITCH A SKIP IF NON-MS
	TAD	(740000)	/(RKB-050) OR A NOP IF IT IS MASS STORAGE
	DAC	.MSDEV		/(RKB-050)
	LAC	SLOT		/(RKB-050) RESTORE AC
	.ENDC			/(RKB-050)
	.IFDEF %DOS15
	DAC FW3	/SET UP .ENTER
	JMS* .DSK	/A DISK?
	SNA
	JMP FW2	/NO
	LAC SLOT	/YES
	JMS* .FLRA	/FILE OPEN FOR RAND. ACC.?
	JMP FW2	/YES
	LAC SLOT	/NO-OPEN DEFAULT FILE IF NO FILE ACTIVE
	JMS* .FLTB1
	JMP FW6	/FILE ACTIVE-CHECK I/O DIRECTION
	DAC FW4	/NO FILE ACTIVE-ADDRESS OF DIR. ENTRY BUFF
/ (RKB-050) DELETE THE FOLLOWING 5 LINES:
/ (RKB-050)	LAC* .STADD	/ZERO SO .INIT WILL GO THRO IN .FC
/ (RKB-050)	DAC FW5
/ (RKB-050)	DZM* FW5
/ (RKB-050)	LAC* .FW	/DAT SLOT
/ (RKB-050)	JMS* .FC	/INIT FOR OUTPUT
FW3	0		/INTO FW4----.ENTER
	4
FW4	0		/BUFFER ADDRESS
	.ENDC
FW2	  ISZ	 .FW
       LAC*   .FW	         /GET FORMAT ADDRESS.  IF A TRANSFER VECTOR,
       DAC    CC	         /   GO ONE MORE LEVEL OF INDIRECT.
	SPA
       LAC*   CC
       JMS    .INIFD	  /INITIALIZE FORMAT DECODER.
       JMS    .INILB	  /INITIALIZE LINE BUFFER.
       LAW    -1	         /SET UPPER LIMIT FOR CHARACTER PACKER AS A
       TAD    .FN	         /   FUNCTION OF LINE BUFFER SIZE.
       TAD*   .FM
       DAC    .HILIM
       ISZ    .FW	         /EXIT.
       JMP*   .FW
	.IFDEF %DOS15
FW5	0		/TEMP
FW6	SMA			/IF AC NEG., FILE ACT. FOR INPUT - ERROR
	JMP	FW2		/FILE ACTIVE FOR OUTPUT - OK
	JMS*	.ER		/OTS 51
	51
	.ENDC
	.TITLE	.FA (.RA)  - -  ARRAY I/O (RANDOM ACCESS - .RA)
/BCD ARRAY I/O
/  CALLING SEQUENCE -- JMS*  .FA (.RA - FOR RAN. ACC.)
/		   .DSA  ADDRESS OF ADB WORD 5
.RA=.			/* RAN. ACC. ENTRY
.FA	CAL	0
	LAC	(.FE		/** SET TO JMP TO FORMATTED ELEMENT
	DAC	.FA3		    /** I/O
.FA4	LAC*	.FA
	DAC	WD5	/ADDRESS OF WORD 5 OF ADB
	SPA		/1 MORE LEVEL?
	LAC*	WD5	/YES
	DAC	WD5	/RESTORE
	TAD	K00004
	DAC	WD1	/ADDRESS OF WORD 1 OF ADB ( NDIM-1, MODE)
	LAC*	WD1	/GET ADDRESS INCREMENT - DELTA = NUMBER OF WORDS
	AND	C00003	/PER DATA ITEM.  MASK OUT THE MODE BITS
	CMA		/CREATE A LAW 1'S COMPLEMENT OF MODE BITS
	DAC	FA1	/WHICH IS EXECUTED JUST BEFORE CALLING ELEMENT I/O
	CMA		/ROUTINE.  RESTORE MODE BITS.
	SAD	C00003	/ELEMENT SIZE IS MODE+1, EXCEPT IS 2 IF MODE
	LAC	C00001	/IS 3
	TAD	C00001	/MODE 3 IS DOUBLE INTEGER
	DAC	DELTA
	LAC*	WD5	/PLACE ADDRESS OF BEGINNING OF ARRAY INTO 
	DAC	FA2	/BCD ELEMENT I/O CALL
	ISZ	WD1	/BUMP TO POINT TO SIZE WORD
	TAD*	WD1	/ADD ARRAY SIZE TO GET HIGH ADDRESS LIMIT
	DAC	LIMIT
FA1	LAW		/(LAW -MODE, 1'S COMPLEMENT PUT HERE)
	JMS*	.FA3		/** CALL BCD EL. I/O ROUTINE
FA2    .DSA   0		       /   ARGUMENT=ADDRESS OF DATA ITEM.
       LAC    FA2	         /INCREMENT DATA ITEM ADDRESS.
       TAD    DELTA
       DAC    FA2
       CMA		  /COMPARE DATA ADDRESS WITH HIGH LIMIT.
       TAD    LIMIT	 /   IF FA2.LT.LIMIT, GO AGAIN.
       SMA		  /   IF FA2.GE.LIMIT, EXIT.
       JMP    FA1
       ISZ    .FA
       JMP*   .FA
.FA3	XX		/** HOLDS .FE (FORM.); .DSA .GD (DDIO)
	.TITLE	.FE (.RE)  - -  ELEMENT I/O (.RE - RANDOM ACCESS)
/BCD ELEMENT I/O CONTROL
/  CALLING SEQUENCE -- .GLOBL  .FE, .RE
/		   LAW	-MODE	1'S COMPLEMENT
/		   JMS*	 .FE (.RE - FOR RAN. ACC.)
/		   CAL	 ELEMENT ADDRESS (T.V. IF BIT 0 = 1)
/		   LAW -MODE, 1'S COMPLEMENT, RETURNED IN AC
/
.RE=.			/* RANDOM ACCESS ENTRY
.FE	CAL	0
	DAC	ACSAVE	/MODE BITS ARE SAVED
	CMA
	DAC	VRTYP
	LAC*	.FE	/GET STARTING ADDRESS OF DATA ELEMENT
	DAC	DADD
       SPA		  /IF T.V., ONE MORE LEVEL OF INDIRECT
       LAC*   DADD		/   ADDRESSING.
/	AND	S77777		/SQUASHES MODE BITS
/				/(RKB-049) ABOVE LINE REMOVED.
       DAC    DADD
	LAC	CC		/** IF D-D I/O,
	SZA			    /** DON'T USE FORM. DECODER
       JMS    .FD	         /GET FORMAT SPECIFICATION
	DZM	OCTL	/CLEAR OCTAL FLAG
       LAC    .S	         /CONVERSION CODE TIMES TWO (PLUS ONE FOR
       RCL		  /   WRITE)=INDEX VALUE FOR JUMP TABLE.
       TAD*   .FH
	AND	S00037		/** MASK 5 BITS
       TAD    JTABLE
       DAC    TEMP1
       JMP*   TEMP1
JTABLE .DSA   FE1
FE1    JMP    FE50		/I-READ
       JMP    FE2	         /I-WRITE
       JMP    FE55		/L-READ
       JMP    FE7	         /L-WRITE
FE66AT JMP    FE60		/A-READ
       JMP    FE8	         /A-WRITE
       JMP    FE50O		 /O-READ
       JMP    FE2O		/O-WRITE
       JMP    FE51		/D-READ
       JMP    FE11		/D-WRITE
       JMP    FE51		/E-READ
       JMP    FE11		/E-WRITE
       JMP    FE51		/F-READ
       JMP    FE23		/F-WRITE
       JMP    FE51		/G-READ
       JMP    FE32		/G-WRITE
	JMP	FE60R		/** R-READ
FE8RT	JMP	FE8R		/** R-WRITE
FE99   ISZ    .FE
ACSAVE LAW			/LAW -MODE PUT HERE, RETURNED IN AC
       JMP*   .FE
	.TITLE	BCDIO
/** O-CONVERSION -- WRITE PROCESSOR
FE2O	DZM	MS
	LAC	VRTYP
	SNA		/SKIP IF DOUBLE INTEGER
	JMP	.+4	/SINGLE INTEGER
	LAC*	DADD
	DAC	MS	/GET HIGH ORDER
	ISZ	DADD
	LAC*	DADD
	DAC	LS	/GET LOW ORDER
	LAC	.W
	TCA		/(RKB-051)
	DAC	POT	/SAVE NEGATIVE OF FIELD WIDTH
	LAW	-15
	TAD	.W
	SPA			/SKP IF LDNG. BLANKS NECESSARY
	JMP	FE2O9
	TAD	(1
	JMS	.PBLKS		/PACK LDNG. BLANKS
	LAW	-14
	DAC	POT		/RESET FIELD CNT.
	CLC			/SET AC=-1
FE2O9	DAC	TEMP6		/CHAR. SKP CNT.
	JMP	FE2O7
FE2O8	LAC	OCHR		/BIN. VAL. OF OCTAL CHAR.
	SZA
	JMP	FOVFL2		/IF NOT=0, OVER-FLOW
FE2O7	JMS	GOCHR		/GET OCTAL CHAR.
	ISZ	TEMP6
	JMP	FE2O8		/CHK. FOR OVFLO
FE2O6	JMS	GETOD		/GET OCTAL DIGIT
	JMS	.PACK
	ISZ	POT
	JMP	FE2O6		/GET NXT DIGIT
	JMP	FE99		/DONE - RTN.
/**
	.EJECT
/** I-CONVERSION -- WRITE PROCESSOR
FE2	LAC*	DADD
	DAC	MS
	ISZ	DADD
	LAC*	DADD
	DAC	LS		/LD. MS+LS W/ DATA
	LAC	VRTYP
	SZA			/SKP IF S.P. INT.
	JMP	FE3		/J
	LAC	MS
	DAC	LS
	SPA!CLA
	CMA
	DAC	MS
FE3	DZM	SIGN		/SET TO POS.
	LAC	MS
	SMA
	JMP	FE4
	JMS	COMJ		/COMPL. D.P. INT.
	ISZ	SIGN		/SET TO MINUS
FE4	LAC	(DIGTS
	DAC	TEMP6		/HOLDS ADDR. OF 1ST DIG.
	DZM	POT		/DIGIT CNTR.
/--DIVIDE BY 10(10) TO GET DEC. DIGITS
FEIL	LAC	MS
	CLL
	IDIV
	12			/INT. DIV. BY 12(8)
	DAC	TEMP8
	LACQ
	DAC	MS
	LAC	LS
	LMQ			/INTO MQ
	LAC	TEMP8		/PREVIOUS QUOTIENT
	CLL
	DIV
	12			/FULL DIV. BY 12(8)
	DAC*	TEMP6		/DEPOSIT IN PROPER DIGIT
	ISZ	TEMP6
	ISZ	POT		/INCR. DIGIT CNTR.
	LACQ
	DAC	LS
	LAC	MS
	OMQ			/INCL. OR AC AND MQ TO CHK. IF BOTH 0
	SZA			/SKP IF DONE
	JMP	FEIL		/NOT DONE - GO AGAIN
/--CHK. FOR FLD. OVFLO, PK. SIGN AND LEADING BLKS. AND DIGITS
	JMS	PLBSN		/PK. LDNG. BLKS. & SIGN IF NEC.
FEDL	CLC
	TAD	TEMP6
	DAC	TEMP6		/PTS. TP PROPER DIGIT
	LAW	60
	TAD*	TEMP6		/ASCII FOR DIGIT
	JMS	.PACK		/PK. DIGIT
	LAC	TEMP6
	SAD	(DIGTS
	JMP	FE99		/ALL DIGITS DONE - EXIT
	JMP	FEDL		/NOT DONE - CONTIN.
DIGTS	.BLOCK	13
/**
	.EJECT
/L-CONVERSION -- WRITE PROCESSOR
FE7	CLC
       TAD    .W
	SPA
       JMP    FE99		/EXIT IF FIELD WIDTH ZERO OR NEGATIVE.
       JMS    .PBLKS	 /PACK (WI1) BLANKS.
       LAC*   DADD
	SNA!CLA
       LAW    -16	         /F CHARACTER TO AC.
       TAD    S00124	 /T CHARACTER TO AC.
       JMS    .PACK		 /PACK TO OR F CHARACTER IN BUFFER
       JMP    FE99		/EXIT
       .EJECT
/** R-CONVERSION--WRITE PROCESSOR
FE8R	LAW	-5
	TAD	.W
	DAC	IGCNT		/NUM OF LDNG. CHRS. TO BE SKPD.
	SKP
/**
/A-CONVERSION -- WRITE PROCESSOR
FE8	DZM	IGCNT		/** SET TO INDIC. A-CONV.
	CLA			/CHECK FOR INTEGER TYPE.  IF SO,
	SAD	VRTYP		/WILL HAVE TO FAKE BLANKS.
	JMP	FE8I
	LAC*	DADD		/FIRST DATA TO MS
       DAC    MS
       ISZ    DADD
       LAC*   DADD		/SECOND DATA WORD TO LS
FE8IX  DAC    LS
       LAC    .W	         /IF W=0, EXIT
	SNA!SPA
       JMP    FE99
	TCA		/(RKB-051) NEGATE W FOR A CHARACTER COUNT
       DAC    POT
       LAW    -5
       TAD    .W
	SPA!SNA
	JMP	FE10R		/**
       JMS    .PBLKS	 /PACK (W-5) BLANKS IF W.GT.5
	LAW	-5
       DAC    POT
FE10R	LAC	IGCNT		/** IGCNT MINUS INDIC. R-CONV. W/
	SMA			    /** W .LT. 5
	JMP	FE9		/** IF NO CHRS. TO BE SKPD., PACK
FE9R	JMS	DSH7		/** SKP FIRST (5-W) CHRS.
	ISZ	IGCNT		/**
	JMP	FE9R		/**
FE9    JMS    DSH7		/ROTATE MS/LS 7 LEFT AND PACK LOW BITS OF
       LAC    LS	         /   LS.  CONTINUE UNTIL CHARACTER COUNT
       JMS    .PACK		 /   IS ZERO.
       ISZ    POT
       JMP    FE9
       JMP    FE99		/EXIT
FE8I	LAC	U01004	/FOR EITHER R OR A CONVERSION OF INTEGER, START
	DAC	MS	/WITH BLANKS,AS A CONV. IS A FAKE R CONV.
	LAC*	TEMP1	/NOW CHECK FOR CONVERSION TYPE.
	SAD	FE8RT
	JMP	FE8IR	/MATCH, WAS R CONVERSION FOR INTEGER
	LAW	-5	/FOR A CONVERSION, RIGHT JUSTIFY ONE (IF A1) OR
	TAD	.W	/TWO CHARACTERS IN MS,LS, THEN TREAT AS IF R-
	DAC	IGCNT	/CONVERSION.
	LAW	-1	/CHECK FOR A1 FORMAT
	TAD	.W	/ADD FIELD WIDTH, IS ZERO OF A1
	SNA!CLA!CLL	/DEFINE AN EAE LRS TO PUT ONE OR TWO CHARACTERS
	LAC	S00007	/IN RIGHT OF LS
	TAD	LRS3	/LRS 3+7 IF A1; LRS 3 OTHERWISE
	DAC	.+2
	LAC*	DADD	/GET CHARACTER(S)
	LRS		/RIGHT ADJUST
	SKP
FE8IR	LAC*	DADD	/FOR R-CONVERSION, SIMPLY COMPLETE MS,LS PAIR
	AND	S77776	/AND IMPOSE BLANK REMNANT AT BEGIN OF WORD
	JMP	FE8IX
LRS3	LRS	3
	.EJECT
/D- AND E-CONVERSION -- WRITE PROCESSOR.
FE11   LAC    .W	         /IF W.LT.7, DEFAULT.
       TAD    K00006
	SPA!SNA
       JMP    FOVFL1		/** FLD. OVFLO
	LAW	-1		/**
	TAD	.SF		/** CNT INCL. .SF-1
	SPA			/**   IF POS.
	CLA			/** ELSE, SET TO 0
	TAD	.D		/**
	TAD	C00002		/**
	DAC	CNT		/** NUM. OF DIGITS (& .) TO BE PRTED.
	TAD	C00005		/** FOR SIGN AND 'E+00'
	TCA		/(RKB-051) **
	TAD	.W		/**
	SPA			/** SKP IF DATA FITS
	JMP	FOVFL1		/** ELSE, FLD. OVFLO
       JMS    .PBLKS	 /IF (W-D).GE.7, PACK (W-D-7) BLANKS
	JMS	GETPS
	JMS	PKSGN
	LAC	CNT		/**
	TCA		/(RKB-051) ** COMPLEMENT FOR COUNTER
       DAC    CNT	         /
	LAC    .D	         /CALCULATE FRACTION FLAG  = -D -1
       CMA
       DAC    FRFLG
	LAC	.SF		/**
	SMA!SZA			/**
	TAD	C00001		/** SIGNIF. DIGS. =.D+.SF+1 (.SF .GT. 0)
	TAD	.D		    /**	=.D+.SF (.SF .LE. 0)
	DAC	SDFLG		/** SIG. DIG. FLG.
FE15   LAC    CNT	         /MANTISSA OUTPUT LOOP.  IF CNT=FRFLAG,
       SAD    FRFLG	 /   PRINT DECIMAL POINT.
       JMP    FE17
       TAD    SDFLG	 /IF /CNT/.GT.SDFLG, PRINT LEADING ZERO
	SMA
       JMP    FE16		/IF /CNT/.LE.SDFLG, PRINT NEXT SIGNIFICANT
       LAW    60	         /   DIGIT.
       JMP    FE18
FE16   JMS    GETDD
       JMP    FE18
FE17   LAW    56
FE18   JMS    .PACK
       ISZ    CNT	         /BUMP DIGIT COUNT
       JMP    FE15
       LAW    53	         /SET EXPONENT SIGN TO PLUS CHARACTER.
       DAC    SIGN
       DZM    DIG1		/ZERO EXPONENT DIGIT 1, AND PLACE ENTIRE
	LAC	.SF	/ *** DDS JAN69 ***
	TCA		/(RKB-051)
	TAD	POT	/ *** DDS JAN69 ***
       DAC    DIG2
       SMA		  /IF EXPONENT IS NEGATIVE, COMPLEMENT IT
       JMP    FE19		/   AND SET EXPONENT SIGN TO MINUS.
	TCA		/(RKB-051)
       DAC    DIG2
       ISZ    SIGN
       ISZ    SIGN
FE19   TAD    K00010	 /INTEGER DIVIDE DIG2 BY 10.0 -- QUOTIENT
       SPA		  /   TO DIG1, REMAINDER TO DIG2.
       JMP    FE20
       DAC    DIG2
       ISZ    DIG1
       JMP    FE19
FE20	LAC	.S
	SAD	S00007		/SKP IF NOT G
	LAC	C00005		/IF G, MAKE E
	TAD	(100		/MAKE ASCII CHR.
       JMS    .PACK		/PACK E OR D CHR.
       LAC    SIGN		/PACK EXPONENT SIGN.
       JMS    .PACK
       LAW    60	         /PACK DIG1 OF EXPONENT.
       TAD    DIG1
       JMS    .PACK
       LAW    60	         /PACK DIG2 OF EXPONENT.
       TAD    DIG2
       JMS    .PACK
       JMP    FE99		/EXIT.
       .EJECT
/F-CONVERSION -- WRITE PROCESSOR
FE23	JMS GETPS		/SCALE AND ROUND DATA.
	LAC POT		/SINCE SCALE FACTOR ACTS AS AN ADDITIONAL
	TAD .SF		/POWER OF TEN FOR F-CONVERSIONS, INCOR-
	DAC POT		/PORATE SF INTO POT.
	SPA!SNA		/DETERMINE THE LENGTH OF THE NUMERIC FIELD
	LAC C00001	/INCLUDING DECIMAL POINT --
	TAD C00001	/POT+D+1 IF DATA.GE.(1.0)
	TAD .D		/D+2 IF DATA.LT.(1.0)
	TCA		/(RKB-051) NEGATE FOR USE AS A LOOP COUNTER (DIG2)
	DAC DIG2
	LAC	SIGN		/**
	SZA			/** SKP IF PLUS
	LAW	-1		/**
	TAD	DIG2
	TAD .W		/IF LENGTH OF NUMERIC FIELD EXCEEDS THE
	SPA		/** .W, GO TO FIELD OVFLO ROUTINE
	JMP	FOVFL3		/** FIELD OVERFLO
	JMS	.PBLKS
	LAC	SIGN		/**
	SZA			/** IF PLUS, DON'T PACK
	JMS	PKSGN		/**
	LAC	.D		/SET FLG. (DPOS) TO INDIC. WHERE THE
	CMA		/DECIMAL POINT SHOULD BE OUTPUT
	DAC DPOS
FE28	LAC DIG2		/NUMERIC OUTPUT LOOP -- IF LOOP COUNTER IS
	SAD DPOS		/SAME AS DECIMAL POINT FLAG (DIG2=DPOS),
	JMP FE29		/OUTPUT DECIMAL POINT.
	LAC POT		/EXAMINE SCALE FACTOR. IF NEGATIVE OR
	ISZ POT		/ZERO, DATA.LT.(1.0) AND A LEADING ZERO
	SPA!SNA		/IS PRINTED. SCALE FACTOR IS INCREMENTED
	JMP FE30		/ONE FOR NEXT PASS THROUGH LOOP.
	JMS GETDD		/GET NEXT DECIMAL DIGIT FROM FLOATING AC.
	JMP FE31
FE29	LAW 56		/ASCII-7 DECIMAL POINT.
	JMP FE31
FE30	LAW 60		/ASCII-7 ZERO
FE31	JMS .PACK		/PACK CHARACTER IN OUTPUT BUFFER AND TEST
	ISZ DIG2		/FOR END OF LOOP.
	JMP FE28
	LAC S2		/EXAMINE CONVERSION TYPE TO DETERMINE
	TAD K00006	/EXIT LOCATION.
	SMA!SZA
	JMP FE33		/REENTER G-CONVERSION
	JMP FE99		/EXIT TO CALLING PROGRAM.
       .EJECT
/G CONVERSION -- WRITE PROCESSOR
FE32   JMS    GETPS	 /GET POWER OF TEN AND SIGN
       LAC    POT	         /IF POT.LT.0, GO TO E-CONVERSION.
	SPA
	JMP	FE11	/ *** DDS JAN69 ***
	TCA		/(RKB-051) IF POT .GT. D, GO TO E-CONVERSION
       TAD    .D
       DAC    DIG1
	SPA
	JMP	FE11	/ *** DDS JAN69 ***
       LAC    .SF	         /IF 0.LE.POT.LE.D, SAVE SF, W, AND D.  GO
       DAC    TEMP1	 /   TO F-CONVERSION WITH SF=0, W=(W-4),
       LAC    .W	         /   AND D=(D-POT).
       DAC    TEMP2
       LAC    .D
       DAC    TEMP3
       DZM    .SF
	LAW    -4
       TAD    .W
       DAC    .W
       LAC    DIG1
	DAC	.D
       LAC    C00006
       DAC    .S
       JMP    FE23
FE33   LAW    4		       /ON RETURN FROM F-CONVERSION PROCESSOR,
       JMS    .PBLKS	 /   OUTPUT 4 BLANKS AND RESTORE SF, W, AND
       LAC    TEMP1	 /   D TO THEIR ORIGINAL VALUES.
       DAC    .SF
       LAC    TEMP2
       DAC    .W
       LAC    TEMP3
	DAC	.D
       ISZ    .S
       JMP    FE99		/EXIT
       .EJECT
/ROUND AND SCALE DECIMAL DATA
/  CALLING SEQUENCE -- JMS	 GETPS
GETPS  CAL    0
       DZM    OVFFLG
       DZM    SIGN		/SET SIGN POSITIVE.
       DZM    POT	         /SET POWER-OF-TEN TO ZERO.
	.IFDEF %FPP
	FZR
	0
	.ENDC
	.IFUND %FPP
       DZM*   .AA	         /CLEAR FLOATING ACCUMULATOR
       DZM*   .AB
       DZM*   .AC
	.ENDC
	LAW	-6		/TEST CONVERSION-TYPE. SET NRZ=0 IF
	TAD	.S		/F, ELSE SET NRZ=1.  .S IS 6 IF F TYPE
	SZA			/REMAIN ZERO IF F TYPE
	LAC	C00001
	DAC	NRZ
	LAC	VRTYP		/LOAD VARIABLE ON BASIS OF MODE TYPE
	SAD	C00002		/NOT ON BASIS OF CONVERSION
	JMP	GET03		/GO DO D.P. LOAD
	FLD%	.AG		/SINGLE PRECISION LOAD
	.DSA	DADD+400000
	JMP	GET06
	.IFDEF %FPP
GET03	DLD			/DOUBLE PRECISION LOAD
	.ENDC
	.IFUND %FPP
GET03	JMS	.FAO		/D.P. LOAD INTO FLOATING ACCUMULATOR
	.ENDC
       .DSA   DADD+400000
/COMMON ROUTINE
	.IFDEF %FPP
GET06	BZA			/BR IF FPP AC=0
	GET17			/ZERO EXIT IMMED
	BPA			/BR IF POS.
	GET07
	ISZ	SIGN		/IF NEG. SET FLAG
	FAB			/MAKE FPP POS.
	0
GET07	DST			/STORE FPP AC IN WORKING
	FP2			    /REGISTERS FOR SCALING MANIPULATION
	LAC	FP2
	SPA!SNA
	JMP	GET10		/DATA IN FPP AC MUST BE SCALED
	DAC	TMPFAC		    /SO THAT 0.100000 .LE.
	DST			    /FPP AC .LE. 0.999999
	FPH2			    /(WHICH IS -3/31463146 .LE.
	DLD			    /FPP AC .LE. +0/3777777....
	DBLONE			    /IN FLT. PT. NOTATION) SO THAT
	DST			    /MULT. BY TEN YIELDS FIRST
	FP2			    /DIGIT.  IN ORDER TO AVOID MANY
GET08	LAC	TMPFAC		    /DIVS. BY 10, THE FPP AC IS
	CMA			    /SAVED IN FPH2 AND FPP AC IS USED
	TAD	FP2		    /TO BUILD A SING. DIVISOR (POW. OF 10)
	SMA			/AFTER SCALING, POT CONTAINS POWER OF
	JMP	GET09		/TEN USED IN DIVISION
	ISZ	POT
	JMS	.MPYTN		/MULT. FPP AC BY 10
	DST			/REST. TEMP FPP AC FOR EXP. TST
	FP2
	JMP	GET08
GET09	URDRD			/DIV. SAVED FPP AC BY FPP AC (NOW
	FPH2			    /APPROPRIATE POWER OF TEN)
GET10	DST			/RESULT IS NOT ROUNDED. LD. FPP AC
	FP2			    /INTO TEMPS FOR MANIP.
	LAC	C00003		/AFTER SCALING, IF EXPON. OF DATA
	TAD	FP2		    /IS NEG., FPP AC IS CHKD. FOR
	SPA			    /.LT. 0.1 (-3/31463146..) IF SO
	JMP	GET11		    /FPP AC IS MULT BY TEN AND POT
	SZA			    /IS DECREM. BY ONE.  IF NOT,
	JMP	GET12		    /SCALING IS COMPLETE AND DATA CAN
	LAC	FP3		    /BE ROUNDED OFF.
	TAD	TESTB
	SPA
	JMP	GET11
	SZA
	JMP	GET12
	LAC	FP4
	TAD	TESTC
	SMA!SZA
	JMP	GET12
	.ENDC
	.IFUND %FPP
GET06  LAC*   .AB	         /CHECK FOR NEGATIVE NUMBER.
       SNA
       JMP    GET17	 /Y ZERO, EXIT IMMEDIATELY
	SMA
       JMP    GET07
       AND    V77777	 /IF MANTISSA IS NEGATIVE, EXTRACT OFF THE
       DAC*   .AB	         /   SIGN BIT AND SET SIGN TO MINUS.
	SNA		/EXIT WITH 0.0 IN CASE OF -0.0
	JMP GET17
       ISZ    SIGN
GET07  LAC*   .AA	         /THE DATA NOW IN FAC MUST BE SCALED SO
       SPA!SNA		      /   THAT 0.100000.3E.FAC.3E0.999999 (WHICH
       JMP    GET10	 /   IN FLOATING POINT POTATION IS
       DAC    TMPFAC	 /   -3/31463146...LE.FAC.LE.+0/3777777...)
       JMS*   .CF	         /   SO THAT MULTIPLYING BY 10 YIELDS FIRST
       JMS    .FAO		/   DIGIT. IN ORDER TO AVOID INNUMERABLE
       .DSA   DBLONE	 /   DIVISIONS BY TEN IN THE CASE WHERE THE
GET08  LAC    TMPFAC	 /    EXPONENT IS LARGER AND POSITIVE, THE
       CMA		  /    FAC IS SAVED IN TMPFAC AND THE FAC IS
       TAD*   .AA	         /   USED TO BUILD A SINGLE DIVISOR WHICH
       SMA		  /   IS A POWER OF TEN.  AFTER SCALING POT
       JMP    GET09	 /   CONTAINS THE POWER OF TEN THAT WAS
       ISZ    POT	         /   USED IN THE DIVISION.
       JMS    .MPYTN
       JMP    GET08
GET09  JMS*   .CI	         /FAC=HAC/FAC
       .DSA   -44
	.DSA	1	/ *** DDS FEB69 ******WAD MAY 69 ***
       JMS*   .CH	         /ROUND AND SIGN
	.DSA	0	/ *** DDS FEB69 ***
	.DSA	-1	/ *** DDS FEB69 ***
GET10  LAC    C00003	 /AFTER SCALING POSITIVE EXPONENTS BY DIVI-
       TAD*   .AA	         /   SION OR IF THE EXPONENT OF THE DATA IS
       SPA		  /   NEGATIVE, THE FAC IS CHECKED IF IT IS
       JMP    GET11	 /   LESS THAN 0.1 (-3/31463146....).
       SZA		  /   IF SO, FAC IS MULTIPLIED BY 10 AND POT
       JMP    GET12	 /   DECREMENTED BY ONE.  IF NOT, SCALING
       LAC*   .AB	         /   IS COMPLETE AND THE DATA IS READY TO
       TAD    TESTB	 /   BE ROUNDED OFF.
	SPA
       JMP    GET11
	SZA
       JMP    GET12
       LAC*   .AC
       TAD    TESTC
	SMA!SZA
       JMP    GET12
	.ENDC
GET11	CLC
       TAD    POT
       DAC    POT
       JMS    .MPYTN
       JMP    GET10
TESTB  .DSA   463147
TESTC  .DSA   314632
/ROUND-OFF ROUTINE
GET12  LAC    NRZ	         /AT THIS TIME NRZ IS A FLAG USED TO DETER-
       SPA		  /   MINE WHICH FORMULA IS TO BE USED TO
       JMP    GET17	 /   CALCULATE WHICH ROUNDING VALUE IS TO
       SNA		  /   BE ADDED TO FAC.
       JMP    GET14
       LAC    .SF	         /D, E, OR G-CONVERSION. NRZ=D+1 IF SF.GT.0
       SMA!SZA		      /   NRZ=D+SF IF SF.LE.0
       LAC    C00001
	TAD    .D
       JMP    GET15
GET14  LAC    .SF	         /F-CONVERSION.  NRZ=D+POT+SF
       TAD    POT
       TAD    .D
GET15	SPA!CMA		/ *** DDS FEB69 ***
       JMP    GET17	 /   DECIMAL DIGITS (MINUS ONE) THAT ARE TO
	DAC	GET30	/ *** DDS JAN69 ***
	.IFDEF %FPP
	DST			/TEMP. STORE FO SCALED FPP AC
	GET31
	DLD
	C00002
GET32	ISZ	GET30
	SKP
	JMP	GET33
	JMS	.MPYTN
	JMP	GET32
GET33	FNM			/NORM. FPP AC BECAUSE MPYTEN DOESN'T
	0
	DRD			/DIV. 1 BY (2*TEN**APPROP. POWER)
	DBLONE			    /WHICH IS IN FPP AC
	DAD			/ADD SCALED DATA TO APPRO. POWER
	GET31			  /OF TEN TIMES .5 FOR ROUNDING
	DST			  /TEST EXPON. FOR OVFLO ONLY
	FP2			  /OVFLO THAT CAN OCCUR THAT MAKE FPP
	LAC	FP2		  /TOO
	SPA!SNA
	.ENDC
	.IFUND %FPP
	JMS	.FAP	/ *** DDS JAN69 ***
	.DSA	GET31	/ *** DDS JAN69 ***
	JMS	.FAO	/ *** DDS JAN69 ***
	.DSA	C00002	/ *** DDS JAN69 ***
GET32	ISZ	GET30	/ *** DDS JAN69 ***
	SKP		/ *** DDS JAN69 ***
	JMP	GET33	/ *** DDS JAN69 ***
	JMS	.MPYTN	/ *** DDS JAN69 ***
	JMP	GET32	/ *** DDS JAN69 ***
GET33	JMS	.FAP	/ *** DDS JAN69 ***
	.DSA	GET34	/ *** DDS JAN69 ***
	JMS	.FAO	/ *** DDS JAN69 ***
	.DSA	DBLONE	/ *** DDS JAN69 ***
	JMS*	.CF	/ *** DDS JAN69 ***
	JMS	.FAO	/ *** DDS JAN69 ***
	.DSA	GET34	/ *** DDS JAN69 ***
	JMS*	.CI	/ *** DDS JAN69 ***
	.DSA	-44	/ *** DDS JAN69 ***
	.DSA	1	/ *** WAD SEPT69 ***
	JMS*	.CH	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS FEB69 ***
	.DSA	-1	/ *** DDS FEB69 ***
	JMS	FAQ	/ *** DDS JAN69 ***
	.DSA	GET31	/ *** DDS JAN69 ***
	LAC*	.AA	/CHECK FAC FOR OVERFLOW. THE ONLY OVER-
	SPA!SNA		/   FLOW THAT CAN OCCUR THAT MAKE FAC TOO
	.ENDC
       JMP    GET17	 /   BIG (.GT. 0.9999...) IS BY ONE BIT.
       LAC    C00001	 /   IN THIS CASE, A FLAG(OVFFLG) IS SET
       DAC    OVFFLG	 /   FOR THE GETDD ROUTINE INDICATING THAT
       ISZ    POT	         /   THE FIRST DECIMAL DIGIT IS A ONE.  THE
	NOP
GET17  JMP*   GETPS	 /   REFLECT THE EXTRA DIGIT.
GET31	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
GET30	.DSA	0	/ *** DDS JAN69 ***
C00002	.DSA	2	/ *** DDS JAN69 ***
	.DSA	200000	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
	.IFUND %FPP
GET34	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
	.ENDC
       .EJECT
/** PACK LEADING BLANKS AND SIGN
/CALLING SEQUENCE--
/	JMS	PLBSN
PLBSN	0
	LAC	.W		/FLD. WIDTH
	CMA
	TAD	POT
	TAD	SIGN		/=0, + (NOT OUTPUT); =1, -
	SMA			/AC= -(.W+1)+POT+SIGN
	JMP	FOVFL2		/FIELD OVFLO
	CMA
	JMS	.PBLKS		/PACK BLKS.
	LAC	SIGN
	SZA			/SKP IF PLUS
	JMS	PKSGN		/PK. SIGN
	JMP*	PLBSN
/**
	.EJECT
/GET DECIMAL DIGIT
/  CALLING SEQUENCE -- JMS	 GETDD
GETDD  CAL    0
       LAC    OVFFLG	 /CHECK OVERFLOW FLAG SET IN GETPS ROUTINE.
       SNA		  /   IF SET, FIRST DIGIT IS A ONE AND
       JMP    GET20	 /   FLOATING ONE IS SUBTRACTED FROM FAC.
       DAC    DIG
       DZM    OVFFLG
       JMP    GET23
GET20  JMS    .MPYTN	 /MULTIPLY FAC BY 10 TO EXTRACT THE NEXT
       DZM    DIG	         /   DECIMAL DIGIT.
	.IFDEF %FPP
	LAC	FP5
	.ENDC
	.IFUND %FPP
       LAC*   .AA
	.ENDC
	SPA!SNA
       JMP    GET22	 /IF FAC EXPONENT.LE.ZERO, DIGIT IS A ZERO.
	TCA		/(RKB-051) IF FAC EXPONENT .GT. 0, THE EXPONENT
       DAC    BCNT		/   IS COMPLEMENTED TO USE AS A SHIFT
       JMS    DSHL		/   COUNTER TO SHIFT THE INTEGER BITS OF
GET21  JMS    DSHL		/   MS/LS INTO DIG
       LAC    DIG
	RAL
       DAC    DIG
       ISZ    BCNT
       JMP    GET21
       JMS    DSHR
GET22  JMS    TRMSLS
	.IFDEF %FPP
	UNDST			/UNNORM. STORE
	FP2
	DZM	FP2
	UNDLD
	FP2
	.ENDC
	.IFUND %FPP
       DZM*   .AA
	.ENDC
       LAW    60	         /EXIT IS TAKEN WITH THE ASCII-7 CODE OF
       XOR    DIG	         /   THE DECIMAL DIGIT IN THE AC.
       JMP*   GETDD
	.IFDEF %FPP
GET23	UNDST
	FP2
	LAC	FP3
	AND	T77777
	DAC	MS
	LAC	FP4
	DAC	LS
	.ENDC
	.IFUND %FPP
GET23  LAC*   .AB	         /MS/LS=FAC-1.0
       AND    T77777
       DAC    MS
       LAC*   .AC
       DAC    LS
	.ENDC
       JMS    DSHL
       JMP    GET22
       .EJECT
/** GET OCTAL CHAR.
/CALLING SEQUENCE--
/	JMS	GOCHR
GOCHR	0
	LAW	-3
	DAC	OCTL		/CNTR.
	DZM	OCHR
GCH1	JMS	DSHL			/SHIFT MS+LS 1 LEFT
	LAC	OCHR
	RAL			/ROTATE BIT INTO AC
	DAC	OCHR
	ISZ	OCTL
	JMP	GCH1
	JMP*	GOCHR		/IN OCHR AND AC
/**
	.EJECT
/**GET OCTAL DIGIT
/CALLING SEQUENCE--
/	JMS	GETOD
GETOD	0
	LAC	OCHR
	XOR	S00060
	DAC	TEMP6
	JMS	GOCHR
	LAC	TEMP6
	JMP*	GETOD
/**
	.EJECT
/** O-CONVERSION -- READ PROCESSOR
FE50O	LAW	-1		/** SET TO INDIC. OCTAL
	DAC	OCTL
	JMS	RDEXTO		/RD. EXT. FLD. AS OCTAL
	JMP	FE501
/**
/I-CONVERSION -- READ PROCESSOR.
FE50	JMS RDEXT		/READ CONTENTS OF EXTERNAL FIELD. IF
	DZM	OCTL		/** CLR. OCTAL FLG.
FE501	LAC	SFFLG		/SFFLG AND DPOS ARE NOT BOTH ZERO
	TAD DPOS		/AN ILLEGAL CHARACTER IS IN THE INPUT
	SNA			/**
	JMP	FE502		/** EXT.FLD. OK
BDTA	DZM	LS		/** ILL. - SET TO 0
	DZM	MS		/**
FE502	LAC	SIGN		/** IF NUM. NEG., CMPL.
	RAR			/**
	LAC	VRTYP		/**
	SAD	C00003		/** SKP IF NOT J (ASSUME I)
	JMP	FE503		/**
	LAC LS
	SZL
	TCA		/(RKB-051)
	DAC* DADD		/STORE INTEGER IN MEMORY.
	JMP FE99		/EXIT.
FE503	SZL			/** J MODE - SKP IF POS. NUM.
	JMS	COMJ		/** NEG. NUM., COMPLEMENT
	LAC	MS		/**
	DAC*	DADD		/** DEPOSIT NUM.
	ISZ	DADD		/**
	LAC	LS		/**
	DAC*	DADD
	JMP	FE99		/**
       .EJECT
/** COMPLEMENT D.P. INT. (IN MS+LS)
COMJ	0
	LAC	LS
	CMA!CLL
	TAD	C00001
	DAC	LS
	LAC	MS
	CMA!SZL			/SKP IF NO LS OVFLO
	TAD	C00001
	DAC	MS
	JMP*	COMJ
	.EJECT
/**
/D- E- F- AND G-CONVERSIONS -- READ PROCESSOR
FE51   JMS    RDEXT	 /READ EXTERNAL INPUT FIELD
       LAC    SFFLG	 /IF THERE WAS NO DECIMAL SCALE FACTOR,
       SZA		  /   TRANSFER MS+LS INTO FAC AND SET SCALE
       JMP    FE515	 /   FACTOR (LS) TO ZERO.
       JMS    TRMSLS
       DZM    LS
	.IFDEF %FPP
FE515	UNDST
	FP1
	LAC	C00035
	DAC	FP1
	DLD
	FP1
	.ENDC
	.IFUND %FPP
FE515  LAC    C00035	 /CONVERT RAW INTEGER MANTISSA TO FLOATING
       DAC*   .AA	         /   POINT.
       JMS*   .CD
	.ENDC
       LAC    FRFLG	 /CALCULATE MULTIPLIER POWER OF TEN = DECI-
	TCA		/(RKB-051) MAL SCALE FACTOR (LS) MINUS NUMBER OF
       TAD    LS	         /   DIGITS AFTER DECIMAL POINT (SFFLG)=POT.
       DAC    POT
	SNA
       JMP    FE54		/IF POT=0, FAC OK AS-IS.
	SMA
       JMP    FE52		/IF POT.GT.0, MULT. FAC BY TEN (POT) TIMES.
	.IFDEF %FPP
	UNDST
	FPH2
	DLD
	DBLONE
	.ENDC
	.IFUND %FPP
       JMS*   .CF	         /IF POT.LT.0, SAVE FAC IN HAC AND LOAD 1.0
       JMS    .FAO		/   INTO FAC --THEN MULTIPLY FAC BY TEN
       .DSA   DBLONE	 /   (-POT) TIMES TO OBTAIN DIVISOR.
	.ENDC
       LAC    POT
	SKP
FE52	TCA		/(RKB-051)
       DAC    CNT
FE53   JMS    .MPYTN
	.IFDEF %FPP
	FNM
	0		/UNUSED
	.ENDC
       ISZ    CNT
       JMP    FE53
       LAC    POT	         /IF POT.GT.0, CONVERSION IS NOW COMPLETE.
       SMA		  /IF POT.LT.0, CONVERSION IS COMPLETED BY
       JMP    FE54		/   DIVIDING HAC BY FAC.
	.IFDEF %FPP
	DRD
	FPH2
	.ENDC
	.IFUND %FPP
       JMS*   .CI
       .DSA   -44
	.DSA	1	/ *** WAD SEPT69 ***
	.ENDC
FE54   LAC    SIGN		/SET ,CE = SIGN OF CONVERTED NUMBER.
       SZA		  /   BIT 0 = 0	PLUS
	.IFDEF %FPP
	FNG			/NEGATE
	NOP
	.ENDC
	.IFUND %FPP
       LAC    W00000	 /   BIT 0 = 1   MINUS
       DAC*   .CE
       JMS*   .CH	         /ROUND OFF FAC LOW BIT AND INSERT SIGN.
	.DSA	0	/ *** DDS FEB69 ***
	.DSA	-1	/ *** DDS FEB69 ***
	.ENDC
	LAC	VRTYP	/STORING IS BASED ON MODE TYPE, NOT 
	SAD	C00002	/CONVERSION TYPE
	JMP	FE545	/GO DO D.P. STORE
	URFST%	.AH
       .DSA   DADD+400000
       JMP    FE99
	.IFDEF %FPP
FE545	UNDST
	.ENDC
	.IFUND %FPP
FE545	JMS	.FAP			/STORE DOUBLE
	.ENDC
       .DSA   DADD+400000
       JMP    FE99
       .EJECT
/L-CONVERSION -- READ PROCESSOR
FE55   LAC    .W	         /SET COUNTER TO (W+1)
	CMA
       DAC    CNT
       DZM    SIGN		/SET INITIAL CONDITION TO FALSE.
FE56   ISZ    CNT
	SKP
       JMP    FE58
       JMS    READ.		 /READ EXTERNAL CHARACTERS UNTIL THE FIRST
       SAD    S00040	 /   NON-BLANK CHARACTER.
       JMP    FE56
       SAD    S00124
       ISZ    SIGN		/IF FIRST NON-BLANK CHARACTER IS A (T),
FE57   ISZ    CNT	         /   SET CONDITION TRUE.
	SKP
       JMP    FE58
       JMS    READ.		 /READ AND IGNORE ALL REMAINING CHARACTERS
       JMP    FE57		/   IN THE EXTERNAL FIELD.
FE58   LAC    SIGN		/IF INPUT IS TRUE, STORE 777777 IN MEMORY.
       SZA		  /IF INPUT IS FALSE, STORE ZERO IN MEMORY.
	CLC
       DAC*   DADD
       JMP    FE99		/EXIT.
       .EJECT
/** R-CONVERSION -- READ PROCESSOR
FE60R	LAC	.W
	TCA		/(RKB-051)
	DAC	IGCNT
	TAD	C00005
	SPA!SNA
/**
/A-CONVERSION -- READ PROCESSOR
FE60	DZM	IGCNT		/** INDIC. A-CON. OR W .GE. 5
	LAC	JMP0		/** INIT. JMP INSTRUC. AND CHAR.
       DAC    FE65		/   COUNTER.
       DZM    CHCT
       LAC    .W	         /IF FIELD WIDTH.LE.0, EXIT IMMEDIATELY.
	SPA!SNA
       JMP    FE99
	TCA		/(RKB-051)
       DAC    CNT
FE63   JMS    READ.		 /FETCH EXTERNAL 7-BIT CHARACTER, ROTATE
FE64   JMS    DSH7		/   MS+LS 7 LEFT, AND MERGE CHARACTER INTO
       AND    Z77600
       XOR    .CHAR		 /   LS.
       DAC    LS
       ISZ    CHCT
       ISZ    CNT	         /CONTINUE UNTIL ALL CHARACTERS HAVE BEEN
FE65   JMP    0		       /   READ AND PACKED.
       LAW    -5	         /CHECK CHARACTER COUNT AND IF LESS THAN
       TAD    CHCT		/   FIVE CHARACTERS HAVE BEEN PACKED, PACK
       SMA		  /   BLANKS UNTIL MS+LS IS FULL.
       JMP    FE66R		/** CHK. IGCNT
       DAC    CNT
       ISZ    FE65
       LAC    S00040
       DAC    .CHAR
       JMP    FE64
FE66R	LAC	IGCNT		/** IGCNT = 0 IF A-CONV. OR IF
	SNA			    /** W .GE. 5
	JMP	FE66		/** NO SKPNG. - GET FIRST CHAR. IN PR.
	JMS	DSHL		/**SHIFT EXTRA BIT OFF
FE67R	JMS	DSH7		/** SHIFT LEFT ONE CHAR.
	LAC	LS
	AND	S00177
	RCL
	DAC	TEMP8
	LAC	LS
	AND	Z77400
	XOR	TEMP8
	DAC	LS
	ISZ	IGCNT		    /** UNTIL BLKS. ON LEFT
	JMP	FE67R		/**
	SKP
FE66	JMS	DSHL		/LEFT JUSTIFY TO 5/7 ASCII FORMAT
	LAC	VRTYP		/IF THE VARIABLE IS AN INTEGER, WILL
	SZA			/TAKE SPECIAL TREATMENT
	JMP	FE66T		/NOT AN INTEGER
	LAC*	TEMP1	/R CONVERSION?
	SAD	FE66AT
	JMP	FE66A		/NO, A CONV.
	LAC	LS		/FOR R CONVERSION OF INTEGER,ONLY THE
	AND	S77776		/LAST TWO CHARACTERS ARE TAKEN, RIGHT 
	JMP	FE66S		/JUSTIFIED, WITH BLANK REMNANT IN BITS 0-3
FE66A	LAW	-3	/FOR A-CONVERSION, GET RIGHTMOST 1 OR 2 CHARCTERS
	TAD	.W	/AND SHIFT LEFT
	SPA		/FIELD WIDTH:  1  2  3  4  5  6  7  .  .  .
	JMP	FE66A1	/SHIFT LEFT:   0  0  1  2  3  3  3  .  .  .
	TAD	K00003	/WHEN .W IS 3 OR GREATER, NUMBER OF SHIFTS
	SMA		/IS LIMITED TO THREE.
	CLC
	TAD	C00003	/ RECOVER 0, 1, 0R 2, OR FORCE 2
	CMA		/EFFECTIVE 2'S COMPLEMENT OF NUMBER OF SHIFTS
	DAC	CNT
	JMS	DSH7	/SHIFT LEFT REQUIRED NUMBER OF TIMES
	ISZ	CNT	/THUS PUT RIGHTMOST OF FIELD OF WIDTH 3 OR
	JMP	.-2	/LARGER INTO MS,LS LEFT JUSTIFIED.
FE66A1	LAC	MS	/ONLY THE
	AND	Z77760		/FIRST TWO CHARACTERS ARE TAKEN, WITH
	XOR	S00004		/BLANK REMNANT  IN LAST 4 BITS.
	JMP	FE66S
FE66T   LAC    MS	         /STORE BCD WORD PAIR IN OBJECT MEMORY.
       DAC*   DADD
       ISZ    DADD
       LAC    LS
FE66S  DAC*   DADD
       JMP    FE99		/EXIT
JMP0   JMP    FE63
       .EJECT
/** READ EXTERNAL FIELD AS OCTAL
/CALLING SEQUENCE--
/	JMS	RDEXTO
RDEXTO	0
	LAC	RDEXTO		/** LD. RDEXT SUB. FOR RTN.
	DAC	RDEXT
	LAC	(JMS	OMPTN	/** LD. JMP TO OCTAL MULT.
	DAC	RDEX25
	JMP	RDXO		/** JMP INTO RDEXT ROUTINE
/**
/READ EXTERNAL FIELD
/  CALLING SEQUENCE -- JMS	 RDEXT
RDEXT  CAL    0		       /THIS SUBROUTINE INPUTS AN EXTERNAL LINE
	LAC	(JMS	IMPTEN	/** LD. JMP TO DEC. MULT.
	DAC	RDEX25		/**
RDXO	DZM	SIGN		/BUFF. FLD. OF LNGTH. W.  AT EXIT
       DZM    SEXP		/   THE FOLLOWING ITEMS HAVE BEEN DETER-
       DZM    MS	         /   MINED--
       DZM    LS	         /     (1) SFFLG=0 IF THE FIELD WAS A RIGHT-
       DZM    POT	         /         JUSTIFIED NUMBER WITH OR WITHOUT
       DZM    DPOS		/	  A DECIMAL POINT AND THE INTEGER
       DZM    SFFLG	 /	   VALUE OF THE DIGITS IS IN MS+LS.
	DZM CRAMFL
       LAC    .W	         /     (2) SFFLG.NE.0 FOR ALL OTHER CASES
       CMA		  /	    AND THE INTEGER VALUE IS IN THE
       DAC    BCNT		/	  FLOATING ACCUMULATOR (UNNORMAL-
/			    /	      IZED) AND LS CONTAINS THE DECI-
/			    /	      MAL SCALE FACTOR.
/			    /	  (3) FRFLG = POWER OF TEN THAT MUST
/			    /	      BE DIVIDED INTO THE INTEGER TO
/			    /	      REDUCE THE INTEGER VALUE OF THE
/			    /	      NUMBER TO THE CORRECT FLOATING
/			    /	      VALUE.
/			    /	  (4) DPOS = 0 WHEN NO DECIMAL POINT
/			    /	      HAS BEEN ENCOUNTERED IN THE
/			    /	      EXTERNAL FIELD.
/			    /	  (5) SIGN = 0, NUMBER IS POSITIVE.
/			    /	      SIGN.NE.0, NUMBER IS NEGATIVE.
RDEX1  JMS    BREAD	 /FETCH LINE BUFFER CHARACTER.
       SAD    S00053
       JMP    RDEX1	 /IF CHARACTER IS PLUS SIGN.
       SAD    S00055
       JMP    RDEX4	 /IF CHARACTER IS MINUS SIGN.
       SAD    S00056
       JMP    RDEX35	 /IF CHARACTER IS DECIMAL POINT.
       JMS    .NMTST	 /TEST FOR FIRST NUMBER.
       JMP    RDEX1	 /   NO, FETCH NEXT CHARACTER.
	SNA		/IS IT A LEADING 0
	JMP RDEX1	/YES.	IGNORE
       DAC    LS	         /   YES, COMPLETE NUMERIC CONVERSION.
	AND	S00010		/** =0 IF LEGAL OCTAL NUM.
	AND	OCTL		/** =0, DEC.; =-1, OCTAL
	SZA			/** SKP IF OK
	JMP	BDTA		/** O NM., NON-0 MD.:SET NM.  TO 0
RDEX2  JMS    BREAD
       JMS    .NMTST	 /IS CHARACTER A NUMBER.
       JMP    RDEX3	 /   NO, TEST FOR DECIMAL POINT.
RDEX25 JMS    IMPTEN	 /   YES, 10*LS+NUMBER TO LS.
       JMP    RDEX2
RDEX14	LAC CRAMFL		/CR OR ALTMODE?
	SZA
	JMP RDEX15		/YES.  DON'T STORE TRAILING 0'S
/BUMP DPOS ANYWAY
	JMP RDEX25		/NO.  CONTINUE
RDEX3  SAD    S00056
       JMP    RDEX35	 /BLANKS TREATED AS ZEROS
       SAD    S00040
       SKP!CLA
       JMP    RDEX5
	JMP RDEX14	/NOT DECIMAL POINT -- END OF CONVERSION.
/MAY HAVE HIT A CR OR ALT.	CHECK ABOVE IN RDEX14
RDEX35 LAC    BCNT		/IF DECIMAL POINT, SAVE ITS POSITION AND
       DAC    DPOS		/   CONTINUE WITH NUMERIC CONVERSION.
       JMP    RDEX2
RDEX4  ISZ    SIGN
       JMP    RDEX1
RDEX5  LAC    BCNT		/SAVE POSITION OF CHARACTER TERMINATING
       DAC    SFFLG	 /   MANTISSA FIELD AND TRANSFER INTEGER
       JMS    TRMSLS	 /   VALUE OF MANTISSA TO THE FLOATING AC.
/EXPONENT FIELD
       DZM    LS
	DZM .SF		/IGNORE P-FORMAT SPEC WHEN EXP. IN EXT. FIELD
       LAC    .CHAR
RDEX6  SAD    S00053	 /IF CHAR=PLUS, IGNORE IT.
       JMP    RDEX8
       SAD    S00055	 /IF CHAR=MINUS, SET SIGN OF EXPONENT.NE.0.
       JMP    RDEX7
       JMS    .NMTST	 /IS CHAR A NUMBER.
       JMP    RDEX8	 /   NO, CONTINUE.
       JMP    RDEX9	 /   YES, COMPLETE NUMERIC CONVERSION.
RDEX7  ISZ    SEXP
RDEX8  JMS    BREAD
       JMP    RDEX6
RDEX9  DZM    MS
       DAC    LS
RDEX10 JMS    BREAD	 /GET NEXT CHARACTER
       JMS    .NMTST	 /IS CHAR A NUMBER.
       JMP    RDEX11	 /   NO, END OF CONVERSION.
       JMS    IMPTEN	 /   YES, LS=10*LS+NUMBER
       JMP    RDEX10
RDEX11 JMS    BREAD	 /READ CHARACTERS UNTIL BREAD EXITS.
       JMP    RDEX11
RDEX12	LAC DPOS
	SNA!CMA		/DECIMAL PT HIT?
	JMP RDEX13		/NO	ADJUST FRFLG
	TAD SFFLG		/YES	OVERRIDE FMAT. SPEC
	JMP RDEX16
RDEX13	LAC .D		/NO. OF DECIMAL DIGITS SPEC.
	TAD CRAMFL		/BCNT AT CR OR ALT. OCCURANCE
RDEX16	TAD .SF		/ALLOW  FOR EXPLICIT P-FORMAT SPEC
	DAC FRFLG	/POWER OF 10 RAW MANTISSA IS TO BE DIVIDED BY
	LAC SEXP	/COMPL. IF SIGN OF EXPONENT IS NEG.
	SNA
	JMP RDEX17
       LAC LS
	TCA		/(RKB-051)
	DAC LS
	JMP RDEX17	/EXIT
RDEX15	LAC DPOS	/BUMP DPOS IN CASE CR OR ALT
	SZA		/DPOS=0 IF NI DECIMAL PT IN EXTER. FIELD
	ISZ DPOS	/DECIMAL PT FOUND
RDEX20	NOP		/FALL THROUGH - (USED AS CONSTANT IN .FF)
	JMP RDEX2	/DON'T STORE TRAILING 0'S ANYWAY
/SINCE CR OR ALT HIT
RDEX17	LAC	SFFLG
	SZA
	JMP	RDEX18
	LAC	MS
	SZA			/WAD ADD.
	JMP	RDEX19		/WAD ADD.
	TAD	LS
	JMP	RDEX19
	.IFDEF %FPP
RDEX18	BNA
	RDEX19
	CLA
RDEX19	SNA			/RDEX19 FROM RDEX17+5 & RDEX17+7
	DAC	SIGN		/ZERO SIGN IN CASE 0.0
	JMP*	RDEXT
	.ENDC
	.IFUND %FPP
RDEX18	LAC*	.AB
	SZA			/ WAD ADD. TO 016 FOR DOS-15 TAF
	JMP	RDEX19		/ WAD ADD. TO 016 FOR DOS-15 TAF
	TAD*	.AC
RDEX19	SNA
	DAC SIGN
	JMP* RDEXT		/EXIT
	.ENDC
       .EJECT
/BUMP BCNT, TEST FOR ZERO, AND FETCH CHARACTER.
/  CALLING SEQUENCE -- JMS	 BREAD
BREAD	CAL 0
	ISZ BCNT
	SKP		/FIELD WIDTH NOT EXHAUSTED
	JMP RDEX12
	JMS READ.	/FETCH LINE BUFFER CHAR
	JMP* BREAD
       .EJECT
/TRANSFER MS/LS TO .AB/.AC
/  CALLING SEQUENCE -- JMS	 TRMSLS
TRMSLS CAL    0
	.IFDEF %FPP
	UNDST
	FP6
	LAC	MS
	AND	V77777
	DAC	FP7
	LAC	LS
	DAC	FP8
	UNDLD
	FP6
	.ENDC
	.IFUND %FPP
       LAC    MS
       AND    V77777
       DAC*   .AB
       LAC    LS
       DAC*   .AC
	.ENDC
       JMP*   TRMSLS
	.IFDEF %FPP
FP6	0
FP7	0
FP8	0
	.ENDC
       .EJECT
/MULTIPLY FLOATING ACCUMULATOR BY TEN.		   74 OR 89 USEC.
/  CALLING SEQUENCE -- JMS	 .MPYTN		   (77.0 USEC AVG)
	.IFDEF %FPP
.MPYTN	0
	UNDMP			/UNNORM.,  MULT.
	MPY1
	UNDST			/LD. MS,LS
	FP5
	JMP*	.MPYTN
MPY1	000004			/FLT. 10
	240000
	0
	.ENDC
	.IFUND %FPP
.MPYTN CAL    0
       LAC*   .AB	         /GET MS AND LS
       DAC    MS
       LAC*   .AC
       DAC    LS
       JMS    DSHR		/SHIFT MS/LS 2 RIGHT AND ADD ORIGINAL
       JMS    DSHR		/   CONTENTS.
	GLK
       TAD*   .AC
       TAD    LS
       DAC    LS
	GLK
       TAD*   .AB
       TAD    MS
       DAC    MS
       SMA!CLA		      /IF OVERFLOW, SHIFT ANSWER 1 RIGHT.
       JMP    MPY1
       JMS    DSHR
       LAC    C00001
MPY1   TAD    C00003	 /ADD 3 OR 4 TO EXPONENT DEPENDING ON
       TAD*   .AA	         /   WHETHER OR NOT FAC OVERFLOWED.
       DAC*   .AA
       JMS    TRMSLS
       JMP*   .MPYTN
	.ENDC
       .EJECT
/** OCTAL MULT. (BY 8)
/CALLING SEQUENCE--
/	JMS	OMPTN
OMPTN	0
	DAC	TAC		/** SAVE NUM. TO BE ADDED
	AND	S00010
	SZA			/** SKP IF LEGAL OCTAL NUM.
	JMP	BDTA		/** NOT OCTAL - RTN.
	LAC	OMPTN		/** SAVE RTN. ADDR.
	DAC	IMPTEN
	DZM	TLS		/** ZERO TEMP. REGS. FOR MULT. BY 8
	DZM	TMS
	JMS	DSHL		/** MULT BY 2
	JMP	IMP2		/** JMP INTO IMPTEN ROUT.
/**
/MULTIPLY MS+LS BY 10 AND ADD (AC)			       71-73 USEC.
/  CALLING SEQUENCE -- LAC	 BINARY NUMBER
/		   JMS   IMPTEN
IMPTEN CAL    0
       DAC    TAC	         /SAVE NUMBER TO BE ADDED.
       JMS    DSHL		/MULTIPLY MS+LS BY 2 AND SAVE IN TMS+TLS.
       LAC    LS
       DAC    TLS
       LAC    MS
       DAC    TMS
IMP2	JMS	DSHL		/** MULT. MS+LS BY 8 (ENTRY FR. OMPTN)
       JMS    DSHL
	CLL		  /ADD LS, TLS, AND ENTRY VALUE OF (AC).
       LAC    LS
       TAD    TLS
	SZL!CLL
       ISZ    TMS	         /BUMP TMS IF OVERFLOW FROM LS+TLS
       NOP
       TAD    TAC
       DAC    LS
       GLK		  /GET CARRY BIT AND ADD MS AND TMS
       TAD    MS
       TAD    TMS
       DAC    MS
       JMP*   IMPTEN	 /EXIT
       .EJECT
/SHIFT	MS+LS  RIGHT ONE OPEN 			     14 USEC
/  CALLING SEQUENCE -- JMS	 DSHR
DSHR   CAL    0
       LAC    MS
	RCR
       DAC    MS
       LAC    LS
	RAR
       DAC    LS
       JMP*   DSHR
       .EJECT
/SHIFT	MS+LS  LEFT ONE OPEN				    14 USEC
/  CALLING SEQUENCE -- JMS	 DSHL
DSHL   CAL    0
       LAC    LS
	RCL
       DAC    LS
       LAC    MS
	RAL
       DAC    MS
       JMP*   DSHL
       .EJECT
/ROTATE MS+LS LEFT SEVEN			         160 USEC.
/  CALLING SEQUENCE -- JMS	 DSH7
DSH7   CAL    0
       LAW    -7
       DAC    SHCT
DSH71  JMS    DSHL
	GLK
       TAD    LS
       DAC    LS
       ISZ    SHCT
       JMP    DSH71
       JMP*   DSH7
       .EJECT
/DOUBLE LOAD
/  CALLING SEQUENCE -- JMS	 .FAO
/		   .DSA  ADDRESS (+400000 IF TRANSFER VECTOR)
	.IFUND %FPP
.FAO	CAL    0
       LAC*   .FAO		/GET ARGUMENT AND SAVE.
       DAC    FADDR
       SPA		  /IF T.V., GO ONE MORE LEVEL INDIRECT.
       LAC*   FADDR
       DAC    FADDR	 /FADDR NOW CONTAINS ADDRESS OF FIRST WORD.
       LAC*   FADDR
       DAC*   .AA	         /LOAD FIRST WORD.
       ISZ    FADDR
       LAC*   FADDR
       DAC*   .AB	         /LOAD SECOND WORD.
       ISZ    FADDR
       LAC*   FADDR
       DAC*   .AC	         /LOAD THIRD WORD.
       ISZ    .FAO
       JMP*   .FAO		/EXIT
	.ENDC
       .EJECT
/DOUBLE STORE
/  CALLING SEQUENCE -- JMS	 .FAP
/		   .DSA  ADDRESS (+400000 IF TRANSFER VECTOR)
	.IFUND %FPP
.FAP    CAL    0
       LAC*   .FAP	         /GET ARGUMENT AND SAVE.
       DAC    FADDR
       SPA		  /IF T.V., GO ONE MORE LEVEL INDIRECT.
       LAC*   FADDR
       DAC    FADDR	 /FADDR NOW CONTAINS ADDRESS OF FIRST WORD.
       LAC*   .AA
       DAC*   FADDR	 /STORE FIRST WORD.
       ISZ    FADDR
       LAC*   .AB
       DAC*   FADDR	 /STORE SECOND WORD.
       ISZ    FADDR
       LAC*   .AC
       DAC*   FADDR	 /STORE THIRD WORD.
       ISZ    .FAP
       JMP*   .FAP	         /EXIT
	.ENDC
       .EJECT
/DOUBLE FLOATING ADD
/  CALLING SEQUENCE -- JMS	 FAQ  (AUGEND IN FAC)
/		   .DSA  ADDEND ADDRESS
	.IFUND %FPP
FAQ    CAL    0
       JMS*   .CF	         /TRANSFER AUGEND TO HAC.
       LAC*   FAQ	         /TRANSFER ARGUMENT TO DBL LOAD CALL.
       DAC    FAQ1
       JMS    .FAO		/LOAD ADDEND INTO FAC.
FAQ1   .DSA   0
       JMS*   .CC	         /ADD HAC TO FAC.
       .DSA   42
       JMS*   .CH	         /ROUND AND SIGN FAC.
	.DSA	0	/ *** DDS FEB69 ***
	.DSA	-1	/ *** DDS FEB69 ***
       ISZ    FAQ	         /BUMP RETURN ADDRESS AND EXIT.
       JMP*   FAQ
	.ENDC
       .EJECT
/*
/INIT. BCDIO FOR SEQ. ACC.
/  TO CHANGE LOCATIONS THAT MIGHT HAVE BEEN ALTERRED BY
/    PREVIOUS R.A. OPERATIONS
/CALLING SEQUENCE --
/	JMS	.INISA
.INISA	0		/*
	LAC	LDEOR	/*
	DAC	.STEOR	/*
	LAC	.FN	/*
	DAC	.BFLOC	/*
	.IFDEF %V5A1
	DZM*	.RN	/* CLR. R.A. FLG.
	.ENDC
	JMP*	.INISA	/*
	.EJECT
/INITIALIZE FORMAT DECODER
/  CALLING SEQUENCE -- LAC	 STARTING ADDRESS OF FORMAT STATEMENT.
/		   JMS   .INIFD
.INIFD	CAL    0
/	AND	S77777		/** AND OFF MODE BITS
/				/(RKB-049) ABOVE LINE DELETED FOR XVM
       DAC    CC	         /CHARACTER POINTER
       DZM    .SF	         /ZERO TO SCALE FACTOR, SPECIFICATION
       DZM    R		       /   REPEAT COUNT, AND PAREN COUNT.
       DZM    P
       LAC    KZ	         /SET GROUP REPEAT COUNT AND REENTRY LOCA-
       DAC    K		       /   TION POINTERS TO THEIR INITIAL VALUES
       ISZ    K		       /   AND SET RE(1) AND K(1) TO ZERO.
       DZM*   K
       DAC    K
       LAC    REZ
       DAC    RE
       ISZ    RE
       DZM*   RE
       DAC    RE
       DAC    NCF	         /SET NO-CONVERSION FLAG.
       DZM    CCN	         /CLEAR RE(P) INTERMEDIATE VALUE.
       JMP*   .INIFD
/FORMAT DECODER DEDICATED PARAMETERS --
KZ     .DSA   K
K      .BLOCK 4
REZ    .DSA   RE
RE     .BLOCK 4
REEN   .DSA   0
CC     .DSA   0
CCN    .DSA   0
CCA    .DSA   0
CC2    .DSA   0
CC1	.DSA	0	/(RKB-051) POINTER TO FIRST WORD OF CURRENT WORD PAIR
P      .DSA   0
.SF	.DSA   0
R      .DSA   0
.S     .DSA   0
S2     .DSA   0
.W	.DSA   0
.D	.DSA   0
NCF    .DSA   0
       .EJECT
/FORMAT STATEMENT DECODER
/  CALLING SEQUENCE -- JMS	 .FD
/THE FOLLOWING INFORMATION IS RETURNED--
/  (1) .S -- THE CONVERSION TYPE -- 0  I-CONVERSION
/				 1  L-CONVERSION
/				 2  A-CONVERSION
/				 3  O-CONVERSION
/				 4  D-CONVERSION
/				 5  E-CONVERSION
/				 6  F-CONVERSION
/				 7  G-CONVERSION
/	     		    10  R-CONVERSION
/  (2) .W -- THE EXTERNAL FIELD WIDTH
/  (3) .D -- THE FRACTION FIELD WIDTH
/  (4) .SF-- THE DECIMAL SCALE FACTOR
.FD    CAL    0
       DZM    NUMFLG	 /INTIALIZE NUMERIC FLAG
K00001 LAW    -1	         /DECREMENT REPEAT COUNT.  IF GREATER THAN
       TAD    R		       /   ZERO, EXIT WITH ALL SPECIFICATIONS
       DAC    R		       /   UNCHANGED.
	SPA!SNA
       JMP    FD01
       DZM    NCF
       JMP    FD99
FD01   JMS    GETCC	 /GET FIRST CHARACTER.  IF A BLANK, FETCH
       SAD    S00040	 /   NON-BLANK CHARACTER.
FD02   JMS    FNBCHR
       SAD    S00054
       JMP    FD20		/IF COMMA.
FD03   SAD    S00057
       JMP    FD21		/IF SLASH
       SAD    S00051
       JMP    FD22		/IF RIGHT PAREN
	SAD    S00055
       JMP    FD25		/IF MINUS
FD05   SAD    S00050
       JMP    FD26		/IF LEFT PAREN
       JMS    NUMCHK
       JMP    FD05		/IF A NUMBER.
       SAD    S00120
       JMP    FD31		/IF P
	SAD	S00044		/**
	JMP	FDSC		/** IF $
	SAD	S00047		/**
	JMP	FDSC		/** IF '
	SAD	S00042		/**
	JMP	FDSC		/** IF "
       SAD    S00110
       JMP    FD32		/IF H
       SAD    S00130
       JMP    FD37		/IF X
       SAD    S00111
       JMP    FD39		/IF I
       SAD    S00114
       JMP    FD40		/IF L
       SAD    S00101
       JMP    FD41		/IF A
	SAD	S00122		/**
	JMP	FD45		/** IF R
	SAD	S00117		/** 
	JMP	FD46		/** IF O
	SAD	S00124		/** IF T
	JMP	FD60		/**
FD06   JMS    NUMCHK
       JMP    FD07		/IF A NUMBER.
FD07   TAD    Z77671	 /CHAR - (107)8
	SMA!SZA
       JMP    FD08
       TAD    C00003	 /CHAR - (104)8
	SMA
       JMP    FD42		/IF D, E, F, OR G
FD08   LAC    .CHAR
FD09   JMS    NUMCHK
       JMP    FD10		/IF A NUMBER
FD86   JMS*   .ER	         /END OF SKIP CHAIN -- ILLEGAL CHARACTER.
       .DSA   12
	LAC*	CC1	/(RKB-051) POINT TO FIRST WORD (USED TO BE 'LAC*  CC')
       LAC*   CC2
FD10   LAC    LS	         /NUMBER IS FIELD WIDTH
       DAC    .W
       DZM    NUMFLG
       LAC    .CHAR		 /IF NEXT CHARACTER IS A PERIOD, FRACTION
       SAD    S00056	 /   FIELD WIDTH FOLLOWS.  IF NOT, EXIT
       JMP    FD11		/   WITH FRACTION FIELD WIDTH=0.
	DZM	.D
       JMP    FD99
FD11   JMS    FNBCHR
       JMS    NUMCHK
	SKP
       JMP    FD86		/IF PERIOD NOT FOLLOWED BY A NUMBER, BAD
       LAC    LS	         /   FORMAT.
	DAC	.D
FD99   LAC    .S
       DAC    S2
       JMP*   .FD
/COMMA
FD20   LAC    P		       /CHECK PAREN COUNT FOR GREATER THAN ZERO.
       SPA!SNA		      /   IF NOT, BAD FORMAT.
       JMP    FD86		/   IF SO, IGNORE COMMA.
       JMS    FNBCHR
       JMP    FD03
/SLASH
FD21   JMS*    .STEOR		   /* START NEW RECORD AND THEN PROCESS LIKE
	LAC P	/CHECK PAREN CNT FOR >0
	SPA!SNA		/IF NOT BAD FORMAT
	JMP FD86
	JMP FD02		/CONTINUE
/RIGHT PAREN
FD22   JMS    DECP		/REDUCE PAREN COUNT.  IF P=0, ITS THE END
       LAC    P		       /   OF THE FORMAT STATEMENT.  RESET CC TO
       SZA		  /   ITS REENTRY POSITION.  IF P.NE.0, ITS
       JMP    FD24		/   THE END OF A REPEATING GROUP.  RESET
       LAC    REEN		/   CHARACTER COUNTER TO BEGINNING OF
       DAC    CC	         /   GROUP.
       JMS    INCP		/REENTRY POSITION IS THE START OF THE FOR-
       LAC*   RE	         /   MAT STATEMENT IF NO GROUPING PARENS
       SNA		  /   ARE PRESENT (RE(1)=0).  IF RE(1).NE.0,
       JMS    DECP		/   REENTER WITH P=1.
       LAC    NCF	         /IF END OF FORMAT STATEMENT HAS BEEN
       SZA		  /   REACHED WITHOUT NO-CONVERSION FLAG
       JMP    FD99		/   BEING RESET, EXIT IMMEDIATELY.
       JMS*    .STEOR		   /* START NEW RECORD.
FD23   JMS    GETCC	 /GET CHARACTER FOR NEW CC, AND REENTER
       JMP    FD03		/   SKIP CHAIN.
FD24   CLC		  /DECREMENT THE GROUP REPEAT COUNT FOR THIS
       TAD*   K		       /   GROUP.  IF K(P).GT.ZERO, SET CC=RE(P),
       DAC*   K		       /   THE SAVED GROUP REENTRY POINT AND
       SNA!SPA		      /   REPEAT THE GROUP AGAIN.  IF K(P)=0,
       JMP    FD243	 /   DO NOT REPEAT AND GO ON TO NEXT CHAR-
       LAC*   RE	         /   ACTER IN THE FORMAT STATEMENT.
       DAC    CC
       JMP    FD23
FD243  DZM*   K
       JMP    FD02
/MINUS SIGN
FD25   JMS    FNBCHR	 /FETCH FIRST CHAR AFTER MINUS SIGN.
       JMS    NUMCHK	 /IS IT A NUMBER.
	SKP
       JMP    FD86		/   NO, BAD FORMAT.
       LAC    LS	         /COMPLEMENT THE CONVERTED NUMBER AND STORE
	TCA		/(RKB-051) IT IN SF.
       DAC    .SF
       LAC    .CHAR		 /FIRST CHARACTER FOLLOWING MUST BE THE
       SAD    S00120	 /   LETTER P.  IF NOT, BAD FORMAT.
	SKP
       JMP    FD86
	DZM NUMFLG	/NO REPEAT COUNT
FD255  JMS    FNBCHR	 /FETCH NEXT CHAR AND REENTER SKIP CHAIN.
       JMP    FD06
/LEFT PAREN
FD26   LAC    P		       /IF P=0, THIS IS THE FIRST LEFT PAREN IN
       SZA		  /   THE FORMAT STATEMENT.  SAVE CC IN REEN
       JMP    FD28		/   FOR REENTRY, BUMP P BY 1, AND REENTER
       LAC    CC	         /   SKIP CHAIN
       DAC    REEN
FD27   JMS    INCP
       JMS    FNBCHR
       JMP    FD03
FD28   LAC*   K		       /IF REPEAT COUNT NOT ZERO, THIS IS A CON-
       SZA		  /   TINUATION OF A GROUP REPEAT CYCLE --
       JMP    FD27		/   BUMP P AND EXIT.
       LAC    NUMFLG	 /IF REPEAT COUNT = 0, THIS IS A NEW GROUP
	SNA
       JMP    FD29		/   NUMERIC FLAG.  IF SET, RESET IT AND
/			    /	STORE CONVERTED NUMBER AS A REPEAT
       LAC    LS	         /   COUNT.	IF NOT SET, ASSUME A GROUP RE-
       JMP    FD30		/   PEAT COUNT OF ONE.  SAVE CC IN RE(P)
FD29   LAC    C00001	 /   AS A GROUP REENTRY LOCATION.
FD30   DAC*   K
       LAC    CC
       DAC*   RE
       LAC    P		       /IF THIS GROUP IS IN THE FIRST LEVEL OF
       SAD    C00001	 /   PAREN NESTING (P=1), CLOBBER REEN WITH
       SKP		  /   CCN OR RE(1) DEPENDING ON WHETHER THIS
       JMP    FD27		/   GROUP HAD A REPEAT COUNT OR NOT.
       LAC    NUMFLG
	SNA
       JMP    FD301
       DZM    NUMFLG
       LAC    CCN
       JMP    FD302
FD301  LAC*   RE
FD302  DAC    REEN
       JMP    FD27
/LETTER P
FD31   LAC    NUMFLG	 /LETTER P MUST BE PRECEDED BY NUMBER.  IF
       SNA		  /   NOT, BAD FORMAT.  IF SO, NUMBER IS A
       JMP    FD86		/   NEW SCALE FACTOR.
       LAC    LS
       DAC    .SF
       DZM    NUMFLG
       JMP    FD255	 /REENTER SKIP CHAIN.
/**T-CONVERSION
FD60	JMS	FNBCHR
	JMS	NUMCHK		
	SKP			/YES - NUM. IN LS; NXT. CHAR. IN .CHAR
	JMP	FD86		/NOT NUM.: ERROR
	DAC	TEMP8
	LAC	LS
	DAC	TBNM		/TAB NUM.
	LAW	-4
	DAC	TEMP7		/CNT. FOR MULT. BY 5
	LAW	-2
	.IFUND	RSX
	TAD*	.FC6		/L.B. SIZE - 2 FOR HDR.
	.ENDC
	.IFDEF	RSX
	AAC	376		/L.B. SIZE -2 FOR HDR.
	.ENDC
	RCR
	DAC	TEMP6
FD601	TAD	TEMP6
	ISZ	TEMP7
	JMP	FD601		/ADD AGAIN
	DAC	TEMP7		/(L.B.-2) * (5/2) - 1
	TCA		/(RKB-051)
	DAC	TEMP6		/COMPL.
	LAC	TBNM
FD602	TAD	TEMP6		/WRAP TBNM AROUND MAX. NM. OF CHRS.
	SZA!SMA
	JMP	FD602
	TAD	TEMP7
	DAC	TBNM		/FINAL TBNM
/--PROCESS FOR READ OR WRITE
	LAC*	.FH		/=0, RD.; =1,WRT.
	SNA
	JMP	FD603		/READ
	LAW	-2		/WRITE
	TAD	TBNM
	SPA			/TBNM MUST BE .GE. 2 FOR WRITE
	JMP	FD608		/ILLEGAL: EXIT
	LAC	CCPTR
	TCA		/(RKB-051)
	TAD	TBNM		/TBNM-CCPTR
	SPA			/SKP IF OUTPT. ON SAME LINE
	JMP	FD604		/START NEW LINE
	JMS	.PBLKS		/PACK TBNM-CCPTR BLANKS
	JMP	FD608		/FINISHED
/----WRITE NEW LINE
FD604	JMS*	.STEOR		/NEW RCD.
	LAW	53		/ '+' FOR NO ADVANCE
	JMS	.PACK
	LAW	-2
	TAD	TBNM
	JMS	.PBLKS		/PACK TBNM-2 BLANKS IN NEW LINE
	JMP	FD608		/FINISHED
/----READ
FD603	LAC	TBNM
	SNA
	JMP	FD608		/ILLEGAL:TBNM MUST BE .GE. 1 FOR RD.
	LAC	CCPTR
	TCA		/(RKB-051)
	TAD	TBNM		/TBNM-CCPTR
	SNA
	JMP	FD608		/DIFFER. = 0: DO NOTHING, RTN.
	SPA			/SKP IF INPUT TO BE TAKEN FROM SAME LINE
	JMP	FD605		/GET NEW LINE
	TCA		/(RKB-051)
	DAC	TEMP6		/CNTR.
FD606	JMS	READ.		/DUMMY READ
	ISZ	TEMP6
	JMP	FD606		/READ AGAIN
	JMP	FD608		/FINISHED, RTN.
/----READ NEXT LINE
FD605	JMS*	.STEOR		/GET NEW RCD.
	LAW	-1
	TAD	TBNM
	TCA		/(RKB-051)
	DAC	TEMP6		/READ TBNM-1  DUMMY CHRS.
FD607	JMS	READ.		/DUMMY READ
	ISZ	TEMP6
	JMP	FD607		/READ AGAIN
/LD. NEXT CHR. AND GO BACK TO SKP CHAIN
FD608	DZM	NUMFLG
	LAC	TEMP8
	JMP	FD02+1
/**
/** $, ' (STRING CONSTANT)-CONVERSION
FDSC	DZM	NUMFLG
	DAC	STCON
FDSC1	JMS	FMTFCH		/GET NEXT FORMAT CHR.
	SAD	STCON
	JMP	FDSC3		/SAME: CHK. IF STR. CHR. OR SEC. DELIM.
FDSC4	LAC*	.FH		/RD./WR. FLG.
	SNA
	JMP	FDSC2		/RD.
	LAC	.CHAR		/WR. - GET FRM. CHR.
	JMS	.PACK		/PACK
	JMP	FDSC1		/RTN. TO GET AND CHK. NEXT CHR.
FDSC3	JMS	FMTFCH		/LK. AT NXT CHR.
	SAD	STCON
	JMP	FDSC4		/DOUBLE CHR.: PACK AS STR. CHR.
	JMP	FD01+1		/SINGLE CHR.: SEC. DELIM.
FDSC2	JMS	RDINFS		/RD. INTO FORMT. STMNT.
	JMP	FDSC1		/RTN. TO GET AND CHK. NEXT CHR.
/**
/H-CONVERSION
FD32   LAC    NUMFLG	 /H CHARACTER MUST BE PRECEDED BY A NUMBER.
       SNA		  /   IF NOT, BAD FORMAT.  IF SO, CONVERTED
       JMP    FD86		/   NUMBER IS THE CHARACTER COUNT FOR
       LAC    LS	         /   HOLLERITH I/O TRANSFERS.
       DZM    NUMFLG
	TCA		/(RKB-051)
       DAC    CCNT
       SNA		  /IF NUMBER IS ZERO, BAD FORMAT.
       JMP    FD86
       LAC*   .FH	         /IS THIS A READ OR WRITE CALL.
       SZA		  /   READ
       JMP    FD36		/   WRITE
FD33   JMS    INCCC	 /UPDATE CC, CC2, CCA AND CLOBBER CHAR WITH
       JMS    SPLIT	 /   INPUT FROM LINE BUFFER.
	JMS	RDINFS		/**RD. INTO FRMT. STMNT.
       ISZ    CCNT		/HAVE ALL CHARACTERS BEEN TRANSFERRED.
       JMP    FD33		/   NO, PROCESS NEXT CHARACTER.
       JMP    FD02		/   YES, REENTER SKIP CHAIN.
FD36   JMS    FMTFCH	 /HOLLERITH OUTPUT -- READ AND PACK (CCNT)
       JMS    .PACK		 /   CHARACTERS IN LINE BUFFER.
       ISZ    CCNT
       JMP    FD36
       JMP    FD02		/REENTER SKIP CHAIN.
/X-CONVERSION
FD37   LAC    NUMFLG	 /X CHARACTER MUST BE PRECEDED BY A NUMBER.
       SNA		  /   IF NOT, BAD FORMAT.  IF SO, COMPLEMENT
       JMP    FD86		/   OF NUMBER IS THE CHARACTER COUNT FOR
       LAC    LS	         /   I/O TRANSFER.
       DZM    NUMFLG
	TCA		/(RKB-051)
       DAC    CCNT
       SNA		  /IF CHARACTER COUNT IS ZERO, BAD FORMAT.
       JMP    FD86
       LAC*   .FH	         /TEST FOR READ OR WRITE.
       SZA		  /   READ.
       JMP    FD385	 /   WRITE.
FD38   JMS    READ.		 /READ--SKIP (CCNT) LINE BUFFER CHARACTERS.
       ISZ    CCNT
       JMP    FD38
       JMP    FD02		/REENTER SKIP CHAIN.
FD385  LAC    LS	         /WRITE--PACK (LS) BLANKS IN LINE BUFFER.
       JMS    .PBLKS
       JMP    FD02		/REENTER SKIP CHAIN.
/I-CONVERSION
FD39   CLA		  /ZERO TO AC(15-17)
       JMP    FD43
/L-CONVERSION
FD40   LAW    1		       /ONE TO AC(15-17)
       JMP    FD43
/A-CONVERSION
FD41   LAW    2		       /TWO TO AC(15-17)
       JMP    FD43
/R-CONVERSION
FD45	LAW	10		/** EIGHT TO AC(14-17)
	JMP	FD43		/**
/**0-CONVERSION
FD46	LAW	3		/**
	JMP	FD43		/**
/D- E- F- AND G-CONVERSIONS  /FOUR(D), FIVE(E), SIX(F), OR SEVEN(G)
FD42   LAC    .CHAR		 /   TO AC(15-17).
	AND	S00007		/GET RID OF AC BITS 0-14
FD43	AND	S00017		/** GET RID OF AC BITS 0-13
       DAC    .S	         /STORE CONVERSION TYPE CODE.
       DZM    NCF	         /RESET NO-CONVERSION FLAG.
       LAC    NUMFLG	 /CHECK FOR REPEAT COUNT.  IF THERE IS A
       SNA		  /   NUMBER, STORE IT IN R.
       JMP    FD44
       DZM    NUMFLG
       LAC    LS
       DAC    R
FD44   JMS    FNBCHR	 /FETCH NEXT CHARACTER (=FIELD WIDTH) AND
       JMP    FD09		/   REENTER SKIP CHAIN.
       .EJECT
/** READ INTO FORMAT STATEMENT
/CALLING SEQUENCE--
/	JMS	RDINFS
RDINFS	0
	JMS	READ.		/GET L.B. CHAR.
	LAC*	CC1	/(RKB-051) MOVE FORMAT WORD PAIR INTO       (WAS 'LAC*  CC')
	DAC	MS		    /MS+LS FOR SHIFTING
	LAC*	CC2
	DAC	LS
	LAW	-5		/INIT. LOOP CNTRS. CNT AND CNT2
	TAD	CCA
	DAC	CNT2
	LAC	CCA
	CMA
	DAC	CNT
FD34	JMS	DSH7
	ISZ	CNT
	JMP	FD34		/UNTIL CUR. CHR. RT. JUST. IN LS
	LAC	LS
	AND	Z77600
	XOR	.CHAR		/REPLACE OLD W/ NEW CHR.
	DAC	LS
	SKP
FD35	JMS	DSH7
	ISZ	CNT2
	JMP	FD35		/COMPLETE 36 BIT CIRCUL. SHIFT
	JMS	DSHL
	LAC	MS
	DAC*	CC1	/(RKB-051)                                   (WAS 'DAC*  CC')
	LAC	LS
	DAC*	CC2		/PUT WD. PR. IN FRMT. STMNT.
	JMP*	RDINFS
/**
	.EJECT
/CHECK CHARACTER FOR NUMERIC -- COMPLETE CONVERSION IF YES.
/  CALLING SEQUENCE -- LAC	 CHARACTER (ASCII-7)
/		   JMS   NUMCHK
/		   JMP   YES (NEXT CHARACTER IN AC)
/		   JMP   NO  (TESTED CHARACTER IN AC)
NUMCHK CAL    0
       JMS    .NMTST	 /IS CHARACTER A NUMBER.
       JMP    NUMCH3	 /   NO, BUMP RETURN ADDRESS AND EXIT.
       DAC    LS	         /   YES, INITIALIZE MS AND LS.
       DZM    MS
       LAC    CC	         /SAVE LOCATION OF 1ST CHARACTER IN CASE
       DAC    CCN	         /   THIS IS A GROUP REPEAT COUNT.
       CLC		  /SET NUMBER FLAG.
       DAC    NUMFLG
       JMP    NUMCH2	 /ENTER LOOP TO COMPLETE NUMERIC CONVERSION.
NUMCH1 JMS    IMPTEN	 /MULTIPLY MS+LS BY 10 AND ADD (AC).
NUMCH2 JMS    FNBCHR	 /FETCH NEXT CHARACTER AND TEST IT.
       JMS    .NMTST	 /IS IT A NUMBER.
       JMP*   NUMCHK	 /   NO, EXIT WITH NEXT CHAR IN AC.
       JMP    NUMCH1	 /   YES, UPDATE TOTAL.
NUMCH3 ISZ    NUMCHK	 /EXIT HERE IF 1ST CHAR NON-NUMERIC.
       JMP*   NUMCHK
       .EJECT
/TEST FOR NUMERIC CHARACTER
/  CALLING SEQUENCE -- LAC	 CHARACTER (ASCII-7)
/		   JMS   .NMTST
/		   JMP   NO  (TESTED CHARACTER IN AC)
/		   JMP   YES (BINARY VALUE OF CHARACTER IN AC)
.NMTST CAL    0
       DAC    NUMTS2	 /SAVE CHARACTER.
       TAD    Z77706	 /IS IT LESS THAN OR EQUAL TO NINE.
       SMA		  /   YES, TEST AGAIN.
       JMP    NUMTS1	 /   NO, EXIT.
       TAD    S00012	 /IS IT GREATER THAN OR EQUAL TO ZERO.
       SPA		  /   YES, VALID NUMBER.
       JMP    NUMTS1	 /   NO, EXIT.
       ISZ    .NMTST	 /BUMP RETURN ADDRESS AND EXIT WITH BINARY
       JMP*   .NMTST	 /   VALUE OF CHARACTER IN AC.
NUMTS1 LAC    NUMTS2	 /EXIT WITH ORIGINAL CHARACTER IN AC.
       JMP*   .NMTST
NUMTS2 .DSA   0		       /TEMP STORAGE FOR (AC) AT ENTRY.
       .EJECT
/INCREMENT PAREN COUNT
/  CALLING SEQUENCE -- JMS	 INCP
INCP   CAL    0
K00003 LAW    -3	         /IF P.GE.3, BAD FORMAT
       TAD    P
	SMA
       JMP    FD86
       ISZ    P		       / (P+1) TO (P)
	NOP
       ISZ    K		       / (K+1) TO (K)
       ISZ    RE	         / (RE+1) TO (RE)
       JMP*   INCP
       .EJECT
/DECREMENT PAREN COUNT
/  CALLING SEQUENCE -- JMS	 DECP
DECP   CAL    0
	CLC
       TAD    P		       /IF (P-1) NEGATIVE, BAD FORMAT.
	SPA
       JMP    FD86
       DAC    P		       / (P-1) TO (P)
	CLC
       TAD    K
       DAC    K		       / (K-1) TO (K)
	CLC
       TAD    RE
       DAC    RE	         / (RE-1) TO (RE)
       JMP*   DECP
       .EJECT
/GET CURRENT CHARACTER
/  CALLING SEQUENCE -- JMS	 GETCC
/  EXIT WITH CHARACTER IN AC AND IN CHAR.
GETCC  CAL    0
       JMS    SPLIT	 /SPLIT CC INTO CCA AND CC2
       TAD    GETCC0	 /FORM TRANSFER VECTOR TO ONE OF FIVE LOCA-
       DAC    TVCC		/   TIONS ACCORDING TO CHARACTER NUMBER.
       JMP*   TVCC
GETCC0 .DSA   GETCC1
GETCC1 JMP    GETCC6	 /1ST CHARACTER
       JMP    GETCC5	 /2ND CHARACTER
       JMP    GETCC4	 /3RD CHARACTER
       JMP    GETCC3	 /4TH CHARACTER
	LAC*   CC2	         /5TH CHARACTER -- SHIFT WD 1 RIGHT
	RAR
       JMP    GETCC7
GETCC3 LAC*   CC2	         /SHIFT WD2 8 RIGHT.
	RTR;	RTR;	RTR;	RTR
       JMP    GETCC7
GETCC4	LAC*	CC2	/(RKB-051) 4 BITS IN WD1 + 3 BITS IN WD2.
	LMQ		/(RKB-051)  THIS SECTION RECODED TO BE SLIGHTLY FASTER
	LAC*	CC1	/(RKB-051) COMBINE WITH WD1
	LLS	3	/(RKB-051) 
       JMP    GETCC7
GETCC5	LAC*	CC1	/(RKB-051) SHIFT WD1 4 RIGHT.
	RTR;	RTR
       JMP    GETCC7
GETCC6	LAC*	CC1	/(RKB-051) SHIFT WD1 8 LEFT
	SWHA; RTR	/(RKB-051)  THIS LINE RECODED TO BE SLIGHTLY FASTER
GETCC7 AND    S00177	 /EXTRACT OFF UPPER 11 BITS.
       DAC    .CHAR
       JMP*   GETCC	 /EXIT.
TVCC   .DSA   0
.CHAR	.DSA   0
       .EJECT
/SPLIT CC INTO CCA AND CC2
/  CALLING SEQUENCE -- JMS	 SPLIT
SPLIT  CAL    0
       LAC    CC
	AND	(77777)	/(RKB-051) STRIP CHARACTER COUNTER FROM [0:2]
	DAC	CC1	/(RKB-051) CC1 IS NOW USED AS POINTER, NOT CC
	IAC		/(RKB-051) POINT TO SECOND WORD OF PAIR
	DAC	CC2	/(RKB-051)  SIMILAR CODE EXISTED HERE
	LAC	CC	/(RKB-051)  NOW EXTRACT THE CHARACTER COUNT
	RTL;	RTL
       AND    S00007
       DAC    CCA	         /CCA=3 HIGH BITS OF CC, RIGHT JUSTIFIED.
       JMP*   SPLIT	 /EXIT WITH CCA IN AC.
       .EJECT
/FETCH FORMAT CHARACTER
/  CALLING SEQUENCE -- JMS	 FMTFCH
FMTFCH CAL    0
       JMS    INCCC	 /BUMP CHARACTRE COUNT +1.
       JMS    GETCC	 /GET CHARACTER.
       JMP*   FMTFCH
       .EJECT
/INCREMENT CHARACTER COUNT
/  CALLING SEQUENCE -- JMS	 INCCC
INCCC  CAL    0
       LAC    CC
       SPA		  /IF LAST CHARACTER IN THE WORD PAIR, RESET
       TAD    V00002	 /   CHARACTER NUMBER TO ZERO, AND BUMP
       TAD    T00000	 /   WORD PAIR ADDRESS BY 2.  IF NOT LAST
       DAC    CC	         /   CHARACTER, BUMP CHARACTER NUMBER BY 1.
       JMP*   INCCC
       .EJECT
/FETCH NON-BLANK FORMAT CHARACTER.
/  CALLING SEQUENCE -- JMS	 FNBCHR
FNBCHR CAL    0
FNB1   JMS    FMTFCH
       SAD    S00040
       JMP    FNB1		/IF CHAR=BLANK, FETCH AGAIN.
       JMP*   FNBCHR
       .EJECT
/BCD I/O CLEANUP
/  CALLING SEQUENCE -- JMS*  .FF
.FF    CAL    0
	LAC	CC		/** =0 IF D-D
	SNA			/** SKP IF NOT D-D
	JMP	FF2		/** IF D-D, CALL TO .FD UNNEC.
       LAW    -1	         /SET NO-CONVERSION FLAG TO STOP AT END OF
       DAC    NCF	         /   FORMAT STATEMENT.
       JMS    .FD	         /CLEANUP ALL H AND X CONVERSIONS.
FF2=.
	.IFDEF %V5A1
	LAC*	.RN	/* R.A. FLG.
	SZA		/* SKP IF NOT R.A.
	JMP*	.FF		/*
	.ENDC
       LAC*   .FH	         /IF A WRITE, OUTPUT LAST LINE.
	SZA
	JMS*	.STEOR		/**
	LAC	RDEX20		/REINIT. .ER
	DAC*	.ER4
       JMP*   .FF	         /EXIT.
       .EJECT
/INITIALIZE LINE BUFFER
/  CALLING SEQUENCE -- JMS	 .INILB
.INILB	CAL    0
       JMS    EXCH		/EXCHANGE MS+LS WITH SMS+SLS.
       CLC		  /SET CHARACTER COUNT TO MINUS ONE FOR THE
       DAC    .SCC		/   BUMP ROUTINE
       TAD    .BFLOC		  /* RESET LINE BUFFER POINTER (LBADD) TO
       DAC    .LBADD	  /   BEGINNING OF LINE BUFFER.
       DZM    .HIFLG	  /RESET FLAG TO 0 (POINTER OK).
	LAC	C00001		/**
	DAC	CCPTR		/** INIT. CURR. CHR. PTR.
       LAC*   .FH
	SZA
       JMP    INILB1
       ISZ    .LBADD	  /   READ -- INCREMENT LINE BUFFER POINTER
       ISZ    .LBADD	  /	 PAST THE TWO HEADER WORDS.
       JMP    INILB2
INILB1 DZM    MS	         /   WRITE -- STORE ZERO IN WORD BUFFER
       DZM    LS	         /	  FOR HEADER WORDS.
INILB2 DZM    .FSTFL	 /SET FIRST CHARACTER FLAG.
	JMS    BUMP		/BUMP CHARACTER COUNTER (.SCC).
       JMS    EXCH		/RESTORE MS+LS AND SMS+SLS.
       JMP*   .INILB	  /EXIT
       .EJECT
/END OF RECORD PROCESSOR
/  CALLING SEQUENCE -- JMS	 EOR
EOR    CAL    0
       LAC*   .FH	         /CHECK FOR READ OR WRITE.
	SZA
       JMP    EOR1
       LAC    SLOT		/READ--INPUT NEXT RECORD.
       XOR    S02000
       JMS*   .FQ
       LAC*   .FN	         /CHECK L.B. HEADER FOR IOPS-ALPHA MODE.
       AND    S00077		/VALIDITY AND MODE BITS
       SAD    C00002
       JMP    EOR3		/IF MODE OK, CONTINUE.
       JMS*   .ER	         /IF MODE NOT IOPS-ALPHA, TAKE ERROR EXIT.
       .DSA   11
.RAENT	0		/* ENTRY FROM RBCDIO
EOR1   LAC    .HIFLG	  /IF LINE BUFFER IS NOT FULL, FILL CURRENT
       SZA		  /   WORD PAIR WITH BLANKS.
       JMP    EOR2
	LAW	15	/SET UP .PBLKS TO PACK CR'S AT END
	DAC	PKBLK1	/OF LINE, SO LP HANDLER WON'T OVERFLOW
       LAC    .SCC
	TCA		/(RKB-051)
       JMS    .PBLKS
	LAW	40	/RESET .PBLKS TO PACK BLANKS
	DAC	PKBLK1
EOR2   LAC*   .LBADD	  /CLOBBER LAST CHARACTER WITH A C/R.
       AND    Z77400	 /REMOVE CURRENT CHARACTER.
       XOR    S00032	 /INSERT C/R IN BITS 10 TO 16 (17=0).
       DAC*   .LBADD
	.IFDEF %V5A1
	LAC*	.RN	/* R.A. FLG.
	SZA		/* SKP IF NOT R.A.
	JMP*	.RAENT	/* RTN. IF R.A.
	.ENDC
       LAC    .FN	         /CALCULATE LINE BUFFER SIZE.
       CMA!STL		      /   (.F4) = 3BADD-.FN+1
       TAD    C00002
       TAD    .LBADD
       RTL; RTL; RTL; RTL	 /CONSTRUCT HEADER WORD.
       XOR    C00002
       DAC*   .FN
       LAC    SLOT		/WRITE CURRENT RECORD.
       XOR    S02000
       JMS*   .FQ
EOR3   JMS    .INILB	  /INITIALIZE LINE BUFFER.
       JMP*   EOR	         /EXIT.
       .EJECT
/PACK CHARACTER IN LINE BUFFER
/  CALLING SEQUENCE -- LAC	 CHARACTER (ASCII-7)
/		   JMS   PACK
.PACK	CAL    0
       AND    S00177	 /SAVE 7-BIT CHARACTER.
       DAC    .CHAR
	ISZ	CCPTR		/** INCREM. CURR. CHR. PTR.
       LAC    .FSTFL	 /TEST FOR FIRST CHARACTER IN LINE.  IF SO,
	SPA			/** SKP IF NOT ENCODE
	JMP	PACK3		/** ENCODE - CHK. IF D-D
       SZA		  /   CHANGE IT TO A CARRIAGE CONTROL CHAR-,
       JMP    PACK1	 /   ACTER.
       LAC    .CHAR
       DAC    .FSTFL	 /KILL FIRST-CHARACTER FLAG.
	.IFUND	MSCC	/(RKB-050)
	XCT	.MSDEV	/(RKB-050) SKP IF NOT MASS STORAGE
	JMP	PACK2	/(RKB-050) NOP IF MASS STORAGE, DON'T CONVERT 1ST CHAR
	.ENDC		/(RKB-050)
       SAD    S00061	 /IF A BCD ONE, CHANGE TO 014.
       LAW    -14	         /   (EJECT PAGE)
       SAD    S00053	 /IF A BCD PLUS, CHANGE TO 020.
       LAW    -20	         /   (NO LINE FEED)
       SAD    S00060	 /IF A BCD ZERO, CHANGE TO 021.
       LAW    -21	         /   (DOUBLE SPACE)
	SMA
	LAW	-12		/IF ANYTHING ELSE, MAKE
	TCA		/(RKB-051)  IT 012 (LF)
       DAC    .CHAR
       JMP    PACK2
PACK1  LAC    .HIFLG	  /IF LINE SIZE HAS BEEN EXCEEDED, EXIT
       SZA		  /   IMMEDIATELY.
       JMP*   .PACK
PACK2  JMS    EXCH		/OK TO PACK--EXCHANGE MS+LS AND SMS+SLS.
       JMS    DSH7		/ROTATE MS+LS LEFT 7, REMOVE CURRENT CON-
       LAC    LS	         /   TENTS OF 7 LOW BITS, AND INSERT
       AND    Z77600	 /   CHARACTER.
       XOR    .CHAR
       DAC    LS
       JMS    BUMP		/BUMP CHARACTER COUNT.
       JMS    EXCH		/RESTORE MS+LS AND SMS+SLS.
       JMP*   .PACK		 /EXIT.
PACK3	LAC	.CHAR		/**
	DAC	.FSTFL		/** SET TO INDIC. 1ST CHAR. REACHED
	LAC	CC		/** =0 IF D-D I/O
	SZA			/**
	JMP	PACK2		/** FRMTD.: NO FORMS CONTROL CHR.
	JMP*	.PACK		/** D-D: IGNORE 1ST CHAR.
       .EJECT
/READ CHARACTER FROM LINE BUFFER
/  CALLING SEQUENCE -- JMS	 READ.
/  EXITS WITH ASCII-7 CHARACTER IN CHAR AND AC.
READ.	CAL    0
       LAC    .HIFLG	  /IF LINE SIZE HAS BEEN EXCEEDED, SET CHAR-
       SNA		  /   ACTER TO A BLANK AND EXIT
       JMP    READ1
       LAC    S00040
       DAC    .CHAR
       JMP*   READ.
READ1  JMS    EXCH		/OK TO READ--EXCHANGE MS+LS AND SMS+SLS.
	ISZ	CCPTR		/** INCREM. CURR. CHR. PTR.
       JMS    DSH7		/ROTATE MS+LS LEFT 7, AND EXTRACT OUT THE
       LAC    LS	         /   7 LOW BITS = FETCHED CHARACTER.
       AND    S00177
	DAC	.CHAR		/**
       SAD    S00015	 /IF CHAR=C/R OR ALT MODE, MAKE IT A BLANK
       JMP    READ3	 /   AND SET .HIFLG TO INDICATE END OF LINE.
       SAD    S00175
       JMP    READ3
READ2	JMS	BUMP		/BUMP CHR. CNT.
       JMS    EXCH		/RESTORE MS+LS AND SMS+SLS.
	LAC	.CHAR		/** TEST FOR CR
	SAD	S00015		/** DON'T IGN. CR (FOR D-D I/O)
	JMP	READ4		/**
	.IFDEF	LFTOSP		/(RKB-050) CONVERT LF'S TO SPACES
	LAC	.FSTFL		/IF THIS IS THE FIRST CHARACTER OF THE
	SNA			/LINE, CHECK IF IT IS A LINE FEED.  IF SO,
	LAC	.CHAR		/IT IS ASSUMED TO BE CARRIAGE CONTROL, AND
	DAC	.FSTFL		/IS CHANGED TO A SPACE.  RESET FIRST CHAR
	LAC	.CHAR
	SAD	S00012		/FLAG
	LAC	S00040
	DAC	.CHAR
	.ENDC			/(RKB-050)
       LAW    -40	         /IGNORE ALL OTHER CHARACTERS LESS THAN 40(8)
       TAD    .CHAR		 /   EXCEPT CARRIAGE RETURN.
       SPA
       JMP    READ1
       LAC    .CHAR		 /EXIT WITH FETCHED CHARACTER IN AC.
READ4	JMP*	READ.		/**
READ3	LAC	CC		/** =0 IF D-D
	SNA			/** IF D-D OTPT., WANT CR, A.M.
	JMP	READ2		/**
	LAC	S00040		/BLANK
       DAC    .HIFLG	  /NON-ZERO TO HIFLG.
	DAC	.CHAR		/**
	LAC BCNT		/STORE BCNT AND SET CR-ALT FLAG
	DAC CRAMFL
       JMP    READ2
       .EJECT
/EXCHANGE MS+LS WITH SMS+SLS				  28 USEC.
/  CALLING SEQUENCE -- JMS	 EXCH
EXCH   CAL    0
       LAC    LS	         /LS TO TEMP
       DAC    EXCH1
       LAC    SLS	         /SLS TO LS
       DAC    LS
       LAC    EXCH1	 /TEMP TO SLS
       DAC    SLS
       LAC    MS	         /MS TO TEMP
       DAC    EXCH1
       LAC    SMS	         /SMS TO MS
       DAC    MS
       LAC    EXCH1	 /TEMP TO SMS
       DAC    SMS
       JMP*   EXCH		/EXIT
EXCH1  .DSA   0
       .EJECT
/BUMP CHARACTER COUNT AND WORD PAIR
/  CALLING SEQUENCE -- JMS	 BUMP
BUMP   CAL    0
       ISZ    .SCC		/INCREMENT CHARACTER COUNT.  IF LESS THAN
       JMP*   BUMP		/   5 CHARACTERS HAVE BEEN READ (PACKED),
       LAW    -5	         /   EXIT IMMEDIATELY.  IF NOT, RESET SCC
       DAC    .SCC		/   AND UPDATE 2 WORDS OF LINE BUFFER.
       LAC*   .FH	         /BRANCH PER READ OR WRITE.
	SZA
       JMP    BUMP2
	ISZ    .LBADD	  /READ--LOAD NEXT 2 WORDS OF LINE BUFFER
       LAC*   .LBADD	  /   INTO MS+LS AND INCREMENT L.B. POINTER
       DAC    MS	         /   BY 2.
       ISZ    .LBADD
       LAC*   .LBADD
       DAC    LS
       JMP*   BUMP
BUMP2  JMS    DSHL		/WRITE--LEFT-JUSTIFY MS+LS, STORE MS+LS IN
       ISZ    .LBADD	  /   NEXT TWO WORDS OF LINE BUFFER, AND
       LAC    MS	         /   INCREMENT L.B. POINTER BY 2.
       DAC*   .LBADD
       ISZ    .LBADD
       LAC    LS
       DAC*   .LBADD
       LAC    .LBADD	  /IF L.B. POINTER HAS REACHED ITS HIGH
       SAD    .HILIM	  /   LIMIT, SET HIFLG=NON-ZERO TO SUPPRESS
       DAC    .HIFLG	  /   FURTHER L.B. ACCESS FOR THIS LINE.
       JMP*   BUMP		/EXIT.
       .EJECT
/PACK BLANKS
/  CALLING SEQUENCE -- LAC	 NUMBER OF BLANKS (127 MAX)
/		   JMS   .PBLKS
.PBLKS CAL    0
       AND    S00177	 /COMPLEMENT NUMBER OF BLANKS TO GET LOOP
       SNA		  /   INDEX.  IF ZERO, EXIT.
       JMP*   .PBLKS
	TCA		/(RKB-051)
       DAC    PKBLK2
PKBLK1 LAW    40	         /PACK ONE BLANK.
       JMS    .PACK
       ISZ    PKBLK2
       JMP    PKBLK1	 /LOOP UNTIL ALL BLANKS PACKED.
       JMP*   .PBLKS
       .EJECT
/** OVER FLOW ROUTINE - PACK *'S  (AND D.P., IF POSS.)
/E,D
FOVFL1	LAC	.D
	TAD	C00005
	TCA		/(RKB-051)
	TAD	.W		/.W-(D+5)
	SPA
	JMP	FOVFL2		/CAN'T DO D.P.
	JMS	PKHSH		/PACK .W-(.D+5) ASTERISKS
	LAW	56		/'.'
	JMS	.PACK
	LAC	.D	
	TAD	S00004
	JMP	PFIN		/PACK .D+4 ASTERISKS
FOVFL2	LAC	.W
	JMP	PFIN
/--F
FOVFL3	LAC	.D
	CMA
	TAD	.W		/.W-(.D+1)
	SPA
	JMP	FOVFL4		/CAN'T DO D.P.
	JMS	PKHSH		/PACK .W-(.D+1) ASTERISKS
	LAW	56		/D.P.
	JMS	.PACK
	LAC	.D
	SKP
/CHK. FOR G-CONV.
FOVFL4	LAC	.W
	JMS	PKHSH
	LAC	S2		/CONV. CODE
	TAD	K00006
	SMA!SZA			/SKP IF NOT G
	SKP
	JMP	FE99		/G, SO, DONE
	LAC	S00004		/PACK 4 MORE ASTERISKS
PFIN	JMS	PKHSH
	JMP	FE99
/**
	.EJECT
/**PACK ASTERISKS
/CALLING SEQUENCE--
/	LAC	(NUM. OF ASTERISKS TO BE PKED.
/	JMS	PKHSH
PKHSH	0
	AND	S00177
	SNA
	JMP*	PKHSH		/0 ASTERISKS: RTN. IMMED.
	TCA		/(RKB-051)
	DAC	TEMP6
PKHSH1	LAW	52		/'*'
	JMS	.PACK
	ISZ	TEMP6
	JMP	PKHSH1
	JMP*	PKHSH
/**
	.EJECT
/PACK SIGN
/  CALLING SEQUENCE -- JMS	 PKSGN
PKSGN  CAL    0
       LAC    SIGN		/IF SIGN IS PLUS (SIGN=0) PACK A BLANK.
       SZA!CLA		      /IF SIGN IS MINUS (SIGN.NE.0), PACK HYPHEN.
       LAW    15
       TAD    S00040
       JMS    .PACK
       JMP*   PKSGN
	.END
