.TITLE	PARTWORD ROUTINES FOR FORTRAN OTS
/ 
/ 
/                   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, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
/EDIT #003	7-14-71
/FOR THE FPP, DEFINE %FPP
	.GLOBL	.PB,.PC,PARTWD
ECLA=641000
	.DEFIN	TAD1
	.IFDEF	%PDP9
	TAD	(1
	.ENDC
	.IFUND	%PDP9
	IAC
	.ENDC
	.ENDM
/DIRECT ASS. FOR FPP
	.IFDEF %FPP
ELD=713100		/EXT. INTEGER LOAD
EST=713700		/EXT. INTEGER STORE
	.ENDC
PARTWD=.
/
.PB	CAL	0		/PARTWORD LOAD ROUTINE
	LAC*	.PB
	SMA
	JMP	.+3
	DAC	TMP
	LAC*	TMP		/SIGN OF ARG PTR=1 MEANS INDIRECT
	DAC	TMP
	TAD1
	DAC	TM2
	ISZ	.PB
	LAC*	.PB		/GET CONTROL WORD
	JMS	GETMSK		/GET BIT MASK AND INITIAL SHIFT NUMBER
	TAD	(LRS 0
	DAC	INSTB
	LAC*	TM2
	LMQ
	LAC*	TMP
INSTB	HLT			/SHIFT RIGHT PROPER AMOUNT
	SNL			/LINK=DOUBLEWORD FLAG FROM GETMSK
	LACQ
	AND	MASK		/AND IN BIT MASK FROM GETMSK
	ISZ	.PB
	.IFDEF %FPP
/IF DOUBLE WORD FLAG SET,LEAVE RESULT IN FPP AC.  OTHERWISE
/LEAVE RESULT IN CPU AC
	SNL		/LINK=DOUBLEWORD FLAG(GETMSK)
	JMP* .PB	/NO FLAG,EXIT(RESULT IN CPU AC)
	DAC TMP		/AC-MQ TO MEMORY FOR FPP AC LOAD.
	LACQ
	DAC TM2	/TMP AND TM2 ARE CONTIG. LOCS
	ELD		/LOAD FPP AC
	TMP
	.ENDC
	JMP*	.PB
/
.PC	CAL	0		/PARTWORD STORE ROUTINE
	.IFDEF %FPP
/IF FPP,ARG IN FPP AC ON ENTRY.
	EST	/STORE FPP AC IN TM3-TM4
	TM3
	.ENDC
	.IFUND %FPP
/IF NO FPP,ARE IN AC-MQ ON ENTRY.
	DAC	TM3
	LACQ
	DAC	TM4
	.ENDC
	LAC*	.PC
	SMA
	JMP	.+3
	DAC	TMP
	LAC*	TMP		/SIGN BIT OF ARG PTR INDICATES INDIRECT
	DAC	TMP
	DAC	TM2		/TM2 IS BACKUP PTR
	ISZ	.PC
	LAC*	.PC
	JMS	GETMSK		/GET BIT MASK AND SHIFT COUNT
	TAD	(LLS 0
	DAC	INSTC
	CLQ!CMQ
	CLA!CMA			/SET AC,MQ=777777777777
	JMS	DOOP		/USE DOOP TO ZERO OUT TARGET AREA
	JMS	CMPAND		/THIS IS AN ARGUMENT TO DOOP
	LAC	TM4
	LMQ
	LAC	TM2
	DAC	TMP
	LAC	TM3
	JMS	DOOP		/NOW USE DOOP TO OR IN DESIRED VALUE
	XOR*	TMP		/THIS IS AN ARGUMENT TO DOOP
	ISZ	.PC
	JMP*	.PC
/
DOOP	CAL	0		/PERFORM A TASK ON A BIT SEGMENT
	SNL			/LINK CONTAINS DOUBLEWORD FLAG
	LACQ
	AND	MASK		/AND MASK WITH HI OR LO ORDER
	SNL			/DOUBLEWORD?
	LMQ!ECLA		/NO - LOAD MQ AND CLEAR AC
	DZM	GETMSK
	SZL!CLL		/SAVE LINK
	ISZ	GETMSK
INSTC	HLT		/SHIFT AC,MQ LEFT TO PROPER POSITION,
	XCT*	DOOP		/PERFORM OPERATION ON WORD 1
	DAC*	TMP		/RESTORE WORD 1
	ISZ	TMP
	LACQ
	XCT*	DOOP		/NOW PERFORM IT ON WORD 2
	DAC*	TMP		/RESTORE WORD 2
	LAC	GETMSK
	RAR		/RESTORE LINK
	ISZ	DOOP
	JMP*	DOOP
/
CMPAND	CAL	0		/"COMPLEMENT AND" ROUTINE FOR .PC
	CMA			/USED IN CONJUNCTION WITH DOOP
	AND*	TMP
	JMP*	CMPAND
/
GETMSK	CAL	0		/GET MASK AND SHIFT COUNT
	DAC	CMPAND
	LRSS	11		/THIS PUTS THE DBLWD FLAG IN THE LINK
	AND	(77		/GET WIDTH COUNT
	TAD	(LLS 0
	DAC	INSTA
	ECLA!CLQ!CMQ
INSTA	HLT			/SHIFT MASK IN
	DAC	MASK
	LAC	CMPAND
	AND	(77
	JMP*	GETMSK		/RETURN WITH SHIFT COUNT IN AC
				/AND DOUBLEWORD FLAG IN LINK
/
/DON'T CHANGE ORDER OF THE FOLLOWING 4 REGISTERS.
/ALSO KEEP CONTIGUOUS.
TMP	.DSA	0
TM2	.DSA	0
TM3	.DSA	0
TM4	.DSA	0
/
/
MASK	.DSA	0
	.END