.INSERT A:S.ASM
.LINK
.IDENT ES
.PREL
.INSERT A:MAC.ASM
.INSERT A:ZRAM.ASM
.INSERT A:NCUEQU.ASM
;+
; INTERNALS
;-
.INTERN CPAREN		;CLOSE PAREN
.INTERN	DOPTAB		;DOUBLE CHAR OPERATORS
.INTERN IADD		;INTEGER ADD
.INTERN IMUL		;INTEGER MULTIPLY
.INTERN OPAREN		;OPEN PAREN
.INTERN	SOPTAB		;SINGLE CHAR OPERATORS
.INTERN UOPTAB		;UNARY OPERATORS
;+
; EXTERNALS
;-
.EXTERN CAT		;STRING CONCATENATION
.EXTERN CONVB		;CONVERT OPERAND B
.EXTERN DONCU		;PERFORM NCU OPERATION
.EXTERN IGET		;GET INT FROM NCU STACK
.EXTERN IND		;INDIRECTION
.EXTERN IPOP		;POP FROM NCU STACK
.EXTERN IPUSH		;PUSH TO NCU STACK
.EXTERN POPOPND		;POP OPERAND
.EXTERN PSHOPND		;PUSH OPERAND
.EXTERN SCMP		;STRING COMARE ROUTINE
;++++
;
; NOP
; NO-OP USED FOR OPERATIONS NOT IMPLEMENTED YET
; RETURNS THE FIRST OPERAND AS RESULT
;
;----
NOP:
	JMP	POPOPND
;++++
;
; SUB
; SUBTRACTS 2 DOUBLE PRECISION INTEGER OPERANDS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   IY->(OPERAND A - OPERAND B)
;
; DESTROYS DE AND HL
;
;----
MINUS:
ISUB:
	CALL	POPOPND		;DE=OPERAND B
	XCHG			;HL=OPERAND B
	CALL	POPOPND		;DE=OPERAND A
	XCHG			;HL=A,DE=B
	CLC			;CLEAR CARRY
	DSBC	D		;HL=A-B
	XCHG			;DE=RESULT
IRET:	MVI	A,$IVAL		;TYPE INTEGER
	JMP	PSHOPND		;PUSH A-B
;++++
;
; ADD
; ADDS 2 DOUBLE PRECISION INTEGER OPERANDS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   IY->(OPERAND A + OPERAND B)
;
; DESTROYS DE AND HL
;
;----
PLUS:
IADD:
	CALL	POPOPND		;DE=OPERAND B
	XCHG			;HL=OPERAND B
	CALL	POPOPND		;DE=OPERAND A
	DAD	D		;HL=A+B
	XCHG			;DE=RESULT
	JMPR	IRET		;PUSH A+B
;++++
;
; MOD
; DIVIDES 2 DOUBLE PRECISION INTEGERS AND
; RETURNS THE REMAINDER
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   IY->OPERAND A - (OPERAND A / OPERAND B) * OPERAND B
;
; DESTROYS: DE, HL
;
;----
MOD:	CALL	POPOPND		;DE=OPERAND B
	XCHG			;HL=OPERAND B
	CALL	POPOPND		;DE=OPERAND A
IMOD:	CALL	IPUSH		;A ON NCU STACK
	XCHG			;DE = OPND B
	CALL	IPUSH		;B ON NCU STACK
	XCHG			;A ON NCU STACK
	CALL	IPUSH
	XCHG			;B ON NCU STACK
	CALL	IPUSH
;+
; NCU STACK HAS:
; SP ->	OPND B
;	OPND A
;	OPND B
;	OPND A
;-
	MVI	A,N.SDIV	;DIVIDE A/B
	CALL	DONCU
	MVI	A,N.SMUL	;MULTIPLY (A/B)*B
	CALL	DONCU
	MVI	A,N.SSUB	;SUBTRACT
	CALL	DONCU		;A-(A/B)*B
	CALL	IPOP		;DE = RESULT
	JMPR	IRET		;PUSH & RETURN
;++++
;
; IDIV
; DIVIDES 2 DOUBLE WORD INTEGERS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
; 
; RETURNS:
;   IY->(OPERAND A / OPERAND B)
;
; DESTROYS HL, DE
;
;----
IDIV:	CALL	POPOPND		;DE=OPERAND B
	XCHG			;HL=OPND B
	CALL	POPOPND		;DE=OPERAND A
	CALL	IPUSH		;A ON NCU STACK
	XCHG			;DE=OPND B
	CALL	IPUSH		;B ON NCU STACK
	MVI	A,N.SDIV	;DIVIDE THEM
	CALL	DONCU		;DO THE DIVIDE
	CALL	IPOP		;DE = A/B
	JMPR	IRET		;PUSH & RETURN
;++++
;
; IMUL
; MULTIPLIES 2 DOUBLE PRECISION INTEGERS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   IY -> OPERAND A * OPERAND B
;
; DESTROYS: HL, DE
;
;----
IMUL:	CALL	POPOPND		;DE=OPERAND B
	CALL	IPUSH		;ON NCU STACK
	CALL	POPOPND		;DE=OPERAND A
	CALL	IPUSH		;ON NCU STACK
	MVI	A,N.SMUL	;MULTIPLY
	CALL	DONCU		;A*B
	CALL	IPOP		;DE = RESULT
	JMPR	IRET		;PUSH & RETURN
;++++
;
; RND
; PRODUCES A RANDOM 16 BIT INTEGER IN THE GIVEN
; RANGE (OPERAND A - OPERAND B)
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;    IY->RANDOM INTEGER BETWEEN OPERAND A
;	AND OPERAND B INCLUSIVE
;
;----
RND:	CALL	POPOPND		;DE=OPND B
	XCHG			;HL=OPND B
	CALL	POPOPND		;DE=OPND A
..R1:	CLC			;CLEAR FOR SUB
	DSBC	D		;HL=B-A
	JP	..R2		;B<A? SWITCH THEN
	DAD	D		;HL=OPND B
	XCHG			;OPND A <-> OPND B
	JMPR	..R1		;TRY SUB AGAIN
..R2:	CALL	PSHOPND		;PUSH OPND A
	INX	H		;BUMP BY 1
	PUSH	H		;SAVE B-A
	CALL	IRND		;GET RANDOM NUM
	RES	7,H		;CLEAR SIGN
	POP	D		;DE=B-A,HL=RND
	XCHG			;DE=RND,HL=B-A
	CALL	IMOD		;GET MOD(X,B-A)
	JMP	IADD		;GET A+MOD(X,B-A)
;++++
;
; IRND
; RANDOM BITSTRING ROUTINE - RETURNS 16 BITS OF
; MADNESS IN HL. TAKEN FROM HVGSYS ORIGINALLY
; WRITTEN BY JEFF FREDRICKSON
;
; NEEDS: NOTHING
;
; RETURNS:
;   HL = RANDOM NUMBER (-32767 TO 32767)
;
; DESTROYS: EVERYTHING (ENTIRE 8080 REGISTER SET)
;
;----
IRND:	CALL	..RND1		;GET HI ORDER
	MOV	A,H
	PUSH	PSW
	CALL	..RND1		;GET LO ORDER
	POP	PSW
	MOV	L,A
	RET
..RND1:	LHLD	RANSHT
	CALL	..SHFT
	LXI	B,23
	DAD	B
	ADC	D
	SHLD	RANSHT
	LHLD	RANSHT+2
	MOV	E,A
	CALL	..SHFT
	DAD	D
	SHLD	RANSHT+2
	RET
..SHFT:	MVD	B,H
	CLR	A
	MVI	D,7
..SH1:	DAD	H
	RAL
	DCR	D
	JRNZ	..SH1
	DAD	B
	ADC	D
	RET
;++++
;
; CMP
; COMPARISON ROUTINE FOR RELATIONAL OPERATORS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   BOTH OPERANDS POPPED OFF
;   CC'S SET FOR COMPARISON
;
;
; CALLS:
;   SCMP - STRING COMPARE
;   DCMP - INTEGER COMPARE
;
;----
CMP:
	MOV	B,E.TYP(Y)	;B=TYPE OF OPNDB
	MOV	A,E.TYP-E.SIZ(Y) ;A=TYPE OF OPNDA
	CMP	B		;TYPES EQUAL?
	JRZ	..C2		;DISPATCH, NO CONV
	JRNC	..C1		;A<B, CONVERT A
	PUSH	Y		;SAVE OPND SP
	LXI	D,-E.SIZ	;DE=OFFSET OF A
	DADY	D		;IY->OPND A
	CALL	CONVB		;CONVERT OPND A
	POP	Y		;RESTORE SP
	JMPR	..C2		;DISPATCH
..C1:	MOV	A,B		;A=TYPE OF OPND A
	CALL	CONVB		;CONVERT OPND B
..C2:	CPI	$NULL		;NULLS?
	JZ	DRET		;RETURN EQ THEN
	CPI	$STRADR		;STRINGS?
	JZ	SCMP		;STRING COMPARE
	CPI	$IVAL		;INTEGERS?
	JZ	DCMP		;INT COMPARE
	ERROR	ER.CNV		;ELSE ERROR
;++++
;
; DCMP
; COMPARES 2 DOUBLE PRECISION INTEGER OPERANDS
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   DE = 0 (FALSE)
;   CONDITION CODES SET FOR (OPERAND A - OPERAND B)
;
; DESTROYS HL
;
;----
DCMP:
	CALL	POPOPND		;DE=OPERAND B
	XCHG			;HL=OPERAND B
	CALL	POPOPND		;DE=OPERAND A
	XCHG			;HL=A,DE=B
	CLC			;CLEAR FOR SUB
	DSBC	D		;HL=A-B
DRET:	LXI	D,0		;DE=0 (FALSE)
	MVI	A,$IVAL		;TYPE INT
	RET
;++++
;
; RELATIONAL OPERATORS LT, GT, GE, LE, NE, EQ
;
; NEEDS:
;   IY->OPERAND B
;	OPERAND A
;
; RETURNS:
;   IF THE RELATIONAL OPERATOR WAS SATISFIED BY THE
;   RESULT OF (OPERAND B - OPERAND A)
;   IY->1 (TRUE)
;   ELSE
;   IY->0 (FALSE)
;
; DESTROYS DE, HL
;
;----
GE:	CALL	CMP		;COMPARE A-B
	JP	TRUE		;A >= B?
	JMPR	FALSE		;A < B
LE:	CALL	CMP		;COMPARE A-B
	JRZ	TRUE		;A = B?
	JM	TRUE		;A < B?
	JMPR	FALSE		;A > B
LT:	CALL	CMP		;COMPARE A-B
	JP	FALSE		;A >= B?
TRUE:	INX	D		;DE=1 (TRUE)
FALSE:	JMP	PSHOPND		;SAVE T/F
GT:	CALL	CMP		;COMPARE A-B
	JRZ	FALSE		;A = B?
	JM	FALSE		;A < B?
	JMPR	TRUE		;A > B
EQ:	CALL	CMP		;COMPARE A-B
	JRNZ	FALSE		;A != B?
	JMPR	TRUE		;A = B
NE:	CALL	CMP		;COMPARE A-B
	JRZ	FALSE		;A = B?
	JMPR	TRUE		;A != B
;++++
;
; OPERATOR TABLES
;   UOPTAB - UNARY OPERATORS
;   SOPTAB - SINGLE CHAR BINARY OPERATORS
;   DOPTAB - DOUBLE CHAR UNARY OPERATORS
;
; ENTRIES ARE AS FOLLOWS:
; OFFSET	DESCRIPTION
; ------	-----------
; O.CHAR	CHARACTER DESCRIPTION OF OPERATOR
;		THIS IS 2 BYTES, 2ND BYTE NULL IF
;		IT IS A SINGLE CHAR OPERATOR
; O.PREC	PRECEDENCE OF OPERATOR
; O.TYP		TYPE OF VALUES OPERATOR WANTS
; O.SUB		ADDRESS OF SUBROUTINE TO EVALUATE
;		THE OPERATOR (2 WORDS)
;----
UOPTAB:
	OPER	'-',,6,$IVAL,MINUS	;UNARY MINUS
	OPER	'+',,6,$IVAL,PLUS	;UNARY PLUS
	OPER	'@',,7,$STRADR,IND	;INDIRECTION
OPAREN:	OPER	'(',,0,0,0		;OPEN PAREN
CPAREN:	OPER	')',,0,0,0		;CLOSE PAREN
SOPTAB:
	OPER	'-',,3,$IVAL,ISUB	;SUBTRACTION
	OPER	'+',,3,$IVAL,IADD	;ADDITION
	OPER	'&',,3,$STRADR,CAT	;STRING CONCATENATION
	OPER	'*',,4,$IVAL,IMUL	;MULTIPLICATION
	OPER	'/',,4,$IVAL,IDIV	;DIVISION
	OPER	'\',,4,$IVAL,MOD	;REMAINDER
	OPER	'%',,5,$IVAL,RND	;RANDOM
	OPER	'<',,2,0,LT		;LESS THAN
	OPER	'>',,2,0,GT		;GREATER THAN
	OPER	'=',,2,0,EQ		;EQUAL
	OPER	'#',,2,0,NE		;NOT EQUAL
	OPER	AASN,,1,0,0		;ASSIGNMENT OPER
DOPTAB:
	OPER	'<','=',2,0,LE	;LESS OR EQUAL
	OPER	'>','=',2,0,GE	;GREATER OR EQUAL
	.BYTE	0
.END
                                                                                         