File: ISHFT.MA of Tape: Sources/Other/new-16
(Source file text) 

	.TITLE	ISHFT	FORTRAN IV COMPATIBLE LOGICAL SHIFT
	.ENABL	AMA
;
;THIS ROUTINE IMPLEMENTS THE INTEGER*2 LOGICAL FUNCTION ISHFT.
;IT IS CALLED BY
;
;	RESULT=ISHFT(VARIABLE,COUNT)
;
;IF COUNT =0, NO SHIFT OCCURS.
;IF COUNT >0, A LEFT SHIFT OCCURS.
;IF COUNT <0, A RIGHT SHIFT OCCURS.
;
	.GLOBL	ISHFT

	R0=%0
	R1=%1
	R2=%2
	R3=%3
	R4=%4
	R5=%5
	SP=%6
	PC=%7

ISHFT:	MOV	(R5)+,R4	;ARGUMENT LIST IN R5... GET # ARGUMENTS.
	MOV	@(R5)+,R0	;GET VARIABLE.
	MOV	@(R5)+,R1	;GET COUNT.
	BEQ	30$		;IF ZERO, EXIT AT ONCE.
	BMI	20$		;IF MI, RIGHT SHIFT.

10$:	ASL	R0		;LEFT SHIFT...
	DEC	R1		;SHIFT NUMBER OF COUNTS REQUIRED.
	BNE	10$
	RTS	PC		;EXIT WHEN DONE.

20$:	CLC			;RIGHT SHIFT... DON'T PROPAGATE SIGN.
	ROR	R0
	DEC	R1
	BNE	20$
30$:	RTS	PC		;EXIT WHEN DONE.

	.END