ALWAYS	2FEB84	ARITH	<ARITHMETIC/LOGICAL OPS ON VIRTUAL MEMORY>
	.MCALL	DIR$,CALLR
;************************************************************************
;*									*
;*	MODULE: ARITH							*
;*									*
;*	FUNCTION: Perform given arithmetic/logical operation on each	*
;*	byte in the range FROM-THRU.					*
;*									*
;*	FUNCTIONS and syntaxes:						*
;*		AND range WITH pp					*
;*		COMPLEMENT range					*
;*		DECREMENT range	BY pp					*
;*		DIVIDE {SIGNED} range BY pp				*
;*		FILL range WITH pp					*
;*		INCREMENT range { BY pp }				*
;*		MULTIPLY range BY pp					*
;*		NEGATE range						*
;*		OR range WITH pp					*
;*		REMAINDER {SIGNED} range BY pp				*
;*		ROTATE LEFT/RIGHT range { BY pp }			*
;*		SHIFT LEFT/RIGHT {SIGNED} range { BY pp }		*
;*		XOR range WITH pp					*
;*									*
;*	pp may be a 2-digit hex number or ASCII character ('char etc).	*
;*									*
;*	INPUT PARAMETERS:						*
;*									*
;*	R0 POINTS TO THE COMMAND LINE IN PROCESS			*
;*									*
;*	OUTPUT PARAMETERS:						*
;*									*
;*	R0 POINTS JUST BEYOND COMMAND LINE				*
;*									*
;*	DESTROYS: R1,R2,R3,R4,R5					*
;*									*
;*	Based on and replacing FILL, COMPLEMENT, and NEGATE functions	*
;*	in Aug 82 version, by:						*
;*									*
;*	AUTHOR: KEVIN ANGLEY						*
;*									*
;*	DATE: 27-JUL-82							*
;*									*
;*	REWRITTEN BY: Chris Doran, Sira Ltd				*
;*									*
;*	DATE: 30-Jan-84							*
;*									*
;************************************************************************

; Local macro:
.MACRO	FUNCTION	FUNCTN	COMMON
FUNCTN::
	MOV	#P'FUNCTN,%5	; Load required routine address
	BR	COMMON		; Fetch SIGNED/operand as required
.ENDM	FUNCTION

FUNCTION	NEGATE		GETRANGE
FUNCTION	COMPLEMENT	GETRANGE
FUNCTION	INCREMENT	GETRANGE
FUNCTION	DECREMENT	GETRANGE
FUNCTION	OR		GETRANGE
FUNCTION	XOR		GETRANGE
FUNCTION	FILL		GETRANGE
FUNCTION	AND		GETRANGE
FUNCTION	MULTIPLY	GETRANGE

FUNCTION	DIVIDE		SIGNED
FUNCTION	REMAINDER	SIGNED

; SHIFT and ROTATE require a LEFT or RIGHT qualifier. Set %4 to 0 for LEFT,
; <>0 for RIGHT.
	.ENABL	LSB
FUNCTION	ROTATE		10$

SHIFT::
	MOV	#PSHIFT,%5	; Load address of shift routine
10$:	SETNZ	%4		; Set left/right flag
	GETKEY	RIGHT		; See if RIGHT
	BEQ	20$		; Yes, continue with flag set
	CLR	%4		; No, see if LEFT
	GETKEY	LEFT
	BNE	MISSINGKEY	; No, "Missing keyword"
20$:	CMP	%5,#PROTATE	; Got LEFT/RIGHT. Is this ROTATE?
	BEQ	GETRANGE	; No SIGNED option if so
;	BR	SIGNED		; Else can be SIGNED
	.DSABL	LSB

; Possible SIGNED option.
SIGNED:	CLR	EXTMSK		; Signed requires no bits cleared
	GETKEY	SIGNED		; See if it is SIGNED
	BEQ	GETRANGE	; Yes, get operand etc
	COMB	EXTMSK+1	; Default or explicit unsigned
;	BR	GETRANGE	; Go get range and operand

; Get range.
GETRANGE:
	CALL	FROMTH		; GET FROM ADDR IN R1, THRU ADDR IN R2,
				;  COUNT IN R3, and step in STEP
	BCS	ERREXIT		;  CS: NOT SUCCESSFUL, TAKE ERROR EXIT
	MOV	R1,R2		; SAVE FROM ADDRESS IN R2 - DON'T NEED THRU

	CMP	%5,#NOOPERAND	; NEGATE and COMPLEMENT
	BLO	START		;  have no operand to fetch.

; Get operand. WITH and BY keywords are synonomous, but one must be present.
	GETKEY	BY		; Try BY
	BEQ	10$		; Yes, OK
	GETKEY	WITH		; No, try WITH
	BEQ	10$		; Go get value if given
	MOV	#1,%1		; No operand. Maybe it should default to 01
	CMP	%5,#DEFAULT1	; Should it?
	BHIS	20$		; Yes, continue with 1 (no need to check AND)
	BR	MISSINGKEY	; No -- "Missing keyword"
10$:
	CLR	%1		; Clear hi byte
	CALL	GETHAS		; Get hex or ASCII value
	BCS	ERREXIT		; Error if none
	CLRB	EXTMSK		; Never clear lo byte
	MOVB	%1,%1		; on sign extend, but clear hi
	BIC	EXTMSK,%1	; unless unsigned (or it doesn't matter)

; Perform any special processing of the operand required by certain functions:

; AND complements operand for BIC operation.
	CMP	%5,#PAND	; Is it AND?
	BNE	20$		; No, branch
	COMB	%1		; Yes, complement for BIC = NAND
	BR	START		; Join common code

; ROTATEs > 7 can be reduced modulus 8, and rotate left n (which can't be done
; by EIS ASHC) is the same as rotate right 8-n = (n-8)&7.
20$:	CMP	%5,#PROTATE	; Is it ROTATE?
	BNE	30$		; No, branch
	BIC	#^C7,%1		; Rotates > 7 bits are redundant
.IF NDF M$$EIS
	BEQ	NOREXIT		; 0 bit rotate does nothing (exit cc from CMP)
.IFTF
	TST	%4		; Test left/right flag
.IFF
	BNE	25$		; NE: right, make sign -ve for ASH
	SUB	#8.,%1		; EQ: left, change it to right equivalent
	BR	START
25$:	NEG	%1		; Negate for ASHC right shift = rotate
.IFT
	BNE	START		; NE: right, keep +ve value
	SUB	#8.,%1		; EQ: left, change it to right equivalent
	NEG	%1		; also +ve
.ENDC
	BR	START		; Join common code

; SHIFT also requires a LEFT/RIGHT flag, which sets the shift count sign
; (+ve = left, -ve = right). Shifts of > 7 bits are redundant.
30$:	CMP	%5,#PSHIFT	; SHIFT operation?
	BNE	START		; No, branch
.IF NDF M$$EIS
	TST	%1		; Test for shift of 0 which does nothing
	BEQ	NOREXIT		; (Saves PSHIFT testing each time)
.ENDC
	CMP	%1,#7		; Shifts > 7 bits are redundant
	BLOS	35$		; If higher, make it 7 to
	MOV	#7,%1		; reduce work by PSHIFT/make ASH sign-extend
35$:	TST	%4		; Yes, should it be right?
	BEQ	START		;   EQ: no, left
	NEG	%1		;   NE: yes, change sign
;	BR	START		; Join common code

START:
	MOV	%1,%4		; Copy operand to %4
	CLRB	EXTMSK		; Never clear lo byte
	PUSH	%0		; Save command line pointer
30$:
	MOVB	MEMORY(R2),%1	; Fetch virtual memory byte (with sign extend)
	BIC	EXTMSK,%1	; Clear sign extend if required
	CALL	@%5		; Call required arithmetic routine
	MOVB	%1,MEMORY(%2)	; Put byte back
40$:	ADD	STEP,R2		; Move to next virtual memory location
	SOB	R3,30$		; USE COUNT TO COUNT LOCATIONS TO NEGATE
	POP	%0		; Restore line pointer
NOREXIT:			; NORMAL EXIT
ERREXIT:
	CALLR	EXTRA		; PURGE COMMAND LINE OF SUPERFLUOUS JUNK
				;  AND RETURN FROM THERE

; Missing keyword (LEFT/RIGHT or WITH/BY).
MISSINGKEY:
	OUTPUT	MSK		; Print message
	SEC			; Set error flag
	BR	ERREXIT		; Take error exit
	.PAGE

; Operation subroutines. Called with value from memory in %1, operand (if
; any) in %4, both sign extended, or sign cleared, as required by SIGNED
; option (if appropriate). Return with result of operation in %1 lo,
; all other registers preserved.
;
; Note that the order of these routines is important -- see NOOPERAND and
; DEFAULT1 positions.

PNEGATE:
	NEGB	%1		; Negate -- monadic
	RETURN

PCOMPLEMENT:
	COMB	%1
	RETURN

; Routines before this have no operand.
NOOPERAND=.

PFILL:	MOVB	%4,%1		; Fill -- straight copy
	RETURN

PAND:
	BIC	%4,%1		; AND = NOT [NAND=BIC]
	RETURN

POR:
	BIS	%4,%1		; BIS = logical OR
	RETURN

PXOR:
	XOR	%4,%1		; Exclusive OR
	RETURN

PMULTIPLY:
.IF DF M$$EIS
	MUL	%4,%1		; Multiply
	RETURN
.IFF
	MOV	%4,%0		; Copy multiplier
	CALLR	$MUL		; Multiply and return
.IFTF

PDIVIDE:
.IFT
	SXT	%0		; Sign extend source if required
	DIV	%4,%0		; Do the divide
.IFF
	MOV	%1,%0		; Load dividend
	MOV	%4,%1		; and divisor
	CALL	$DIV		; Divide
.IFTF
	MOV	%0,%1		; Copy result
	RETURN

PREMAINDER:
.IFT
	SXT	%0		; Sign extend source if required
	DIV	%4,%0		; Do the divide, remainder to %1
.IFF
	MOV	%1,%0		; Load dividend
	MOV	%4,%1		; and divisor
	CALL	$DIV		; Divide, remainder to %1
.IFTF
	RETURN

; NOTE: All routines beyond this point may take a default operand value of 01.
;	Any which have a mandatory BY/WITH/operand must be before this.
DEFAULT1=.

.IFT
; Rotate (always right, since ASHC only works that way).
PROTATE:
	PUSH	%1		; Push value
	MOVB	%1,1(SP)	; to copy bits 0-7 into 8-15
	POP	%1
	ASHC	%4,%1		; So we can do a 16-bit rotate
.IFF
; Rotate (always left, never 0).
PROTATE:
	PUSH	%4		; Save counter
10$:	ASLB	%1		; Shift left into carry, clearing bit 0
	ADCB	%1		; Put carry from bit 7 back into bit 0
15$:	DECB	@SP		; Decrement count
	BNE	10$		; until zero
20$:	POP			; Purge stack
.IFTF
	RETURN			; Return

PSHIFT:
.IFT
	ASH	%4,%1		; Shift signed/unsigned (extend already done)
	RETURN
.IFF
	PUSH	%4		; Save counter (0 checked above)
	BMI	10$		; -ve is a right shift
				; +ve is left:
5$:	ASL	%1		; Shift whole word, including sign extend if reqd
	DECB	@SP		; Decrement counter
	BNE	5$		; Repeat until zero
	BR	20$		; when return

10$:	ASRB	%1		; Shift right (always loses sign)
	DECB	@SP		; Decrement count
	BNE	10$		; until zero
20$:	POP			; Purge stack
	RETURN			; and return
	.DSABL	LSB
.ENDC

PINCREMENT:
	ADD	%4,%1		; Add operand
	RETURN

PDECREMENT:
	SUB	%4,%1		; Subtract operand
	RETURN
.PAGE
	.PSECT	PURE	RO,D

	KEY	LEFT
	KEY	RIGHT
	KEY	SIGNED
	KEY	BY		; (WITH is in HEX, also used by INIT)
	.EVEN

	.PSECT	DATA	RW,D

EXTMSK:	.WORD	0		; Sign extend clear mask, 0 = signed
				;			  177600 = unsigned
	.END