/  LBYT  --  SBYT

/LBYT FUNCTION SUBROUTINE PROGRAMMED BY MIKE ALLEN
/TO LOAD A BYTE OF LENGTH 'ARG3' FROM WORD 'ARG1' AND
/STORE IN THE FIXED ACCUMULATOR, WHERE 'ARG2' IS POSITION
/OF RIGHTMOST (LEAST SIGNIFICANT) BIT OF BYTE.
/(NOTE: LEFTMOST BIT POSITION OF WORD IS ZERO.)
/CALLING SEQUENCE:
/	CALL 3,LBYT	/CALL SUBROUTINE
/	ARG1		/INTEGER FROM WHICH BYTE IS TAKEN
/	ARG2		/LEAST SIG. BIT POSITION OF BYTE
/	ARG3		/BYTE LENGTH

/ MODIFIED BY PHILLIP SIEMENS
/	LAWRENCE LIVERMORE LABORATORY
/	SEPTEMBER 8, 1975

/TO DEFINE NEW SYMBOLS FOR EAE
OPDEF	DVI 7404
OPDEF	NMI 7411
OPDEF	SHL 7413
OPDEF	ASR 7415
OPDEF	LSR 7417
OPDEF	MQL 7421
OPDEF	MUY 7405
OPDEF	MQA 7501
OPDEF	CAM 7621
OPDEF	SCA 7441
OPDEF	JMPI 5400
OPDEF	TADI 1400
OPDEF	DCAI 3400

	ENTRY LBYT
	ENTRY SBYT
/////////////
LBYT,	6140
	0002
	JMS GETARG	/GET WORD CONTAINING BYTE
	SNA		/IS IT ZERO?
	JMP QUXIT	/YES. MAKE A QUICK EXIT
	DCA KWORD	/NO. SAVE IT
	JMS GETARG	/GET BIT POSITION OF LSB
	DCA LFTADJ	/INITIALIZE SHIFT LEFT COMMAND
	TAD KWORD	/GET WORD
	MQL SHL		/PUT RIGHTMOST BIT IN AC11
LFTADJ,	0
	DCA KWORD	/SAVE RIGHT-ADJUSTED BYTE
	JMS GETARG	/GET BYTE LENGTH AND SUBTRACT ONE
	TAD (-1
	SPA		/LOGICAL OR LEGAL BYTE LENGTH?
	CLA CMA
	DCA MSKMOV	/PROBABLY OK
	STA
	MQL SHL		/POSITION MASK IN AC
MSKMOV,	0
	AND KWORD	/MASK OFF UNWANTED BITS
XIT,	MQL		/SAVE AC
	CLA CLL CML RTL	/GET A 2
	TAD LBYT
	DCA XIT2
	MQA		/GET AC BACK
XIT2,	HLT		/DO FAST EXIT
	JMPI LBYT#

QUXIT,	TAD (4
	TAD LBYT#
	DCA LBYT#	/INCREMENT EXIT POINTER BY 4
	JMP XIT
KWORD,	0		/HOLDS BYTE AFTER SHIFTING

GETARG,	0		/GET AN ARGUMENT
	TAD LBYT
	DCA GET1	/SET UP CDF TO FROM FIELD
GET1,	HLT		/CHANGE DF TO FROM FIELD
	TADI LBYT#
	DCA GET2	/SET UP CDF TO ARG FIELD
	INC LBYT#	/BUMP POINTER
	TADI LBYT#
	DCA XIT2	/POINTER TO ARG
	INC LBYT#	/BUMP POINTER
GET2,	HLT		/CHANGE DF TO ARG FIELD
	TADI XIT2	/GET ARG
	JMPI GETARG
////////////
/SBYT SUBROUTINE
/THIS SUBROUTINE WILL LOAD A BYTE FROM 'ARG4',
/LEFT ADJUST BY 'ARG2' PLACES AND STORE IN 'ARG1',
/WHERE 'ARG3' IS THE BYTE LENGTH
/(NOTE: LEFTMOST BIT POSITION OF WORD IS ZERO).
/CALLING SEQUENCE:
/	CALL 4,SBYT	/CALL SUBROUTINE
/	ARG1		/INTGER IN WHICH BYTE IS INSERTED
/	ARG2		/BIT POSITIONS TO LEFT-ADJUST BYTE
/	ARG3		/BYTE LENGTH
/	ARG4		/RIGHT-ADJUSTED BYTE INTEGER



TEMARG,	BLOCK 2
SBYT,	6140
	0002
	TAD SBYT	/MOVE POINTERS
	DCA LBYT	/SO GETARG
	TAD SBYT#	/CAN USE THEM
	DCA LBYT#
	JMS GETARG	/GET STORAGE WORD
	DCA TEMARG	/SAVE IT
	DCA MSKMOV	/CLEAR ZERO SHIFT FLAG
	TAD GET2	/SAVE ARG FIELD
	DCA SB2
	TAD XIT2	/SAVE ARG POINTER
	DCA SBYT#
	JMS GETARG	/GET # OF RIGHT SHIFTS
	TAD (-1
	SPA		/SHIFT REQUIRED?
	JMP NOSHFT	/NO. DON'T SHIFT THIS BYTE
	DCA RSHIFT	/YES. INITIALIZE SHIFTING INSTR.
	TAD TEMARG	/GET ORGINAL WORD
	LSR		/RIGHT ADJUST BYTE POSITION
RSHIFT,	0
	DCA TEMARG	/SAVE UPPER BITS
	MQA		/GET LOW BITS
	DCA TEMARG#	/SAVE THEM ALSO
	TAD RSHIFT	/GET NUMBER OF SHIFTS DONE
	DCA LSHIFT	/INIT SHIFT INSTR TO RESTORE WORD
THDARG,	JMS GETARG	/GET # OF BITS IN BYTE
	TAD (-1
	SPA		/BYTE OF ZERO WIDTH?
	JMP QXIT	/YES. EXIT QUICKLY
	DCA MSKGEN	/NO. INITIALIZE MASK GENERATOR
	JMS GETARG	/GET BYTE
	DCA SBYT	/AND SAVE IT FOR LATER
	STA		/SET AC=-1
	MQL SHL		/GENERATE THE MASK
MSKGEN,	0
	DCA KWORD	/SAVE IT
	TAD KWORD	/GET IT AGAIN
	CMA		/COMPLEMENT IT
	AND TEMARG	/MASK OFF UNDESIRED BITS
	DCA TEMARG	/SAVE IT AGAIN
	TAD MSKMOV	/GET SHIFTING FLAG
	CLL RAL		/INITIALIZE LINK
	CLA
	TAD TEMARG#	/GET LOW BITS OF ORIGINAL WORD
	MQL		/RETURN THEM TO THE MQ
	TAD KWORD	/GET MASK AGAIN
	AND SBYT	/EXTRACT DESIRED BYTE
	TAD TEMARG	/INSERT BYTE INTO ORGINAL WORD
	SZL		/SHIFT THIS WORD TO RESTORE IT?
	JMP LSHIFT#	/NO
	SHL		/YES. REPOSITION WORD IN AC
LSHIFT,	0
SB2,	HLT		/SET TO ARG FIELD
	DCAI SBYT#	/PUT ANSWER THERE
	JMP XIT		/EXIT QUICK

NOSHFT,	STA
	DCA MSKMOV	/INITIALIZE ZERO SHIFT FLAG
	JMP THDARG
QXIT,	CLA
	INC LBYT#	/ADD 2 TO EXIT POINTER
	INC LBYT#	/TO SKIP NEXT ARGUMENT
	JMP XIT
	END