.NLIST	TTM,BEX
	.TITLE	MC68000 CROSS ASSEMBLER SUPPORT
;
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; ASSEMBLY LANGUAGE SUBROUTINES FOR MC68000 CROSS-ASSEMBLER.
; FORTRAN LINKAGE TO THESE ROUTINES IS AS FOLLOWS:
;	1. RETURN VIA 'RTS PC'.
;	2. R5 POINTS TO PARAMETER LIST WITH FOLLOWING:
;		A. NUMBER OF PARAMETERS.
;		B. ADDRESS OF FIRST PARAMETER
;		C. ADDRESS OF SECOND PARAMETER, ETC.
;	3. FUNCTION SUBROUTINES (INTEGER) RETURN VALUE IN R0.
;
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; ** I4CLR **
;
; CLEAR LOW AND HIGH WORDS OF DOUBLE PRECISION VARIABLE
; ADR OF LOW WORD PASSED VIA (R5)
;
I4CLR::	TST (R5)+
	MOV R0,-(SP)
	MOV (R5),R0
	CLR (R0)+
	CLR (R0)
	MOV (SP)+,R0
	RTS PC
;
; ** GETBIT **
;
; SUBROUTINE TO CONVERT 4 LSB OF A INTEGER*2 VARIABLE TO A HEX
; ASCII DIGIT.  THE INTEGER IS IN THE FIRST PARAMETER AND THE
; HEX DIGIT IS RETURNED IN THE SECOND PARAMETER (BYTE).  THE
; INTEGER IS SHIFTED RIGHT BY 4 BEFORE RETURNING.
;
CNVTBL:	.ASCII	'0123456789ABCDEF'
GETBIT::	MOV	R0,-(SP)		;
	MOV	@2(R5),R0		;GET WORD
	BIC	#177760,R0		;MASK OUT 4 LSB
	MOVB	CNVTBL(R0),@4(R5)	;CONVERT AND RETURN
	MOV	@2(R5),R0		;SHIFT INPUT INTEGER
	ASH	#-4,R0			; RIGHT BY 4.
	MOV	R0,@2(R5)		;
	MOV	(SP)+,R0		;
	RTS	PC			;RETURN
	.PAGE
;
; ** ICKVAL **
;
; INTEGER FUNCTION TO CHK IF I*2 VARIABLE IS IN THE RANGE
; -64,63. IF IT IS A VALUE OF 0 IS RETURNED, OTHERWISE
; A VALUE OF ONE IS RETURNED
;
ICKVAL::	MOV	@2(R5),R0
	BIT	#177600,R0
	BEQ	10$
	BIC	#177,R0
	CMP	R0,#177600
	BEQ	10$
	MOV	#1,R0
	RTS	PC
10$:	CLR	R0
	RTS	PC
	.PAGE
;
;	THE FOLLOWING INTEGER*4 ARITHMETIC ROUTINES ARE USED INSTEAD
;	OF F4P CALLS TO PERMIT THE CROSS ASSEMBLER TO RUN WITHOUT
;	MODIFICATIONS ON EITHER RT-11 OR RSX-11 SYSTEMS
;
JADD::	CLR	R0		;INITIALIZE FOR NORMAL EXIT
	TST	(R5)+		;SKIP COUNT ARG
	MOV	(R5)+,R4	;ADDR OF OPERAND 1
	MOV	(R5)+,R3	;ADDR OF OPERAND 2
	MOV	(R5)+,R1	;ADDR OF RESULT
	MOV	(R4)+,R2	;GET LOW ORDER OP 1
	ADD	(R3)+,R2	;ADD IN LOW ORDER OP 2
	MOV	@R4,R5		;GET HIGH ORDER OP 1
	ADC	R5		;ADD IN CARRY
	BVS	1$
	ADD	@R3,R5		;ADD IN HIGH ORDER OP 2
	BVC	2$
1$:	CLR	R2		;SET RESULT TO 0
	CLR	R5
	MOV	#-2,R0		;INDICATE OVERFLOW
2$:	MOV	R2,(R1)+	;STORE RESULT
	MOV	R5,@R1
	RTS	PC
	.PAGE
;
;	INTEGER*4 SUBTRACTION
;
JSUB::	CLR	R0		;INITIALIZE FOR NORMAL EXIT
	TST	(R5)+		;SKIP COUNT ARG
	MOV	(R5)+,R4	;ADDR OF OPERAND 1
	MOV	(R5)+,R3	;ADDR OF OPERAND 2
	MOV	(R5)+,R1	;ADDR OF RESULT
	MOV	(R4)+,R2	;GET LOW ORDER OP 1
	SUB	(R3)+,R2	;SUBTRACT LOW ORDER OP 2
	MOV	@R4,R5		;GET HIGH ORDER RESULT
	SBC	R5		;SUBTRACT CARRY
	BVS	1$
	SUB	@R3,R5		;SUBTRACT HIGH ORDER OP 2
	BVC	2$
1$:	CLR	R2		;SET RESULT TO 0
	CLR	R5
	MOV	#-2,R0		;INDICATE OVERFLOW
2$:	MOV	R2,(R1)+	;STORE RESULT
	MOV	R5,@R1
	RTS	PC
	.PAGE
;
;	INTEGER*4 MULTIPLICATION
;
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	1$		;BRNCH IF POSITIVE
	NEG	R3		;TAKE ABSOLUTE VALUE
	NEG	R1
	SBC	R3
	INC	@SP		;AND SET SIGN FLAG
1$:	MOV	(R5)+,R4	;ADDR OF OPERAND 2
	MOV	(R4)+,R0	;LOW ORDER OF OP 2
	MOV	@R4,R2		;HIGH ORDER OF OP 2
	BPL	2$		;BRAANCH IF POSITIVE
	INC	@SP		;SET SIGN FLAG
	NEG	R2		;AND TAKE ABSOLUTE VALUE
	NEG	R0
	SBC	R2
2$:	BEQ	3$		;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
3$:	CLR	R4		;RESULT WILL END UP IN R2:R4
4$:	ROR	R0		;SHIFT BIT OUT OF MULTIPLIER
	BCC	5$		;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?
5$:	BEQ	DONE		;BRANCH IF FINISHED
	ASL	R1		;SHIFT MULTIPLICAND LEFT
	ROL	R3
	BVC	4$		;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	1$		;BRANCH IF TO BE POSITIVE
	NEG	R2		;NEGATE RESULT
	NEG	R4
	SBC	R2
1$:	MOV	@R5,R1		;ADDR OF RESULT
	MOV	R4,(R1)+	;STORE LOW ORDER
	MOV	R2,@R1		;STORE HIGH ORDER
	RTS	PC
	.PAGE
;
;	INTEGER*4 DIVISION
;
JDIV::	CLR	-(SP)		;SET SUCCCESSFUL EXIT FLAG
	MOV	(R5)+,-(SP)	;SAVE ARG COUNT
	MOV	(R5)+,R4	;ADDR OF NUMERATOR
	MOV	(R5)+,R1	;ADDR OF DENOMINATOR
	MOV	R5,-(SP)	;SAVE ADDR OF RESULT
	MOV	#33.,-(SP)	;SET SHIFT COUNTER
	MOV	(R1)+,R0	;GET LOW ORDER DENOM
	MOV	@R1,R1		;GET HIGH ORDER DENOM
	BPL	1$		;BRANCH IF POSITIVE
	NEG	R1		;TAKE ABSOLUTE VALUE
	NEG	R0
	SBC	R1
	ADD	#100000,@SP	;AND SET SIGN FLAG
1$:	BNE	2$		;BRANCH IF DENOM CAN'T BE 0
	TST	R0		;MAKE SURE LOW DENOM ISN'T 0
	BEQ	ZDIV		;BRANCH IF ZERO DIVIDE
2$:	MOV	(R4)+,R2	;LOW ORDER OF NUM
	MOV	@R4,R3		;HIGH ORDER OF NUM
	BPL	3$		;BRANCH IF POSITIVE
	ADD	#40000,@SP	;SET SIGN FLAG
	NEG	R3		;AND TAKE ABSOLUTE VALUE
	NEG	R2
	SBC	R3
3$:	CLR	R5		;QUOTIENT ENDS UP IN R3:R2
	CLR	R4		;REMAINDER ENDS UP IN R5:R4
4$:	ROL	R4		;EXPOSE NEW BIT OF NUMERATOR
	ROL	R5
	CMP	R1,R5		;DOES DENOM FIT?
	BHI	6$		;BRANCH IF NOT, C=0
	BNE	5$		;BRANCH IF YES
	CMP	R0,R4		;HIGH PARTS SAME, CHECK LOW
	BHI	6$		;BRANCH IF NOT, C=0
5$:	SUB	R0,R4		;SUBTRACT DENOM FROM REMAINDER
	SBC	R5
	SUB	R1,R5
	SEC			;INDICATE NEW QUOTIENT BIT
6$:	ROL	R2		;SHIFT IN NEW BIT OF QUOTIENT
	ROL	R3
	DECB	@SP		;CHECK LOOP COUNT
	BGT	4$		;BRANCH TO LOOP
ENDCOD:	ASL	@SP		;PUT QUOTIENT RESULT SIGN IN V
	BVC	1$		;BRANCH IF TO BE POSITIVE
	NEG	R3		;NEGATE QUOTIENT
	NEG	R2
	SBC	R3
1$:	TST	(SP)+		;GET REMAINDERS SIGN
	BPL	2$		;BRANCH IF REMAINDER TO BE POSITIVE
	NEG	R5		;NEGATE REMAINDER
	NEG	R4
	SBC	R5
2$:	MOV	(SP)+,R0	;GET ARG LIST POINTER AGAIN
	MOV	(R0)+,R1	;ADDR OF QUOTIENT RESULT
	CMPB	#3,(SP)+	;CHECK NUMBER OF ARGUMENTS
	BEQ	3$		;BRANCH IF ONLY 3 PASSED
	MOV	@R0,R0		;GET ADDR REMAINDER RESULT
	MOV	R4,(R0)+	;STORE LOW
	MOV	R5,@R0		;STORE HIGH
3$:	MOV	R2,(R1)+	;STORE LOW QUOTIENT RESULT
	MOV	R3,@R1		;STORE HIGH
	TST	(SP)+
	RTS	PC
ZDIV:	CLR	R4		;SET REMAINDER TO 0
	CLR	R5
	CLR	R2		;SET QUOTIENT TO 0
	CLR	R3
	MOV	#-3,6(SP)	;SET ZDIV ERROR INDICATOR
	BR	ENDCOD		;GO SET RESULTS
	.PAGE
;
;	INTEGER*4 LOGICAL AND
;
JAND::	TST	(R5)+		;SKIP COUNT ARGUMENT
	MOV	(R5)+,R0	;ADR OF NUMBER
	MOV	(R5)+,R1	;ADR OF NUMBER TO BE ANDED
	MOV	(R5)+,R2	;ADR OF DESTINATION
	MOV	(R0)+,R3	;GET VAL OF HIGH PART OF NUMBER
	MOV	(R1)+,R4	;GET VAL OF HIGH PART OF MASK
	COM	R4		;INVERT MASK BITS
	BIC	R4,R3		;AND 'EM
	MOV	R3,(R2)+	;STORE RESULT IN DESTINATION
	MOV	(R0),R3		;GET VAL OF LOW PART OF NUMBER
	MOV	(R1),R4		;GET VAL OF LOW PART OF MASK
	COM	R4		;INVERT MASK BITS
	BIC	R4,R3		;AND 'EM
	MOV	R3,(R2)		;STORE RESULT IN DESTINATION
	CLR	R0		;CLR VAL OF FUNCTION
	RTS	PC
	.PAGE
;
;	INTEGER*4 INCLUSIVE OR
;
JOR::	TST	(R5)+		;SKIP OVER ARGUMENT COUNT
	MOV	(R5)+,R0	;ADR OF NUMBER
	MOV	(R5)+,R1	;ADR OF NUMBER TO BE OR'ED
	MOV	(R5)+,R2	;ADR OF DESTINATION
	MOV	(R0)+,R3	;GET VAL OF HIGH PART OF NUMBER
	MOV	(R1)+,R4	;GET VAL OF HIGH PART OF OR MASK
	BIS	R4,R3		;OR 'EM
	MOV	R3,(R2)+	;STORE RESULT IN DESTINATION
	MOV	(R0),R3		;GET VAL OF LOW PART OF NUMBER
	MOV	(R1),R4		;GET VAL OF LOW PART OF OR MASK
	BIS	R4,R3		;OR 'EM
	MOV	R3,(R2)		;STORE RESULT IN DESTINATION
	CLR	R0		;STD FUNCTION RETURN VAL
	RTS	PC
	.PAGE
;
; ** JLSHF **
;
;	INTEGER*4 LEFT SHIFT (UNSIGNED)
;
JLSHF::	TST	(R5)+		;SKIP OVER ARGUMENT COUNT
	MOV	(R5),R0		;SRC ADR
	MOV	@2(R5),R1	;NUMBER OF BITS TO SHIFT IT
	MOV	4(R5),R2	;DEST ADR
	MOV	(R0)+, (R2)	;MOVE SRC TO DEST
	MOV	(R0) ,2(R2)
	TST	R1
	BEQ	99$		;SHIFTING 0 BITS IS SILLY
	CMP	R1,#40
	BHI	99$		;CAN'T SHIFT MORE THAN 32 BITS
1$:	CLC			;MAKE SURE CARRY IS CLEAR
	ROL	(R2)		;SHIFT LO HALF 1 BIT
	ROL	2(R2)		;SHIFT HI WRD
3$:	DEC	R1		;DECR #BITS TO SHIFT
	BNE	1$		;LOOP IF NON ZERO
;
99$:	CLR	R0
	RTS	PC
	.PAGE
;
; ** JRSHF **
;
;	INTEGER*4 RIGHT SHIFT (UNSIGNED)
;
JRSHF::	TST	(R5)+		;SKIP OVER ARGUMENT COUNT
	MOV	(R5),R0		;ADR OF NUMBER TO SHIFT
	MOV	@2(R5),R1	;NUMBER OF BITS TO SHIFT IT
	MOV	4(R5),R2	;DESTINATION ADDRESS
	MOV	(R0)+, (R2)	;MOVE SRC TO DEST
	MOV	(R0) ,2(R2)
	TST	R1
	BEQ	99$		;SHIFTING 0 BITS IS SILLY
	CMP	R1,#40
	BHI	99$		;CAN'T SHIFT MORE THAN 32 BITS
1$:	CLC			;MAKE SURE CARRY IS CLEAR
	ROR	2(R2)		;SHIFT HI HALF 1 BIT
	ROR	(R2)		;SHIFT LO WRD
	DEC	R1		;DECR #BITS TO SHIFT
	BNE	1$		;LOOP IF NON ZERO
;
99$:	CLR	R0
	RTS	PC
	.PAGE
;
; ** JICMP **
;
;	COMPARE A 32 BIT SIGNED NUMBER WITH A 16 BIT SIGNED NUMBER
;	FUNCTION RETURNS A VALUE OF ZERO IF THE NUMBERS ARE EQUIVALENT
;
JICMP::	TST	(R5)+
	MOV	(R5)+,R0	;ADR OF I*4 VALUE
	MOV	@(R5)+,R1	;VALUE OF I*2 NUMBER
	TST	R1		;SEE IF VAL NEGATIVE
	BPL	1$		;
	CMP	(R0),#177777	;SEE IF NUMBER NEGATIVE
	BNE	99$		;NUMBER NOT NEGATIVE
	BR	2$
1$:	TST	(R0)		;IF I*2 NUMBER NOT NEG THEN HI WORD
	BNE	99$		;MUST BE ZERO
2$:	CMP	2(R0),R1	;CMP THE TWO NUMBERS
	BNE	99$
	CLR	R0
	RTS	PC		;NUMBERS ARE EQUAL
99$:	MOV	#1,R0		;NUMBERS NOT EQUAL
	RTS	PC
	.PAGE
;
; ** JMOV **
;
;	INTEGER*4 MOVE
;
JMOV::	CLR	R0		;INITIALIZE FOR NORMAL EXIT
	TST	(R5)+		;SKIP COUNT ARG
	MOV	(R5)+,R4	;ADDR OF OPERAND 1
	MOV	(R5)+,R1	;ADDR OF OPERAND 2
	MOV	(R4)+,(R1)+	;MOVE LOW PART
	MOV	@R4,@R1		;MOVE HIGH PART
	RTS	PC
	.PAGE
;
; ** BLDMAP (DLIST,ALIST,OUTPUT) **
;
;	CREATE A REGISTER BITMAP FROM A DATA AND ADR REG MAP
;
BLDMAP:: TST	(R5)+		;SKIP OVER ARG COUNT
	MOV	@(R5)+,R0	;GET DATA BITMAP
	BIC	#177400,R0	;MAKE SURE NO EXTRA BITS SET
	MOV	@(R5)+,R1	;GET ADR BITMAP
	BIC	#177400,R1	;MAKE SURE NO EXTRA BITS SET
	SWAB	R1		;MOVE ADR REG BITS UP WHERE THEY BELONG
	BIS	R0,R1		;OR IN THE D-REG BITS
	MOV	R1,@(R5)	;SAVE THE RESULT IN THE DESTINATION
	RTS	PC		;AND RETURN
	.PAGE
;
; ** JICVT (I*2,I*4 RESULT) **
;
;	I*2 TO I*4 CONVERSION (SIGNED)
;
JICVT::	TST	(R5)+		;SKIP COUNT ARG
	CLR	R2		;INIT SIGN EXTEND WORD
	MOV	@(R5)+,R0	;GET INTEGER VALUE
	BPL	1$		;BRANCH IF POSITIVE
	DEC	R2		;SET SIGN EXTEND WORD
1$:	MOV	@R5,R1		;ADDR OF RESULT
	MOV	R0,(R1)+	;STORE LOW ORDER
	MOV	R2,@R1		;STORE HIGH ORDER
	CLR	R0		;INITIALIZE FOR NORMAL EXIT
	RTS	PC
	.END