.TITLE EDCODE
/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/COPYRIGHT 1971,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/
/EDIT #003  15 FEB 73   TAM*REF(2)*
/
/ 004	27-APR-76	G. A. REID	FIX TO 
/				INITIALIZE THE MASS
/				STORAGE SWITCH (.MSDEV).
/
/OBJECT-TIME SYSTEM ROUTINES FOR ENCODE/DECODE
/  A SPECIFIED NUMBER OF CHARACTERS, C (RAISED TO A
/    MULTIPLE OF 5), DEFINES A RECORD OF
/    (C X (5/2)) WORDS OF AN ARRAY, V, INTO WHICH
/    ALPHANUMERIC DATA FROM THE I/O DATA LIST IS
/    PLACED (ENCODE), OR FROM WHICH THE I/O DATA
/    LIST IS FILLED (DECODE).
/
/ROY FOLK
/
/
/INTERNAL GLOBALS--
	.GLOBL	.GF	/ENCODE INIT. ROUTINE
	.GLOBL	.GG	/DECODE INIT. ROUTINE
	.GLOBL	EDCODE
EDCODE=.
/EXTERNAL GLOBALS--
	.GLOBL	.FH	/R/W FLAG (FIOPS)
	.GLOBL	.FM	/WDS. PER RCD. +2 (FIOPS)
	.GLOBL	.FN	/ADR. OF L.B. (FIOPS)
	.GLOBL	.STEOR	/ADR. OF PROPER EOR ROUTINE (BCDI0)
	.GLOBL	.INILB	/INIT. L.B. (BCDI0)
	.GLOBL	.INISA	/INIT. FOR SEQ. ACC. (BCDI0)
	.GLOBL	.HILIM	/ADR. OF LAST WD. OF RCD. IN L.B. (BCDI0)
	.GLOBL	.INIFD	/INIT. FORM DECODER (BCDI0)
	.GLOBL	.HIFLG	/NON-0 IF L.B. FILLED (BCDI0)
	.GLOBL	.SCC	/CHAR. CNTR. (BCDI0)
	.GLOBL	.PBLKS	/PACK BLANKS (BCDI0)
	.GLOBL	.LBADD	/L.B. ADR. (BCDI0)
	.GLOBL	.ER	/ERROR (OTSER)
	.GLOBL	.FSTFL		/1ST CHR. FLG.: =-1 FOR ENCODE
	.GLOBL	.MSDEV		/(GAR-004) MASS STORAGE SWITCH
/
/CONSTANTS
S00001	1
K00001	-1
K00625	-1161
K00005	-5
S00002	2
K00003	-3
S17777	17777
S77777	77777
ADEER	.DSA	ENEOR
ADBGN	.DSA	DBGNR
BLKSCR	.ASCII '    '<015>
/  WORKING STORAGE
ARGAD	0			/PTR. TO ADR. OF ARGS. OF INIT. ROUTINES
ERMSEN	0			/ERROR MESS. ENABLE
CHRS	0			/NUM. OF CHARS. PER RCD.
STAADR	0			/ST. ADR. OF ARRAY VAR.
LSTAAD	0			/LAST ARRAY WD. ADR.
TEMP	0
BUFIDX	0			/BUFFER INDEX
ARAY=LSTAAD			/ARRAY
	.EJECT
/ENCODE INITIALIZATION ROUTINE
/CALLING SEQUENCE--
/	JMS	.GF
/	.DSA	C		/NUMBER OF CHARS. PER RCD.
/	V			/ARRAY VARIABLE
/	.DSA	F		/FORMAT STATEMENT
.GF	0
	LAC	S00001
	DAC*	.FH		/INIT. FOR WRITING
	LAC	.GF
	DAC	ARGAD
	JMS	EDCOM		/GET ARGS., SET POINTERS
	LAC	ADEER		/ADR. OF ENEOR
	DAC*	.STEOR		/INIT. BCDIO FOR ENCODE
	JMS*	.INILB		/INIT. LINE BUFFER
	LAW	-1
	DAC*	.FSTFL		/SET 1ST CHR. FLG. IN BCDIO
	JMP*	ARGAD		/ADR.AFTER .GF ARGS
	.EJECT
/DECODE INITIALIZATION ROUTINE
/CALLING SEQUENCE--
/	JMS	.GG
/	.DSA	C		/NUM. OF CHARS. PER RCD.
/	V			/ARRAY VARIABLE
/	.DSA	F		/FORMAT STATEMENT
.GG	0	
	DZM*	.FH		/INIT. FOR READING
	LAC	.GG
	DAC	ARGAD
	JMS	EDCOM		/GET ARGS., SET PTRS.
	LAC	ADBGN		/ADR. OF EDBGN
	DAC*	.STEOR		/.INIT BCDIO FOR DECODE
	JMS	DBGNR		/SET UP BUFFER
	JMP*	ARGAD		/ADR. AFTER .GG ARGS.
	.EJECT
/ENCODE/DECODE COMMON INITIALIZATION ROUTINE
/CALLING SEQUENCE--
/	JMS	EDCOM
EDCOM	0
	LAC	(NOP)		/(GAR-004) SET UP SWITCH TO ...
	DAC*	.MSDEV		/(GAR-004) INDICATE MASS STORAGE DEVICE.
	ISZ	ERMSEN		/SET ERROR MESS. ENABLE
	JMS*	.INISA		/INIT. FOR SEQ. ACC.
/GET C, RAISE TO NXT HIGHEST MULT. OF FIVE, GET WORDS
/  PER RECORD, SET .HILIM
	LAC*	ARGAD		/GET ADDR. OF C
	DAC	CHRS		/CHARACTERS
	SPA			/IF T.VECTOR, GO ONE MORE
	LAC*	CHRS		    /LEVEL OF INDIRECT
	DAC	CHRS
	LAC*	CHRS
	DAC	CHRS		/NOW, CHRS HOLDS NUM. OF CHARS.
	SNA
	JMP	ERR40		/0 CHARS. ILLEGAL
	TAD	K00625		/-625(10)
	SMA!SZA
	JMP	ERR40		/MORE THAN 625(10) CHARS. ILLEGAL
/--GET WDS. PER RCD.
	LAC	CHRS
	DZM*	.FM
EDC1	TAD	K00005		/-5
	ISZ*	.FM		/INCREM. FOR EACH WD. PAIR
	SMA!SZA
	JMP	EDC1		/MORE
	LAC*	.FM		/WD. PRS. PER RCD.
	TAD*	.FM
	TAD	S00002		/2 HEADER WORDS
	DAC*	.FM		/NOW HOLDS WORDS PER RECORD
	TAD	.FN		/STARTING ADR. OF L. BUFF.
	TAD	K00001
	DAC*	.HILIM		/ADR. IN L. BUFF., OF LAST WD. OF RCD.
/GET V AND FIND STARTING ADR. (STAADR) AND LAST ADR.
/  (LSTAAD) OF ARRAY
	ISZ	ARGAD
	LAC*	ARGAD		/GET ARRAY VAR. ADR.
	DAC	ARAY
	SPA			/IF T. VECTOR, GO ONE MORE
	LAC*	ARAY		    /LEVEL OF INDIRECT
	DAC	ARAY		/AC=ADR. OF WD. 5 OF DESCRIP. BLOCK
	LAC*	ARAY
	TAD	K00001
	DAC	STAADR		/HOLDS ADR. BEFORE FIRST WD. OF ARRAY
	LAC	ARAY
	TAD	K00003		/AC=ADR. OF WD. 2 OF ADB
	DAC	ARAY
	LAC*	ARAY		/AC=WD. 2, SIZE OF ARRAY
	TAD	STAADR
	DAC	LSTAAD		/LAST ARRAY WD. ADR.
/GET F AND INIT.	FORMAT DECODER
	ISZ	ARGAD
	LAC*	ARGAD		/GET FORMAT STATEMENT ADR.
	DAC	TEMP
	SPA			/IF T.V., GO ONE MORE LEVEL
	LAC*	TEMP		    /OF INDIRECT
	JMS*	.INIFD		/INIT. FORMAT DECODER
	ISZ	ARGAD		/PTS. TO ADR. AFTER .GF OR .GG ARGS
	JMP*	EDCOM
	.EJECT
/ENCODE END OF RCD.
/CALLING SEQUENCE--
/	JMS	ENEOR
ENEOR	0
	LAC*	.HIFLG		/IF L. BUFF. NOT FULL, PAD W/ BLANKS
	SZA
	JMP	ENEOR1
	LAC*	.SCC
	CMA
	TAD	S00001
	JMS*	.PBLKS		/PACK BLANKS
ENEOR1	LAC*	.LBADD
	SAD*	.HILIM		/SKP IF PTR. NOT AT LAST WD. OF RCD
	JMP	ENEOR2
	LAW	5		/PK. BLANKS UNTIL RECORD FILLED
	JMS*	.PBLKS
	JMP	ENEOR1
/TRANSFER BUFFER TO ARRAY
ENEOR2	LAC	.FN
	TAD	S00002
	DAC	BUFIDX		/BUFFER INDEX
ENEOR5	LAC	STAADR
	SAD	LSTAAD		/SKP IF ARRAY NOT FILLED
	JMP	ENEOR3		/ARRAY FILLED
	ISZ	STAADR
	LAC*	BUFIDX
	DAC*	STAADR
	LAC	BUFIDX
	SAD*	.HILIM		/SKP IF RCD. NOT EXHAUSTED
	JMP	ENEOR4		/RCD. DONE
	ISZ	BUFIDX
	JMP	ENEOR5		/MORE
ENEOR3	JMS	ERTST		/TEST FOR ERROR
ENEOR4	JMS*	.INILB		/.INIT. LIB.
	LAW	-1
	DAC*	.FSTFL		/SET TO INDIC. ENCODE IN BCDIO
	JMP*	ENEOR
	.EJECT
/DECODE BEGIN RECORD
/  LOADS LINE BUFFER FROM ARRAY VAR. FOR SUBSEQUENT
/    READ INTO I/O LIST
/CALLING SEQUENCE--
/	JMS	DBGNR
DBGNR	0
	LAC	.FN
	TAD	S00002
	DAC	BUFIDX
/IF ERMSEN IS DISABLED AT THIS POINT, THEN ARRAY HAS
/  BEEN EXHAUSTED-FOR THE REST OF THE I/O LIST,
/  PUT '    CR' IN BUFFER AND READ.
DBGNR3	LAC	STAADR
	SAD	LSTAAD
	JMP	DBGNR1		/ARRAY EXHAUSTED
	ISZ	STAADR
	LAC*	STAADR
	DAC*	BUFIDX
	LAC	BUFIDX
	ISZ	BUFIDX
	SAD*	.HILIM
	JMP	DBGNR2		/RCD. FILLED
	JMP	DBGNR3
DBGNR1	JMS	ERTST		/ERROR MESS. TEST
/PUT '	  CR' BELOW RCD. IN L. BUFF.
DBGNR2	LAC	BLKSCR
	DAC*	BUFIDX
	ISZ	BUFIDX
	LAC	BLKSCR+1
	DAC*	BUFIDX
	JMS*	.INILB		/INIT. L.BUFF.
	JMP*	DBGNR
	.EJECT
/ERROR MESSAGE TEST
/CALLING SEQUENCE--
/	JMS	ERTST
ERTST	0
	LAC	ERMSEN
	SNA			/SKP IF ENABLED
	JMP*	ERTST		/DISABLED-RTN
	JMS*	.ER
	400041			/ARRAY FILLED  (RECOVERABLE)
	DZM	ERMSEN		/DISABLE SWITCH
	JMP*	ERTST
ERR40	JMP*	.ER
	40			/ILL. NUM. OF CHARS.
	.END