/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
	/EDIT 11  10-14-70
       .TITLE BCDIO
/BCD I/O OBJECT-TIME PACKAGE.
/   INTERNAL GLOBALS--
       .GLOBL .FR	         /BCD READ
       .GLOBL .FW	         /BCD WRITE
       .GLOBL .FA	         /BCD ARRAY I/O
       .GLOBL .FE	         /BCD ELEMENT I/O
       .GLOBL .FF	         /BCD I/O CLEANUP
	.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 .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.
/   CONSTANTS AND WORKING STORAGE--
C00003	.DSA	3	/ *** DDS FEB69 ***
C00005	.DSA	5	/ *** DDS FEB69 ***
C00006	.DSA 6
C00017	.DSA 21
C00035	.DSA 43
K00002	.DSA	-2	/ *** DDS FEB69 ***
K00006	.DSA -6
K00010	.DSA	-12	/ *** DDS FEB69 ***
S00007	.DSA 7
S00012	.DSA 12
S00015	.DSA 15
S00017	.DSA 17
S00032	.DSA 32
S00040	.DSA 40
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
S00101 .DSA   101
S00110 .DSA   110
S00111 .DSA   111
S00114 .DSA   114
S00120 .DSA   120
S00124 .DSA   124
S00130 .DSA   130
S00170 .DSA   170
S00175 .DSA   175
S00177 .DSA   177
S02000 .DSA   2000
S17777	.DSA	17777	/ *** DDS FEB69 ***
S77777 .DSA   77777
T00000 .DSA   100000
T77777 .DSA   177777
V00002 .DSA   300002
V77777 .DSA   377777
W00000 .DSA   400000
Z77400 .DSA   777400
Z77600 .DSA   777600
Z77671 .DSA   777671
Z77706 .DSA   777706
DBLONE .DSA   1
       .DSA   200000
       .DSA   0
CCNT   .DSA   0
CNT2   .DSA   0
CNT    .DSA   0
DADD   .DSA   0
DELTA  .DSA   0
HIFLG  .DSA   0
HILIM  .DSA   0
LBADD  .DSA   0
LIMIT  .DSA   0
MS     .DSA   0
LS     .DSA   0
NUMFLG .DSA   0
SCC    .DSA   0
SIGN   .DSA   0
SLOT   .DSA   0
SMS    .DSA   0
SLS    .DSA   0
FSTFLG .DSA   0
CRAMFL	0		/CR-ALTMODE FLAG RDEXT
BCNT=CCNT
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
WD4=CCA
PKBLK2=NUMTS2
CHCT=BCNT
C00001=DBLONE		/ *** DDS FEB69 ***
       .EJECT
/BCD READ
/CALLING SEQUENCE -- JMS     .FR
/		 .DSA    ADDRESS OF SLOT NUMBER.
/		 .DSA    ADDRESS OF FORMAT STATEMENT OR ARRAY.
.FR    CAL    0
       DZM*   .FH	         /SET READ/WRITE FLAG TO READ.
       LAC*   .FR	         /INITIALIZE INPUT DEVICE.
       JMS*   .FC
       DAC    SLOT	         /SAVE SLOT NUMBER.
       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
       .EJECT
/BCD WRITE
/  CALLING SEQUENCE -- JMS   .FW
/		   .DSA  ADDRESS OF SLOT NUMBER.
/		   .DSA  ADDRESS OF FORMAT STATEMENT OR ARRAY
.FW    CAL    0
       LAC    C00001         /SET READ/WRITE FLAG TO WRITE.
       DAC*   .FH
       LAC*   .FW	         /INITIALIZE OUTPUT DEVICE.
       JMS*   .FC
       DAC    SLOT	         /SAVE SLOT NUMBER.
       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
       .EJECT
/BCD ARRAY I/O
/  CALLING SEQUENCE -- JMS*  .FA
/		   .DSA  ADDRESS OF DIMENSION INFORMATION
.FA    CAL    0
       LAC*   .FA
       DAC    WD4	         /ADDR OF WORD 4 OF DIM. INFO. (ARRAY ADDR).
	SPA		/1 MORE LEVEL?
	LAC* WD4	/YES
	DAC WD4	/RESTORE
       TAD    K00003
       DAC    WD1	         /ADDR OF WORD 1 OF DIM. INFO. (N,SIZE).
       LAC*   WD1	         /GET ADDRESS INCREMENT--DELTA=NO. OF WORDS
       RTL	         /   PER DATA ITEM.
	RTL
       RTL
       TAD    C00001
       AND    C00003
       SNA
       LAC    C00001
       DAC    DELTA
       LAC*   WD4	         /GET FIRST ADDRESS OF ARRAY AND INITIALIZE
       DAC    FA2	         /   BCD ELEMENT I/O CALL.
       LAC*   WD1	         /ADD ARRAY SIZE TO GET HIGH ADDRESS LIMIT.
	AND	S17777	/ *** DDS FEB69 ***
       TAD    FA2
       DAC    LIMIT
FA1    JMS    .FE	         /CALL BCD ELEMENT 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
       .EJECT
/BCD ELEMENT I/O CONTROL
/  CALLING SEQUENCE -- .GLOBL  .FE
/		   JMS*	 .FE
/		   CAL	 ELEMENT ADDRESS (T.V. IF BIT 0 = 1)
.FE    CAL    0
       LAC*   .FE	         /GET STARTING ADDRESS OF DATA ELEMENT.
       DAC    DADD
       SPA	         /IF T.V., ONE MORE LEVEL OF INDIRECT
       LAC*   DADD	         /   ADDRESSING.
       DAC    DADD
       JMS    .FD	         /GET FORMAT SPECIFICATION
       LAC    S	         /CONVERSION CODE TIMES TWO (PLUS ONE FOR
       RCL	         /   WRITE)=INDEX VALUE FOR JUMP TABLE.
       TAD*   .FH
       AND    S00017
       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
       JMP    FE60	         /A-READ
       JMP    FE8	         /A-WRITE
       JMP    FD86	         /O-READ
       JMP    FD86	         /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
FE99   ISZ    .FE
       JMP*   .FE
       .EJECT
/I-CONVERSION -- WRITE PROCESSOR.
FE2    JMS    GETPS          /GET INTEGER POWER OF TEN (POT), SIGN, AND
       LAC    POT	         /   INITIALIZE THE GETDD ROUTINE.  IF THE
       SZA	        /    NUMBER TO BE PRINTED IS ZERO (POT=0),
       JMP    FE3
       DZM*   .AB
       ISZ    POT	         /   SET POT = 1 SO THAT A SINGLE ZERO WILL
       LAC    POT	         /   BE PRINTED.  NOW POT = NO. OF INTEGER
FE3    SAD    W	         /   DIGITS TO BE PRINTED.  IF POT=FIELD
       JMP    FE5	         /   WIDTH(W), DO NOT PACK ANY LEADING
       CMA	         /   BLANKS OR SIGN. IF POT.GT.W, TRUNCATE
       TAD    W	         /   (POT-W) MOST SIGNIFICANT DIGITS.  IF
       SMA	         /   POT.LT.W, PACK (W-POT-1) LEADING
       JMP    FE4	         /   BLANKS AND THE SIGN.
       JMS    GETDD
	CLC
       TAD    POT
       DAC    POT
       JMP    FE3
FE4    JMS    PKBLKS         /PACK LEADING BLANKS.
       JMS    PKSGN 	   /PACK SIGN.
FE5    CLC	         /PACK (POT) DECIMAL DIGITS.
       TAD    POT
	CMA
       DAC    POT
FE6    JMS    GETDD
       JMS    PACK
       ISZ    POT
       JMP    FE6
       JMP    FE99	         /EXIT
       .EJECT
/L-CONVERSION -- WRITE PROCESSOR
FE7	CLC
       TAD    W
	SPA
       JMP    FE99	         /EXIT IF FIELD WIDTH ZERO OR NEGATIVE.
       JMS    PKBLKS         /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
/A-CONVERSION -- WRITE PROCESSOR
FE8    LAC*   DADD	         /FIRST DATA WORD TO MS
       DAC    MS
       ISZ    DADD
       LAC*   DADD	         /SECOND DATA WORD TO LS
       DAC    LS
       LAC    W	         /IF W=0, EXIT
	SNA!SPA
       JMP    FE99
       JMS    CMP	         /TWOS COMPLEMENT W FOR A CHARACTER COUNT.
       DAC    POT
       LAW    -5
       TAD    W
	SPA!SNA
       JMP    FE9
       JMS    PKBLKS         /PACK (W-5) BLANKS IF W.GT.5
K00005 LAW    -5
       DAC    POT
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
       .EJECT
/D- AND E-CONVERSION -- WRITE PROCESSOR.
FE11   LAC    W	         /IF W.LT.7, DEFAULT.
       TAD    K00006
	SPA!SNA
       JMP    FE21
       LAC    D	         /IF (W-D).LT.7, DEFAULT.
	CMA
       TAD    K00006
       TAD    W
	SPA
       JMP    FE22
       JMS    PKBLKS         /IF (W-D).GE.7, PACK (W-D-7) BLANKS
FE12   JMS    GETPS
FE125  JMS    PKSGN
       LAC    D	         /SET CNT TO TWOS COMPLEMENT OF THE NUMBER
       TAD    C00001         /   OF DECIMAL CHARACTERS IN THE MANTISSA
       CMA	         /   FIELD (INCLUDING DECIMAL POINT), VIZ.,
       DAC    CNT	         /   -D-2.
       TAD    SF	         /CHECK SCALE FACTOR VS. CNT TO SEE IF TOO
       TAD    C00001         /   MANY INTEGER DIGITS HAVE BEEN SPECI-
       JMS    CMP	         /   FIED.	IF SO,  TRUNCATE THE NECESSARY
       DAC    DIG1	         /   DIGITS.
	SMA
       JMP    FE14
FE13   JMS    GETDD
       ISZ    DIG1
       JMP    FE13
FE14   LAC    D	         /CALCULATE FRACTION FLAG  = -D -1
       CMA
       DAC    FRFLG
       LAC    D	         /CALCULATE SIGNIFICANT DIGIT FLAG = D+SF
       TAD    SF
       DAC    SDFLG
       LAC    SF	         /IF SF.GT.0, MODIFY FLAGS --
       SPA!SNA	         /    FRFLG=SF-D-2 (-1 MAXIMUM)
       JMP    FE15	         /   SDFLG=+SF+D+1
	CLC
       TAD    SF
       TAD    FRFLG
       SMA
       LAW    -1
       DAC    FRFLG
       LAC    C00001
       TAD    SDFLG
       DAC    SDFLG
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 ***
	JMS	CMP	/ *** DDS JAN69 ***
	TAD	POT	/ *** DDS JAN69 ***
       DAC    DIG2
       SMA	         /IF EXPONENT IS NEGATIVE, COMPLEMENT IT
       JMP    FE19	         /   AND SET EXPONENT SIGN TO MINUS.
       JMS    CMP
       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   LAW    100	         /PACK E OR D CHARACTER.
       TAD    S
       JMS    PACK
       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.
FE21   LAC    W	         /FIELD WIDTH TOO SMALL -- PACK (W) BLANKS
       JMS    PKBLKS         /   AND EXIT.
       JMP    FE99
FE22   TAD    D	         /D IS GREATER THAN (W-7) -- SET D=(W-7)
       DAC    D	         /   AND CONTINUE.
       JMP    FE12
       .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)
	JMS CMP		/NEGATE FOR USE AS A LOOP COUNTER (DIG2)
	DAC DIG2
	TAD W		/IF LENGTH OF NUMERIC FIELD EXCEEDS THE
	DAC DIG1		/SPECIFIED FIELD WIDTH, DEFAULT. IF
	SMA		/NOT, RIGHT-JUSTIFY IN FIELD WITH LEAD-
	JMP FE26		/ING BLANKS AND SIGN.
	LAC W		/DEFAULT--FORCE NUMERIC FIELD WIDTH (-DIG2)
	JMS CMP		/TO SPECIFIED FIELD WIDTH (W). THEN
	DAC DIG2		/DETERMINE WHICH DEFAULT CONDITION MOST
	LAC POT		/BE EMPLOYED
	SPA!SNA
	JMP FE25
FE24	JMS GETDD		/DEFAULT FOR DATA.GE.(1.0)--TRUNCATE MOST
	ISZ DIG1		/SIGNIFICANT DIGITS UNTIL NUMBER FITS
	JMP FE24		/INTO SPECIFIED FIELD WIDTH(W DIGITS).
	JMP FE27
FE25	TAD C00001	/DEFAULT FOR DATA.LT.(1.0)--ALTER POT SO
	DAC POT		/ZERO NOT PRINTED BEFORE DECIMAL POINT
	JMP FE27
FE26	SNA		/NORMAL PATH (NO DEFAULT)--OUTPUT NECES-
	JMP FE27		/SARY LEADING BLANKS AND SIGN REQUIRED
	TAD K00001	/TO RIGHT-JUSTIFY NUMERIC OUTPUT.
	SZA
	JMS PKBLKS
	JMS PKSGN
FE27	LAC D		/SET A FLAG (DPOS) TO INDICATE 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 ***
       JMS    CMP	         /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
K00004 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    PKBLKS         /   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.
       DZM*   .AA	         /CLEAR FLOATING ACCUMULATOR
       DZM*   .AB
       DZM*   .AC
       LAW    -4	         /TEST CONVERSION-TYPE FOR ENTRY POINT
       TAD    S
	SPA
       JMP    GET04          /I-CONVERSION.
	SNA
       JMP    GET03          /D-CONVERSION.
       TAD    K00002
	SZA
       JMP    GET01          /E- OR G-CONVERSION
/F-CONVERSION ENTRY.
       DZM    NRZ	         /ZERO TO ROUNDING FLAG.
       JMP    GET02
/E- AND G-CONVERSION ENTRY.
GET01  LAC    C00001         /PLUS-ONE TO ROUNDING FLAG.
       DAC    NRZ
GET02  JMS*   .AG	         /REAL LOAD DATA INTO FLOATING ACCUMULATOR.
       .DSA   DADD+400000
       JMP    GET06
/D-CONVERSION ENTRY.
GET03  LAC    C00001         /PLUS-ONE TO ROUNDING FLAG.
       DAC    NRZ
       JMS    FAO	         /DBL LOAD DATA INTO FLOATING ACCUMULATOR.
       .DSA   DADD+400000
       JMP    GET06
/I-CONVERSION ENTRY.
GET04  CLC	         /MINUS-ONE TO ROUNDING FLAG
       DAC    NRZ
       LAC*   DADD	         /GET ACTUAL DATA WORD FOR FIXED-TO-FLOAT
       SNA	         /   CONVERSION
       JMP    GET06          /IF DATA=0, FAC OK AS-IS.
	SMA
       JMP    GET05
       ISZ    SIGN	         /IF DATA NEGATIVE, SET SIGN TO MINUS AND
       JMS    CMP	         /   COMPLEMENT DATA.
GET05  DAC*   .AB	         /STORE DATA IN FAC MANTISSA.
       LAC    W00000         /SET ROUND-OFF BIT.
       DAC*   .AC
       LAC    C00017         /SET FAC EXPONENT TO +17.
       DAC*   .AA
       JMS*   .CD	         /NORMALIZE FAC--DATA IS NOW FLOATING POINT.
/COMMON ROUTINE
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    MPYTEN
       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
GET11	CLC
       TAD    POT
       DAC    POT
       JMS    MPYTEN
       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
GET13  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 ***
	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	MPYTEN	/ *** 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
       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 ***
GET34	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
	.DSA	0	/ *** DDS JAN69 ***
       .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    MPYTEN         /MULTIPLY FAC BY 10 TO EXTRACT THE NEXT
       DZM    DIG	         /   DECIMAL DIGIT.
       LAC*   .AA
	SPA!SNA
       JMP    GET22          /IF FAC EXPONENT.LE.ZERO, DIGIT IS A ZERO.
       JMS    CMP	         /   IF FAC EXPONENT.GT.ZERO, 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
       DZM*   .AA
       LAW    60	         /EXIT IS TAKEN WITH THE ASCII-7 CODE OF
       XOR    DIG	         /   THE DECIMAL DIGIT IN THE AC.
       JMP*   GETDD
GET23  LAC*   .AB	         /MS/LS=FAC-1.0
       AND    T77777
       DAC    MS
       LAC*   .AC
       DAC    LS
       JMS    DSHL
       JMP    GET22
       .EJECT
/I-CONVERSION -- READ PROCESSOR.
FE50	JMS RDEXT		/READ CONTENTS OF EXTERNAL FIELD. IF
	LAC SFFLG		/SFFLG AND DPOS ARE NOT BOTH ZERO,
	TAD DPOS		/AN ILLEGAL CHARACTER IS IN THE INPUT
	SZA		/FIELD AND ZERO IS STORED IN MEMORY.
	DZM LS
	LAC SIGN		/IF NUMBER IS NEGATIVE (SIGN=1), TWOS-
	RAR		/COMPLEMENT BEFORE STORING.
	LAC LS
	SZL
	JMS CMP
	DAC* DADD		/STORE INTEGER IN MEMORY.
	JMP FE99		/EXIT.
       .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
FE515  LAC    C00035         /CONVERT RAW INTEGER MANTISSA TO FLOATING
       DAC*   .AA	         /   POINT.
       JMS*   .CD
       LAC    FRFLG          /CALCULATE MULTIPLIER POWER OF TEN = DECI-
       JMS    CMP	         /   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.
       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.
       LAC    POT
	SKP
FE52   JMS    CMP
       DAC    CNT
FE53   JMS    MPYTEN
       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.
       JMS*   .CI
       .DSA   -44
	.DSA	1	/ *** WAD SEPT69 ***
FE54   LAC    SIGN	         /SET ,CE = SIGN OF CONVERTED NUMBER.
       SZA	         /   BIT 0 = 0   PLUS
       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 ***
       LAW    -4	         /TEST CONVERSION TYPE.
       TAD    S
	SNA
       JMP    FE545          /D-CONVERSION
       JMS*   .AH	         /E-, F-, OR G-CONVERSION -- STORE REAL
       .DSA   DADD+400000
       JMP    FE99
FE545  JMS    FAP	         /STORE DOUBLE.
       .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
/A-CONVERSION -- READ PROCESSOR
FE60   LAC JMP0	         /INITIALIZE JUMP INSTRUCTION AND CHARACTER
       DAC    FE65	         /   COUNTER.
       DZM    CHCT
       LAC    W	         /IF FIELD WIDTH.LE.0, EXIT IMMEDIATELY.
	SPA!SNA
       JMP    FE99
       JMS    CMP
       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    FE66
       DAC    CNT
       ISZ    FE65
       LAC    S00040
       DAC    CHAR
       JMP    FE64
FE66   JMS    DSHL	         /LEFT JUSTIFY TO 5/7 ASCII FORMAT.
       LAC    MS	         /STORE BOD WORD PAIR IN OBJECT MEMORY.
       DAC*   DADD
       ISZ    DADD
       LAC    LS
       DAC*   DADD
       JMP    FE99	         /EXIT
JMP0   JMP    FE63
       .EJECT
/READ EXTERNAL FIELD
/  CALLING SEQUENCE -- JMS   RDEXT
RDEXT  CAL    0	         /THIS SUBROUTINE INPUTS AN EXTERNAL LINE
       DZM    SIGN	         /   BUFFER FIELD OF LENGTH 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    NUMTST         /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.
RDEX2  JMS    BREAD
       JMS    NUMTST         /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    NUMTST         /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    NUMTST         /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
	JMS CMP
	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
	NOP		/FALL THROUGH
	JMP RDEX2	/DON'T STORE TRAILING 0'S ANYWAY
/SINCE CR OR ALT HIT
RDEX17	LAC	SFFLG
	SZA
	JMP	RDEX18
	LAC	MS
	TAD	LS
	JMP	RDEX19
RDEX18	LAC*	.AB
	TAD*	.AC
RDEX19	SNA
	DAC SIGN
	JMP* RDEXT		/EXIT
       .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
       LAC    MS
       AND    V77777
       DAC*   .AB
       LAC    LS
       DAC*   .AC
       JMP*   TRMSLS
       .EJECT
/MULTIPLY FLOATING ACCUMULATOR BY TEN.		   74 OR 89 USEC.
/  CALLING SEQUENCE -- JMS   MPYTEN		   (77.0 USEC AVG)
MPYTEN 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*   MPYTEN
       .EJECT
/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
       JMS    DSHL	         /MULTIPLY MS+LS BY 8.
       JMS    DSHL
IMP1   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)
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
       .EJECT
/DOUBLE STORE
/  CALLING SEQUENCE -- JMS   FAP
/		   .DSA  ADDRESS (+400000 IF TRANSFER VECTOR)
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
       .EJECT
/DOUBLE FLOATING ADD
/  CALLING SEQUENCE -- JMS   FAQ  (AUGEND IN FAC)
/		   .DSA  ADDEND ADDRESS
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
       .EJECT
/INITIALIZE FORMAT DECODER
/  CALLING SEQUENCE -- LAC   STARTING ADDRESS OF FORMAT STATEMENT.
/		   JMS   INIFD
INIFD  CAL    0
       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
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
/  (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
FD04   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    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
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*   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    EOR	         /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    EOR	         /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
       JMS    CMP	         /   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.
/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
       JMS    CMP
       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    READ	         /TRANSFER FORMAT STATEMENT WORD PAIR INTO
       LAC*   CC	         /   MS/LS FOR SHIFTING.
       DAC    MS
       LAC*   CC2
       DAC    LS
       LAW    -5	         /INITIALIZE LOOP COUNTERS CNT AND CNT2
       TAD    CCA	         /   CCA=CHARACTER POSITION IN WORD PAIR.
       DAC    CNT2
       LAC    CCA
	CMA
       DAC    CNT
FD34   JMS    DSH7	         /LOOP ONE -- ROTATE MS/LS LEFT UNTIL THE
       ISZ    CNT	         /   CURRENT CHARACTER IS RIGHT-JUSTIFIED
       JMP    FD34	         /   IN LS.
       LAC    LS	         /GET RID OF OLD CHARACTER AND MERGE IN
       AND    Z77600         /   THE NEW ONE.
       XOR    CHAR
       DAC    LS
	SKP
FD35   JMS    DSH7	         /CONTINUE ROTATING MS/LS UNTIL A COMPLETE
       ISZ    CNT2	         /   36 BIT CIRCULAR SHIFT HAS BEEN DONE.
       JMP    FD35
       JMS    DSHL
       LAC    MS	         /TRANSFER MS AND LS BACK INTO THE FORMAT
       DAC*   CC	         /   STATEMENT.
       LAC    LS
       DAC*   CC2
       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
       JMS    CMP
       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    PKBLKS
       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
/D- E- F- AND G-CONVERSIONS  /FOUR(D), FIVE(E), SIX(F), OR SEVEN(G)
FD42   LAC    CHAR	         /   TO AC(15-17).
FD43   AND    S00007         /GET RID OF AC BITS 0-14.
       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
/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    NUMTST         /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    NUMTST         /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   NUMTST
/		   JMP   NO  (TESTED CHARACTER IN AC)
/		   JMP   YES (BINARY VALUE OF CHARACTER IN AC)
NUMTST 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    NUMTST         /BUMP RETURN ADDRESS AND EXIT WITH BINARY
       JMP*   NUMTST         /   VALUE OF CHARACTER IN AC.
NUMTS1 LAC    NUMTS2         /EXIT WITH ORIGINAL CHARACTER IN AC.
       JMP*   NUMTST
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
GETCC2 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*   CC	         /4 BITS IN WD1 + 3 BITS IN WD2.
	RAL;	RTL
       AND    S00170
       DAC    CHAR
       LAC*   CC2
	RTL;	RTL
       AND    S00007
       XOR    CHAR
       JMP    GETCC7
GETCC5 LAC*   CC	         /SHIFT WD1 4 RIGHT.
	RTR;	RTR
       JMP    GETCC7
GETCC6 LAC*   CC	         /REVOLVE WD1 8 LEFT.
	RTL;	RTL;	RTL;	RTL
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
       TAD    C00001
       DAC    CC2	         /CC2= CC+1
	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
       LAW    -1	         /SET NO-CONVERSION FLAG TO STOP AT END OF
       DAC    NCF	         /   FORMAT STATEMENT.
       JMS    .FD	         /CLEANUP ALL H AND X CONVERSIONS.
       LAC*   .FH	         /IF A WRITE, OUTPUT LAST LINE.
	SZA
       JMS    EOR
       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    .FN	         /RESET LINE BUFFER POINTER (LBADD) TO
       DAC    LBADD          /   BEGINNING OF LINE BUFFER.
       DZM    HIFLG          /RESET FLAG TO 0 (POINTER OK).
       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.
       DZM    FSTFLG         /SET FIRST CHARACTER FLAG.
INILB2 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    S00017
       SAD    C00002
       JMP    EOR3	         /IF MODE OK, CONTINUE.
       JMS*   .ER	         /IF MODE NOT IOPS-ALPHA, TAKE ERROR EXIT.
       .DSA   11
EOR1   LAC    HIFLG          /IF LINE BUFFER IS NOT FULL, FILL CURRENT
       SZA	         /   WORD PAIR WITH BLANKS.
       JMP    EOR2
       LAC    SCC
       JMS    CMP
       JMS    PKBLKS
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
       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
       LAC    FSTFLG         /TEST FOR FIRST CHARACTER IN LINE.  IF SO,
       SZA	         /   CHANGE IT TO A CARRIAGE CONTROL CHAR-,
       JMP    PACK1          /   ACTER.
       LAC    CHAR
       DAC    FSTFLG         /KILL FIRST-CHARACTER FLAG.
       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
	JMS	CMP		/012
       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.
       .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.
       JMS    DSH7	         /ROTATE MS+LS LEFT 7, AND EXTRACT OUT THE
       LAC    LS	         /   7 LOW BITS = FETCHED CHARACTER.
       AND    S00177
       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  DAC    CHAR
       JMS    BUMP	         /BUMP CHARACTER COUNT.
       JMS    E
2c@
