.TITLE DDIO
/
/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
/COPYRIGHT 1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/DEFINE %FPP FOR FLOATING PT. HARDWARE
/DEFINE RSX FOR RSX SYSTEM.
/
/EDIT #017  15 JAN 74  TAM(15)*REF(10)*:WAD(11):*REF*
/
/EDIT #018  25-JUL-75	R. K. BLACKETT  CHANGE THE BCDIO ENTRY POINT '.READ'
/			  TO 'READ.' SO THERE IS NO CONFLICT WITH THE SYSTEM
/			  MACRO OF THE SAME NAME.
/
/ EDIT #019	20-AUG-75	M. HEBENSTREIT  DISCLAIMER
/
/ EDIT #020  12-DEC-75	R. K. BLACKETT  FIX BUG IN ELEMENT INPUT WHICH
/			  WAS MASKING DATA ADDRESS TO 32K, THUS
/			  PRVENTING DD INPUT TO XVM EXTENDED MEMORY.
/
/
/OBJECT TIME SYSTEM DATA-DIRECTED I/O ROUTINES
/--D-D OUTPUT
/    ELEMENT OUTPUT (.GA) PRINTS NAME AND SETS UP
/      CALL TO .FE WITH A PSEUDO-FORMAT FIXED
/      ACCORDING TO MODE
/    S.S. VAR. OUTPUT (.GC) SETS UP PRINTING OF S.S.
/      AFTER NAME AND GOES TO .GA
/    ARRAY OUTPUT (.GB) SETS UP S.S. AND CALLS
/      .SS AND .GC IN A LOOP
/    FIXED FORMATS:
/      LOGICAL 	L1
/      INTEGER	I7
/      REAL	G16.8
/      D.P. REAL D20.11
/      D.P. INTEGER I12
/--D-D INPUT
/
/ROY FOLK
/FPP DIRECT ASSIGN.
	.IFDEF %FPP
FNG=713272		/MAKE FPPAC NEG.
ELD=713100		/EXTENDED INTEGER LOAD
DLD=713150		/DOUBLE LOAD
FAB=713271		/MAKE FPPAC POS.
FNM=713250		/NORMALIZE FPPAC
DRD=712540		/DOUBLE REV. DIV.
DST=713750		/DOUBLE STORE
ELD=713100		/EXTENDDD LOAD
	.ENDC
/
/--INTERNAL GLOBALS--
	.GLOBL	.GA		/D-D ELEMENT OUTPUT
	.GLOBL	.GB		/D-D ARRAY OUTPUT
	.GLOBL	.GC		/D-D SUBSCR. VAR. OUTPUT
	.GLOBL	.GD
	.GLOBL	.GE
	.GLOBL	DDIO
DDIO=.
/--EXTERNAL GLOBALS
	.IFDEF	RSX
	.GLOBL .SLOT	/FIOPS DAT SLOT-FOR LUN.
	.ENDC
	.GLOBL	.ER		/ERROR ROUTINE (OTSER)
	.GLOBL	.SS		/CALC ELEMENT ADDR. (.SS)
	.GLOBL	.FE		/BCD ELEM. I/O (BCDIO)
	.GLOBL	.D		/FRACTION FIELD WIDTH (BCDIO)
	.GLOBL	.W		/FIELD WIDTH (BCDIO)
	.GLOBL	.S		/CONVERSION TYPE (BCDIO)
	.GLOBL	.SF		/SCALE FACTOR (BCDIO)
	.GLOBL	.CHAR		/(BCDIO)
	.IFUND %FPP
	.GLOBL	.FAO		/(BCDIO)
	.GLOBL .FAP		/(BCDIO)
	.ENDC
	.GLOBL	.STEOR		/(FIOPF)
	.GLOBL	READ.	/(RKB-018) (BCDIO)
	.GLOBL .MPYTN	/(BCDIO)
	.GLOBL	.NMTST		/(BCDIO)
	.GLOBL .AX
	.IFUND %FPP
	.GLOBL	.AA		/(REAL)
	.GLOBL .CI		/(REAL)
	.GLOBL	.AB		/(REAL)
	.GLOBL	.AC		/(REAL)
	.GLOBL	.CD		/(REAL)
	.GLOBL	.CE		/(REAL)
	.GLOBL .CF		/(REAL)
	.GLOBL	.CH		/(REAL)
	.GLOBL .JA,.JX,.JH	/COMPL.,FIX,STORE--EXTENDED INT.(DBLINT)
	.ENDC
	.GLOBL	.FA		/FOR ARRAY INPUT (BCDIO)
	.GLOBL	.FA3		/FILL W/ .DSA .GD FOR D-D ARRAY IN. (BCDIO)
	.GLOBL	.FA4		/JMP INTO .FA FROM .GE (BCDIO)
	.IFUND	RSX
	.GLOBL	.FC6		/LINE BUFF. SIZE (FIOPS)
	.ENDC
/
	.GLOBL	.PACK		/PACK CHAR. INTO L.B. (BCDIO)
	.IFUND %FPP
	.DEFIN EST%,A	/EXTENDED INTEGER STORE (.JH)
	JMS* A
	.ENDM
	.ENDC
	.IFDEF %FPP
EST=713700
	.DEFIN EST%
	EST
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN URFXA%,A	/EXTENDED INTEGER FIX (.JX)
	JMS* A
	.ENDM
	.ENDC
	.IFDEF %FPP
URFXA=714670
	.DEFIN URFXA%
	URFXA
	0
	.ENDM
	.ENDC
/TEMP FPP REGISTERS
	.IFDEF %FPP
FP0	0	/EXPONENT-THESE REGISTERS MUST BE IN THIS ORDER
FP1	0	/HO MANT.
FP2	0	/LO MANT.
	.ENDC
/--CONSTANTS
S00777	777
S17777	17777
S00002	2
S00003	3
S00040	40
S00054	54
S00043	43
	.IFUND	RSX
S00042	42
	.ENDC
S00044	44
S00047	47
S00124	124
S00106	106
S00105	105
S00104	104
S00053	53
S00056	56
S00010	10
Y00000	600000
T15020	115020
Y62760	662760
V77777	377777
Z77400	777400
Z77000	777000
Z77377	777377
S00175	175	
S00015	15
K00006	-6
S00001	1
S00055	55
K00026	-32
K00003	-3
W00000	400000
T77777	177777
V00000	300000
S00017	17
S00037	37
S00007	7
K00010	-12
S00072	72
T00000	100000
/(RKB-020)
/(RKB-020) FOLLOWING LINE DELETED:
/S77777	77777
DPONE	1
U00000	200000
	000000
Z40000=ADNOP
/
ADCHR1	.DSA	CHR1
ADCHR3	.DSA	CHR3
ADCHR6	.DSA	CHR6
QTCH	047			/'
EQCH	075			/=
FDTAB	.DSA	FDPRMS		/FORMAT DECODER PARAM. TABLE ADDR.
LPCH	050			/(
RPCH	051			/)
CMACH	054			/,
ADLD1	LAC	ADDM1
ADLD2	LAC	ADDM2
ADLD3	LAC	ADDM3
ADNOP	NOP
/--WORKING STORAGE
NMADR	0			/ADDR. OF RADIX50 WORD
CHRCNT	0			/CHAR. CNT.
STCHR	0			/CUR. CHAR. ADDR.
QUO	0			/QUOTIENT
CHR1	0			/THESE 6 REGS. MUST STAY IN ORDER
CHR2	0			    / "
CHR3	0			    / "
CHR4	0			    / "
CHR5	0			    / "
CHR6	0			    / "
SSVAR	0			/SUBSCRIPTED VAR. SW.
TEMP4	0
DIM1	0			/DIMENSION 1
DIM2	0			/DIMENSION 2
DIM3	0			/DIMENSION 3
ADDM1	0			/ADDR. OF FIRST DIM. OF S.S.
ADDM2	0			/ADDR. OF SECOND DIM. OF S.S.
ADDM3	0			/ADDR. OF THIRD DIM. OF S.S.
WPEL=NMADR			/WORDS PER ELEMENT
BINSS=CHRCNT			/BIN. S.S.
SSCNT=SSVAR			/SUBSCRIPT COUNT
DIMCNT=CHRCNT			/DIMEN. CNT.:  O=1D; -1=2D; -2=3D
DBLAD=STCHR			/DESCRIP. BLOCK ADDR.
ASZ=QUO				/ARRAY SIZE
DBWD2=CHR1			/DESCR. BLK. WD. 2
MDBWD3=CHR2			/MINUS DESCR. BLK. WD 3
STRCON	0			/STRING CONST. SW.: =-1, NO DELIM.; =42,44,
/				/1ST D.; =0, SEC. D.
SIGN1	0			/FIRST SIGN SW.:  =-1, -; =1, +; =0, NONE
SIGN2	0			/SEC. SIGN SW.: =-1, -; =1, +; =0, NONE
EXPSW	0			/EXPON. SW.: =0, E OR D NOT HIT; =1, HIT
LOGSW	0			/LOGICAL SW.: =1, NOT LOG.; =0, F; =-1,T
OCTSW	0			/OCTAL SW.: =0, NOT OCT.; =43, OCTAL
CHRIDX	0			/CHAR.INDEX: =0, NO NON-TERM CHRS.; =1, FIRST
/				/CHR.; .GT. 1, LATER CHAR.
DPISW	0			/D.P. INT. SW.: =-1, S.P.; =0, D.P.
NUM1	0			/FIRST NUM.: =0, NO; NOT = 0, YES
DPTSW	0			/DEC. PT. SW.: =-1, NOT HIT; =0, HIT
RNDSW	0			/ROUNDING SW.: =1,NO; =0, YES
GMS	0		/MOST SIGN HALF--THESE TWO REG.CONTIGUOUS
GLS	0			/LEAST SIGNIF. MANTISSA
GLS2	0
GLS3	0
GMS2	0
GMS3	0
DADR	0			/DATA ADDRESS
VTYPE	0			/VARIABLE TYPE: =0, I/L; =1, R; =2, D; =3, J
SCCNT	0			/STR. CONS. COUNT
BINEX	0			/BIN. EXPONENT
DPCNT	0			/DEC. PT. CNT.
NWRCD	0			/HOLDS ADDR. OF END OF RCD. RTN.
	.TITLE	.GC,.GA  - -  S.S. VARIABLE AND ELEMENT OUTPUT
/DATA DIRECTED OUTPUT - SUBSCRIPTED VARIABLE (.GC) AND ELEMENT (.GA)
/  (.GC SETS A SWITCH AND JMPS INTO .GA)
/CALLING SEQUENCE--
/	1'S COMPLEMENT OF MODE IN AC
/	JMS*	.GC(.GA)	/SUBSCRIPTED VARIABLE (ELEMENT)
/	NAME1			/FIRST 3 CHARS. OF NAME IN RADIX50
/	NAME2			/SECOND 3 CHARS. OF NAME IN RADIX50
/					 /(BIT #0=1 IF LOGICAL)
/	.DSA	ELEMENT ADDRESS
/	1'S COMPLEMENT OF MODE RETURNED IN AC
.GC	0
	DAC	ACSAVE
	ISZ	SSVAR		/SUBSCRIPTED VAR. SW.
	LAC	.GC
	DAC	.GA
	JMP	GA1		/JMP INTO .GA
/
/
.GA	0
	DAC	ACSAVE
	DZM	SSVAR		/CLR. S.S. VAR. SW.
GA1	LAC	QTCH		/SINGLE QUOTE CHAR (054)
	JMS*	.PACK		/PACK DUMMY CHAR. - CLOBBERED BY FORMS CONTROL
	LAC	QTCH
	JMS*	.PACK		/PRINT ' (SINGLE QUOTE)
	LAC	.GA		/ADDR. OF NAME1
/CONVERT RADIX50 CHARS. TO ASCII AND PACK INTO LINE BUFFER
	JMS	R50AS		/RADIX50 TO ASCII
	LAC	ADCHR1
	DAC	STCHR		/ADDR. OF FIRST CHAR.
GA2	LAC*	STCHR
	SNA
	JMP	GA3		/IF CHAR.=0, NO MORE CHARS. IN NAME
	JMS*	.PACK		/PACK CHAR.
	LAC	STCHR
	SAD	ADCHR6		/IF LAST CHAR. (SIXTH),
	JMP	GA3		    /NO MORE
	ISZ	STCHR		/CHANGE PTR
	JMP	GA2		/GET NXT. CHAR.
/
GA3	LAC	SSVAR
	SZA			/SKP IF NOT S.S. VAR.
	JMS	PRSS		/PRINT SUBSCRIPT
	LAC	QTCH
	JMS*	.PACK		/PRINT RIGHT HAND QUOTE
	LAC	EQCH		/=
	JMS*	.PACK		/PRINT EQUAL SIGN
/GET MODE AND SET FORMAT DECODER PARAMETERS
/  IN BCDIO
	LAC*	NMADR		/AC=NAME2 - SET IN R50AS
	AND	W00000		/400000(8) - GET LOGICAL MODE BIT
	CLL!RTL
	RTL
	DAC	TEMP4		/NOW, LOGICAL BIT IS BIT #15
	LAC	ACSAVE
	CMA			/NOW, MODE BITS IN BITS #16,17
	XOR	TEMP4		/MODE BITS, INCLUDING LOGICAL, IN BITS #15,16,17
	TAD	FDTAB		/ADD ADDR. OF F.D. PARAM. TABLE
	DAC	TEMP4		/HOLDS ADDR. OF PROPER PARAMS
/--GET APPROPRIATE F.D. PARAMS. AND LOAD INTO PROPER LOCATIONS
/    IN BCDIO
	LAC*	TEMP4
	AND	S00017		/THESE BITS ARE FRACTION FIELD WIDTH
	DAC*	.D		/IN BCDIO
	LAC*	TEMP4
	RTR
	RTR
	AND	S00037		/EXTERNAL FIELD WIDTH
	DAC*	.W		/IN BCDIO
	LAC*	TEMP4
	RTL
	RTL
	AND	S00007		/CONVERSION TYPE
	DAC*	.S		/IN BCDIO
	DZM*	.SF		/SCALE FACTOR ALWAYS=0
/GO TO .FE FOR ACTUAL I/O
	ISZ	NMADR		/POINT TO ELEMENT ADDRESS
	LAC*	NMADR		/ELEMENT ADDR.
	DAC	FEARG
ACSAVE	LAW			/LAW 1'S COMPLEMENT OF MODE PUT HERE
	JMS*	.FE		/IN BCDIO
FEARG	XX
	ISZ	NMADR		/INCR. FOR RTN.
	LAC*	.STEOR		/GET PROPER END OF RCD. RTINE.
	DAC	NWRCD
	JMS*	NWRCD		/SET UP FOR OUTPT. ON NEW LINE
	LAC	ACSAVE		/GET 1'S COMPLEMENT OF MODE BEFORE RETURN
	JMP*	NMADR		/RTN.
/
/TABLE OF F.D. PARAMS FOR EACH MODE
FDPRMS	000160			/INTEGER
	700410			/REAL
	400513			/DOUBLE PRECISION REAL
	000300			/DOUBLE PRECISION INTEGER
	100020			/LOGICAL
	.TITLE	DDIO
/PRINT SUBSCRIPT
/CALLING SEQUENCE--
/	JMS	PRSS
PRSS	0
	LAC*	.SS	/.SS RETAINS ADDRESS HAD WHEN ENTERED.  ITS FIRST 
	DAC	TEMP4	/PARAMETER WAS ADDRESS OF ADB WD5.  REGRESS TO POINT TO
K00004	LAW	-4	/FIRST ADB WORD, AND GET THAT WORD
	TAD*	TEMP4	/TEMP4 IS SAVED FOR FURTHER USE BELOW
	DAC	SSCNT	/SAVE ADDRESS OF ADB WD 1; THE NUMBER OF DIMENS-1 IS IN
	LAC*	SSCNT	/BITS 1,2 OF THAT WORD, AND BIT 0 = 0..  RIGHT JUSTIFY,
	LRSS	17	/AND COMPLEMENT, TO GET 2'S COMPLEMENT OF NUMBER OF 
	CMA		/DIMENSIONS
	DAC	SSCNT	/
/AT THIS POINT, SSCNT HOLDS 2'S COMPL. OF THE NUMBER OF
/  SUBSCRIPTS, AND TEMP4 POINTS TO ADDR. ABOVE THE
/  FIRST "LAC" OF THE .SS ARGS.
/  NOW MUST GET EACH S.S., CONVERT BINARY TO ASCII
/  CHARS., AND PACK INTO LINE BUFFER
	LAC	LPCH		/LEFT PAREN.
	JMS*	.PACK		/PACK
	JMP	PRSS3
PRSS4	LAC	CMACH		/COMMA
	JMS*	.PACK
PRSS3	ISZ	TEMP4		/INCREM. TO POINT TO CURR. "LAC" INSTRUC.
	XCT*	TEMP4		/GET S.S. INTO AC
	JMS	BAPR		/CONVERT BINARY TO ASCII AND PRINT
	ISZ	SSCNT
	JMP	PRSS4		/MORE S.S.
	LAC	RPCH		/RIGHT PAREN. - S.S. EXHAUSTED
	JMS*	.PACK
	JMP*	PRSS		/RTN.
	.EJECT
/CONVERT BINARY SUBSCRIPT TO ASCII CHARS. AND PRINT
/CALLING SEQUENCE--
/	LAC	(BINARY SUBSCRIPT
/	JMS	BAPR
BAPR	0
	DAC	BINSS
	LAC	ADCHR6		/ADDR. OF CHR6
	DAC	STCHR
/DIVIDE BY 10(10) TO GET ASCII CHARS AND STORE, ONE CHAR. PER
/  WORD IN CHR6 THROUGH CHR1 AS NEEDED.
	LAC	BINSS
BAPR3	DZM	QUO		/QUOTIENT
BAPR2	TAD	K00010		/-12(8)
	SPA
	JMP	BAPR1		/DONE WITH CURRENT DIVISION
	ISZ	QUO
	JMP	BAPR2		/SUBTRACT AGAIN
BAPR1	TAD	S00072		/AC+12(8)=REMAINDER+60(8)=ASCII CHAR.
	DAC*	STCHR		/LOAD INTO CURRENT CHAR.
	LAW	-1
	TAD	STCHR
	DAC	STCHR
	LAC	QUO
	SZA			/SKP IF THROUGH
	JMP	BAPR3		/DIVIDE AGAIN
/NOW, STCHR POINTS TO WORD ABOVE LAST CHAR. FILLED WHICH
/  IS FIRST CHAR. OF S.S. ELEMENT
/  MUST PRINT CHARS. FOR FIRST TO THE CHAR. IN CHR6
BAPR4	ISZ	STCHR
	LAC*	STCHR
	JMS*	.PACK		/PRINT
	LAC	STCHR
	SAD	ADCHR6
	JMP*	BAPR		/IF LAST CHAR. PRINTER RTN.
	JMP	BAPR4		/GET NEXT CHAR. AND PRINT
	.EJECT
/RADIX50 TO ASCII CONVERSION
/  TAKEC TWO CONTIGUOUS WORDS OF CHARACTERS CODED IN RADIX50
/  AND CONVERTS THEM TO ASCII CHARACTERS ONE PER
/  WORD, IN LOCATIONS CHR1 TO CHR6
/CALLING SEQUENCE
/	LAC	(ADDR. OF FIRST RADIX50 WORD
/	JMS	R50AS
R50AS	0
	DAC	NMADR
	LAC	K00006		/-6
	DAC	CHRCNT		/CHARACTER COUNT
	LAC	ADCHR3		/ADDR. OF CHR3
	DAC	STCHR		/CUR. CHAR. ADDR.
R50AS1	LAC*	NMADR
	AND	T77777		/177777(8)
R50AS2	CLL
	IDIV			/INT. DIVIDE
	50			    /BY 50(8)
	SNA
	JMP	NULCHR		/NULL CHAR.
	TAD	K00026		/-32(8); ALPHA: -31 TO 0 ; NUMER.: 3 TO 14
	SPA!SNA			/SKP IF NUMERIC
	TAD	S00055		/ALPHA: 24 TO 55
	TAD	S00055		/ALPHA: 101 TO 132; NUMER.: 60 TO 71
NULCHR	DAC*	STCHR
	ISZ	CHRCNT		/SKP IF ALL CHARS. CONVERTED
	SKP
	JMP*	R50AS		/RTN.
	LAC	CHRCNT
	SAD	K00003		/-3
	JMP	NXTWD		/CHRCNT= -3: GET NXT. RADIX50 WD.
	LAC	STCHR
	TAD	K00001
	DAC	STCHR		/CHANGE CHAR. PTR.
	LACQ			/NOW DIVIDE FORMER QUOTIENT
	JMP	R50AS2
NXTWD	ISZ	NMADR		/INCREM. TO POINT TO SECOND RADIX50 WD.
	LAC	ADCHR6
	DAC	STCHR		/CHANGE CHAR. PTR.
	JMP	R50AS1		/PROCESS NXT. RADIX50 WD.
	.TITLE	.GB  - -  WHOLE ARRAY I/O
/DATA DIRECTED OUTPUT - WHOLE ARRAY
/  THIS ROUTINE SETS UP ARRAY ELEMENT SUBSCRIPTS AND
/    CALLS .SS AND .GC IN A LOOP
/CALLING SEQUENCE--
/	JMS*	.GB
/	NAME1			/FIRST 3 CHARS. OF NAME IN RADIX50
/	NAME2			/SECOND 3 CHARS. IN RADIX50
/					 (BIT #0=1 IF LOGICAL)
/	.DSA	ADDR OF WORD 5 OF ADB
.GB	0
	LAC*	.GB		/AC=NAME1
	DAC	GBGC1		/SET UP FOR CALL TO .GC
	ISZ	.GB
	LAC*	.GB		/AC=NAME2
	DAC	GBGC2		/SET UP FOR CALL TO .GC
	ISZ	.GB
	LAC*	.GB		/AC=ADDR. OF WD. 5
	DAC	GBSS1
	ISZ	.GB
	TAD	K00004		/GET ADDR OF ADB WORD 1
	DAC	DBLAD
	LAC*	DBLAD		/CONVERT MODE IN BITS 16,17 TO WORDS
	TAD	S00001		/PER ELEMENT
	AND	S00003		/WPEL = MODE + 1, EXCEPT IF MODE = 3,
	SNA			/WPEL= 2
	LAC	S00002		/(HAVE ALSO MASKED NDIM-1 OUT BITS 1,2)
	DAC	WPEL
/MUST LOOK AT ARRAY DESCRIPTOR BLOCK FOR ARRAY TO GET
/  NUMBER AND SIZE OF DIMENSIONS
	DZM	DIM1		/DIMENSION 1
	DZM	DIM2		/DIMEN. 2
	DZM	DIM3		/DIMEN. 3
	LAW	-3
	DAC	DIMCNT		/DIMENSION CNT.
	ISZ	DBLAD		/POINT TO WORD 2 OF ADB
	LAC*	DBLAD
	DAC	ASZ		/ARRAY SIZE IN ASZ
	ISZ	DBLAD		/ADDR. OF WD. 3
/--IF WORD 3 OF DESCR. BLK =0, WANT TO DIVIDE ARRAY SIZE
/    BY WDS. PER ELEMENT TO GET DIMEN. 1
/    IF WD. 3 DOES NOT EQUAL 0, IT HOLDS (WDS. PER EL.) * (DIMEN. 1),
/    THEREFORE DIVIDE IT BY WDS. PER EL.
	LAC*	DBLAD
	SNA			/SKP IF AT LEAST 2 DIMENSIONS
	LAC	ASZ		/ONE DIMENSION
	DAC	DBWD2		/DESCR. BLK. WD. 3 (IF NOT =0)
	CMA
	TAD	S00001		/2'S COMPL.
	SKP
GB4	ISZ	DIM1
	TAD	WPEL		/WORDS PER ELEMENT
	SPA!SNA			/SKP IF DONE
	JMP	GB4		/SUBTRACT AGAIN
	LAC*	DBLAD
	SNA
	JMP	GB10		/ONLY ONE DIMENSION, NO MORE DIVIDES
	ISZ	DBLAD		/ADDR. OF WD. 4
/--IF WD. 4 OF D. BLK. =0, WANT TO DIVIDE ARRAY SIZE
/    BY D. BLK. WD. 3 TO GET DIMEN. 2
/    ELSE, DIVIDE WD. 4 BY WD. 3 TO GET DIMEN. 2
	LAC*	DBLAD		/AC=WD. 4
	SNA			/SKP IF 3 DIMENS.
	LAC	ASZ		/SIZE
	CMA
	TAD	S00001		/2'S COMPL.
	DAC	MDBWD3		/MINUS D. BLK. WD. 4 (IF NOT =0)
	SKP
GB5	ISZ	DIM2
	TAD	DBWD2		/D. BLK. WD. 3
	SPA!SNA			/SKP IF DONE
	JMP	GB5		/SUBTRACT AGAIN
	LAC*	DBLAD
	SNA
	JMP	GB11		/ONLY 2 DIMENS., NO MORE DIVIDES
/--IF D. BLK. WD. 4 NOT =0, DIVIDE SIZE BY WD. 4
/    TO GET DIMEN. 3
	LAC	ASZ
	SKP
GB6	ISZ	DIM3
	TAD	MDBWD3		/MINUS WD. 4
	SMA			/SKP IF DONE
	JMP	GB6		/SUBTRACT AGAIN
/AT THIS POINT, THE DIMENSIONS OF THE ARRAY HAVE BEEN FOUND
/  THE DIMEN. CNT. IS SET ACCORDING TO NUM. OF DIMENSION
	ISZ	DIMCNT	/3 DIMENS, BUMP TO -1
GB11	ISZ	DIMCNT	/2 DIMENS, BUMP TO -2
GB10	LAC	(JMS* .SS)
	DAC	GBSS0	/THE CALLING SEQUENCE OF .SS IS DEFINED FIRST AS
	LAC	ADLD1	/	JMS*	.SS
	DAC	GBSS2	/	.DSA	ADB WD5 ADDRESS
	LAC	ADLD2	/	LAC	ADDM1
	DAC	GBSS3	/	LAC	ADDM2
	LAC	ADLD3	/	LAC	ADDM3
	DAC	GBSS4	/..THEN THIS IS SCRUNCHED DOWN ONCE FOR
GB9A	ISZ	DIMCNT	/EACH DIMENSION LESS THAN THREE, WITH NOP'S IN
	SKP		/ON TOP.
	JMP	GB9
	LAC	GBSS3
	DAC	GBSS4
	LAC	GBSS2
	DAC	GBSS3
	LAC	GBSS1
	DAC	GBSS2
	LAC	GBSS0
	DAC	GBSS1
	LAC	(NOP)
	DAC	GBSS0
	JMP	GB9A
/LOAD .SS CALL WITH EACH SUBSCRIPT IN THE ARRAY, IN ORDER
/  OF STORAGE, AND DO .SS, .GC FOR EACH
GB9	DZM	ADDM1		/S.S. DIMEN. 1
	DZM	ADDM2		/S.S. DIMEN. 2
	DZM	ADDM3		/S.S. DIMEN. 3
GBD3	ISZ	ADDM3
GBD2	ISZ	ADDM2
GBD1	ISZ	ADDM1
	JMS	SSGC		/.SS, .GC
	LAC	ADDM1
	SAD	DIM1
	SKP			/SAME
	JMP	GBD1		/IF S.S. DIMEN 1 .LT. ARRAY DIMEN. 1, INCR.
	LAC	DIM2
	SNA
	JMP	GB12		/IF DIMEN. 2 =0, DONE
	DZM	ADDM1
	LAC	ADDM2
	SAD	DIM2
	SKP			/SAME
	JMP	GBD2		/IF S.S. DIMEN. 2 .LT. ARRAY DIMEN. 2, INCR.
	LAC	DIM3
	SNA
	JMP	GB12		/IF DIMEN. 3=0, DONE
	DZM	ADDM1
	DZM	ADDM2
	LAC	ADDM3
	SAD	DIM3
	SKP			/SAME: DONE
	JMP	GBD3		/IF S.S DIMEN. 3 .LT. ARRAY DIMEN. 3, INCR.
GB12	JMP*	.GB
/
/
/CALL TO .SS THEN .GB
SSGC	0
GBSS0	XX
GBSS1	XX		/POINTER TO ADB WORD 5
GBSS2	XX
GBSS3	XX
GBSS4	XX
	DAC	GBGC3		/SET UP FOR .GC, XCT'D BY .SS
	JMS	.GC
GBGC1	XX			/NAME1
GBGC2	XX			/NAME2
GBGC3	XX			/PTR
	JMP*	SSGC
	.TITLE	.GD  - -  ELEMENT INPUT
/DATA DIRECTED ELEMENT INPUT
/CALLING SEQUENCE--
/	1'S COMPLEMENT OF MODE IN AC
/	JMS*	.GD
/	.DSA	ELEMENT ADDR (BIT0=1 IF TRANSFER VECTOR)
/	1'S COMPLEMENT OF MODE RETURNED IN AC
.GD	0
	DAC	ACSAV2		/SAVE MODE FOR RETURN
	CMA			/SAVE ITS ACTUAL VALUE
	DAC	VTYPE
	LAC	(JMP	GPNM5	/SET NUM. PACKING ROUTINE TO
	DAC	GPNM2		    /PACK DEC. NUMS
	DZM	DPCNT
	DZM	SIGN1
	DZM	EXPSW
	DZM	SIGN2
	DZM	CHRIDX
	DZM	OCTSW
	DZM	GLS
	DZM	GMS
	DZM	BINEX
	DZM	NUM1
	LAW	-6
	DAC	SCCNT
K00001	LAW	-1
	DAC	STRCON
	DAC	DPISW
	DAC	DPTSW
	LAC	S00001
	DAC	LOGSW
	DAC	RNDSW
	LAC*	.STEOR		/HOLDS DESTIN. ON END OF RCD. OCCUR.
	DAC	NWRCD
/GET ELEMENT ADDRESS
	LAC*	.GD
	ISZ	.GD		/FOR RTN.
	DAC	DADR
	SPA			/IF T.V., GO ONE MORE
	LAC*	DADR		    /LEVEL OF INDIRECT
/(RKB-020)
/(RKB-020) FOLLOWING LINE DELETED:
/	AND	S77777		/MASK OFF ADDR.
	DAC	DADR
	LAC*	.SF		/IF PREVIOUS CALL TO .GD ENDED IN CR
	SZA			    /OR A.M., .SF SET TO NON-0
/GET NEW RCD. (IF NEC.) AND READ CHAR.
GRDGT	JMS*	NWRCD		/READ NEW LINE
GGTCH	JMS*	READ.	/(RKB-018) PUT ASCII CHAR. INTO .CHAR
	SAD	S00175		/ALT MODE
	JMP	GCRAM
	SAD	S00015		/CR
	JMP	GCRAM
	SAD	STRCON		/HOLDS FIRST DELIM. IF ANY
	JMP	GSDHT		/CHR. IS DELIM.: CHK. IF SNG. OR DOUBLE
	LAC	STRCON		/IF NO DELIM. OR SECOND DELIM.,
	SMA!SZA			    /SP. & COMMA ARE TERMIN.
	JMP	GSCPK		/FIRST DELIM.:PACK .CHAR
GD2	LAC*	.CHAR
	SAD	S00040		/SPACE
	JMP	GSPCM
	SAD	S00054		/COMMA
	JMP	GSPCM
	LAC	STRCON		/IF SECOND DELIM. HAS BEEN HIT,
	SMA			    /IGNORE CHR.
	JMP	GGTCH		/GET NEXT CHAR.
	ISZ	CHRIDX		/INCR. CHAR INDEX
	LAC	LOGSW
	SPA!SNA		/SKP IF NOT LOGICAL INPUT
	JMP	GGTCH		/IGNORE NON-TERMINATING CHARS.
	LAC*	.CHAR
	SAD	S00043		/#
	JMP	GOCT
	SAD	S00042		/" (STRING DELIM.)
	JMP	GSTDL
	SAD	S00044		/$ (STRING DELIM.)
	JMP	GSTDL
	SAD	S00047		/' (STRING DELIM.)
	JMP	GSTDL
	SAD	S00124		/T
	JMP	GLOGT		/TRUE
	SAD	S00106		/F
	JMP	GLOGF		/FALSE
	SAD	S00105		/E
	JMP	GE
	SAD	S00104		/D
	JMP	GD
	SAD	S00053		/+
	JMP	GSIGN
	SAD	S00055		/-
	JMP	GSIGN
	SAD	S00056		/DEC. OR OCTAL POINT
	JMP	GDOPT
	JMS*	.NMTST		/NUMBER TEST
	JMP	BDIND		/NO: BAD INPUT DATA
	JMP	GNUM		/YES: AC= BINARY VAL. OF NUM.
/
ACSAV2	LAW			/LAW 1'S COMPLEMENT OF MODE RETURNED IN AC
	JMP*	.GD
	.TITLE	DDIO
/STRING DELIMS.,LOGICAL, OCTAL
GLOGT	LAW	-1
	SKP
GLOGF	CLA			/SWITCH= 0 IF FALSE
	DAC	LOGSW
	JMP	GCHFC		/T, F MUST BE FIRST CHARS.
GOCT	DAC	OCTSW		/SET SW. WITH 043
	LAC	(NOP		/IF OCTAL, MUST NOP AN ADD IN
	DAC	GPNM2		    /NUM. PACKING ROUTINE
	SKP
GSTDL	DAC	STRCON		/SET SW. W/ ASCII OF DELIM.
GCHFC	LAC	CHRIDX		/CHK. IF FIRST CHAR.
	SAD	S00001		/SKP IF NOT FIRST
	JMP	GGTCH		/GET NEXT CHAR.
	JMP	BDIND		/BAD INPUT DATA
GSDHT	JMS*	READ.	/(RKB-018) LOOK AT NEXT CHARACTER.
	SAD	STRCON
	JMP	GSCPK		/DOUBLE CHR. SO PACK
	SAD	S00175		/ALT MODE
	JMP	GCRAM
	SAD	S00015		/CR
	JMP	GCRAM
	SAD	S00040		/SPACE
	JMP	GSPCM
	SAD	S00054		/COMMA
	JMP	GSPCM
	JMP	BDIND		/NO TERM. CHR. AFTER SEC. DELIM.
/SPACE, COMMA, CR, ALT MODE
GSPCM	LAC	CHRIDX
	SNA				/SKP IF FIRST NON-TERM. CHAR HIT
	JMP	GGTCH		/ELSE, IGNORE LEADING SP. & COMMA
	DZM*	.SF		/DON'T RD. IN NEW LINE ON NXT .GD
	JMP	GVINP		/CHECK VALID INPUT
GCRAM	LAC	CHRIDX	
	SNA			/SKP IF FIRST NON-TERM. CHR. HIT
	JMP	GRDGT		/ELSE, IGNORE AND READ NEW LINE
	LAW	-1		/SET TO RD. IN NEW LINE ON NEXT
	DAC*	.SF		    /CALL TO .GD
	JMP	GVINP		/CHECK VALID INPUT
/--CHECK THAT INPUT IS STR.CONS. OR LOG. OR HAS NUMBER
GVINP	LAC	STRCON		/-1, NO; 0,42,44 YES
	TAD	NUM1		/AC: -1, NO; .GE. 0, YES
	SMA
	JMP	GTRM		/O.K., INPUT TERMINATED
	TAD	LOGSW		/AC: 0, NO; -1,-2 YES
	SZA
	JMP	GTRM		/INPUT TERMINATED
	JMP	BDIND		/BAD INPUT DATA
/SIGN
GSIGN	CMA
	TAD	S00055		/AC= 1 IF +; -1 IF -
	DAC	TEMP4
/--LEGAL SIGN1 IF NO SIGN1 (D.P. AND 1ST NUM. SET SIGN1)
	LAC	SIGN1
	SZA
	JMP	GSIGN2
	LAC	TEMP4
	DAC	SIGN1		/SET FIRST SIGN
	JMP	GGTCH		/GET NEXT CHAR
/--LEGAL SIGN2 IF  EXP. AND NO SIGN2
GSIGN2	LAW	-1
	TAD	SIGN2		/AC: -1,YES; -2,0,NO
	AND	EXPSW		/AC: 1, OK; 0, NO
	SNA
	JMP	BDIND		/BAD INPUT DATA
	LAC	TEMP4
	DAC	SIGN2		/SET SEC. SIGN
	JMP	GGTCH		/GET NEXT CHAR.
/D, E
GD	LAC	SIGN1
	SZA			/SKP IF NO SIGN1
	JMP	GE		/IF ON, CAN ONLY BE EXP. INDIC.
/--LEGAL IF OCTAL WITH NO D
	LAC	OCTSW		/AC: 43, YES; 0, NO
	AND	DPISW		/AC: 43, OK; 0, NO
	SNA			/SKP IF OK AS OCT. D.P. INT. INDIC.
	JMP	GE		/ELSE, CHK. EXP. INDIC.
	DZM	DPISW		/SET D.P. SW.
	JMP	GGTCH		/GET NEXT CHAR.
/--NOW, LEGAL IF 1ST NUM, NO EXP., NO D.P.I. INDIC.
GE	LAC	NUM1
	SNA			/SKP IF 1ST NUM. HIT
	JMP	BDIND		/ELSE, BAD INPUT DATA
	LAC	DPISW		/AC: 0, D.P.I.; -1, NO
	TAD	EXPSW		/AC: -1, OK; 0,1 NO
	SMA
	JMP	BDIND		/BAD DATA INPUT
	ISZ	EXPSW		/SET EXPON. SW.
	LAC	GMS
	SPA			/IF BIT# 0=0, NEED NOT RND.
	JMS	GRND
	JMS	GLFPA		/LD. FPACC (UNSIGNED) AND NORMAL.
	JMP	GGTCH		/GET NEXT CHAR
/DEC. OR OCT. POINT - LEGAL IF NO PT. AND NO EXPON.
GDOPT	LAC	DPTSW		/AC: -1, NO; 0 YES
	TAD	EXPSW		/AC: -1, OK; 0,1, NO
	SMA			/SKP IF NO EXP. AND NO PT.
	JMP	BDIND		/BAD INPUT DATA
	DZM	DPTSW		/SET PT. SW.
	LAC	SIGN1
	SNA			/SKP IF SET
	ISZ	SIGN1		/ELSE, SET TO +
	JMP	GGTCH		/GET NEXT CHAR.
/NUMBER
GNUM	DAC*	.CHAR		/PUT BINARY INTO .CHAR
	ISZ	NUM1		/INDICATE NUM. HIT
	LAC	EXPSW
	SZA			/SKP IF NUM. NOT EXP.
	JMP	GNUM2
	LAC	SIGN1
	SNA			/SKP IF SET
	ISZ	SIGN1		/ELSE, SET TO +
	JMP	GPNM		/PACK NUM.
GNUM2	LAC	SIGN2
	SNA			/SKP IF SET
	ISZ	SIGN2		/ELSE, SET TO +
	JMP	GPNM		/PACK NUM.
/PACK STRING CONSTANT
/  IF ENTRY FROM CHAR. SKIP CHAIN, PACK CHARS. TO FIFTH,
/    RTN. AND CHK. FOR TERMINATOR AFTER FIFTH
/  IF ENTRY FROM INPUT TERMIN., PACK SPACES TO FIFTH
/    CHAR. (IF NEC.), THEN LD. FPACC AND CONVERT
GSCPK	ISZ	SCCNT		/INCR. STR. CONS. CNT.
	SKP
	JMS	GSHL1		/SHIFT L. 1 FOR PROPER FORMAT
	LAC	SCCNT
	SPA			/SKP IF .GT. 5 CHRS.
	JMP	GSCPK1		/PACK CHAR
	LAC	STRCON
	SZA			/SKP IF SEC. DELIM. (I.E.,FROM GTRM)
	JMP	GD2		/1 DELIM.: BACK TO SKIP CHAIN
/--NOW, GMS+GLS CONTAINS CHARS. W/ PACKED SPACES AND SHIFTED
/    ONE LEFT
/    CHANGE GMS+GLS TO MAGNITUDE, SAVE SIGN, LD. FPACC,
/    AND CONVRT
	LAC	GMS
	SMA			/SKP IF MAG. CONVER.
	JMP	GSCPK2
	JMS GAB			/COMPL. DOUBL. INTEGER
	SKP
GSCPK2	ISZ	SIGN1		/SIGN POS
	JMS	GLFPA		/LD. INTO FPACC AND NORM.
	JMP	GCNVRT
/--PACK CHAR.
GSCPK1	LAW	-7
	DAC	TEMP4		/SET SHIFT CNT.
GSCPK3	JMS	GSHL1		/SHIFT GMS+GLS LEFT ONE
	ISZ	TEMP4
	JMP	GSCPK3
	LAC	GLS
	XOR*	.CHAR
	DAC	GLS
	LAC	STRCON
	SZA			/SKP IF ENTRY FROM GTRM
	JMP	GGTCH		/GET NEXT CHAR
	JMP	GSCPK		/PACK SPACE AGAIN
/PACK NUMBER
GPNM	LAC	OCTSW
	SNA			/SKP IF OCTAL
	JMP	GPNM1		/DEC. NUM.
	LAC*	.CHAR		/BINARY
	AND	S00010
	SZA			/SKP IF NOT 8 OR 9
	JMP	BDIND		/BAD INPUT DATA
GPNM1	LAC	EXPSW
	SZA			/SKP IF NOT EXP.
	JMP	GPNM3
/--MUST ADJUST DECIMAL (OR OCTAL) POINT COUNT (DPCNT) ACCORDING
/   TO ROUNDING AND ENCOUNTER OF POINT
	LAC	DPTSW		/-1, NO PT.; 0, PT.
	TAD	RNDSW		/AC: 0, NONE OR BOTH; 1,PT.; -1,RND.
	SNA
	JMP	GPNM3A		/NO CNT. ADJ.
	CMA
	TAD	S00001		/AC=-1 IF D, NOT R;=1 IF R, NOT D
	TAD	DPCNT
	DAC	DPCNT
GPNM3A	LAC	RNDSW
	SNA			/SKP IF NO RND.
	JMP	GGTCH		/IF ROUNDING, IGNORE CHAR
/--MULT. GMS+GLS BY 10 (OR 8 IF OCTAL) AND ADD CHAR.
GPNM3	LAC	GMS
	DAC	GMS2
	LAC	GLS
	DAC	GLS2		/SAVE FOR USE IF RNDING
	JMS	GSHL1		/MULT. BY 2
	SZL			/INDICATES OVER FLOW
	JMP	GOVFL		/OVER FLOW
GPNM2	XX			/DEC.: 'JMP GPNM5'; OCT.: 'NOP'
	DZM	GMS3		/IF OCT, MUST ZERO TEMP STORAGE TO
	DZM	GLS3		    /GET MULT. BY 8
	JMP	GPNM4
GPNM5	LAC	GMS
	DAC	GMS3
	LAC	GLS
	DAC	GLS3		/SAVE (GMS+GLS)*2
GPNM4	JMS	GSHL1		/MULT. BY 4
	SZL
	JMP	GOVFL
	JMS	GSHL1		/MULT. BY 8
	SZL!CLL
	JMP	GOVFL
	LAC	GLS
	TAD	GLS3
	SZL!CLL
	ISZ	GMS3		/IF OVFL. OF GLS, ADD 1 TO GMS
	NOP
	TAD*	.CHAR
	DAC	GLS
	GLK			/IF OVFL. OF GLS, ADD 1 TO GMS
	TAD	GMS3
	TAD	GMS
	DAC	GMS
	SNL!CLL		/SKP IF OVFL. OF GMS
	JMP	GGTCH		/CHAR ADDED, GET NEXT
GOVFL	LAC	EXPSW
	SZA			/NOT EXP.
	JMP	BDIND		/EXP.:BAD INPUT DATA
	ISZ	DPCNT		/EXP. EFFECTIVELY INCREM.
	NOP
	LAC	GMS2		/RESTORE OLD GMS+GLS
	DAC	GMS
	LAC	GLS2
	DAC	GLS
	DZM	RNDSW		/SET TO INDICATE ROUNDING
	JMP	GGTCH		/GET NEXT CHAR.
/INPUT TERMINATED - COME HERE ON CR, A.M., SPACE, COMMA
/--STRING CONS
GTRM	LAC	STRCON
	SPA			/SKP IF STR. CON.
	JMP	GTRM1
	LAC	S00040		/SPACE
	DAC*	.CHAR		/SET FOR PADDING W/ SPACES
	DZM	STRCON		/FAKE SEC. DELIM. IF NOT ALREADY
	JMP	GSCPK		/PAD SPACES
/--LOGICAL
GTRM1	LAC	LOGSW
	SMA!SZA		/SKP IF LOG.
	JMP	GTRM2
	DZM	GMS
	DZM	GLS		/FAKE PKNG. OF 0.0 FOR FALSE
	SMA			/SKP IF TRUE
	JMP	GTRM4
	DAC	SIGN1		/-1:NEG FOR TRUE
	LAC	S00001
	DAC	GLS		/FAKE PACKING OF -1.0 FOR TRUE
	SKP
GTRM4	ISZ	SIGN1		/=1: POS FOR FALSE
	JMS	GLFPA		/LD. FPACC AND NORM.
	JMP	GCNVRT		/CONVERT DATA
/--OCTAL
GTRM2	LAC	NUM1
	SNA			/SKP IF AT LEAST 1 NUM.
	JMP	BDIND		/IF NOT, AT THIS PT., BAD IN. DATA
	LAC	OCTSW
	SNA			/SKP IF OCTAL
	JMP	GTRM3
/----MUST CHK. SPECIAL CASE OF #(D)400000000000 TO
/      #(D)777777777777 AND #400000 TO #777777
/      THESE ARE INPUT EXACTLY AS WRITTEN FOR MASKING
/      ALLOWABLE ONLY IF NO EXP., SIGN1 IS +, NO PT., NO RNDING.
	LAC	EXPSW		/EXPSW= 0, NO; 1, YES
	XOR	SIGN1		/SIGN1= 1, +; -1, -
	SPA			/AC: 1, POSIBLE; 0,-1,-2, NO
	JMP	GTRM3
	LAC	RNDSW		/RNDSW= 1, NO; 0, YES
	AND	DPTSW		/DPTSW= -1, NO; 0, YES
	SPA!SNA			/AC: 1, POSS.; 0, NO
	JMP	GTRM3
	LAC	DPISW
	SNA			/SKP IF I OR J SP. CS. POSS.
	JMP	GJSC		/ONLY J SP. CS. POSS.
/------GMS+GLS MUST = 000000YXXXXX WHERE Y=4,5,6,7
	LAC	GMS
	SZA
	JMP	GJSC
	LAC	GLS		/BIT# 0=1 IF S.C.
	XOR	W00000		/400000
	SPA
	JMP	GJSC
	SNA
	JMP	GIVSC		/000000400000 IS VERY SP.CS.
	LAW	-1
	DAC	SIGN1
	LAC	GLS
	CMA			/2'S COMPL. TO GET MAGN.
	TAD	S00001
	DAC	GLS
	JMP	GTRM3
/------I VERY SP. CS.: IF ELEMENT IS INT., LD. IN
GIVSC	LAC	VTYPE
	SZA			/SKP IF INT.
	JMP	GTRM3
	LAC	GLS
	DAC*	DADR
	JMP	ACSAV2
/------J SP. CS.: GMS+GLS MUST = YXXXXXXXXXXX WHERE Y=4,5,6,7
GJSC	LAC	GMS
	XOR	W00000
	SPA			/BIT# 0 NOW =0 IF SP. CS.
	JMP	GTRM3
	SZA
	JMP	GJSC1		/GMS NOT = 400000
	LAC	GLS
	SNA
	JMP	GJVSC		/GLS=000000: J VERY SP. CS.
GJSC1	JMS GAB	/COMPL. DOUBL. INTEGER
	JMP	GTRM3
/------J VERY SP. CS.: IF ELEMENT IS J, LD. IN
GJVSC	LAW	-3
	TAD	VTYPE		/AC= 0 IF J
	SZA
	JMP	GTRM3
	LAC	GMS
	DAC*	DADR
	ISZ	DADR
	LAC	GLS
	DAC*	DADR
	JMP	ACSAV2		/FINISHED, RTN.
/--DECIMAL AND OCTAL NON-SPECIAL CASES
/    IF EXP. HIT, ROUNDED MANTISSA IN FPACC, EXPON. IN GMS+GLS
/    IF NO EXP. HIT, UNRNDED. MANT. IN GMS+GLS
GTRM3	LAC	EXPSW
	SNA			/SKP IF EXP.
	JMP	GNXP
	LAC	GMS
	SZA			/IF NOT = 0, TOO LARGE
	JMP	BDIND
	LAC	GLS
	AND	Y00000		/600000
	SZA
	JMP	BDIND		/EXP. CAN'T BE .GT. 600000(10)
	LAC	SIGN2
	SMA			/SKP IF -
	JMP	GD3
	LAC	GLS
	CMA			/2'S COMPL.
	TAD	S00001
	DAC	GLS
GD3	LAC	GLS
	TAD	DPCNT		/ADD TO EXP. FROM RNDING. AND PT.
	DAC	GLS
	TAD	T15020		/MAX. DEC. EXP. ALLOWED
	SPA			/SUM MUST BE POS.
	JMP	BDIND
	LAC	GLS
	TAD	Y62760		/-115020(8)
	SMA!SZA
	JMP	BDIND
GD7	LAC	OCTSW
	SNA
	JMP	GDCXP
	.IFDEF %FPP
	DST
	FP0	/TEMP. JUST FOR FOLLOWING CODE
	LAC FP0	/EXP+3*GLS--8**N = 2**3N
	TAD GLS
	TAD GLS
	TAD GLS
	DAC FP0
	DLD		/DOUBLE LOAD FPPAC
	FP0
	.ENDC
	.IFUND %FPP
	LAC*	.AA		/GET EXP.
	TAD	GLS
	TAD	GLS
	TAD	GLS
	DAC*	.AA
	.ENDC
	JMP	GCNVRT		/SET TO CONVERT
/----DEC. EXP.: IF POS., MULT. NUM. BY 10 GLS TIMES;
/      IF NEG., DIVIDE NUM. BY 10 -GLS TIMES
GDCXP	LAC	GLS
	SNA
	JMP	GCNVRT		/EXP. =0: FPACC O.K.
	SMA
	JMP	GD5		/EXP. POS
	.IFUND %FPP
	JMS* .CF	/FAC TO HAC FOR LATER
	.ENDC
	.IFDEF %FPP
	DST		/STORE TEMP.
	FP0
	.ENDC
	.IFUND %FPP
	JMS*	.FAO		/LD. 1.0 INTO FPACC
	.ENDC
	.IFDEF %FPP
	DLD		/LOAD 1.0
	.ENDC
	DPONE			/D.P. ONE
	LAC	GLS		/USE AS CNT.
	JMP	GD6
GD5	CMA			/2'S COMPL. FOR COUNTER
	TAD	S00001
GD6	DAC	TEMP4
GD6A	JMS*	.MPYTN		/D.P. MULT. BY TEN
	.IFDEF %FPP
	FNM		/NORMAL. RESULT OF MPY SINCE .MPYTN WON'T
	0		/UNUSED
	.ENDC
	ISZ	TEMP4
	JMP	GD6A
	LAC	GLS
	SMA
	JMP	GCNVRT		/POS. EXP., CONV. DONE
	.IFUND %FPP
	JMS* .CI	/HAC/FAC--NEG EXP.
	44		/D.P. DIVIDE
	1
	JMS* .CH	/ROUND AND SIGN TO D.P. RESULT
	1
	777776
	.ENDC
	.IFDEF %FPP
	DRD		/DOUBLE REV. DIV.--FP0/FPPAC
	FP0		/TEMP. STORED EXTERN. NUMBER
	.ENDC
	JMP	GCNVRT
/----NO EXP.
GNXP	LAC	GMS
	SMA
	JMP	GJILT		/IF POS., TEST FOR J,I,LOG.
	JMS	GRND
GNXP2	JMS	GLFPA		/LD. FPACC AND NORM
	LAC	DPCNT
	DAC	GLS		/DPCNT IS ONLY EXP.
	JMP	GD7		/ADJUST NUM. BY EXP.
/MUST SIGN AND CONVERT D.P. NUM. TO PROPER DATA TYPE
GCNVRT=.
	.IFDEF %FPP
	LAC SIGN1	/SIGN?
	SPA
	FNG		/MINUS.  MAKE FPPAC NEG
	NOP		/POS.  FNG SKIPPED.  NOP IGNORED IF FNG ISSUED
	LAC VTYPE	/ET VAR. TYPE
	TAD (JMP GDTDTB)	/BUILD JUMP
	DAC .+1
	XX
	.ENDC
	.IFUND %FPP
	LAC	W00000
	AND	SIGN1		/=100000 IF NEG., =000000 IF POS.
	DAC*	.CE		/SET SIGN
	LAC	STRCON		/STR. CON. SW.
	SMA			/SKP IF NOT STR. CON.
	JMP	GD8
	JMS*	.CH		/RND. OFF LOW BIT, INSERT SIGN
	1
	777776
GD9	LAC	VTYPE
	TAD	(JMP	GDTDTB
	DAC	.+1
	XX
GD8	LAC*	.CE
	XOR*	.AB
	DAC*	.AB
	JMP	GD9
	.ENDC
GDTDTB	JMP	GILCNV
	JMP	GRLCNV
	JMP	GDPCNV
	JMP	GJCNV
/--CONVERT TO INT. OR LOG.
GILCNV	JMS*	.AX		/FIX
	DAC*	DADR
	JMP	ACSAV2
/--CONVERT TO D.P.
GDPCNV=.
	.IFDEF %FPP
	DST		/DOUBLE STORE
	.ENDC
	.IFUND %FPP
	JMS*	.FAP		/STORE
	.ENDC
	.DSA	400000+DADR
	JMP	ACSAV2
/CONVERT TO D.P. INT OR STR. CON
GJCNV	URFXA% .JX	/FLT TO J
	EST% .JH	/ST J
	.DSA 400000+DADR
	JMP	ACSAV2
GRLCNV=.
/CONVERT TO REAL AND CHK FOR UNDER-OVERFLOW AS WELL
	.IFDEF %FPP
	DST		/DOUBLE STR. FPPAC TEMP
	FP0
	LAC FP0
	TAD Z77400	/-400(8)
	SMA
	JMP GD11	/OVERFLOW
	TAD (1000)
	SPA!CLA
	JMP GD14	/UNDERFLOW
GD13	LAC FP0		/O.K.
	AND S00777	/GET EXP. BITS (LO NINE)
	DAC FP0		/STORE
	LAC FP2		/GET LO MANT.
	AND Z77000	/(777000)
	XOR FP0		/MERGE WITH EXP.
	DAC* DADR	/STORE IN MEM.
	LAC FP1		/GET HO MANT.
GD15	ISZ DADR	/STORE IN MEM. AFTER BUMP
	DAC* DADR
	JMP	ACSAV2	/EXIT
GD11	LAC Z77377	/OVERFLOW-PASS + OR - LARGEST REPR. VAL.
	DAC* DADR	/777377--LO BITS AND EXP
	LAC FP1
	SMA!CLC		/IF NEG.,PASS 777777 AS HIGH OR MANT.
	LAC V77777	/377777 IF POS.
	JMP GD15
GD14	DAC* DADR	/UNDERFLOW-  SET HO WORD TO 0
	JMP GD15
	.EJECT
	.ENDC
	.IFUND %FPP
/--CONVERT TO REAL
	LAC*	.AA
	SPA
	JMP	GD10		/NEG. EXP.
	AND	Z77400		/777400
	SZA			/SKP IF NO ILLEGAL BITS
	JMP	GD11		/OVFLO.: LD. LARG. VAL.
GD13	LAC*	.AC
	AND	Z77000		/GET FIRST 9 BITS
	XOR*	.AA		/EXP.
	DAC*	DADR		/LD. FIRST
	ISZ	DADR
	LAC*	.AB
	DAC*	DADR		/LD. SEC. WD.
	JMP	ACSAV2		/DONE: RTN.
GD11	LAC	Z77377		/777377 - LD. LARG. VAL.
	DAC*	DADR
	ISZ	DADR
	LAC*	.AB
	AND	W00000		/GET SIGN BIT
	XOR	V77777		/LD. LARG. MAG.
	DAC*	DADR		/LD. SEC. WD.
	JMP	ACSAV2		/DONE: RTN.
GD10	AND	Z77400		/
	XOR	Z77400		/=0 UNLESS TOO SMALL
	SZA
	JMP	GD14		/LD. 0
	LAC*	.AA
	AND	S00777		/SAVE EXP. BITS
	DAC*	.AA
	JMP	GD13
GD14	CLA
	DAC*	DADR
	ISZ	DADR
	DAC*	DADR
	JMP	ACSAV2
	.ENDC
	.EJECT
/J, INT., LOGICAL TEST
/  COME HERE IF NO EXP., GMS POS.
/  IF NO RNDNG., NO D.PT., CHK. NUM. AND VAR. TYPE AND DEPOSIT
/    DIRECTLY IF MATCH
/    ELSE, RTN. TO GNXP2
GJILT	LAC	RNDSW		/=1, NO; =0, YES
	AND	DPTSW		/=-1, NO; =0, YES
	SPA!SNA
	JMP	GNXP2		/ONE OR BOTH: RTN.
	LAC	SIGN1
	RCL			/L=0 IF POS.; =1 IF NEG.
	LAC	VTYPE
	SAD	S00003
	JMP	GJVAR		/J
	SZA			/NOT J
	JMP	GNXP2		/NOT I, RTN.
	LAC	GMS		/VAR. IS I OR L
	SZA
	JMP	GNXP2		/TOO LARGE, RTN.
	LAC	GLS
	SPA
	JMP	GNXP2		/TOO LARGE, RTN.
	SNL			/SKP IF NEG.
	JMP	GIVAR		/POS., DON'T COMPL.
	CMA
	TAD	S00001
GIVAR	DAC*	DADR		/DEPOSIT
	JMP	ACSAV2		/RTN.
GJVAR	SNL			/ - SKP IF NEG.
	JMP	GJVAR2		/POS.: DON'T COMPL.
	LAC	GLS
	CMA!CLL
	TAD	S00001
	DAC	GLS
	LAC	GMS
	SZL!CMA
	TAD	S00001
	DAC	GMS
GJVAR2	LAC	GMS
	DAC*	DADR
	ISZ	DADR
	LAC	GLS
	DAC*	DADR		/DEPOSIT BOTH WDS.
	JMP	ACSAV2		/RTN.
	.EJECT
/BAD INPUT DATA - TYPE MESS. AND RE-DO IF TTY
BDIND=.
	.IFUND	RSX
	LAC*	.FC6		/LINE BUFF. SIZE - INDIC. DEVICE
	SAD	S00042		/TTY L.B. SIZE
	JMP	GWREM		/TTY - WRITE ERR. MESS.
	JMS*	.ER
	42			/BAD D-D INPUT DATA
/ROUND GMS+GLS
GWREM	002776			/.WRITE TO .DAT -2 (TTY)
	11			/.WRITE CAL CODE
	.DSA	GEMBF
	-34
	000776		/.WAIT
	12
	LAW	-1		/SET TO RD. NEW RCD ON NEXT .GD
	DAC*	.SF
	LAW	-2
	TAD	.GD		/SET TO GO TO CURRENT .GD
	DAC	.GD
	JMP	ACSAV2		/AGAIN
GEMBF	GBFEN-GEMBF/2*1000+2	/HDR. WD. 0 FOR .WRITE
	0
	.ASCII 'BAD INPUT DATA - RETYPE FROM INPUT WITH ERROR'<15>
GBFEN=.				/END OF MESS. BUFF.
	.ENDC
/WITH RSX,DETERMINE IF TTY ASSIGNED TO LUN.  IF IT IS,OUTPUT
/RECOVR. OTS 42 WITH TASK NAME.  IF NOT,OUTPUT UNRECOVR. MESG.
	.IFDEF	RSX
	LAC*	.SLOT	/GET LUN.  SHOULD BE SET BY .FC ROUT. OF FIOPS.
	DAC	GLUN	/ALSO,ALREADY CHECKED FOR POS.  SET HINF
	CAL	GHINF	/HINF.  DETERMINE IF TTY.
	CAL	GWTFR	/WAITFOR
	LAC	EV1	/GET HANDLER INFO.  IF BITS 12-17=1,TTY.
	AND	(77)
	SAD	S00001	/1?
	JMP	ERREC	/YES.  RECOVR. OTS 42
	JMS*	.ER	/NO.  UNRECOVR. OTS 42
S00042	42
ERREC	JMS*	.ER
	400042
	LAW	-1	/SET TO RD. NEW REC. ON NXT. CALL TO .GD.
	DAC*	.SF
	LAW	-2
	TAD	.GD	/REDO.
	DAC	.GD
	JMP	ACSAV2
/CALL PARAM. BLKS.
GHINF	3600	/HINF
	EV1
GLUN	0	/LUN
/
GWTFR	20	/WAITFOR
	EV1
/
EV1	0	/EVENT VARIABLE
	.ENDC
	.EJECT
/DATA DIRECTED ARRAY INPUT
/CALLING SEQUENCE--
/	JMS*	.GE
/	.DSA	ADDR. OF DIMEN. INFO.
.GE	0
	LAC	GE2		/LD. .DSA .GD INTO .FA
	DAC*	.FA3
	LAC	.GE		/GET ADDR. FOR PTR. AND RTN.
	DAC*	.FA		/LD. INTO .FA 
	JMP*	.FA4		/ENTRY INTO .FA
GE2	.DSA	.GD
	.EJECT
/CALLING SEQUENCE--
/	JMS	GRND
GRND	0
	DZM	BINEX
GRND1	ISZ	BINEX
	JMS	GSHR1		/SH. RT. 1
	GLK			/LK.= FORMER BIT# 17 OF GLS
	TAD	GLS
	DAC	GLS
	SZL!CLL!CLA		/SKP IF GLS DIDN'T OVFLO.
	LAC	S00001
	TAD	GMS
	DAC	GMS
	SPA			/SKP IF GMS DIDN'T OVFLO
	JMP	GRND1		/DO AGAIN
	JMP*	GRND
	.EJECT
/SHIFT RT. 1, GMS+GLS
/CALLING SEQUENCE--
/	JMS	GSHR1
/	(ON RTN., LINK HOLDS OLD GLS BIT# 17
GSHR1	0
	LAC	GMS
	RCR
	DAC	GMS
	LAC	GLS
	RAR
	DAC	GLS
	JMP*	GSHR1
	.EJECT
/SHIFT GMS+GLS LEFT 1
/CALLING SEQUENCE--
/	JMS	GSHL1
/	(ON RTN., LINK HOLDS OLD GMS BIT# 0)
GSHL1	0
	LAC	GLS
	RCL
	DAC	GLS
	LAC	GMS
	RAL
	DAC	GMS
	JMP*	GSHL1
/MAKE GMS+GLS ABSOLUTE AND SET SIGN1 TO 777777
/RETURN AC MEANINGLESS
GAB	0
	LAW -1
	DAC SIGN1	/SET FLAG
	.IFUND %FPP
	LAC GLS		/LOAD MMQ WITH LS
	LMQ
	LAC GMS		/LOAD AC WITH MS
	JMS* .JA	/COMPL.
	DAC GMS		/RESTORE GMS+GLS
	LACQ
	DAC GLS
	.ENDC
	.IFDEF %FPP
	ELD		/LOAD EXT. INT
	GMS		/GMS,GLS CONTIG. LOCS.
	FAB		/MAKE ABSOLUTE
	0		/UNUSED
	EST		/RESTORE GMS+GLS
	GMS
	.ENDC
	JMP* GAB
	.EJECT
/LD. FPACC (UNSIGNED), NORMALIZE, ADD BINEX
/CALLING SEQUENCE--
/	JMS	GLFPA
GLFPA	0
	.IFDEF %FPP
	LAC GMS		/BUILD TEMP. FLT. PT. REPR. 
	DAC FP1		/IN PREP. FOR NORMAL.
	LAC GLS
	DAC FP2
	DZM GMS
	DZM GLS
	LAC S00043	/SET EXP.
	TAD BINEX	/ADJUST. EXP
	DAC FP0		/NOW NUM. IN FP0,FP1,FP2 READY FOR NORMAL.
	DLD		/NORMAL. DOUBLE LOAD--LOAD WILL AUTO NORM.
	FP0
	.ENDC
	.IFUND %FPP
	LAC	GMS
	DAC*	.AB
	DZM	GMS		/CLR. GMS FOR EXP.
	LAC	GLS
	DAC*	.AC
	DZM	GLS		/CLR. GLS FOR EXP
	LAC	S00043		/35(10)
	DAC*	.AA
	JMS*	.CD		/NORMALIZE
	LAC*	.AA
	TAD	BINEX		/ADJ. EXP.
	DAC*	.AA
	.ENDC
	JMP*	GLFPA
	.END