/
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)		1978,1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/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 RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED 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 PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/VERSION=1
/
	.TITLE SUBROUTINE PACK6

/THIS SERVICE ROUTINE PROVIDES FOR PACKING ASCII DATA IN SIXBIT
/FORMAT, PRIMARILLY FOR USR CALLS. 

	.FSECT PACK6
	.EXTERNAL PACPTR,EPAC,CLR
	.EXTERNAL TABLE1,PCKPTR,TTYPTR,EPACK
	.EXTERNAL TEMP1,TEMP2,TEMP3,TEMP4,TEMP5
	.ENTRY PAC1
	.NOLIST LN
	XLIST
	.INCLUDE MACLIB.MA
	XLIST
	.MCALL ,,CLEAR



/CALLING SEQUENCE:
/
/	CDF	.FLD
/	CIF	PAC1
/	JMS I	SUB
/	ARG1
/	 .
/	 .
/	 .
/SUB,	PAC1
/
/WHERE:
/	ARG1 - SOURCE BUFFER



/THIS ROUTINE TAKES THE UNPACKED SIX-BIT CODE IN THE SOURCE TABLE,
/AND PACKS THE CODE IN SIXBIT FORMAT. (FOR USERV CALLS.)

PAC1,	0
	CLA
	TAD I	PAC1
	DCA	SBUF
	ISZ	PAC1
					/GET PARAMETER PASSED BY CALLER
					/THEN INCREMENT PAST ARG1

	TAD	F1
	RDF
	CDF	.FLD
	DCA	PAC16
					/SETUP FOR RETURN
	CLEAR	PACPTR,EPAC,TABLE1,0,SUBR
					/CLEAR OUTPUT TABLE
	CDF	TABLE1
	TAD	F2
	DCA I	F3
					/HANDLES 12 UNPACKED WORDS
	TAD	10
	DCA I	F4
	TAD	11
	DCA I	F5
					/SAVE AUTOINDEX REGISTERS
	TAD	SBUF
	DCA	10
	TAD I	F6
	DCA	11
					/SETUP FOR AUTO INDEX
PAC2,	TAD I	10
					/GET FIRST CHARACTER
	AND	F12
	TAD	F13
	TAD	CR
	SNA
	JMP	PAC15
					/IF CARRIAGE RETURN,PACKING IS COMPLETED
	TAD	CRP
	AND	F7
	DCA I	F10
					/MASK LOWER SIX BITS AND TEMP STORE
	TAD I	10
					/GET SECOND CHARACTER
	AND	F12
	TAD	F13
	TAD	CR
	SNA
	JMP	PAC14
					/CHECK FOR CARRIAGE RETURN
	TAD	CRP
	AND	F7
	DCA I	F11
					/MASK BITS 4 AND 5
	TAD I	F10
	CLL
	RTL;RTL;RTL
	TAD I	F11
	DCA I	11
					/FORM SIXBIT AND STORE
	ISZ I	F3
	JMP	PAC2
					/NOT DONE, GO AGAIN
PAC15,	TAD I	F4
	DCA	10
	TAD I	F5
	DCA	11
PAC16,	0
	JMP I	PAC1
					/RESTORE AUTOINDEX AND RETURN
PAC14,	CLA
	CLL
	TAD I	F10
	RTL;RTL;RTL
	DCA I	11
	JMP	PAC15

SUBR,CLR	/POINTER TO CLEAR ROUTINE
CR,-215		/CARRIAGE RETURN CODE
CRP,215
SBUF,0		/STORAGE FOR POINTER TO SOURCE BUFFER
F1,	CIF CDF
F2,	-6
F3,	TEMP1
F4,	TEMP2
F5,	TEMP3
F6,	PACPTR
F7,	77
F10,	TEMP4
F11,	TEMP5
F12,177
F13,200