.MCALL	.MODULE
.MODULE	JMUL,VERSION=04,COMMENT=<JMUL/SYSLIB>,IDENT=NO,LIB=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
	.SBTTL	Module Declaration

	.NLIST
	.ENABL	LC
	.DSABL	GBL
	.NLIST	CND
	.LIST
; ++
; FACILITY:
;
;    RT-11 System Subroutine Library
;
; CALLABLE ENTRIES:
;
;    JMUL
;
; ENVIRONMENT:
;
;    These routines can be used by any job running in a single-job
;    or multi-job environment . It uses "TRAP" to provide error processing.
;
; INCLUDE FILES:
;

	; SYSMAC.SML		; RT-11 system macro library.

;
; EXTERNAL REFERENCES:
;

	.GLOBL	$SYSLB		; Include system library work area.
	.GLOBL	$SETR0		; Entry point to SET R0 routine

	.SBTTL	JMUL - Fortran-callable Routine
;
; ++
; FUNCTIONAL DESCRIPTION:
;
;    The JMUL function computes the product of two INTEGER*4 values.
;    
; CALLING SEQUENCE:
;
;    i = JMUL( jopr1, jopr2, jres )
;
; INPUT PARAMETERS:
;
;    R5	    -  address of JMUL's argument block
;
;    0(R5)  -  argument count of JMUL call
;    2(R5)  -  address of first INTEGER*4 variable that is the multiplicand
;    4(R5)  -  address of second INTEGER*4 variable that is multiplier
;    6(R5)  -  address of an INTEGER*4 variable that receives the product
;              of the operation
;
; RETURNED FUNCTION VALUE:
;
;    i =  -1 normal return; the result is negative
;      =   0 normal return; the result is zero
;      =   1 normal return; the result is positive
;      =  -2 an overflow occured while computing the result
;
; --

	.SBTTL	JMUL - Fortran-callable Routine

	.PSECT	SYS$I

JMUL::	TST	(R5)+		; skip count arg
	CLR	-(SP)		; init sign flag
	MOV	(R5)+,R4	; addr of operand 1
	MOV	(R4)+,R1	; get low order op 1
	MOV	@R4,R3		; get high order op 1
	BPL	10$		; branch if positive
	NEG	R3		; take absolute value
	NEG	R1
	SBC	R3
	INC	@SP		; and set sign flag
10$:	MOV	(R5)+,R4	; addr of operand 2
	MOV	(R4)+,R0	; low order of op 2
	MOV	@R4,R2		; high order of op 2
	BPL	20$		; branch if positive
	INC	@SP		; set sign flag
	NEG	R2		; and take absolute value
	NEG	R0
	SBC	R2
20$:	BEQ	30$		; branch if high part of op 2 is 0
	TST	R3		; if wasn't op 2 must be op 1
	BNE	OVRFL		; branch if result will be too big
	MOV	R0,R4		; otherwise switch ops
	MOV	R1,R0
	MOV	R4,R1
	MOV	R2,R3
	CLR	R2
30$:	CLR	R4		; result will end up in r2:r4
40$:	ROR	R0		; shift bit out of multiplier
	BCC	50$		; branch if 0
	ADD	R1,R4		; add low parts together
	ADC	R2		; add in carry
	BVS	OVRFL		; branch if overflow
	ADD	R3,R2		; add high parts together
	BVS	OVRFL		; branch if overflow
	TST	R0		; any more of multiplier left?
50$:	BEQ	DONE		; branch if finished
	ASL	R1		; shift multiplicand left
	ROL	R3
	BVC	40$		; loop
OVRFL:	MOV	#-2,R0		; set oveflow indicator
	CLR	R2		; set result to 0
	CLR	R4
DONE:	ROR	(SP)+		; get result sign into c
	BCC	10$		; branch if to be positive
	NEG	R2		; negate result
	NEG	R4
	SBC	R2
10$:	MOV	@R5,R1		; addr of result
	MOV	R4,(R1)+	; store low order
	MOV	R2,@R1		; store high order
	CALLR	$SETR0		; exit via setr0 routine

	.END