;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME MULX1

	CSEG


			;RE-ENTRANT MULTIPLY ROUTINE (SIGNED)
			;SINGLE LENGTH (USES MULX2)
			;BC * DE
			;result is in DE


PUBLIC	MULX1
EXTRN	MULXC,MULX0

MULX1:	XRA A		;ZERO ACC
	MOV H,A		;SIGN COUNT ZERO
	MOV B,A		;SIGN EXTEND OF C
	MOV D,A		;SIGN EXTEND OF E
	SUB C
	JZ MULX0	;MUST BE ZERO RESULT
	JM NEXTB	;GO TO NEXT ONE
	INR H
	MOV C,A		;ALREADY NEGATED
NEXTB:	XRA A
	SUB E
	JZ MULX0
	JM MULXC
	INR H
	MOV E,A		;SIGN NOW POS
	JMP MULXC
END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	MULX2


	CSEG


			;RE-ENTRANT MULTIPLY ROUTINE (SIGNED)
			;DOUBLE LENGTH (ALSO USED BY MULX1)
			;BC * DE
			;result is in DE

PUBLIC	MULX2,MULXC,MULX0


MULX2:	XRA A
	MOV H,A		;ZERO THE COUNT
	ADD B		;SIGN OF BC?
	JM	BNEG	;SIGN OF BC?
	ORA	C	;ALL ZERO
	JZ	MULX0
	JMP	NEXTI	;MUST BE POSITIVE NON ZERO
BNEG:	INR H
	CMA
	MOV B,A
	MOV A,C
	CMA
	MOV C,A
	INX B		;2'S COMP NEGATE
NEXTI:	XRA A
	ADD D
	JM	DDNEG	;NEGATIVE
	ORA	E
	JZ	MULX0	;ALL ZEROS
	JMP	MULXC	;POSITIVE NON ZERO
DDNEG:	INR H
	CMA
	MOV D,A
	MOV A,E
	CMA
	MOV E,A
	INX D		;2'S COMP NEGATE

MULXC:	PUSH H		;SAVE THE SIGNS COUNT
	MOV A,C
	SUB E		;BC > DE ?
	MOV A,B
	SBB D
	JP OK		;RIGHT WAY ROUND NOW
	MOV H,B		;OTHERWISE SWITCH 'EM
	MOV L,C
	XCHG
	MOV B,H
	MOV C,L

OK:	LXI H,0
	XCHG		;DE<-0  HL<-1ST ARG

MLOOP:	MOV A,B
	ORA C
	JZ EXIT		;BC<-0 THEN FINISH
	MOV A,B
	RAR
	MOV B,A
	MOV A,C
	RAR
	MOV C,A		;BC >> 1
	JNC HSHFT
	XCHG
	DAD D		;ADD IN MULITIPLICAND
	XCHG		;DE <- DE + HL
HSHFT:	DAD H
	JMP MLOOP

EXIT:	POP PSW
	RAR
	RNC		;EVEN NO OF SIGN CHANGES
	MOV A,D
	CMA
	MOV D,A
	MOV A,E
	CMA
	MOV E,A
	INX D
	RET		;2'S COMP OF DE

MULX0:	LXI D,0		;ZERO RESULT
	RET
END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	DIVX1


	CSEG


				;RE-ENTRANT DIVIDE ROUTINE (SIGNED)
				;SINGLE LENGTH (USES DIVX2)
				;BC/DE
				;quotient is in BC
				;remainder is in HL


PUBLIC	DIVX1
EXTRN	DIVXC,DIVXD
DIVX1:	XRA	A	;ZERO ACC
	MOV	L,C	;USE HL, NOT BC
	MOV	B,A	;ZERO THE COUNT OF SIGNS
	MOV	H,A	;SIGN EXTEND OF L
	MOV	D,A	;SIGN EXTEND OF E
	SUB	E	;WHAT SIGN FOR E?
	JM	SKIP1	;OK
	RZ		;!
	INR	B	;COUNT IT
	MOV	E,A	;DONE THE NEGATE

SKIP1:	XRA	A	;ZERO AGAIN
	SUB	L	;WHAT SIGN OF L?
	JM	DIVXC	;OK
	JZ	DIVXD	;WATCH IT
	MOV	L,A	;NEGATED
	MOV	A,B
	ORI	2	;NOTE SIGN
	MOV	B,A
	JMP	DIVXC

END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	DIVX2



	CSEG



				;RE-ENTRANT DIVIDE ROUTINE (SIGNED)
				;DOUBLE LENGTH (ALSO USED BY DIVX1)
				;BC/DE
				;quotient is in BC
				;remainder is in HL

PUBLIC	DIVX2,DIVXC,DIVXD

DIVX2:	XRA	A	;ZERO ACC
	MOV H,B
	MOV L,C
	MOV	B,A	;ZERO THE COUNT
	ADD D
	JM DNEG
	ORA E
	JNZ SKIP
	RET
DNEG:	INR B		;NOTE NEG
	MOV A,D		;AND NEGATE
	CMA
	MOV D,A
	MOV A,E
	CMA
	MOV E,A
	INX D		;TWOS COMPLEMENT
	
SKIP:	XRA A
	ADD H
	JM HNEG
	ORA L
	JNZ DIVXC
DIVXD:	LXI B,0
	RET
HNEG:	MOV A,B
	ORI 2
	MOV B,A
	MOV A,H
	CMA
	MOV H,A
	MOV A,L
	CMA
	MOV L,A		;NEGATED H
	INX H		;TWOS COMP

DIVXC:	PUSH B		;STORE THE SIGNS
	MVI A,1		;COUNT
	PUSH PSW	;ON STACK
	LXI B,0 	;CLEAR QUOTIENT

	XRA A		;MOVE DE UNTIL SIGN SET
	ADD D
	JM GO		;SET?
	XCHG
AGN:	POP PSW
	INR A		;COUNT IT
	PUSH PSW	;STORE IT
	DAD H
	MOV A,H
	CPI 0		;SET SIGN BIT
	JP AGN		;LEAVE WHEN SET
	XCHG
	XRA A		;CY  0

GO:	MOV A,C		;THE ACTUAL LOOP
	RAL
	MOV C,A
	MOV A,B		;Q << 1  + CY
	RAL
	MOV B,A

	MOV A,L
	SUB E
	MOV L,A
	MOV A,H		;HL<- HL - DE
	SBB D
	MOV H,A
	JC RESTO	;WATCH CRRY OUT
	INX B		;ELSE REMEMBER OK
	JMP SHIFT
RESTO:	DAD D		;QUICKIE RESTORE
SHIFT:	POP PSW
	DCR A		;COUNT
	JZ FINIS
	PUSH PSW	;STORE AGAIN
	XRA A
	MOV A,D
	RAR
	MOV D,A
	MOV A,E		; DE >> 1  -> CY
	RAR
	MOV E,A
	JMP GO		;NB CY MAY BE SET

FINIS:	XRA A		;ONE MORE SHIFT LEFT
	MOV A,D
	RAR
	MOV D,A
	MOV A,E
	RAR
	MOV E,A
	POP PSW		;SIGN INFO
	PUSH PSW
	RAR
	RAR
	JNC POSREM	;NO 2 BIT IN CY
	MOV A,H
	CMA
	MOV H,A
	MOV A,L
	CMA
	MOV L,A
	INX H		;2'S COMP HL
	
POSREM:	POP PSW		;GET SIGN INFO	
	INR A
	RAR
	RAR		;NO 2 BIT IN CY
	RNC		;GET OUT
	MOV A,B
	CMA
	MOV B,A
	MOV A,C
	CMA
	MOV C,A
	INX B		;2'S COMP B
	RET
END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	BITS0


	CSEG





				;BITS machine code
PUBLIC	BITS0
EXTRN	BITARG

					;enters with value in HL
					;leaves with value in HL
BITS0:	CALL	BITARG			;UNPICK THE POSITION AND SIZE
	JZ	SIZES			;WATCH FOR ZERO SHIFT
SHFTS:	MOV	A,D
	RAR				;SHIFT VALUE DOWN
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	DCR	C
	JNZ	SHFTS
SIZES:	LXI	H,0			;SET UP THE MASK
SETM:	DAD	H			;SHIFT IT OVER ONE
	INX	H			;SET BOTTOM BIT
	DCR	B
	JNZ	SETM
	MOV	A,E			;NOW MASK OFF WHAT WE WANT
	ANA	L
	MOV	L,A
	MOV	A,D
	ANA	H
	MOV	H,A
	RET

END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	BITSR0


	CSEG


				;BITSTIND machine code
PUBLIC	BITSR0
EXTRN	BITARG

					;enters with value in DE
					;and memory address in HL
BITSR0:	POP	B			;GET RETURN ADDR
	PUSH	D			;SAVE THE VALUE FOR NOW
	PUSH	B			;RESTORE RET ADDR
	CALL	BITARG			;GET SET UP
	POP	H			;RET ADDR
	XTHL				;SWOP FOR VALUE
	XCHG				;HL <- addr; DE <- value
	PUSH	H			;SAVE ADDR
	LXI	H,0			;BUILD A MASK
SIZER:	DAD	H
	INX	H
	DCR	B
	JNZ	SIZER			;KEEP GOING UNTIL BUILT
	MOV	A,E			;NOW MASK OFF THE VALUE
	ANA	L
	MOV	E,A
	MOV	A,D
	ANA	H
	MOV	D,A
	XRA	A			;NOW SHIFT UP THE MASK
SHFTR:	CMP	C			;FINISHED?
	JZ	STORE			;IF SO DO THE WORK
	DAD	H			;SHIFT MASK
	XCHG
	DAD	H			;SHIFT VALUE
	XCHG
	DCR	C
	JMP	SHFTR
STORE:	XTHL				;GET ADDR FROM STACK
	POP	B			;AND MASK IN BC
	MOV	A,C
	CMA				;INVERT MASK
	ANA	M			;GET STORED VALUE
	ORA	E			;SUPLEMENT IT WITH NEW
	MOV	M,A			;PUT IT BACK
	INX	H
	MOV	A,B			;NOW THE OTHER HALF
	CMA
	ANA 	M			;BRING IN THE VALUE
	ORA	D			;SET IN THE NEW ONE
	MOV	M,A			;STORE IT AGAIN
	RET
END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	BITARG


	CSEG


PUBLIC	BITARG


					;unpicks byte following the call
					;DE := HL; BC := size+pos
BITARG:	XCHG				;SWOP OUT OF HL
	POP	H			;CALLING ADDRESS
	XTHL				;GET TRUE ADDR
	MOV	A,M			;POINTS AT S*16 + P&15
	INX	H			;POINT TO NEXT INSTR
	XTHL				;CORRECT ORDER
	PUSH	H			;PUT IT BACK AGAIN
	MOV	L,A
	MVI	H,0			;SET IT INTO HL
	ANI	15			;GET OUT P
	MOV	C,A			;SAVE IT
	DAD	H			;SHIFT UP HL FOUR PLACES
	DAD	H
	DAD	H
	DAD	H
	MOV	B,H			;IS IN H NOW
	RET



	END
			;GEC SEMICONDUCTORS LTD
			;8080 CORAL LIBRARY ROUTINES
			;COPYRIGHT (C) 1976 BY GEC
			;AUTHOR: STEWART LANG
NAME	ENTRY0


	CSEG





			;CODE FOR RECURSIVE FUNCTION ENTRY & EXIT
PUBLIC	ENTRY0,EXIT0



				;RECURSIVE FUNCTION ENTRY SEQUENCE
				;CALL	ENTRY0
				;DB	SP ARGS SIZE, LOCALS SIZE
				;DW	LOCALS ADDRESS

ENTRY0:	POP	H		;HOLD ONTO THE ENTRY ADDRESS
	PUSH	B
	PUSH	D		;SAVE THE ARGUMENTS IN REGS
	MVI	A,8		;COUNT ADDR,BC,DE,HL
	ADD	M		;ADD IN STACKED ARGS SIZE
	MOV	E,A		;SAVE FOR NOW
	INX	H
	XRA	A		;CLEAR ACC
	MOV	B,A		;ZERO B
	SUB	M		;NEGATE THE SIZE OF LOCALS
	JZ	DOUB		;FORCE TO DOUBLE LENGHT WORD
	DCR	B		;NB. 8 BITS UNSIGNED, 16 SIGNED
DOUB:	MOV	C,A
	MOV	A,E		;RESTORE STACKED COUNT
	PUSH	H
	LXI	H,0		;PREPARE TO RESET THE STACK
	DAD	SP		;TO ITS NEW POSITION
	MOV	D,H		;REMEMBER WHERE IT IS NOW
	MOV	E,L
	DAD	B		;THEN SUBTRACT THE LOCAL WORKSPACE
	SPHL			;RESET STACK
SR:	ORA	A		;TEST ARGS TO BE COPIED UP
	JZ	XR
	XCHG			;M <- OLD STACK ADDR
	MOV	C,M
	XCHG			;M <- NEW STACK ADDR
	MOV	M,C
	INX	H
	INX	D
	DCR	A		;KEEP COUNT
	JMP	SR
XR:	POP	H		;ARGS ARE NOW ALL COPIED UP
	MOV	A,M		;PICK UP WORKSPACE SIZE AGAIN
	INX	H
	MOV	C,M		;AND NOW ITS ADDRESS
	INX	H
	MOV	B,M
	INX	H		;NB. DE - BASE OF STACK STORE
	PUSH	B
	XTHL			;&   HL - BASE IF WORK SPACE
SN:	ORA	A		;&  (SP)- ENTRY POINT
	JZ	XN		;SEE IF WORK SPACE LEFT TO SAVE
	DCX	D		;NEXT SPARE STACK SPACE	
	MOV	C,M
	XCHG
	MOV	M,C
	XCHG
	INX	H		;MOVE TO NEXT LOCAL SPACE
	DCR	A		;KEEP COUNT
	JMP	SN
XN:	POP	H		;REGAIN ENTRY ADDRESS
	POP	D		;ARG DE
	POP	B		;ARG BC
	PCHL





				;RECURSIVE EXIT SEQUENCE
				;CALL	EXIT0
				;DB	LOCALS SIZE
				;DW	LOCALS ADDRESS

EXIT0:	XTHL			;SWOP INTEGER RESULT AND CALLING ADDR
	PUSH	PSW		;AND SAVE BYTE RESULT AS WELL
	MOV	A,M		;PICK UP SIZE OF LOCAL WORKSPACE
	INX	H
	MOV	E,M		;AND ITS BASE ADDRESS
	INX	H
	MOV	D,M
	LXI	H,6		;REMEMBER WE HAVE TO SKIP 6 BYTES
	MOV	B,H		;ZERO B
	MOV	C,A		;TO MAKE LOCALS SIZE 16 BITS
	DAD	SP
	XCHG			;DE - TOP OF SAVED SPACE
	DAD	B		;HL - TOP OF LOCAL SPACE
XXR:	ORA	A
	JZ	XXN		;COUNT BYTES TO BE MOVED
	DCX	H		;MOVE TO NEXT FREE LOCAL
	XCHG
	MOV	C,M		;INTO C WITH SAVED BYTE
	XCHG
	MOV	M,C		;THEN INTO THE LOCAL SPACE
	INX	D		;MOVE TO NEXT SAVED BYTE
	DCR	A
	JMP	XXR		;KEEP COUNT OF THE LOOP
XXN:	XCHG			;HL - PREVIOUS STACK POSITION
	POP	PSW		;A  - TYPED PROCEDURE RESULT - BYTE
	POP	D		;DE - TYPED PROCEDURE RESULT - INTEGER
	POP	B		;BC - CORAL PROCEDURE CALLING ADDR
	SPHL			;SET NEW STACK ADDR
	PUSH	B		;SET RETURN ADDR
	XCHG			;HL - RESULT
	RET
END