.TITLE	NPUT ; STORE FIELD INTO ARRAY
	.GLOBL	NPUT
;FORTRAN CALLABLE:
;	CALL NPUT(OUTADDR,OUTSKIP,INLEN,INADDR,INSKIP)
; WHERE THE ARGUMENTS MEAN:
;	INADDR=ADDRESS OF 1ST WORD TO MOVE DATA FROM
;	INSKIP=BITS TO SKIP FROM LEFT TO GET TO THE
;		FIRST DATA BIT TO MOVE
;	INLEN=NUMBER OF BITS IN THE FIELD TO MOVE (MAY BE
;		MORE THAN 8)
;	OUTADDR=ADDRESS OF FIRST WORD OF OUTPUT AREA TO GET
;		DATA.
;	OUTSKIP=NUMBER OF BITS TO SKIP IN THAT WORD TO GET TO
;		FIRST DATA BIT. NOTE THAT A SKIP OF 0 MEANS THE
;		HIGH BIT OF THE WORD IS TO RECEIVE THE DATA.
;
;	ALL REGISTERS PRESERVED BUT R5 ASSUMED TO POINT TO
;	STANDARD FORTRAN ARG BLOCK ON ENTRY.
;
;
;	UTILITY REG SAVE/RESTORE SUBS:
S.RSAV:
	MOV	R5,-(SP)	;JSR PC,S.RSAV SAVES REGS
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	JMP	@14(SP)		;BACK TO CALLER
S.RRES:				;JSR PC,S.RRES PUTS REGS BACK
	MOV	(SP)+,14(SP)	;COPY RETURN ADDRESS
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RTS	PC		;BACK AT LAST TO CALLER.
;
; THE ROUTINE ITSELF:
;
NPUT::
	JSR	PC,S.RSAV	;SAVE REGS TO USE HERE
	CMPB	@R5,#5		;RIGHT NUMBER OF ARGS?
	BEQ	DOIT
	JMP	EXIT
DOIT:
	CLR	-(SP)		;SAVE SPACE ON STACK
	CLR	-(SP)		;FOR START, END WORD MASKS.
	TST	(R5)+	;SKIP ARG COUNT
	MOV	(R5)+,-(SP)	;SAVE WSTART
	MOV	@(R5)+,-(SP)	;SAVE BSTART
	MOV	@(R5)+,-(SP)	;SAVE WC
	MOV	(R5)+,-(SP)	;SAVE ISTART
	MOV	@(R5)+,-(SP)	;SAVE ISTBIT
	MOV	SP,R4		;POINT R4 AT STACKED ARGS
BGNMSK=12	;MASK FOR FIRST OUTPUT WORD
ENDMSK=14	;MASK FOR LAST OUTPUT WORD (WHAT TO MOVE)
;THESE MASKS WILL BE APPLIED TO PREVENT MODIFICATION TO ANYTHING BUT
;THE BITS IT IS DESIRED TO MOVE.
WSTART=10
BSTART=6	;DEFINE OFFSETS OFF R4 TO ARGS ON STACK
WC=4
ISTART=2
ISTBIT=0
	MOV	#-1,R0		;SET UP INITIAL MASK TO CLEAR
	MOV	BSTART(R4),R1	;START BIT
;MASK OFF DATA ORIGINALLY IN WORD OUT WHERE IT WILL BE OVER-WRITTEN
	BIC	#-20,R1		;GUARANTEE START BIT IN 0-15 RANGE
		;(REALLY IT IS BITS TO SKIP IN WORD)
	BNE	22$		;IF NON-ZERO, SHIFT LOGIC OK
	CLR	R0		;BUT IF SKIPPING 0, SHIFT LOGIC FAILS
22$:
	SUB	#20,R1		;FORM NBITS-16. = - NO. BITS TO SHIFT OFF
	NEG	R1
	BIC	#-20,R1		;ZOT OUT ALL BUT 0-15 RANGE
	NEG	R1
	ASH	R1,R0		;SHIFT OFF UN-NEEDED BITS
	NEG	R1
	ASH	R1,R0		;THEN SHIFT BACK 0'S
	MOV	R0,BGNMSK(R4)	;SAVE START MASK, ALL 1'S WHERE DATA SHOULD
				;BE LEFT ALONE.
	MOV	WC(R4),R2	;GENERATE END MASK NOW
	ADD	BSTART(R4),R2	;BY ADDING SHIFTS
	MOV	#-1,R3		;SET UP INITIAL MASK
	BIC	#-20,R2		;MAKE A SHIFT COUNT UP
	BNE	122$		;IF NONZERO GO ON
	CLR	R3		;OTHERWISE FIX LOGIC UP
122$:	SUB	#20,R2		;DO AS ABOVE TO MAKE MASK FOR LAST STUFF
	NEG	R2
	BIC	#-20,R2		;"RANGE CHECK"
	NEG	R2
	ASH	R2,R3		;N.B. EIS ASSUMED!
	NEG	R2
	ASH	R2,R3		;SHIFT IN LOW ORDER 0'S AS NEEDED.
	MOV	R3,ENDMSK(R4)	;AND SAVE MASK OF BITS 1 WHERE
				;TOP OF DATA SHOULD BE LEFT ALONE.
	MOV	WC(R4),-(SP)	;SEE IF MUST MASK 1ST OUT WORD
	ADD	BSTART(R4),(SP)	;BY CHECKING SUM OF START,LENGTH BITS
	CMP	(SP)+,#20	;AGAINST 16.
	BHIS	100$		;IF NOT, USE BGNMSK ONLY
	TST	R3		;SEE IF R3 == 0
	BEQ	101$		;IF NOT ALL OK
	COM	R3		;GET MASK WITH LOW BITS ON
	BIS	R3,R0		;MASK MAY BE OF FORM 170177 NOW ...
101$:
100$:
	COM	R0		;MAKE UP A MASK LIKE 007600...
	BIC	R0,@WSTART(R4)	;AND BASH THOSE BITS FOR LATER BIS OPERATION.
	MOV	ISTBIT(R4),R3
	SUB	BSTART(R4),R3	;GET BIT LOC AND FIGURE OUT HOW FAR TO
				;SHIFT
	BPL	1$
	NEG	R3		;NEGATIVE, SO NOW GUARANTEE LEGAL RANGE...
	BIC	#-20,R3		;GUARANTEE IN 0-15 RANGE OR 0--15
	NEG	R3		; NOW MAKE IT 0 TO -15 AS REQUIRED
	BR	2$
1$:	BIC	#-20,R3		;PERFORM ELABORATE RANGE CHECK ON POS. SHFT.
2$:
	MOV	WSTART(R4),R0	;START WORD OUT
	MOV	ISTART(R4),R1	;AND IN (ADDRESSES...)
	MOV	WC(R4),R2	;WORDS TO DO
	BEQ	CLNSTK		;NO LENGTH MEANS NO COPY...
;	ADD	R1,R2		;TACK IN NO. BITS SKIPPED IN...
	MOV	R5,-(SP)	;SAVE R5,R4
	MOV	R4,-(SP)
	CLR	-(SP)		;BGN MASK
	CLR	-(SP)		;END MASK
	MOV	BGNMSK(R4),2(SP)	;SAVE BGN MASK
	BEQ	130$		;IF 0, LEAVE
130$:	MOV	ENDMSK(R4),(SP)	;END MASK
	BEQ	131$
	COM	@SP		;MAKE RIGHT FORM FOR BIC INSTRUCTION...
131$:
	TST	R3		;WHICH WAY DO WE SHIFT?
	BPL	10$		;LEFT SHIFT (OR NO SHIFT)
	MOV	(R1)+,R5	;L.O. RIGHT SHIFT
	MOV	-4(R1),R4		;H.O.
	ASHC	R3,R4		;SHIFT DATA RIGHT
	BIC	2(SP),R5	;ALWAYS MASK 1ST WORD WITH BGNMSK (WHICH
				;COULD BE 0)
	MOV	16(SP),-(SP)	;NOW SEE IF THIS WORD MASKS WITH ENDMSK TOO
	BGE	140$		;IF NEGATIVE MAKE IT +
	NEG	@SP
140$:				;NOW @SP IS SKIP COUNT.
	ADD	R2,(SP)	;IF OUT SKIP + SIZE > 16. NO MASK SINCE NOT
				;SAME WORD.
	CMP	(SP)+,#20	;IS END IN SAME WORD?
	BHIS	132$		;IF NOT SKIP
	BIC	(SP),R5		;ELSE MASK
132$:
	BIS	R5,(R0)+	;SET BITS INTO OUTPUT FIRST TIME THRU
	BR	20$
10$:	MOV	(R1)+,R4	;SHIFT H.O. LEFT WORD
	MOV	(R1),R5	;LEFT SHIFT WORD N-1
	ASHC	R3,R4
	BIC	2(SP),R4	;MASK WITH BGNMSK ALWAYS
	MOV	16(SP),-(SP)
	ADD	R2,(SP)		;SEE IF END MASKS SAME WORD
	CMP	(SP)+,#20	;SEE IF SAME WORD BY BIT COUNT
	BHIS	133$
	BIC	(SP),R4		;IF SO, MASK HERE TOO...
133$:
	BIS	R4,(R0)+	;LEAVE BITS IN OUTPUT ON IF THERE NOW
20$:	SUB	#20,R2		;DECREASE WORD COUNT BY 1
	MOV	4(SP),-(SP)	;GET OLD R4
	ADD	#BSTART,(SP)	;POINT AT # BITS TO SKIP IN OUTPUT
	ADD	@(SP)+,R2	;ADD IN SKIPPED BITS.
	BLE	30$		;BE SURE ANY ARE LEFT
40$:	TST	R3		;CHECK RIGHT OR LEFT SHIFT REQUIRED
	BPL	41$
	MOV	(R1)+,R5	;L.O. = WORD N FOR RIGHT SHIFT
	MOV	-4(R1),R4		;H.O. = WORD N-1 FOR RIGHT SHIFT
	ASHC	R3,R4		;SHIFT BY BIT DIFFERENCE
	CMP	R2,#20		;1 WORD OR LESS LEFT?
	BHI	150$		;IF MORE, USE MOV.
	MOV	R4,-(SP)	;IF NOT, GRAB END MASK
	MOV	2(SP),R4	;TO A REG
	BIC	R4,R5		;ZAP OUT R5 BITS
	COM	R4
	BIC	R4,@R0		;AND OTHER BITS IN DATA AREA
	BIS	R5,(R0)+
	MOV	(SP)+,R4	;RESTORE R4
	BR	151$
150$:				;NORMAL CASE IS MOV
	MOV	R5,(R0)+	;SAVE L.O. FOR RIGHT SHIFT
151$:	BR	42$
41$:	MOV	(R1)+,R4	;H.O. = WORD N FOR LEFT SHIFT
	MOV	(R1),R5	;L.O. = WORD N-1 FOR LEFT SHIFT
	ASHC	R3,R4		;SHIFT BY BIT DIFFERENCE
	CMP	R2,#20		;1 WORD OR LESS LEFT?
	BHI	152$		;IF MORE USE MOV
	MOV	R5,-(SP)	;SAVE OLD R5
	MOV	2(SP),R5
	BIC	R5,R4		;ZAP DATA
	COM	R5
	BIC	R5,@R0		;AND OTHER BITS OF OUTPUT DATA
	BIS	R4,(R0)+	;SET DATA BACK AGAIN...
	MOV	(SP)+,R5	;FIX UP R5
	BR	153$
152$:
	MOV	R4,(R0)+	;SAVE DATA
153$:
42$:	SUB	#20,R2
	BGT	40$		;DO ALL WORDS LEFT TO DO
30$:	CMP	(SP)+,(SP)+	;FLUSH COPIES OF MASKS.
	MOV	(SP)+,R4
	MOV	(SP)+,R5	;RESTORE R4,R5
CLNSTK:	ADD	#16,SP		;POP ARGS OFF STACK
EXIT:	JSR	PC,S.RRES	;GET REGS BACK 	(COMMON EXIT)
	RTS	PC		;BACK TO CALLER
	.END