; ****************************************************************************
;
;                                  Calculator
;
; ****************************************************************************

#include "include.inc"

; float number structure
;   0: (1) 1 byte exponent with bias EXPBIAS=128 (0x80): 0.5 exp -1 -> 128, 1 exp 0 -> 129
;   1: (4) 4 bytes mantissa, from high order to lower order
;          bit 7 of 1st (highest) byte = sign

; Text in float number structure:
;  0: (1) length
;  1: (2) address in RAM (high byte, low byte)
;  3: (2) ... unused

	.text

; ===== Constants
; #define C_CONST(len, exp) (((len-1)<<6)+exp-80) // 1st byte of constant (len=length 1..4, exponent must be in range 81..143)
; If exponent is out of range 81..143, then use exponent 80 and real exponent-80 store into next byte.

ConstTab:

; 0: (3) CONST_0 zero 0.0 (expanded to 0x00 0x00 0x00 0x00 0x00)
	.byte	C_CONST(1, 80), 0-80, 0

; 3: (2) CONST_1 one 1.0 (expanded to 0x81 0x00 0x00 0x00 0x00)
	.byte	C_CONST(1, 129), 0

; 5: (2) CONST_05 half 0.5 (expanded to 0x80 0x00 0x00 0x00 0x00)
	.byte	C_CONST(1, 128), 0

; 7: (2) CONST_10 10 (expanded to 0x84 0x20 0x00 0x00 0x00
	.byte	C_CONST(1, 132), 0x20

; 9: (5) CONST_PI2 pi/2 (expanded to value 0x81 0x49 0x0f 0xda 0xa2
	.byte	C_CONST(4, 129), 0x49, 0x0f, 0xda, 0xa2

; 14: (2) CONST_2 two 2.0 (expanded to 0x82 0x00 0x00 0x00 0x00) .... not used
	.byte	C_CONST(1, 130), 0

	.balign 2	; to avoid linker error "warning: internal error: out of range error" must be at the end of unaligned tables

; ----------------------------------------------------------------------------
;                      Get end of calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = end of calculator stack (=STKEND)
; STACK: 2 bytes
; ----------------------------------------------------------------------------
; Saves flags

.global CalcStkEnd
CalcStkEnd:
	ldd	r30,Y+DATA_STKEND
	ldd	r31,Y+DATA_STKEND+1 ; end of calculator stack
	ret

; ----------------------------------------------------------------------------
;                     Get last number on calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
; ----------------------------------------------------------------------------

.global CalcTop
CalcTop:
	rcall	CalcStkEnd	; get end of calculator stack -> Z
	sbiw	r30,5		; Z <- last number on calculator stack
	ret

; ----------------------------------------------------------------------------
;                   Get last number and check if zero
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
; ----------------------------------------------------------------------------

.global CalcTopCheck
CalcTopCheck:

; ----- get last number on calculator stack -> Z
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop

; ----- check zero number (exponent will be = 0)

	ldd	r24,Z+0		; R24 <- exponent
	tst	r24		; zero number?
	ret

; ----------------------------------------------------------------------------
;                    Get pre-last number on calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = pre-last number on calculator stack (=STKEND-2*5)
; STACK: 4 bytes
; ----------------------------------------------------------------------------

.global CalcPreTop
CalcPreTop:
	rcall	CalcStkEnd	; get end of calculator stack -> Z
	sbiw	r30,10		; Z <- pre-last number on calculator stack
	ret

; ----------------------------------------------------------------------------
;                     Get last 2 numbers on calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
; ----------------------------------------------------------------------------

.global CalcTop2
CalcTop2:
	rcall	CalcTop		; get last number on calculator stack -> Z
	movw	r26,r30		; X <- last number
	sbiw	r26,5		; X <- pre-last number
	ret

; ----------------------------------------------------------------------------
;             Get last 2 numbers on calculator stack, inverted
; ----------------------------------------------------------------------------
; OUTPUT: R27:R26 (X) = last number on calculator stack (=STKEND-5)
;	  R31:R30 (Z) = pre-last number on calculator stack (=STKEND-2*5)
; STACK: 8 bytes
; ----------------------------------------------------------------------------

.global CalcTop2B
CalcTop2B:
	rcall	CalcTop2	; get last 2 numbers (X=pre-last, Z=last)

; ExcXZ must follow

; ----------------------------------------------------------------------------
;                    Exchange registers X and Z
; ----------------------------------------------------------------------------
; INPUT and OUTPUT: R31:R30 (Z), R27:R26 (X) = registers to exchange
; DESTROYS: -
; STACK: 2 bytes
; ----------------------------------------------------------------------------

.global ExcXZ
ExcXZ:
	eor	r30,r26		; R30 <- ZL^XL
	eor	r26,r30		; R26 <- ZL
	eor	r30,r26		; R30 <- XL

	eor	r31,r27		; R31 <- ZH^XH
	eor	r27,r31		; R27 <- ZH
	eor	r31,r27		; R31 <- XH
	ret

; ----------------------------------------------------------------------------
;                       Load next literal
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
;	 R24 = next literal
; DESTROYS: R31, R30
; STACK: 2 bytes
; ----------------------------------------------------------------------------

.global CalcLit
CalcLit:
	movw	r30,R_LITL	; Z <- literal pointer
	lpm	r24,Z+		; R24 <- load next literal
	movw	R_LITL,r30	; R_LITH:R_LITL <- save literal pointer
	ret

; ----------------------------------------------------------------------------
;                 Create new number on end of calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = new end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------

.global CalcNew
CalcNew:

; OUTPUT: R31:R30 (Z) = end of calculator stack (=STKEND)
; STACK: 2 bytes
	rcall	CalcStkEnd	; get end of calculator stack -> Z
	clr	r25
	ldi	r24,5		; size of float number -> R25:R24 = 5
	ldi	r26,OFF_MEMTOP

; INPUT: R31:R30 (Z) = start address
;	 R25:R24 = number of bytes to insert (>= 0)
;	 R26 = start offset of first pointer to update (OFF_CURLINE,...)
; OUTPUT: R31:R30 (Z) = start address + number of bytes
;	  R27:R26 (X) = start address
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes
	rjmp	MemIns		; insert data

; ----------------------------------------------------------------------------
;                    Get address of a number in memory area
; ----------------------------------------------------------------------------
; INPUT: R24 = offset of a number (should be multiply of 5)
; OUTPUT: R31:R30 = address of a number in MemAddr
; STACK: 2 bytes
; ----------------------------------------------------------------------------

CalcAddrMem:
	ldd	r30,Y+DATA_MEMADDR
	ldd	r31,Y+DATA_MEMADDR+1
	add	r30,r24
	adc	r31,R_ZERO
	ret

; ----------------------------------------------------------------------------
;                 Store integer number into calculator stack
; ----------------------------------------------------------------------------
; INPUT: (R23:)R22 = unsigned integer
; DESTROYS: R31, R30, R27, R26, R24..R23
; STACK: 8 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------

.global CalcStackB		; stack unsigned byte R22
CalcStackB:
	clr	r23		; clear number HIGH

.global CalcStackW		; stack unsigned word R23:R22
CalcStackW:

; ----- create new number 0 on end of calculator stack -> Z
; OUTPUT: R31:R30 (Z) = new end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes
; CALCULATOR STACK: +1
	rcall	CalcNew		; create number
	rcall	CalcTopZ0	; clear top number -> Z

; ----- zero

	mov	r24,r23		; HIGH byte
	or	r24,r22		; check zero
	breq	CalcStack9	; zero number

; ----- preset exponent to maximum value 65536

	ldi	r24,0x91

; ----- normalize number

CalcStack2:
	dec	r24		; decrement exponent
	lsl	r22		; rotate mantissa left
	rol	r23
	brcc	CalcStack2	; until find highest bit set

; ----- correct mantissa (clear sign bit)

	lsr	r23		; shift mantissa
	ror	r22

; ----- save number

	std	Z+0,r24		; exponent
	std	Z+1,r23		; mantissa high
	std	Z+2,r22		; matnissa low

CalcStack9:
	ret

; ----------------------------------------------------------------------------
;                 Get integer number from calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R25:R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R20..R16
; STACK: 10 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; Valid range is 0..65535.4999 (negative or positive)
; L158A

.global CalcUnstackW
CalcUnstackW:

; ---- fetch number from stack and delete it -> Z (pointer to new top number)
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = number
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1
	rcall	CalcFetch
	rcall	CalcTop		; get pointer to new top number

; ----- zero number

	clr	r25		; clear result HIGH
	clr	r24		; clear result LOW
	tst	R_M1		; check zero exponent
	breq	CalcUnstack72	; zero

; ----- get mantissa -> R23:R22

	movw	r24,R_M3	; get first 2 bytes from mantissa
	ori	r25,B7		; set implied hidden bit

; ----- prepare (and check) exponent

	subi	R_M1,0x91	; subtract exponent of 65536
	brcc	CalcUnstack8	; overflow exponent (>= 65536)
	inc	R_M1		; exponent + 1
	neg	R_M1		; negate exponent -> value 0..15
	breq	CalcUnstack6	; already maximal exponent 0

; ----- normalize mantissa

CalcUnstack4:
	lsr	r25		; rotate mantissa HIGH to right
	ror	r24		; rotate mantissa LOW to right
	dec	R_M1		; decrement exponent
	brne	CalcUnstack4	; normalize

; ----- rounding

	ror	R_M4		; save lowest bit (for rounding)
CalcUnstack6:
	lsl	R_M4		; shift lower byte left
	brcc	CalcUnstack7	; no rounding
	adiw	r24,1		; rounding up
	brcs	CalcUnstack8	; overflow

; ----- result is OK

CalcUnstack7:
	andi	R_M2,B7		; check negative flag
CalcUnstack72:
	clc			; clear carry flag
	ret

; ----- overflow

CalcUnstack8:
	andi	R_M2,B7		; check negative flag
CalcUnstack9:
	sec			; set carry flag (=overflow)
	ret

; ----------------------------------------------------------------------------
;                 Get integer number from calculator stack
; ----------------------------------------------------------------------------
; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; Valid range is 0..255.4999 (negative or positive)
; L15CD

.global CalcUnstackB
CalcUnstackB:
; OUTPUT: R25:R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R20..R16
; STACK: 10 bytes
; CALCULATOR STACK: -1
	rcall	CalcUnstackW
	brcs	CalcUnstackB6	; overflow

	ldi	r26,0
	breq	CalcUnstackB2
	inc	r26		; save Z flag

CalcUnstackB2:
	tst	r25		; check number HIGH
	breq	CalcUnstackB4	; number is <= 255
	sec			; set overflow flag
CalcUnstackB4:
	tst	r26		; return Z flag (=negative number)

CalcUnstackB6:
	ret

; ----------------------------------------------------------------------------
;                 Print character into output buffer OutBuf
; ----------------------------------------------------------------------------
; INPUT: R24 = character
; DESTROYS: R27, R26
; ----------------------------------------------------------------------------

.global OutChar0
OutChar0:
	ldi	r24,CH_0

.global OutChar
OutChar:
	ldd	r26,Y+DATA_OUTBUFNUM ; current number of characters
	clr	r27
	subi	r26,lo8(-(OutBuf)) ; current address
	sbci	r27,hi8(-(OutBuf))
	st	X+,r24		; output character
	subi	r26,lo8(OutBuf) ; current address
	std	Y+DATA_OUTBUFNUM,r26 ; set new number of characters
	ret



; !!!!!!!!!!!!!!!!!!

OutCh:
	push	r26
	push	r27
	rcall	OutChar
	pop	r27
	pop	r26
	ret


OutHexB:
	push	r24
	swap	r24
	rcall	OutHexN
	swap	r24
	rcall	OutHexN
	ldi	r24,CH_SPC
	rcall	OutCh
	pop	r24
	ret

OutHexN:
	push	r24
	andi	r24,0x0f
	cpi	r24,10
	brcs	OutHexN2
	subi	r24,-7
OutHexN2:
	subi	r24,-CH_0
	rcall	OutCh
	pop	r24
	ret

; ----------------------------------------------------------------------------
;                   Decode number into output buffer OutBuf
; ----------------------------------------------------------------------------
; DESTROYS: 
; STACK: ? bytes
; CALCULATOR STACK: -1
; uses: MEM0..MEM5
; ----------------------------------------------------------------------------
; L15DB

.global DecNum
DecNum:

; ----- reset output buffer

	std	Y+DATA_OUTBUFNUM,R_ZERO

; ----- check negative number

	rcall	Calc
; offset 0
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_LT0		; less than 0 (x,1/0)
	.byte	C_JUMPT		; jump if true (jump if number is negative)
	.byte	8		; jump to offset 12 (12-4=8)

; ----- check zero number
; offset 4
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_GR0		; greater than 0 (x,1/0)
	.byte	C_JUMPT		; jump if true (jump if number is positive, not zero)
	.byte	12		; jump to offset 20 (20-8=12)

; ----- number is zero
; offset 8
	.byte	C_DEL		; delete
	.byte	C_END		; end
; offset 10
	.balign 2		; align
; ofset 10
	rjmp	OutChar0	; write zero

; ----- number is negative - print '-' and negate number
; offset 12
	.byte	C_ABS		; absolute value
	.byte	C_END		; end
; offset 14
	.balign 2		; align
; offset 14
	ldi	r24,CH_MINUS
	rcall	OutChar		; write '-'

; offset 18
	rcall	Calc

; ----- number is positive
; offset 20
	.byte	C_END		; end
; offset 21
	.balign 2		; align

; ----- save exponent
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes

; offset 22
	rcall	CalcTop		; get top number
	ld	r22,Z		; exponent

; INPUT: (R23:)R22 = unsigned integer
; DESTROYS: R31, R30, R27, R26, R24..R23
; STACK: 8 bytes
; CALCULATOR STACK: +1

; offset 26
	rcall	CalcStackB	; stack exponent

; ----- convert binary exponent to decimal exponent
; offset 28
	rcall	Calc		; (x,e)
	.byte	C_DATA		; stack data
	.byte	C_CONST(2,0x88)	; constant 0x88 0x00 0x80 (0x00 0x00) (=128.5)
	.byte	0x00,0x80	; (x,e,128.5)
	.byte	C_SUB		; subtract (x,e-128.5)
	.byte	C_DATA		; stack data
	.byte	C_CONST(4,0x7f)	; constant 0x7F 0x1A 0x20 0x9A 0x85 (= log10(2) = 0.30103)
	.byte	0x1a,0x20,0x9a,0x85
	.byte	C_MUL		; multiply (x,(e-128.5)*log10(2))
	.byte	C_INT		; integer (x,n) (uses MEM0)
	.byte	C_SETMEM(0)	; set memory 0 from stack (decimal exponent)
	.byte	C_EXC		; exchange (n,x)
	.byte	C_GETMEM(0)	; get memory 0 into stack (n,x,n)

; ----- normalize mantissa (multiplyied by 10^8)

	.byte	C_DATA		; stack data
	.byte	C_CONST(1,0x84)	; constant 0x84 0x00 (0x00 0x00 0x00) (= 8)
	.byte	0
	.byte	C_SUB		; subtract (n,x,n-8)
	.byte	C_NEG		; negate (n,x,8-n)
	.byte	C_EFP		; E to fp, normalize mantissa (n,x*(10^n)) (uses MEM0 MEM1)

; ----- round mantissa to 8 or 9 digits

	.byte	C_CONSTAB(CONST_05) ; constant 0.5
	.byte	C_ADD		; add 0.5
	.byte	C_INT		; integer (uses MEM0)
	.byte	C_END		; end
	.balign 2		; align

; ----- prepare temporary buffer in (MEM2) MEM3, MEM4 and MEM5 -> Z (space for 11 digits)

	ldi	r30,lo8(NumBuf+3*5-1) ; last byte of MEM3
	ldi	r31,hi8(NumBuf+3*5-1)
	st	Z+,R_ZERO	; save 1st digit '0'

; ----- decode 10 digits of mantissa into buffer MEM4 and MEM5

	ldi	r22,10		; 10 digits

; ----- save pointer and counter

DecNum4:
	push	r30
	push	r31
	push	r22

; ----- decode next digit from mantissa

	rcall	Calc		; 
	.byte	C_CONSTAB(CONST_10) ; stack 10 (m,10)
	.byte	C_MOD		; modulus (m mod 10, m/10) (uses MEM0 MEM1)
	.byte	C_EXC		; exchange (m/10,m mod 10)
	.byte	C_END		; end
	.balign 2		; align

; ----- get digit
; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
	rcall 	CalcUnstackB	; integer -> R24

; ----- save digit

	pop	r22
	pop	r31
	pop	r30
	st	Z+,r24

; ----- loop counter

	dec	r22
	brne	DecNum4

; ----- skip leading zeroes and find highest non-zero digit -> Z
; There will be 0, 1 or 2 leading zeroes.

	push	r30
	push	r31		; save pointer to end after digits
1:
	ld	r24,-Z		; load digit
	cpi	r24,0		; zero?
	breq	1b		; skip zeroes

; ----- shift pointer to first digit of mantissa (skip 8 digits)
; Remains 9, 10 or 11 digits. Pointer can start on last byte of MEM3.

	sbiw	r30,8		; pointer to 1st digit
	push	r30
	push	r31		; save pointer to 1st digit

; ----- round mantissa by last digit (highest digit will not overflow)

	ld	r24,Z+		; load last digit
	cpi	r24,5		; round up?
	brcs	2f		; no rounding

1:	ld	r24,Z		; load next digit
	inc	r24		; increase digit
	st	Z,r24		; save new digit
	cpi	r24,10		; overflow?
	brcs	2f		; no overflow
	ldi	r24,B7		; digit 0 + bit 7 = stop mark of trailing zeroes
	st	Z+,r24		; save digit 0
	rjmp	1b		; carry to next digit

; ----- insert 6 trailing zeroes
; This may overlap last byte of MEM2 by 0x80

2:	pop	r31		; return pointer to 1st digit (first rounding)
	pop	r30

	ldi	r22,6		; 6 digits
	ldi	r24,B7		; digit 0 + bit 7 = stop mark of trailing zeroes
3:	st	Z,r24		; store digit 0 with stop mark set
	sbiw	r30,1
	dec	r22
	brne	3b

; ----- prepare exponent -> R24

	rcall	Calc
	.byte	C_DEL		; delete mantissa
	.byte	C_END		; end
	.balign 2		; align

; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
	rcall 	CalcUnstackB	; integer -> R24
	mov	r22,r24		; R22 <- exponent
	breq	1f		; number is positive
	neg	r22		; absolute value of exponent
1:	subi	r22,-2		; exponent + 2 = count of digits before decimal point

; ----- find number of digits before decimal point

	pop	r31		; pop pointer to end after digits
	pop	r30

1:	dec	r22		; decrement exponent
	ld	r24,-Z		; load digit
	tst	r24		; is digit 0 ?
	breq	1b		; find non-zero digit

; ----- check if E-format is needed

	mov	r24,r22		; exponent
	subi	r24,5		; 5 digits
	cpi	r24,8		; maximum digits is 13
	brpl	DecNumE		; print E-format
	cpi	r24,-10		; more than 4 zeroes after point?
	brmi	DecNumE		; print E-format
	subi	r24,-6		; test for leading zeroes (0.5)
	breq	DecNumLead	; print leading zero
	brmi	DecNumZero	; print zeroes after decimal point

; ----- fixed point, output digits before decimal point

	mov	r22,r24
1:	rcall	DecNumDig
	dec	r22
	brne	1b
	rjmp	DecNumDot	; print decimal point and trailing digits

; ----- print number in E-format (R22=exponent)

DecNumE:
	; 1st digit (before decimal point)
	rcall	DecNumDig	; print 1st digit

	; dot and trailing digits
	rcall	DecNumDot	; print decimal point and trailing digits

	; character 'E'
	ldi	r24,CH_E
	rcall	OutChar		; print character 'E'

	; sign of exponent
	ldi	r24,CH_PLUS
	tst	r22		; test sign of exponent
	brpl	1f		; exponent is positive
	neg	r22		; absolute value of exponent
	ldi	r24,CH_MINUS
1:	rcall	OutChar		; print sign of exponent

	; convert exponent to digits
	ldi	r24,CH_0-1
2:	inc	r24		; increase digit
	subi	r22,10		; subtract 10
	brcc	2b

	subi	r22,-10-CH_0
	cpi	r24,CH_0	; leading zero?
	breq	3f		; skip leading zero
	rcall	OutChar		; print 1st digit

3:	mov	r24,r22
	rjmp	OutChar		; print 2nd digit

; ----- print zeroes after decimal point (before valid fractional digits; e.g. .0000999)

DecNumZero:
;	rcall	OutChar0

	neg	r22		; negate exponent = number of zeroes 1 to 4

	ldi	r24,CH_DOT
	rcall	OutChar		; output character

	dec	r22
	breq	DecNumFrac

1:	rcall	OutChar0	; output character '0'
	dec	r22
	brne	1b

	rjmp	DecNumFrac	; print valid fracitonal digits

; ----- print leading zero, decimal point and trailing digits

DecNumLead:
	rcall	OutChar0	; output character '0'

; ----- print decimal point and trailing digits

DecNumDot:
	ld	r24,Z		; load next digit
	cpi	r24,0x80	; end mark?
	breq	DecNumDig2	; end mark (trailing zero)

; ----- print decimal point

	ldi	r24,CH_DOT
	rcall	OutChar		; output character

; ----- print valid fractional digits

DecNumFrac:
	ld	r24,Z		; load next digit
	cpi	r24,0x80	; end mark?
	breq	DecNumDig2	; end mark (trailing zero)
	rcall	DecNumDig	; print digit
	rjmp	DecNumFrac	; next digit

; ----- decode digit from Z- (destroy X)

DecNumDig:
	ld	r24,Z
	andi	r24,0x0f	; mask only digit bits
	subi	r24,-CH_0
	rcall	OutChar		; output character
	sbiw	r30,1
DecNumDig2:
	ret

; ========================== Calculator functions =============================

; ----------------------------------------------------------------------------
;                   No function, align (C_NOP, 0)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; STACK: 2 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------

CalcNop:
	ret

; ----------------------------------------------------------------------------
;                   Swap two numbers on top of stack (C_EXC, 1)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1A72

.global CalcSwap
CalcSwap:

; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes

	rcall	CalcTop2	; get pre-last number -> X and last number -> Z

	ldi	r23,5		; R23 <- length of number
1:	ld	r24,Z
	ld	r25,X
	st	X+,r24
	st	Z+,r25
	dec	r23
	brne	1b
	ret

; ----------------------------------------------------------------------------
;               Prepare number for multiplication and division
; ----------------------------------------------------------------------------
; INPUT: R_MS = previous sign flag
;	 R31:R30 (Z) = pointer to the number
; OUTPUT: R_MS = new sign flag
;	  flag Z = number is zero
; DESTROYS: R_MT
; STACK: 2 bytes
; ----------------------------------------------------------------------------
; Get sign bit and restore hidden bit of mantissa.
; L17BC

CalcPrepMul:

; ----- test for zero

	ldd	R_MT,Z+0	; fetch exponent
	tst	R_MT		; zero number?
	breq	CalcPrepMul9	; number is zero

; ----- check sign and restore highest bit of the mantissa

	ldd	R_MT,Z+1	; 1st byte of the mantissa
	eor	R_MS,R_MT	; flip sign flag
	ori	R_MT,B7		; restore hidden highest bit of the mantissa
	std	Z+1,R_MT	; save new 1st byte
	; here is Z flag clear

CalcPrepMul9:
	ret


; ===== here is rest of CalcMul function (to reach with branch instructions)

; ----- clear result
; OUTPUT: R31:R30 (Z) = pre-last number on calculator stack (=STKEND-2*5)
; STACK: 4 bytes

CalcMul8:
	rcall	CalcPreTop	; get pre-last number -> Z
	rcall	CalcZ0		; clear number Z

; ----- delete 2nd operand

; CalcDel must follow

; ----------------------------------------------------------------------------
;                Delete number from top of the stack (C_DEL, 2)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30
; STACK: 6 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L19E3

.global CalcDel
CalcDel:

; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop		; get last number -> Z

; ----- set new end of stack to Z (saves SREG)

CalcDel2:
	std	Y+DATA_STKEND,r30 ; save new end of stack
	std	Y+DATA_STKEND+1,r31
	ret

; ----------------------------------------------------------------------------
;                        Multiplication (C_MUL, 4)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 10 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L17C6

.global CalcMul
CalcMul:

; ----- get last 2 numbers (1st -> X, 2nd -> Z)
; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
	rcall	CalcTop2

; ----- prepare numbers for multiplication; -> 1st number Z, 2nd number X, sign bit R_MS (not masked)
; INPUT: R_MS = previous sign flag
;	 R31:R30 (Z) = pointer to the number
; OUTPUT: R_MS = new sign flag
;	  flag Z = number is zero
; DESTROYS: R_MT
; STACK: 2 bytes

	clr	R_MS		; prepare sign flag = 0
	rcall	CalcPrepMul	; prepare 2nd number
	breq	CalcMul8	; 2nd number is zero, clear result
	rcall	ExcXZ		; exchange pointers
	rcall	CalcPrepMul	; prepare 1st number
	breq	CalcDel		; 1st number is zero, only delete 2nd operand (result will be zero)

; ----- fetch 2 numbers and delete 2nd number:
;			1st number Z -> R_M1:R_M2:R_M3:R_M4:R_M5
;			2nd number X -> R_N1:R_N2:R_N3:R_N4:R_N5
; INPUT: R31:R30 (Z) = pointer to 1st number
;	 R27:R26 (X) = pointer to 2nd number
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = 1st number (from Z)
;	  R_N1:R_N2:R_N3:R_N4:R_N5 = 2nd number (from X)
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1

	rcall	CalcFetch2

; ----- multiplication of mantissas, R_M2:R_M3:R_M4:R_M5 * R_N2:R_N3:R_N4:R_N5 -> R_MT2:R_MT3:R_MT4:R_MT5

	; clear result register
	clr	R_MT2
	clr	R_MT3
	clr	R_MT4
	clr	R_MT5

	; prepare loop counter
	ldi	R_MTT,32+1	; number of loops + 1
	rjmp	CalcMulLoop4	; loop (C flag is undefined here, but it does not matter)

	; add 2nd number if carry
CalcMulLoop:
	brcc	CalcMulLoop2	; no carry (no add)

	add	R_MT5,R_N5
	adc	R_MT4,R_N4
	adc	R_MT3,R_N3
	adc	R_MT2,R_N2

	; shift result right (with carry from previous add operation)
CalcMulLoop2:
	ror	R_MT2
	ror	R_MT3
	ror	R_MT4
	ror	R_MT5

	; shift 1st number right (with carry from result)
CalcMulLoop4:
	ror	R_M2
	ror	R_M3
	ror	R_M4
	ror	R_M5	

	; loop counter
	dec	R_MTT		; loop counter (C stays untouched)
	brne	CalcMulLoop

; ----- prepare exponent -> R_EXH:R_EXL (here is R_EXH=R_MTT=0)

	add	R_M1,R_N1	; sum both exponents
	adc	R_EXH,R_EXH	; carry
	mov	R_EXL,R_M1	; exponent LOW
	subi	R_EXL,EXPBIAS-1	; subtract exponent bias
	sbc	R_EXH,R_ZERO

; ----- prepare sign -> R_M1

	mov	R_M1,R_MS

; ----- prepare mantissa -> R_M2:R_M3:R_M4:R_M5(:R_M6)

	mov	R_M6,R_M2	; low carry from result
	movw	R_M5,R_MT5
	movw	R_M3,R_MT3

; ----- normalize number R_M1 sign, R_M2:R_M3:R_M4:R_M5(:R_M6) mantissa, R_EXH:R_EXL exponent
; L1828

CalcMulNorm:
	ldi	R_MS,32		; max. number of shifts
CalcMulNorm2:
	sbrc	R_M2,7		; check highest bit of mantissa
	rjmp	CalcMulNorm5	; highest bit is on the position, number is normalized
	lsl	R_M6
	rol	R_M5
	rol	R_M4
	rol	R_M3
	rol	R_M2		; shift mantissa 1 bit left
	sbiw	R_EXL,1		; decrement exponent
	dec	R_MS		; bit counter
	brne	CalcMulNorm2

; ----- underflow, result is zero
; INPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = number (mantissa)
; OUTPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = 0
; STACK: 2

	rcall	CalcAddClear5	; clear R_M1..R_M5
	clr	R_M6
	clr	R_EXL
	clr	R_EXH

; ----- round up

CalcMulNorm5:
	lsl	R_M6		; check lowest bit
	brcc	CalcMulNorm6	; no carry

; INPUT: R_M2:R_M3:R_M4:R_M5 = number (mantissa, lower 4 bytes)
; OUTPUT: returns Z flag if result is 0 (input was 0x?? 0xFF 0xFF 0xFF 0xFF)
; STACK: 2
	rcall	CalcAddBack	; increment mantissa
	brne	CalcMulNorm6	; result is not 0
	ldi	R_M2,0x80	; overflow, set value to 0x80 0x00 0x00 0x00
	adiw	R_EXL,1		; increment exponent R_EXH:R_EXL

; ----- check exponent

CalcMulNorm6:
	tst	R_EXH		; check exponent HIGH
	brmi	CalcMulUnder	; exponent is < 0, underflow
	brne	CalcMulOver	; exponent is > 255, overflow
	tst	R_EXL		; check exponent LOW
	breq	CalcMulUnder	; exponent is = 0, underflow

; ----- prepare 1st byte of mantissa -> R_M2

	andi	R_M2,0x7f	; reset hidden highest bit "1"
	andi	R_M1,0x80	; mask sign flag
	or	R_M2,R_M1	; put bits together

; ----- exponent -> R_M1

	mov	R_M1,R_EXL
	
; ----- save result R_M1:R_M2:R_M3:R_M4:R_M5
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes

CalcMulSave:
	rcall	CalcTop		; get pointer to top number -> Z
	std	Z+0,R_M1
	std	Z+1,R_M2
	std	Z+2,R_M3
	std	Z+3,R_M4
	std	Z+4,R_M5
	ret

; ----- underflow, reset result to 0
; INPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = number (mantissa)
; OUTPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = 0
; STACK: 2

CalcMulUnder:
	rcall	CalcAddClear5	; clear result
	rjmp	CalcMulSave	; save result

; ----- overflow error

CalcMulOver:
	ldi	r24,ERR_OVERFLOW
	rjmp	Error

; ----------------------------------------------------------------------------
;                        Division (C_DIV, 5)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L1882

.global CalcDiv
CalcDiv:

; ----- get last 2 numbers (1st -> X, 2nd -> Z)
; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
	rcall	CalcTop2

; ----- prepare numbers for multiplication; -> 1st number Z, 2nd number X, sign bit R_MS (not masked)
; INPUT: R_MS = previous sign flag
;	 R31:R30 (Z) = pointer to the number
; OUTPUT: R_MS = new sign flag
;	  flag Z = number is zero
; DESTROYS: R_MT
; STACK: 2 bytes

	clr	R_MS		; prepare sign flag = 0
	rcall	CalcPrepMul	; prepare 2nd number
	breq	CalcMulOver	; 2nd number is zero, overflow
	rcall	ExcXZ		; exchange pointers
	rcall	CalcPrepMul	; prepare 1st number
	brne	CalcDiv2	; 1st number is not zero
	rjmp	CalcDel		; 1st number is zero, only delete 2nd operand (result will be zero)

; ----- fetch 2 numbers and delete 2nd number:
;			1st number Z -> R_M1:R_M2:R_M3:R_M4:R_M5
;			2nd number X -> R_N1:R_N2:R_N3:R_N4:R_N5
; INPUT: R31:R30 (Z) = pointer to 1st number
;	 R27:R26 (X) = pointer to 2nd number
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = 1st number (from Z)
;	  R_N1:R_N2:R_N3:R_N4:R_N5 = 2nd number (from X)
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1

CalcDiv2:
	rcall	CalcFetch2

; ----- division of mantissas, dividend R_M2:R_M3:R_M4:R_M5 / divisor R_N2:R_N3:R_N4:R_N5 -> quotient R_MT2:R_MT3:R_MT4:R_MT5

	; clear quotient result LOW
	clr	R_MT5
	clr	R_M6

	; prepare loop counter
	ldi	R_MTT,-33	; negative 'number of loops + 1' (=32 loops + 1 extra increment)
	rjmp	CalcDivLoop4	; start loop (carry is undefined, but not needed)

CalcDivLoop:
	; shift quotient left, adding result carry from right
	rol	R_MT5
	rol	R_MT4
	rol	R_MT3
	rol	R_MT2

CalcDivLoop2:
	; shift dividend left
	lsl	R_M5
	rol	R_M4
	rol	R_M3
	rol	R_M2
	brcs	CalcDivLoop6	; carry - dividend is higher than divisor, subtract only (result bit will be 1)

CalcDivLoop4:
	; try to subtract divisor from dividend
	sub	R_M5,R_N5
	sbc	R_M4,R_N4
	sbc	R_M3,R_N3
	sbc	R_M2,R_N2
	brcc	CalcDivLoop8	; no cary, no restore (dividend is not smaller than divisor, result bit will be 1)

	; carry is set - dividend is smaler than divisor, restore dividend (result bit will be 0)
	add	R_M5,R_N5
	adc	R_M4,R_N4
	adc	R_M3,R_N3
	adc	R_M2,R_N2
	clc			; clear carry flag
	rjmp	CalcDivLoop9	; result bit will be 0

CalcDivLoop6:
	; subtract only, result bit will be 1
	sub	R_M5,R_N5
	sbc	R_M4,R_N4
	sbc	R_M3,R_N3
	sbc	R_M2,R_N2

CalcDivLoop8:
	; result bit is 1
	sec			; set carry flag, result bit is 1

CalcDivLoop9:
	; loop counter
	inc	R_MTT		; loop counter (C stays untouched)
	brmi	CalcDivLoop	; do 32 loops, while loop counter is negativ

	; one extra loop, to get bit 34 (we already have bit 33 in carry)
	rol	R_M6		; save bit 33 and than bit 34
	tst	R_MTT		; check loop counter
	breq	CalcDivLoop2	; one extra loop

; ----- prepare extra result byte -> R_MT6 (bits 33 and 34)

	ror	R_M6
	ror	R_M6
	ror	R_M6		; sihft bits 33 and 34 to right position 6 and 7

; ----- prepare exponent -> R_EXH:R_EXL (here is R_EXH=R_MTT=0)

	clr	R_EXH		; exponent high = 0
	sub	R_M1,R_N1	; difference of exponents
	sbc	R_EXH,R_ZERO	; carry
	mov	R_EXL,R_M1	; exponent LOW
	subi	R_EXL,-EXPBIAS	; add exponent bias
	sbci	R_EXH,-1

; ----- prepare sign -> R_M1

	mov	R_M1,R_MS

; ----- prepare mantissa -> R_M2:R_M3:R_M4:R_M5

	movw	R_M5,R_MT5
	movw	R_M3,R_MT3

; ----- normalize number R_M1 sign, R_M2:R_M3:R_M4:R_M5(:R_M6) mantissa, R_EXH:R_EXL exponent

	rjmp	CalcMulNorm

; ----------------------------------------------------------------------------
;       Fetch 1 number (or text) from calculator stack and delete it
; ----------------------------------------------------------------------------
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = number
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L13F8

CalcFetch:

; ----- get pointer to top number -> Z
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop		; get last number -> Z

; ----- load number

CalcFetch1:
	ldd	R_M1,Z+0
	ldd	R_M2,Z+1
	ldd	R_M3,Z+2
	ldd	R_M4,Z+3
	ldd	R_M5,Z+4

; ----- delete top number
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30
; STACK: 6 bytes
; CALCULATOR STACK: -1

	rjmp	CalcDel

; ----------------------------------------------------------------------------
;     Fetch 2 numbers and delete top number (used for ADD, SUB, MUL, DIV)
; ----------------------------------------------------------------------------
; INPUT: R31:R30 (Z) = pointer to 1st number
;	 R27:R26 (X) = pointer to 2nd number
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = 1st number (from Z)
;	  R_N1:R_N2:R_N3:R_N4:R_N5 = 2nd number (from X)
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L16F7

CalcFetch2:

; ----- fetch 2nd number

	ld	R_N1,X+
	ld	R_N2,X+
	ld	R_N3,X+
	ld	R_N4,X+
	ld	R_N5,X

	rjmp	CalcFetch1	; fetch 1st number and delete top number

; ----------------------------------------------------------------------------
;                 Fetch 2 texts and delete top operand
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z,=R_M2:R_M3) = pointer to 1st text
;	  R27:R26 (X,=R_N2:R_N3) = pointer to 2nd text
;	  R20 (R_M1) = length of 1st text
;	  R14 (R_N1) = length of 2nd text
; DESTROYS: R21..R16 (R_M2..R_M5), R13..R10 (R_N2..R_N5)
; STACK: 10 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------

.global CalcFetch2Txt
CalcFetch2Txt:

; ----- get operands and delete 2nd operand -> 1st text = Z addr + R_M1 len, 2nd text = X addr + R_N1 len

; Text in float number structure:
;  0: (1) length
;  1: (2) address in RAM
;  3: (2) ... unused

; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
	rcall	CalcTop2

; INPUT: R31:R30 (Z) = pointer to 1st number
;	 R27:R26 (X) = pointer to 2nd number
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = 1st number (from Z)
;	  R_N1:R_N2:R_N3:R_N4:R_N5 = 2nd number (from X)
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1
	rcall	CalcFetch2	; fetch strings and delete top number
	movw	r30,R_M3	; 1st text address (length is R_M1) -> Z
	movw	r26,R_N3	; 2nd text address (length is R_N1) -> X
	ret

; ----------------------------------------------------------------------------
;                            OR operator (C_OR, 7)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; Result is zero, if both values are zero; else a non-zero value.
; e.g.    0 OR 0  returns 0.
;        -3 OR 0  returns -3.
;         0 OR -3 returns 1.
;        -3 OR 2  returns 1.
; L1AED

.global CalcOr
CalcOr:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck

; ----- destroy last number (saves SREG)

	rcall	CalcDel2	; set stack end to Z (saves SREG)

; ----- if second number is zero, first operand will stay unchanged

	breq	CalcPrepAdd9	; second number is zero -> first number will contain result (0 or nonzero number)

; ----- second number is not zero, result will be TRUE - set number in Z to +1

; CalcTopZ1 must follow

; ----------------------------------------------------------------------------
;                   Set number on top of the stack to 1
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; DESTROYS: R24
; STACK: 6 bytes
; ----------------------------------------------------------------------------

.global CalcTopZ1
CalcTopZ1:
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop		; get last number -> Z
; INPUT: R31:R30 = float number
; DESTROYS: R24
; STACK: 2 bytes
	rjmp	CalcZ1		; set new last number to 1

; ----------------------------------------------------------------------------
;                            AND operator (C_AND, 8)
;                        String AND operator (C_SAND, 16)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; Result is zero, if any of the values is zero; else a non-zero value.
; Can be used as string operator too - because 1st byte contain text length.
; e.g.    -3 AND 2  returns -3.
;         -3 AND 0  returns 0.
;          0 and -2 returns 0.
;          0 and 0  returns 0.
;
; L1AF3, L1AF8

.global CalcSAnd
.global CalcAnd
CalcSAnd:
CalcAnd:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck

; ----- destroy last number (saves SREG)

	rcall	CalcDel2	; set stack end to Z (saves SREG)

; ----- if second number is not zero, first operand will stay unchanged

	brne	CalcPrepAdd9	; second number is not zero -> first number will containg result

; ----- second number is zero, result will be FALSE - set number in Z to 0

; CalcTopZ0 must follow

; ----------------------------------------------------------------------------
;                   Set number on top of the stack to 0
; ----------------------------------------------------------------------------
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
; ----------------------------------------------------------------------------

.global CalcTopZ0
CalcTopZ0:
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop		; get last number -> Z
; INPUT: R31:R30 = float number
; STACK: 2 bytes
	rjmp	CalcZ0		; set new last number to 0

; ----------------------------------------------------------------------------
;                   Prepare number for addition
; ----------------------------------------------------------------------------
; INPUT: R31:R30 (Z) = pointer to the number
; OUTPUT: R_AX1 = exponent
; DESTROYS: R_AT1..R_AT4
; STACK: 2 bytes
; ----------------------------------------------------------------------------
; Clear exponent and expand mantissa to 5 bytes signed.
; L16D8

CalcPrepAdd:

; ----- get exponent and test for zero, clear 1st byte (highest byte of mantissa)

	ldd	R_AX1,Z+0	; fetch exponent
	std	Z+0,R_ZERO	; clear 1st byte as highest byte of mantissa
	tst	R_AX1		; zero number?
	breq	CalcPrepAdd9	; number is zero

; ----- check sign and restore highest bit of the mantissa

	ldd	R_AT1,Z+1	; 1st byte of the mantissa
	bst	R_AT1,7		; load sign bit into T flag
	ori	R_AT1,B7	; restore hidden highest bit of the mantissa
	std	Z+1,R_AT1	; save new 1st byte
	brtc	CalcPrepAdd9	; number is positive, all ok

; ----- negate mantissa

	ldd	R_AT2,Z+2
	ldd	R_AT3,Z+3
	ldd	R_AT4,Z+4

	com	R_AT1
	com	R_AT2
	com	R_AT3

	neg	R_AT4		; carry will be set if number was NOT 0 (R_AT4 = 0 - R_AT4, CARRY <- (R_AT4 != 0))

	sbci	R_AT3,0xff	; increment if lower byte was 0, set carry if result is NOT 0 (R_AT3 = R_AT3 - (0xFF + CARRY))
	sbci	R_AT2,0xff
	sbci	R_AT1,0xff
 
	std	Z+0,R_MINUS	; 1st byte = 0xff
	std	Z+1,R_AT1
	std	Z+2,R_AT2
	std	Z+3,R_AT3
	std	Z+4,R_AT4

CalcPrepAdd9:
	ret

; ----------------------------------------------------------------------------
;              Shift 1st number right (to normalize numbers)
; ----------------------------------------------------------------------------
; INPUT: R_AX2 = number of shifts
;	 R_M1:R_M2:R_M3:R_M4:R_M5 = normalized number (mantissa, R_M1=0x00 or 0xFF)
; DESTROYS: R_AX2
; STACK: 4
; ----------------------------------------------------------------------------
; L171A

CalcAddShift:

; ----- check difference of exponents

	tst	R_AX2
	breq	CalcAddClear9	; numbers are normalized, no shift needed

; ----- check overflow

	cpi	R_AX2,33	; max. size of mantissa
	brcc	CalcAddClear5	; overflow difference, clear the number

; ----- rotate mantissa right

CalcAddShift2:
	asr	R_M1		; bit 7 unchanged
	ror	R_M2
	ror	R_M3
	ror	R_M4
	ror	R_M5
	dec	R_AX2
	brne	CalcAddShift2

; ----- round up, if last shiftet bit was set
; INPUT: R_M2:R_M3:R_M4:R_M5 = number (mantissa, lower 4 bytes)
; OUTPUT: returns Z flag if result is 0 (input was 0x?? 0xFF 0xFF 0xFF 0xFF)
; STACK: 2

	brcc	CalcAddClear9	; no carry bits
	rcall	CalcAddBack	; increment mantissa (only 4 bytes)
	brne	CalcAddClear9	; no overflow
; Overflow (here is number 0xFF 0x00 0x00 0x00 0x00), result will be 0

; CalcAddClear5 must follow

; ----------------------------------------------------------------------------
;                   Clear result number (4 or 5 bytes of mantissa)
; ----------------------------------------------------------------------------
; INPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = number (mantissa)
; OUTPUT: (R_M1:)R_M2:R_M3:R_M4:R_M5 = 0
; STACK: 2
; ----------------------------------------------------------------------------
; L1736

CalcAddClear5: ; clear 5 bytes
	clr	R_M1
CalcAddClear4: ; clear 4 bytes
	clr	R_M5
	clr	R_M4
	movw	R_M3,R_M5	; clear R_M2 and R_M3
CalcAddClear9:
	ret

; ----------------------------------------------------------------------------
;          Add 1 back to 1st number (only 4 lower bytes of mantissa)
; ----------------------------------------------------------------------------
; INPUT: R_M2:R_M3:R_M4:R_M5 = number (mantissa, lower 4 bytes)
; OUTPUT: returns Z flag if result is 0 (input was 0x?? 0xFF 0xFF 0xFF 0xFF)
; STACK: 2
; ----------------------------------------------------------------------------
; L1741

CalcAddBack:
	subi	R_M5,0xff
	sbci	R_M4,0xff
	sbci	R_M3,0xff
	sbci	R_M2,0xff
	ret

; ----------------------------------------------------------------------------
;                            Subtraction (C_SUB, 3)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 10 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L174C

.global CalcSub
CalcSub:

; ----- negate second number
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: 0
	rcall	CalcNeg

; CalcAdd must follow

; ----------------------------------------------------------------------------
;                            Addition (C_ADD, 15)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 8 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L1755

.global CalcAdd
CalcAdd:

; ----- get last 2 numbers (1st -> X, 2nd -> Z)
; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
	rcall	CalcTop2

; ----- prepare numbers for addition; 1st exponent -> R_AX1/Z, 2nd exponent -> R_AX2/X
; Clear exponent and expand mantissa to 5 bytes signed.
; INPUT: R31:R30 (Z) = pointer to the number
; OUTPUT: R_AX1 = exponent
; DESTROYS: R_AT1..R_AT4
; STACK: 2 bytes

	rcall	CalcPrepAdd	; prepare 2nd number
	mov	R_AX2,R_AX1	; save 2nd exponent -> R_AX2
	rcall	ExcXZ		; exchange pointers
	rcall	CalcPrepAdd	; prepare 1st number, 1st exponent -> R_AX1

; ----- sort numbers - 2nd exponent must not be less than 1st one

	cp	R_AX2,R_AX1	; compare exponents
	brcc	CalcAdd2	; 2nd exponent is higher or equal, it is OK

	rcall	ExcXZ		; exchange pointers

	eor	R_AX2,R_AX1	; exchange exponents
	eor	R_AX1,R_AX2
	eor	R_AX2,R_AX1

; ----- fetch 2 numbers and delete 2nd number:
;			1st number Z -> (R_AX1) R_M1:R_M2:R_M3:R_M4:R_M5
;			2nd number X -> (R_AX2) R_N1:R_N2:R_N3:R_N4:R_N5
; INPUT: R31:R30 (Z) = pointer to 1st number
;	 R27:R26 (X) = pointer to 2nd number
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = 1st number (from Z)
;	  R_N1:R_N2:R_N3:R_N4:R_N5 = 2nd number (from X)
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1

CalcAdd2:
	rcall	CalcFetch2

; ----- prepare new exponent (= exponent of 2nd number) -> R_EXH:R_EXL

	mov	R_EXL,R_AX2	; R_AXL <- 2nd exponent
	ldi	R_EXH,0

; ----- difference of exponents (= 2nd exponent - 1st exponent; result is >= 0)

	sub	R_AX2,R_AX1	; R_AX2 <- 2nd exponent - 1st exponent

; ----- shift 1st number right to normalize numbers to the same exponent
; INPUT: R_AX2 = number of shifts
;	 R_M1:R_M2:R_M3:R_M4:R_M5 = normalized number (mantissa, R_M1=0x00 or 0xFF)
; DESTROYS: R_AX2
; STACK: 4
	rcall	CalcAddShift

; ----- add both numbers (here is R_M1=0x00 or 0xFF, R_N1=0x00 or 0xFF)

	add	R_M5,R_N5
	adc	R_M4,R_N4
	adc	R_M3,R_N3
	adc	R_M2,R_N2
	adc	R_M1,R_N1
; possible results in highest byte R_M1: 0x00, 0x01, 0xff, 0xfe

; ----- check overflow = highest byte is 0x01 or 0xfe

	cpi	R_M1,1
	breq	CalcAdd3
	cpi	R_M1,0xfe
	brne	CalcAdd4

; ----- overflow - shift result right and increment exponent
; INPUT: R_AX2 = number of shifts
;	 R_M1:R_M2:R_M3:R_M4:R_M5 = normalized number (mantissa, R_M1=0x00 or 0xFF)
; DESTROYS: R_AX2
; STACK: 4

CalcAdd3:
	ldi	R_AX2,1		; number of shifts = 1
	rcall	CalcAddShift	; shift result right
	adiw	R_EXL,1		; increment exponent R_EXH:R_EXL

; ----- prepare sign flag -> R_M1

CalcAdd4:
	andi	R_M1,B7		; isolate sign bit
	breq	CalcAdd6	; number is positive

; ----- negate mantissa R_M2:R_M3:R_M4:R_M5

	com	R_M2
	com	R_M3
	com	R_M4

	neg	R_M5		; carry will be set if number was NOT 0 (R_M5 = 0 - R_M5, CARRY <- (R_M5 != 0))

	sbci	R_M4,0xff	; increment if lower byte was 0, set carry if result is NOT 0 (R_M4 = R_M4 - (0xFF + CARRY))
	sbci	R_M3,0xff
	sbci	R_M2,0xff
	brcs	CalcAdd6	; result is not zero (C is clear if result is 0; flag Z can be used too)

; ----- overflow, result of negation is zero -> change result to 0x80 0x00 0x00 0x00 and increase exponent

	ldi	R_M2,0x80	; set value to 0x80 0x00 0x00 0x00
	adiw	R_EXL,1		; increment exponent R_EXH:R_EXL

; ----- normalize number R_M1 sign, R_M2:R_M3:R_M4:R_M5(:R_M6) mantissa, R_EXH:R_EXL exponent

CalcAdd6:
	clr	R_M6		; R_M6 <- 0, mantissa extra lowest byte
	rjmp	CalcMulNorm	; normalize result

; ----------------------------------------------------------------------------
;                           Square root (C_SQR, 37)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: stack, R31, R30
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2 MEM3
; ----------------------------------------------------------------------------
; L1DDB

.global CalcSqr
CalcSqr:
	rcall	Calc
; offset 0
	.byte	C_DUP		; duplicate
	.byte	C_NOT		; not
	.byte	C_JUMPT		; jump if true (if argument is 0)
	.byte	29		; jump to offset 25 of CalcPow (25 + 8 - 4 = 29)
; offset 4
	.byte	C_CONSTAB(CONST_05) ; constant 0.5
	.byte	C_END		; end
; offset 6
	.balign 2		; align
; offset 6

; CalcPow must follow

; ----------------------------------------------------------------------------
;                             Power (C_POW, 6)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 8 bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2 MEM3
; ----------------------------------------------------------------------------
; We calculate power x**y. Special cases: 0**0=1, 0**+n=0, 0**-n=overflow.
; L1DE2

.global CalcPow
CalcPow:
				; (x,y) ... want to get x**y
	rcall	Calc		; calculator
; CalcSqr offset 8
; offset 0
	.byte	C_EXC		; exchange (y,x)
	.byte	C_DUP		; duplicate (y,x,x)
	.byte	C_NOT		; NOT (y,x,1/0)
	.byte	C_JUMPT		; jump if true (jump if x is 0)
	.byte	5		; jump to offset 10 (10-5=5)

; offset 5 (here is x non-zero)
	.byte	C_LN		; ln (y,ln(x)) (uses MEM0 MEM1 MEM2)
	.byte	C_MUL		; multiply (y*ln(x))
	.byte	C_END		; end
; offset 8
	.balign 2		; align
; offset 8
	rjmp	CalcExp		; calculate exp(x) (uses MEM0 MEM3)

; offset 10 (here is x=0, we will calculate 0**y)
	.byte	C_DEL		; delete (y)
	.byte	C_DUP		; duplicate (y,y)
	.byte	C_NOT		; NOT (y,1/0)
	.byte	C_JUMPT		; jump if true (jump if y is 0)
	.byte	8		; jump to offset 23 (23-15=8)

; offset 15 (y is not zero; check sign of y)
	.byte	C_CONSTAB(CONST_0) ; stack constant 0 (y,0)
	.byte	C_EXC		; exchange (0,y)
	.byte	C_GR0		; greater 0 (0,1/0)
	.byte	C_JUMPT		; jump if true (jump if y is >= 0)
	.byte	5		; jump to offset 25 (25-20=5)

; offset 20 (0**-n is not allowed, we raise overflow)
	.byte	C_CONSTAB(CONST_1) ; stack constant 1 (0,1)
	.byte	C_EXC		; exchange (1,0)
	.byte	C_DIV		; division (raise overflow error)

; offset 23 (here is y=0, result will be 0**0 = 1)
	.byte	C_DEL		; delete ()
	.byte	C_CONSTAB(CONST_1) ; stack constant 1 (1)
; offset 25
	.byte	C_END		; end
	.balign 2		; align

	ret

; ----------------------------------------------------------------------------
;           Compare (C_LTEQ..C_EQU, C_SLTEQ..C_SEQU, 9..14, 17..22)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
;	 R24 = literal
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 13 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; Leaves 0/1 on top of calculator stack.
; L1B03

;#define C_LTEQ		9	// 0x09 <= .... 1 (0001)
;#define C_GREQ		10	// 0x0A >= .... 2 (0010)
;#define C_NEQU		11	// 0x0B <> .... 3 (0011)
;#define C_GR		12	// 0x0C > .... 4 (0100)
;#define C_LT		13	// 0x0D < .... 5 (0101)
;#define C_EQU		14	// 0x0E = .... 6 (0110)

;#define C_SLTEQ	17	// 0x11 string <= .... 9 (1001)
;#define C_SGREQ	18	// 0x12 string >= .... 10 (1010)
;#define C_SNEQU	19	// 0x13 string <> .... 11 (1011)
;#define C_SGR		20	// 0x14 string > .... 12 (1100)
;#define C_SLT		21	// 0x15 string < .... 13 (1101)
;#define C_SEQU		22	// 0x16 string = .... 14 (1110)

.global CalcCmp
CalcCmp:

; ----- get last 2 numbers -> 1st number X, 2nd number Z
; OUTPUT: R27:R26 (X) = pre-last number on calculator stack (=STKEND-2*5)
;	  R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes

	rcall	CalcTop2

; ----- prepare comparison code -> R24
; numbers: <= 01001 ( 9), >= 01010 (10), <> 01011 (11), > 01100 (12), < 01101 (13), = 01110 (14)
;    text: <= 10001 (17), >= 10010 (18), <> 10011 (19), > 10100 (20), < 10101 (21), = 10110 (22)

;	subi	r24,8 ... not needed

; ----- code correction to get opposed cases (we will inverse result by bit 2)
; <= xx000, >= xx001, <> xx010
;  > xx100,  < xx101,  = xx110

	sbrs	r24,2		; skip if bit 2 is set
	dec	r24		; code correction for cases <=, >=, <>

; ----- swap operands in cases >= and <
; <= xx00x, <> xx01x
;  > xx10x,  = xx11x

; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23
; STACK: 8 bytes
; CALCULATOR STACK: 0

	lsr	r24		; shift right
; <= xx00, <> xx01
;  > xx10,  = xx11
	brcc	1f		; skip if bit 0 is clear
	push	r24		; push comparison flags
	rcall	CalcSwap	; swap two number on the stack
	pop	r24		; pop comparison flags

; ----- jump to string comparisons

1:	sbrs	r24,2		; skip if bit 2 (old bit 3) is set (=numbers)
	push	r24		; push comparison flags
	rjmp	CalcCmpStr	; jump to string comparison

; ----- substract numbers (result leaves on top of stack)
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 10 bytes
; CALCULATOR STACK: -1

	rcall	CalcSub
	pop	r24		; pop comparison flags
	rjmp	CalcCmpTest2	; set result

; ----- string comparison

CalcCmpStr:

; ----- get operands and delete 2nd operand -> 1st text = Z addr + R_M1 len, 2nd text = X addr + R_N1 len
; OUTPUT: R31:R30 (Z,=R_M2:R_M3) = pointer to 1st text
;	  R27:R26 (X,=R_N2:R_N3) = pointer to 2nd text
;	  R20 (R_M1) = length of 1st text
;	  R14 (R_N1) = length of 2nd text
; DESTROYS: R21..R16 (R_M2..R_M5), R13..R10 (R_N2..R_N5)
; STACK: 10 bytes
; CALCULATOR STACK: -1
	rcall	CalcFetch2Txt

; ----- check if 2nd text is nul

CalcCmpStr2:
	tst	R_N1		; check 2nd text length
	brne	CalcCmpStr4	; 2nd text is not nul

; ----- 2nd text is nul, check if 1st text is nul

	tst	R_M1		; check 1st text length
	breq	CalcCmpEqu	; both texts are nul, texts are equal

; ----- TRUE condidion: 1st text is longer than 2nd one
; <= xx00, <> xx01
;  > xx10,  = xx11

CalcCmpGt:
	pop	r24		; pop comparison flags
	eor	r24,R_ONE	; flip equ flag, bit 0

; 1st text > 2nd text: <= xx01, <> xx00, > xx11,  = xx10
	rjmp	CalcCmpTest

; ----- texts are equal
; <= xx00, <> xx01
;  > xx10,  = xx11

CalcCmpEqu:
	pop	r24		; pop comparison flags

; 1st text == 2nd text: <= xx00, <> xx01, > xx10,  = xx11
	rjmp	CalcCmpTest

; ----- 2nd is not nul, check if 1st text is nul

CalcCmpStr4:
	tst	R_M1		; check 1st text length
	breq	CalcCmpLt	; 1st text is shorter

; ----- both texts are not nul, compare characters

	ld	r0,Z+		; load character from text 1
	ld	r1,X+		; load character from text 2
	cp	r0,r1		; compare characters
	brcs	CalcCmpLt	; 1st text is less than 2nd text
	brne	CalcCmpGt	; 1st text is greater than 2nd text

; ----- prepare for next character

	dec	R_M1		; decrease length of 1st text
	dec	R_N1		; decrease length of 2nd text
	rjmp	CalcCmpStr2	; characters are equal, continue comparison

; ----- FALSE condition, 1st text is less than 2nd one
; <= xx00, <> xx01
;  > xx10,  = xx11

CalcCmpLt:
	pop	r24		; pop comparison flags
	andi	r24,0xfe	; clear bit 0 (equ flag)

; ----- clear text in the stack, change it to number 0
; 1st text  > 2nd text: <= xx01, <> xx00, > xx11,  = xx10
; 1st text == 2nd text: <= xx00, <> xx01, > xx10,  = xx11
; 1st text  < 2nd text: <= xx00, <> xx00, > xx10,  = xx10

CalcCmpTest:

; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 6 bytes
	rcall	CalcTopZ0	; zero number on top of stack

; ----- process result
; text: top number = 0
; numbers: top number = 1st number - 2nd number
; 1st text  > 2nd text: <= xx01, <> xx00, > xx11, = xx10
; 1st text == 2nd text: <= xx00, <> xx01, > xx10, = xx11
; 1st text  < 2nd text: <= xx00, <> xx00, > xx10, = xx10
;              numbers: <= xx00, <> xx01, > xx10, = xx11

CalcCmpTest2:
	push	r24		; push comparison flags

; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
	sbrc	r24,0		; skip if bit 0 is clear (= equal flag)
	rcall	CalcNot		; invert result number if bit 0 is set

; text: top number = 0
; numbers: top number = 1st number - 2nd number = dif
; 1st text  > 2nd text: <= xx01 (->1), <> xx00 (->0), > xx11 (->1), = xx10 (->0)
; 1st text == 2nd text: <= xx00 (->0), <> xx01 (->1), > xx10 (->0), = xx11 (->1)
; 1st text  < 2nd text: <= xx00 (->0), <> xx00 (->0), > xx10 (->0), = xx10 (->0)
;     numbers, dif = 0: <= xx00 (->0), <> xx01 (->1), > xx10 (->0), = xx11 (->1)
;    numbers, dif <> 0: <= xx00 (dif), <> xx01 (->0), > xx10 (dif), = xx11 (->0)

; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
	rcall	CalcGr0		; greater-0, sets 1 if number was > 0, or 0 otherwise

;     numbers, dif > 0: <= xx00 (->1), <> xx01 (->0), > xx10 (->1), = xx11 (->0)
;     numbers, dif < 0: <= xx00 (->0), <> xx01 (->0), > xx10 (->0), = xx11 (->0)

	pop	r24		; pop comparison flags

; ----- apply a terminal NOT by bit 2 of comparison flag - inverts meaning of <= and <>

; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
	sbrs	r24,1		; skip if bit 1 (old bit 2) is set
	rcall	CalcNot		; NOT result if bit 1 is clear

; 1st text  > 2nd text: <= xx01 (->0), <> xx00 (->1), > xx11 (->1), = xx10 (->0)
; 1st text == 2nd text: <= xx00 (->1), <> xx01 (->0), > xx10 (->0), = xx11 (->1)
; 1st text  < 2nd text: <= xx00 (->1), <> xx00 (->1), > xx10 (->0), = xx10 (->0)
;     numbers, dif = 0: <= xx00 (->1), <> xx01 (->0), > xx10 (->0), = xx11 (->1)
;     numbers, dif > 0: <= xx00 (->0), <> xx01 (->1), > xx10 (->1), = xx11 (->0)
;     numbers, dif < 0: <= xx00 (->1), <> xx01 (->1), > xx10 (->0), = xx11 (->0)

	ret

; ----------------------------------------------------------------------------
;                         String concatenation (C_SADD, 23)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R10
; STACK: 12 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------

.global CalcSAdd
CalcSAdd:

; ----- get operands and delete 2nd operand -> 1st text = Z addr + R_M1 len, 2nd text = X addr + R_N1 len
; OUTPUT: R31:R30 (Z,=R_M2:R_M3) = pointer to 1st text
;	  R27:R26 (X,=R_N2:R_N3) = pointer to 2nd text
;	  R20 (R_M1) = length of 1st text
;	  R14 (R_N1) = length of 2nd text
; DESTROYS: R21..R16 (R_M2..R_M5), R13..R10 (R_N2..R_N5)
; STACK: 10 bytes
; CALCULATOR STACK: -1
	rcall	CalcFetch2Txt

; ----- prepare length of new number

	mov	r24,R_M1	; length of 1st text
	add	r24,R_N1	; add length of 2nd text
	brcc	1f		; sum is OK
	ldi	r24,255		; max. total length
	mov	R_N1,r24
	sub	R_N1,R_M1	; max. length of 2nd text

; ----- create space for new text in workspace
; INPUT: R24 = number of bytes
; OUTPUT: R27:R26 (Z) = address of start of the space
; DESTROYS: R31, R30, R25, R24, R1, R0
; STACK: 6 bytes

1:	mov	R_M5,r24	; save total length
	rcall	EditIns		; reserve space

; ----- update destination variable
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes

	rcall	CalcTop		; addres -> Z
	std	Z+0,R_M5	; text length
	std	Z+1,r27		; address HIGH
	std	Z+2,r26		; address LOW

; ----- copy first string

	movw	r30,R_M3	; 1st text address
	tst	R_M1		; zero length?
	breq	3f		; 1st text has zero length
2:	ld	r24,Z+
	st	X+,r24
	dec	R_M1
	brne	2b

; ----- copy second string

3:	movw	r30,R_N3	; 2nd text address
	tst	R_N1		; zero length?
	breq	5f		; 1st text has zero length
4:	ld	r24,Z+
	st	X+,r24
	dec	R_N1
	brne	4b

5:	ret

; ----------------------------------------------------------------------------
;                             Unary minus, Negate (C_NEG, 24)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1AA0

.global CalcNeg
CalcNeg:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	breq	CalcNeg9	; zero number left unchanged

; ----- load sign (bit 7 in 1st byte of mantissa)

	ldd	r25,Z+1		; R25 <- first byte of mantissa
	subi	r25,-0x80	; flip sign
	rjmp	CalcSgn8	; set new sign

; ----------------------------------------------------------------------------
;                             Code (C_CODE, 25)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R22, R20..R16
; STACK: 10 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Get first character of text and save it as number.
; L1C06

.global CalcCode
CalcCode:

; ----- fetch text from stack and delete it
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = number
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1

; Text in float number structure:
;  0: (1) length
;  1: (2) address in RAM
;  3: (2) ... unused

	rcall	CalcFetch

; ----- check zero length

	clr	r22		; R22 <- 0
	tst	R_M1		; zero length?
	breq	CalcCode2	; store byte 0

; ----- load first character

	movw	r30,R_M3	; Z <- pointer to text
	ld	r22,Z		; R22 <- load 1st character

; ----- store byte into calculator stack
; INPUT: R22 = unsigned integer
; DESTROYS: R31, R30, R27, R26, R24..R23
; STACK: 8 bytes
; CALCULATOR STACK: +1

CalcCode2:
	rjmp	CalcStackB

; ----------------------------------------------------------------------------
;                             Value (C_VAL, 26)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R22, R20..R16
; STACK: 10 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Evaluates numeric expression from text.
; L1C06

.global CalcVal
CalcVal:



#if 0

<a name="L1BA4"></a>;; <b>val</b>
L1BA4:  LD      HL,($4016)      ; fetch value of system variable CH_ADD - ukazatel do prohledavaneho radku (program nebo editor)
        PUSH    HL              ; and save on the machine stack.

- vyjmuti textove promenne (ukazatel do promennych) ze zasobniku kalkulatoru

        CALL    <A href="#L13F8">L13F8</a>           ; routine STK-FETCH fetches the string operand
                                ; from calculator stack.

        PUSH    DE              ; save the address of the start of the string.

- vytvoreni mista v editacnim radku (+1 pro konec radku)

        INC     BC              ; increment the length for a carriage return.

        RST     30H             ; BC-SPACES creates the space in workspace. - vytvoreni mista (BC bajtu) na zacatku editacniho radku

- string se nastavi jako cteci adresa textu

        POP     HL              ; restore start of string to HL.
        LD      ($4016),DE      ; load CH_ADD with start DE in workspace. - ukazatel do prohledavaneho radku (program nebo editor)

- kopie textu z promenne do editacniho radku

        PUSH    DE              ; save the start in workspace
        LDIR                    ; copy string from program or variables or
                                ; workspace to the workspace area.

- konec textu se oznaci NEWLINE

        EX      DE,HL           ; end of string + 1 to HL
        DEC     HL              ; decrement HL to point to end of new area.
        LD      (HL),$76  ; CH_NEWLINE        ; insert a carriage return at end.
                                ; ZX81 has a non-ASCII character set

- vyhodnoceni vyrazu

        RES     7,(IY+$01)      ; update FLAGS  - signal checking syntax. - flagy (B0=potlaceni uvodni mezer, B1=tiskarna, B2=vyber K/L F/G, B6=FP cislo nebo string, B7=reset pri kontrole syntaxe)
        CALL    <A href="#L0D92">L0D92</a>           ; routine CLASS-06 - SCANNING evaluates string
                                ; expression and checks for integer result.

        CALL    <A href="#L0D22">L0D22</a>           ; routine CHECK-2 checks for carriage return.


- navrat ukazatele textu

        POP     HL              ; restore start of string in workspace.

        LD      ($4016),HL      ; set CH_ADD to the start of the string again. - ukazatel do prohledavaneho radku (program nebo editor)
        SET     7,(IY+$01)      ; update FLAGS  - signal running program. - flagy (B0=potlaceni uvodni mezer, B1=tiskarna, B2=vyber K/L F/G, B6=FP cislo nebo string, B7=reset pri kontrole syntaxe)
        CALL    <A href="#L0F55">L0F55</a>           ; routine SCANNING evaluates the string
                                ; in full leaving result on calculator stack.

        POP     HL              ; restore saved character address in program.
        LD      ($4016),HL      ; and reset the system variable CH_ADD. - ukazatel do prohledavaneho radku (program nebo editor)

        JR      <A href="#L1B85">L1B85</a>           ; back to exit via STK-PNTRS. - nacteni ukazatele konce zasobniku kalkulatoru (-> DE) a posledniho cisla pred koncem (-> HL)
                                ; resetting the calculator stack pointers
                                ; HL and DE from STKEND as it wasn't possible - ukazatel na konec zasobniku kalkulatoru
                                ; to preserve them during this routine.

#endif







; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

	ret

; ----------------------------------------------------------------------------
;                             Length of text (C_LEN, 27)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R22, R20..R16
; STACK: 10 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1C11

.global CalcLen
CalcLen:

; ----- fetch text from stack and delete it
; OUTPUT: R_M1:R_M2:R_M3:R_M4:R_M5 = number
; DESTROYS: R31, R30, R27, R26
; STACK: 8 bytes
; CALCULATOR STACK: -1

; Text in float number structure:
;  0: (1) length
;  1: (2) address in RAM
;  3: (2) ... unused

	rcall	CalcFetch

; ----- get length of text

	mov	r22,R_M1

; ----- store byte into calculator stack
; INPUT: R22 = unsigned integer
; DESTROYS: R31, R30, R27, R26, R24..R23
; STACK: 8 bytes
; CALCULATOR STACK: +1

	rjmp	CalcStackB

; ----------------------------------------------------------------------------
;                             Cosinus (C_COS, 29)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; L1D3E

.global CalcCos
CalcCos:

; ----- first prepare angle (we want to use sinus function)

	rcall	Calc		; calculator
; offset 0
	.byte	C_ARG		; get arg (x) (uses MEM0)
	.byte	C_ABS		; abs (abs(x))
	.byte	C_CONSTAB(CONST_1) ; constant 1 (abs(x),1)
	.byte	C_SUB		; subtract (abs(x)-1)

	.byte	C_GETMEM(0)	; get number 0 into stack (abs(x)-1,) - sign (from C_ARG)
	.byte	C_JUMPT		; jump if true
	.byte	6		; jump to CalcSin offset 1 = offset 13 (13-7=6)
; offset 7
	.byte	C_NEG		; negate
	.byte	C_JMP		; jump
	.byte	3		; jump to CalcSin offset 1 = offset 13 (13-10=3)
; offset 10
	.balign 2		; align
; offset 10

; CalcSin must follow

; ----------------------------------------------------------------------------
;                             Sinus (C_SIN, 28)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; L1D49

.global CalcSin
CalcSin:

	rcall	Calc		; calculator
; CalcCos offset 12
; offset 0
	.byte	C_ARG		; get arg (x) (uses MEM0)
; CalcCos offet 13
; offset 1
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_DUP		; duplicate (x,x,x)
	.byte	C_MUL		; multiply (=square) (x,x*x)
	.byte	C_DUP		; duplicate (x,x*x,x*x)
	.byte	C_ADD		; addition (x,2*x*x)
	.byte	C_CONSTAB(CONST_1) ; constant 1 (x,2*x*x,1)
	.byte	C_SUB		; subtract (x,2*x*x-1)

	.byte	C_SERIE(6)	; serie (6 loops) (uses MEM0 MEM1 MEM2)
	.byte	C_CONST(1,0x64)	; constant 1: 0x64 0xE6 (0x00 0x00 0x00)
	.byte	0xe6
	.byte	C_CONST(2,0x6c)	; constant 2: 0x6C 0x1F 0x0B (0x00 0x00)
	.byte	0x1f,0x0b
	.byte	C_CONST(3,0x73)	; constant 3: 0x73 0x8F 0x38 0xEE (0x00)
	.byte	0x8f,0x38,0xee
	.byte	C_CONST(4,0x79)	; constant 4: 0x79 0x15 0x63 0xBB 0x23
	.byte	0x15,0x63,0xbb,0x23
	.byte	C_CONST(4,0x7e)	; constant 5: 0x7E 0x92 0x0D 0xCD 0xED
	.byte	0x92,0x0d,0xcd,0xed
	.byte	C_CONST(4,0x81)	; constant 6: 0x81 0x23 0x5D 0x1B 0xEA
	.byte	0x23,0x5d,0x1b,0xea

	.byte	C_MUL		; multiply (x*y)
	.byte	C_END		; end

	.balign 2		; align

CalcNeg9:
	ret

; ----------------------------------------------------------------------------
;                             Tangent (C_TAN, 30)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; Evaluates tangent x as sin(x)/cos(x).
; L1D6E

.global CalcTan
CalcTan:

	rcall	Calc		; calculator
; offset 0
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_SIN		; sinus (x,sin(x)) (uses MEM0 MEM1 MEM2)
	.byte	C_EXC		; exchange (sin(x),x)
	.byte	C_COS		; cosinus (sin(x),cos(x)) (uses MEM0 MEM1 MEM2)
	.byte	C_DIV		; division (sin(x)/cos(x))
	.byte	C_END		; end

	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                             Arcsin (C_ASN, 31)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2 MEM3
; ----------------------------------------------------------------------------
; asn(a) = atn(x/sqr(1-x*x))
; L1DC4

.global CalcAsn
CalcAsn:

	rcall	Calc		; calculator
; offset 0
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_DUP		; duplicate (x,x,x)
	.byte	C_MUL		; multiply (x,x*x)
	.byte	C_CONSTAB(CONST_1) ; stack 1 (x,x*x,1)
	.byte	C_SUB		; subtract (x,x*x-1)
	.byte	C_NEG		; negate (x,1-x*x)
	.byte	C_SQR		; square root (x,sqr(1-x*x) = y) (uses MEM0 MEM3)
	.byte	C_CONSTAB(CONST_1) ; stack 1 (x,y,1)
	.byte	C_ADD		; addition (x,y+1)
	.byte	C_DIV		; division (x/(y+1))
	.byte	C_ATN		; arcus tangent (a/2) (half the angle)
	.byte	C_DUP		; duplicate (a/2,a/2)
	.byte	C_ADD		; addition
	.byte	C_END		; end
	
	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                             Arccos (C_ACS, 32)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2 MEM3
; ----------------------------------------------------------------------------
; acs(x) = pi/2 - asn(x)
; L1DD4

.global CalcAcs
CalcAcs:

	rcall	Calc		; calculator
; offset 0
	.byte	C_ASN		; arcus sinus (asn(x)) (uses MEM0 MEM3)
	.byte	C_CONSTAB(CONST_PI2) ; stack pi/2 (asn(x),pi/2)
	.byte	C_SUB		; subtract (asn(x)-pi/2)
	.byte	C_NEG		; negate (pi/2-asn(x))
	.byte	C_END		; end
	
	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                             Arctan (C_ATN, 33)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; L1D76

.global CalcAtn
CalcAtn:

; ----- check value range
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	cpi	r24,0x81	; check boundary "1"
	brcs	CalcAtn2	; small value (< 1)

; ----- big values (>= 1)

	rcall	Calc		; calculator
; offset 0
	.byte	C_CONSTAB(CONST_1) ; stack one (x,1)
	.byte	C_NEG		; negate (x,-1)
	.byte	C_EXC		; exchange (-1,x)
	.byte	C_DIV		; division (-1/x)
	.byte	C_DUP		; duplicaze (-1/x,-1/x)
	.byte	C_LT0		; less than 0 (-1/x,1/0)
	.byte	C_CONSTAB(CONST_PI2) ; stack pi/2 (-1/x,1/0,pi/2)
	.byte	C_EXC		; exchange (-1/x,pi/2,1/0)
	.byte	C_JUMPT		; jump if true
	.byte	7		; jump to offset 17 (17-10=7)
; offset 10
	.byte	C_NEG		; negate (-1/x,-pi/2)
	.byte	C_JMP		; jump
	.byte	4		; jump to offset 17 (17-13=4)
; offset 13
	.balign 2		; align

; ----- small values (< 1)
; offset 14
CalcAtn2:
	rcall	Calc		; calculator
	.byte	C_CONSTAB(CONST_0) ; stack 0 (x,0)
; offset 17
	.byte	C_EXC		; exchange (0 or +-pi/2 = a,x or -1/x = z)
	.byte	C_DUP		; duplicate (a,z,z)
	.byte	C_DUP		; duplicate (a,z,z,z)
	.byte	C_MUL		; multiply (a,z,z*z)
	.byte	C_DUP		; duplicate (a,z,z*z,z*z)
	.byte	C_ADD		; addition (a,z,2*z*z)
	.byte	C_CONSTAB(CONST_1) ; stack 1 (a,z,2*z*z,1)
	.byte	C_SUB		; subtract (a,z,2*z*z-1)
	
	.byte	C_SERIE(12)	; series, 12 parameters (uses MEM0 MEM1 MEM2)
	.byte	C_CONST(1,0x60)	; constant 1: 0x60 0xB2 (0x00 0x00 0x00)
	.byte	0xb2
	.byte	C_CONST(1,0x63)	; constant 2: 0x63 0x0E (0x00 0x00 0x00)
	.byte	0x0e
	.byte	C_CONST(2,0x65)	; constant 3: 0x65 0xE4 0x8D (0x00 0x00)
	.byte	0xe4,0x8d
	.byte	C_CONST(2,0x68)	; constant 4: 0x68 0x39 0xBC (0x00 0x00)
	.byte	0x39,0xbc
	.byte	C_CONST(2,0x6b)	; constant 5: 0x6B 0x98 0xFD (0x00 0x00)
	.byte	0x98,0xfd
	.byte	C_CONST(3,0x6e)	; constant 6: 0x6E 0x00 0x36 0x75 (0x00)
	.byte	0x00,0x36,0x75
	.byte	C_CONST(3,0x70)	; constant 7: 0x70 0xDB 0xE8 0xB4 (0x00)
	.byte	0xdb,0xe8,0xb4
	.byte	C_CONST(2,0x73)	; constant 8: 0x73 0x42 0xC4 (0x00 0x00)
	.byte	0x42,0xc4
	.byte	C_CONST(4,0x76)	; constant 9: 0x76 0xB5 0x09 0x36 0xBE
	.byte	0xb5,0x09,0x36,0xbe
	.byte	C_CONST(4,0x79)	; constant 10: 0x79 0x36 0x73 0x1B 0x5D
	.byte	0x36,0x73,0x1b,0x5d
	.byte	C_CONST(4,0x7c)	; constant 11: 0x7C 0xD8 0xDE 0x63 0xBE
	.byte	0xd8,0xde,0x63,0xbe
	.byte	C_CONST(4,0x80)	; constant 12: 0x80 0x61 0xA1 0xB3 0x0C
	.byte	0x61,0xa1,0xb3,0x0c

	.byte	C_MUL		; multiply (a,z*y)
	.byte	C_ADD		; addition (a+z*y)
	.byte	C_END		; end
	
	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                           Natural Logarithm (C_LN, 34)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: stack, R31, R30
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; L1CA9

.global CalcLn
CalcLn:

; ------ check invalid argument <= 0
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	breq	CalcInvArg	; invalid argument 0
	brcc	CalcLn2		; argument > 0 is OK

CalcInvArg:
	ldi	r24,ERR_INVARG	; error - invalid argument
	rjmp	Error

; ----- change number to 1-base

CalcLn2:
	ldi	r25,0x80	; exponent for "1"
	st	Z,r25		; set exponent to 0x80

; ----- add exponent as new number
; INPUT: R22 = unsigned integer
; DESTROYS: R31, R30, R27, R26, R24..R23
; STACK: 8 bytes
; CALCULATOR STACK: +1
	mov	r22,r24		; exponent
	rcall	CalcStackB

; ----- process

	rcall	Calc		; (x,n)
; offset 0
	.byte	C_DATA		; stack data
	.byte	C_CONST(1,0x88)	; constant 0x88 0x00 (0x00 0x00 0x00) = 128
	.byte	0x00
	.byte	C_SUB		; subtract (x,n-128)
	.byte	C_EXC		; exchange (n-128,x)
	.byte	C_DUP		; duplicate (n-128,x,x)
	.byte	C_DATA		; stack data
	.byte	C_CONST(4,0x80)	; constant 0x80 0x4C 0xCC 0xCC 0xCD
	.byte	0x4c,0xcc,0xcc,0xcd ; (n-128,x,x,C)
	.byte	C_SUB		; subtract (n-128,x,x-C)
	.byte	C_GR0		; greater 0 (n-128,x,x-C,1/0)	
	.byte	C_JUMPT		; jump if true
	.byte	14		; jump to offset 30 (30-16=14)
; offset 16
	.byte	C_EXC		; exchange (n-128,x,x-C)
	.byte	C_CONSTAB(CONST_1) ; stack 1 (n-128,x,x-C,1)
	.byte	C_SUB		; subtract (n-128,x,x-C-1)
	.byte	C_EXC		; exchange (n-128,x-C-1,x)
	.byte	C_END		; end
; offset 21
	.balign 2		; align

; ----- increase exponent

; offset 22
	rcall	CalcTopCheck
	inc	r24
	st	Z,r24

; offset 28
	rcall	Calc
; offset 30
	.byte	C_EXC		; exchange
	.byte	C_DATA		; stack data
	.byte	C_CONST(4,0x80)	; constant 0x80 0x31 0x72 0x17 0xF8
	.byte	0x31,0x72,0x17,0xf8 ; 
	.byte	C_MUL		; multiply
	.byte	C_EXC		; exchange
	.byte	C_CONSTAB(CONST_05) ; stack half
	.byte	C_SUB		; subtract
	.byte	C_CONSTAB(CONST_05) ; stack half
	.byte	C_SUB		; subtract
	.byte	C_DUP		; duplicate
	.byte	C_DATA		; stack data
	.byte	C_CONST(1,0x82)	; constant 0x82 0x20 (0x00 0x00 0x00)
	.byte	0x20
	.byte	C_MUL		; multiply
	.byte	C_CONSTAB(CONST_05) ; stack half
	.byte	C_SUB		; subtract

	.byte	C_SERIE(12)	; serie, 12 parameters (uses MEM0 MEM1 MEM2)
	.byte	C_CONST(1,0x61)	; constant 1: 0x61 0xAC (0x00 0x00 0x00)
	.byte	0xac
	.byte	C_CONST(1,0x64)	; constant 2: 0x64 0x09 (0x00 0x00 0x00)
	.byte	0x09
	.byte	C_CONST(2,0x66)	; constant 3: 0x66 0xDA 0xA5 (0x00 0x00)
	.byte	0xda,0xa5
	.byte	C_CONST(2,0x69)	; constant 4: 0x69 0x30 0xC5 (0x00 0x00)
	.byte	0x30,0xc5
	.byte	C_CONST(2,0x6c)	; constant 5: 0x6C 0x90 0xAA (0x00 0x00)
	.byte	0x90,0xaa
	.byte	C_CONST(3,0x6e)	; constant 6: 0x6E 0x70 0x6F 0x61 (0x00)
	.byte	0x70,0x6f,0x61
	.byte	C_CONST(3,0x71)	; constant 7: 0x71 0xCB 0xDA 0x96 (0x00)
	.byte	0xcb,0xda,0x96
	.byte	C_CONST(3,0x74)	; constant 8: 0x74 0x31 0x9F 0xB4 (0x00)
	.byte	0x31,0x9f,0xb4
	.byte	C_CONST(4,0x77)	; constant 9: 0x77 0xA0 0xFE 0x5C 0xFC
	.byte	0xa0,0xfe,0x5c,0xfc
	.byte	C_CONST(4,0x7a)	; constant 10: 0x7A 0x1B 0x43 0xCA 0x36
	.byte	0x1b,0x43,0xca,0x36
	.byte	C_CONST(4,0x7d)	; constant 11: 0x7D 0xA7 0x9C 0x7E 0x5E
	.byte	0xa7,0x9c,0x7e,0x5e
	.byte	C_CONST(4,0x80)	; constant 12: 0x80 0x6E 0x23 0x80 0x93
	.byte	0x6e,0x23,0x80,0x93

	.byte	C_MUL		; multiply
	.byte	C_ADD		; addition
	.byte	C_END		; end

	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                           Exponential (C_EXP, 35)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: stack, R31, R30
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0 MEM1 MEM2 MEM3
; ----------------------------------------------------------------------------
; L1C5B

.global CalcExp
CalcExp:

	rcall	Calc

	.byte	C_DATA		; stack data (x,c)
	.byte	C_CONST(4,0x81)	; constant 0x81 0x38 0xAA 0x3B 0x29
	.byte	0x38,0xaa,0x3b,0x29	
	.byte	C_MUL		; multiply (x*c)
	.byte	C_DUP		; duplicate (x*c,x*c)
	.byte	C_INT		; integer (x*c,int(x*c) (uses MEM0)
	.byte	C_SETMEM(3)	; set memory 3 from stack (x*c,int(x*c))
	.byte	C_SUB		; subtract (fra(x*c))
	.byte	C_DUP		; duplicate (fra(x*c),fra(x*c)
	.byte	C_ADD		; addition (2*fra(x*c))
	.byte	C_CONSTAB(CONST_1) ; stack 1 (2*fra(x*c),1)
	.byte	C_SUB		; subtract (2*fra(x*c)-1)

	.byte	C_SERIE(8)	; serie (uses MEM0 MEM1 MEM2)
	.byte	C_CONST(1,0x63)	; constant 1: 0x63 0x36 (0x00 0x00 0x00)
	.byte	0x36
	.byte	C_CONST(2,0x68)	; constant 2: 0x68 0x65 0x66 (0x00 0x00)
	.byte	0x65,0x66
	.byte	C_CONST(3,0x6d)	; constant 3: 0x6D 0x78 0x65 0x40 (0x00)
	.byte	0x78,0x65,0x40
	.byte	C_CONST(3,0x72)	; constant 4: 0x72 0x60 0x32 0xC9 (0x00)
	.byte	0x60,0x32,0xc9
	.byte	C_CONST(4,0x77)	; constant 5: 0x77 0x21 0xF7 0xAF 0x24
	.byte	0x21,0xf7,0xaf,0x24
	.byte	C_CONST(4,0x7b)	; constant 6: 0x7B 0x2F 0xB0 0xB0 0x14 
	.byte	0x2f,0xb0,0xb0,0x14
	.byte	C_CONST(4,0x7e)	; constant 7: 0x7E 0x7E 0xBB 0x94 0x58
	.byte	0x7e,0xbb,0x94,0x58
	.byte	C_CONST(4,0x81)	; constant 8: 0x81 0x3A 0x7E 0xF8 0xCF
	.byte	0x3a,0x7e,0xf8,0xcf

	.byte	C_GETMEM(3)	; get memory 3 to stack
	.byte	C_END		; end
	.balign 2		; align

; ----- get byte integer from stack -> R24
; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
	rcall	CalcUnstackB
	ld	r25,Z		; exponent of new number
	brne	CalcExp2	; number is negative
	brcs	CalcExpOver	; overflow positive number

	add	r24,r25		; add exponents
	brcc	CalcExp4	; exonent is OK	

CalcExpOver:
	rjmp	CalcMulOver	; overflow error

CalcExp2:
	brcs	CalcExp6	; overflow negative number
	sub	r24,r25		; subtract exponent
	brcc	CalcExp6	; overflow to zero
	neg	r24		; negate exponent
CalcExp4:
	st	Z,r24		; save new exponent
	ret

; ----- overflow to zero

CalcExp6:
	rjmp	CalcZ0		; clear result

; ----------------------------------------------------------------------------
;                           Integer (C_INT, 36)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: stack, R31, R30
; STACK: ? bytes
; CALCULATOR STACK: 0
; USES: MEM0
; ----------------------------------------------------------------------------
; L1C46

.global CalcInt
CalcInt:
	rcall	Calc
; offset 0
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_LT0		; less 0 (x,1/0)
	.byte	C_JUMPT		; jump if true
	.byte	4		; jump to offset 8 (8-4=4)
; offset 4
	.byte	C_TRUNC		; truncate
	.byte	C_END		; end
; offset 6
	.balign 2		; align
; offset 6
	ret

; offset 8
	.byte	C_DUP		; duplicate
	.byte	C_TRUNC		; truncate
	.byte	C_SETMEM(0)	; set memory 0 from stack
	.byte	C_SUB		; subtract
	.byte	C_GETMEM(0)	; get memory 0 into stack
	.byte	C_EXC		; exchange
	.byte	C_NOT		; not
	.byte	C_JUMPT		; jump if true
	.byte	2		; jump to offset 19 (19 - 17 = 2)
; offset 17
	.byte	C_CONSTAB(CONST_1) ; stack 1
	.byte	C_SUB		; subtract
; offset 19
	.byte	C_END		; end
	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                             Signum (C_SGN, 38)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Replace number on top of calculator stack by value -1, 0, 1.
; L1AAF

.global CalcSgn
CalcSgn:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	breq	CalcSgn9	; zero number left unchanged

; ----- load sign (bit 7 in 1st byte of mantissa)

	ldd	r25,Z+1		; R25 <- first byte of mantissa

; ----- set number in Z to +1
; INPUT: R31:R30 = float number
; DESTROYS: R24
; STACK: 2 bytes
	rcall	CalcZ1

; ----- save sign of the number back to mantissa

	andi	r25,0x80	; mask sign bit
CalcSgn8:
	std	Z+1,r25		; set sign back to mantissa
CalcSgn9:
	ret

; ----------------------------------------------------------------------------
;                             Absolute value (C_ABS, 39)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 6 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1AAA

.global CalcAbs
CalcAbs:

; ----- get last number on calculator stack -> Z
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop

; ----- load sign (bit 7 in 1st byte of mantissa)

	ldd	r25,Z+1		; R25 <- first byte of mantissa
	andi	r25,0x7f	; reset sign bit
	rjmp	CalcSgn8	; set new sign

; ----------------------------------------------------------------------------
;                 Calculator relative jump if true (C_JUMPT, 41)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R24
; STACK: 2 bytes
; CALCULATOR STACK: -1
; ----------------------------------------------------------------------------
; L1C2F

.global CalcJumpT
CalcJumpT:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck

; ----- destroy last number (saves SREG)

	rcall	CalcDel2	; set stack end to Z (saves SREG)

; ----- jump if not zero

CalcJumpT4:
	brne	CalcJump	; not zero, jump is valid

; ----- or only destroy literal with jump offset

	rjmp	CalcLit		; load literal -> R24 (destroys R31:R30)

; ----------------------------------------------------------------------------
;                    Calculator relative jump (C_JMP, 47)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R24
; STACK: 4 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1C23

.global CalcJump
CalcJump:
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
;	 R24 = next literal
; DESTROYS: R31, R30
; STACK: 2 bytes
	rcall	CalcLit		; load literal -> R24 (destroys R31:R30)

	ldi	r30,0		; jump HIGH positive offset
	tst	r24		; negative number?
	brpl	CalcJump2	; jump offset is positive
	ldi	r30,0xff	; HIGH negative offset
CalcJump2:
	add	R_LITL,r24	; add offset LOW
	adc	R_LITH,r30	; add offset HIGH
	ret

; ----------------------------------------------------------------------------
;                Loop and relative jump of not zero (C_LOOP, 49)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R24
; STACK: 4 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1C17

.global CalcLoop
CalcLoop:
	ldd	r24,Y+DATA_CALCPAR ; get calculator parameter
	dec	r24		; decrement counter
	std	Y+DATA_CALCPAR,r24 ; save calculator parameter
	rjmp	CalcJumpT4

; ----------------------------------------------------------------------------
;                  Decode number into text (C_STR, 42)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R24, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1BD5

.global CalcStr
CalcStr:

; ----- decode number into OutBuf

	rcall	DecNum

; ----- prepare space in workspace
; INPUT: R24 = number of bytes
; OUTPUT: R27:R26 (Z) = address of start of the space
; DESTROYS: R31, R30, R25, R24, R1, R0
; STACK: 6 bytes
	ldd	r24,Y+DATA_OUTBUFNUM	; number of bytes
	rcall	EditIns

; ----- copy number into workspace

	push	r26
	push	r27

	ldd	r23,Y+DATA_OUTBUFNUM	; number of bytes
	ldi	r30,lo8(OutBuf)
	ldi	r31,hi8(OutBuf)
1:	ld	r24,Z+
	st	X+,r24
	dec	r23
	brne	1b
	
; ----- create new entry in stack
; OUTPUT: R31:R30 (Z) = new end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes
; CALCULATOR STACK: +1
	rcall	CalcNew

; ----- save entry

	ldd	r24,Y+DATA_OUTBUFNUM	; number of bytes
	st	X+,r24		; text length
	pop	r24
	st	X+,r24		; high byte
	pop	r24
	st	X+,r24		; low byte
	ret

; ----------------------------------------------------------------------------
;                  Convert number 0..255 to 1-character string (C_CHR, 43)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R24, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1B8F

.global CalcChr
CalcChr:

; ----- get number 0..255 from calculator stack (-> R24)
; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
	rcall	CalcUnstackB
	brcs	CalcChr9	; overflow
	brne	CalcChr9	; negative number not allowed

; ----- prepare space in workspace
; INPUT: R24 = number of bytes
; OUTPUT: R27:R26 (Z) = address of start of the space
; DESTROYS: R31, R30, R25, R24, R1, R0
; STACK: 6 bytes
	push	r24		; push number

	ldi	r24,1		; number of bytes = 1
	rcall	EditIns

	pop	r24		; pop number

; ----- copy number into workspace
	
	push	r26
	push	r27

	st	X,r24		; save number
	
; ----- create new entry in stack
; OUTPUT: R31:R30 (Z) = new end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes
; CALCULATOR STACK: +1
	rcall	CalcNew

; ----- save entry

	st	X+,R_ONE	; text length
	pop	r24
	st	X+,r24		; high byte
	pop	r24
	st	X+,r24		; low byte
	ret

; ----- error, integer out of range

CalcChr9:
	ldi	r24,ERR_INTOUT
	rjmp	Error

; ----------------------------------------------------------------------------
;                  Duplicate number on top of stack (C_DUP, 45)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R24, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------
; L19F6

.global CalcDup
CalcDup:

; ----- create new number on top of stack
; OUTPUT: R31:R30 (Z) = end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes

	rcall	CalcNew		; create new number -> X

; ----- copy last number

	sbiw	r30,10		; shift to previous number

; CalcCopyNum must follow

; ----------------------------------------------------------------------------
;                               Copy number (Z -> X)
; ----------------------------------------------------------------------------
; INPUT: R31:R30 (Z) = source address in RAM
;	 R27:R26 (X) = destination address in RAM
; OUTPUT: R31:R30 (Z) = next source address in RAM
;	 R27:R26 (X) = next destination address in RAM
; DESTROYS: R25, R24
; STACK: 2 bytes
; ----------------------------------------------------------------------------

.global CalcCopyNum
CalcCopyNum:			; copy number from Z to X (destroys R25 and R24)

	ldi	r25,5		; length of a number
1:	ld	r24,Z+
	st	X+,r24
	dec	r25
	brne	1b
	ret

; ----------------------------------------------------------------------------
;                       Stack unformated data (C_DATA, 48)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------
; L19FC

; Format of 1st byte of the number C_DATA:
;  	B7,B6 = length - 1 (= length 1..4 bytes)
;	B5..B0 = exponent - 80 (range 81..143); if exponent=0 -> get exponent-80 from following byte
;  Follow 1..4 bytes of the number, rest bytes fill with 0.

.global CalcData
CalcData:

; ----- create new number on top of stack
; OUTPUT: R31:R30 (Z) = end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes

	rcall	CalcNew		; create new number -> X

; ----- load next literal -> R24

	rcall	CalcLit		; load literal -> R24 (destroys R31:R30)

; ----- prepare length of number -> R25

	mov	r25,r24
	andi	r25,0xc0	; B6,B7 = length-1
	swap	r25
	lsr	r25
	lsr	r25
	inc	r25		; R25 = length 1..4

; ----- save  exponent

	andi	r24,0x3f	; mask exponent
	brne	1f		; exponent is valid
	rcall	CalcLit		; load exponent from following byte -> R24
1:	subi	r24,-80		; add exponent base 80
	st	X+,r24		; save exponent

; ----- prepare number of trailing zeores -> R23

	ldi	r23,5		; length of float number = 5
	sub	r23,r25		; R23 <- rest of number

; ----- copy number

2:	rcall	CalcLit		; load next byte -> R24
	st	X+,r24
	dec	r25
	brne	2b

; ----- save trailing zeroes

	rjmp	4f
3:	st	X+,r25
4:	dec	r23
	brne	3b
	ret

; ----------------------------------------------------------------------------
;            Check if number if less than zero (C_LT0, 50)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Returns 1 if number is < 0, or 0 otherwise.
; L1ADB

.global CalcLt0
CalcLt0:

; ----- get last number on calculator stack -> Z
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop

; ----- prepare mask for check

	ldi	r24,0		; XOR mask

; ----- check sign bit
; jump here from CalcGr0

CalcLt02:
	ldd	r25,Z+1		; get sign bit (from 1st byte of mantissa)
	eor	r25,r24		; check sign bit

; ----- set result

	brmi	CalcZ1		; set to 1 in case of negative number

; CalcZ0 must follow

; ----------------------------------------------------------------------------
;                      Set number in Z to value 0
; ----------------------------------------------------------------------------
; INPUT: R31:R30 = float number
; STACK: 2 bytes
; ----------------------------------------------------------------------------

.global CalcZ0
CalcZ0:
	std	Z+0,R_ZERO
	rjmp	CalcZ13

; ----------------------------------------------------------------------------
;                      Set number in Z to value 1
; ----------------------------------------------------------------------------
; INPUT: R31:R30 = float number
; DESTROYS: R24
; STACK: 2 bytes
; ----------------------------------------------------------------------------

.global CalcZ1
CalcZ1:
	ldi	r24,0x81
	std	Z+0,r24
CalcZ13:
	std	Z+1,R_ZERO
	std	Z+2,R_ZERO
	std	Z+3,R_ZERO
	std	Z+4,R_ZERO
CalcZ19:
	ret

; ----------------------------------------------------------------------------
;            Check if number if greater than zero (C_GR0, 51)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Returns 1 if number is > 0, or 0 otherwise.
; L1ACE

.global CalcGr0
CalcGr0:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	breq	CalcZ19		; zero number left unchanged

; ----- prepare mask for check

	ldi	r24,0xff	; negative mask
	rjmp	CalcLt02

; ----------------------------------------------------------------------------
;                            NOT operator (C_NOT, 44)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R25, R24
; STACK: 8 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; Returns value 0 or 1.
; L1AD5

.global CalcNot
CalcNot:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck

; ----- set result

	breq	CalcZ1		; set to 1 in case of zero
	rjmp	CalcZ0		; set to 0 in case of not zero

; ----------------------------------------------------------------------------
;                           Modulus (C_MOD, 46)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; STACK: -2 bytes
; DESTROYS: stack, R31, R30
; CALCULATOR STACK: 0
; USES: MEM0 MEM1
; ----------------------------------------------------------------------------
; L1C37

.global CalcMod
CalcMod:
	rcall	Calc
	.byte	C_SETMEM(1)	; set memory 1 from stack (a,b)
	.byte	C_DEL		; delete (a)
	.byte	C_DUP		; duplicate (a,a)
	.byte	C_GETMEM(1)	; get memory 1 to stack (a,a,b)
	.byte	C_DIV		; division (a,a/b)
	.byte	C_INT		; int (a,int(a/b)) (uses MEM0)
	.byte	C_GETMEM(1)	; get memory 1 to stack (a,int(a/b),b)
	.byte	C_EXC		; exchange (a,b,int(a/b))
	.byte	C_SETMEM(1)	; set memory 1 from stack (a,b,int(a/b))
	.byte	C_MUL		; multiply (a,b*int(a/b))
	.byte	C_SUB		; subtract (a-b*int(a/b))
	.byte	C_GETMEM(1)	; get memory 1 to stack (a-b*int(a/b)=fraction,int(a/b)=integer)
	.byte	C_END		; end
	.balign 2		; align

	ret

; ----------------------------------------------------------------------------
;                           End calculator (C_END, 52)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; STACK: -2 bytes
; DESTROYS: stack, R31, R30
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L002B

.global CalcEnd
CalcEnd:
	pop	r31
	pop	r30		; destroy return address

	movw	r30,R_LITL	; Z <- literal pointer

	pop	R_LITH		; pop registers
	pop	R_LITL

	adiw	r30,1		; round up
	lsr	r31
	ror	r30		; convert pointer back to word index
	ijmp			; jump back to the program

; ----------------------------------------------------------------------------
;             Get argument of trigonometric functions (C_ARG, 53)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 
; CALCULATOR STACK: 0
; USES: MEM0
; ----------------------------------------------------------------------------
; Result lies in range -1 to +1 (input is angle in radians).
; L1D18

.global CalcArg
CalcArg:

	rcall	Calc		; (x)
; offset 0
	.byte	C_DATA		; stack data
	.byte	C_CONST(4,0x7e)	; constant 0x7E 0x22 0xF9 0x83 0x64 = 1/(2*PI) = 0.159154943092
	.byte	0x22,0xf9,0x83,0x6e ; (x,1/(2*PI))
	.byte	C_MUL		; multiply (x/(2*PI)) (fraction, 0..360 deg = 0..1)
	.byte	C_DUP		; duplicate (x/(2*PI),x/(2*PI))
	.byte	C_CONSTAB(CONST_05) ; stack 0.5 (x/(2*PI),x/(2*PI),0.5)
	.byte	C_ADD		; addition (x/(2*PI),x/(2*PI)+0.5)
	.byte	C_INT		; integer (x/2*PI), int(x/(2*PI)+0.5)), get number of while loops (uses MEM0)
	.byte	C_SUB		; subtrac (a = angle in range -0.5..+0.5)
	.byte	C_DUP		; duplicate (a,a)
	.byte	C_ADD		; addition (2*a), angle in range -1..+1
	.byte	C_DUP		; duplicate
	.byte	C_ADD		; addition (4*a), angle in range -2..+2 (90 deg = +1)

; Quadrants I (0..+1) and IV (-1..0) are now correct.
; Quadrant II ranges +1..+2 -> should be +1..0.
; Quadrant III ranges -1..-2 -> should be -1..0.

; offset 16
	.byte	C_DUP		; duplicate (y,y)
	.byte	C_ABS		; absolute value (y,abs(y)) (range 0..2)
	.byte	C_CONSTAB(CONST_1) ; stack 1 (y,abs(y),1)
	.byte	C_SUB		; subtract (y,abs(y)-1) (range 0..1)
	.byte	C_DUP		; duplicate (y,z,z)
	.byte	C_GR0		; check greater 0 (y,z,1/0)
	.byte	C_SETMEM(0)	; set memory 0 from stack (possible sign for cosine function)
	.byte	C_JUMPT		; jump if true (jump if II or III quadrant)
	.byte	3		; jump to offset 28 (28-25=3)
; offset 25
	.byte	C_DEL		; delete (y)
	.byte	C_JMP		; jump
	.byte	7		; jump to offset 35 (35-28=7)

; branch with quadrants II or III
; offset 28
	.byte	C_CONSTAB(CONST_1) ; stack 1 (y,z,1)
	.byte	C_SUB		; subtract (y,abs(y)-2)
	.byte	C_EXC		; exchange (abs(y)-2,y)
	.byte	C_LT0		; less than 0 (abs(y)-2,1/0)
	.byte	C_JUMPT		; jump if true (jump if y < 0)
	.byte	1		; jump to offset 37 (37-36=1)
; offset 34
	.byte	C_NEG		; negate
; offset 35
	.byte	C_END		; end
	.balign 2		; align

	ret

; ----------------------------------------------------------------------------
;                  Integer truncation towards zero (C_TRUNC, 54)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L18E4

.global CalcTrunc
CalcTrunc:

; ----- get last number and check if zero -> Z, R24
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
;	  R24 = 1st byte (=exponent; 0 = number is zero)
;	  SREG = status bits are set by "tst r24"
; STACK: 6 bytes
	rcall	CalcTopCheck
	cpi	r24,0x81	; compare to +1
	brcc	CalcTrunc2	; 1 or greater

; ----- number is smaller than +-1, can be made zero
; INPUT: R31:R30 = float number

	rjmp	CalcZ0		; clear number to 0

; ----- prepare number of bits to clear (here is R24 = 0x81..0xFF)

CalcTrunc2:
	subi	r24,0x80+32	; subtract base and 32 (=maximum) from exponent
	brpl	CalcTrunc9	; number is too high, always integer (no fractional part)

	neg	r24		; number of bits = 31..1

; ----- prepare number of bytes to clear

CalcTrunc3:
	adiw	r30,5		; shift pointer behind end of number
	mov	r22,r24		; R22 <- number of bits
	lsr	r22
	lsr	r22
	lsr	r22		; number of bits / 8 = number of bytes
	breq	CalcTrunc6

; ----- reset whole bytes to 0

CalcTrunc4:
	st	-Z,R_ZERO	; set 8 bits to 0
	dec	r22		; byte counter
	brne	CalcTrunc4	; next byte

; ----- reset remaining bits

CalcTrunc6:
	andi	r24,7		; remaining bits
	breq	CalcTrunc9	; no bits

	ldi	r22,0xff	; mask
CalcTrunc8:
	lsl	r22
	dec	r24
	brne	CalcTrunc8

	ld	r24,-Z
	and	r24,r22		; mask bits
	st	Z,r24

CalcTrunc9:
	ret

; ----------------------------------------------------------------------------
;                  Jump to function by register value (C_TO, 55)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L19E4

.global CalcTo
CalcTo:
	pop	r31
	pop	r30		; destroy return address

	ldd	r24,Y+DATA_CALCPAR ; get calculator parameter
	rjmp	CalcEnter	; enter next function

; ----------------------------------------------------------------------------
;            Format e-format floating point number (C_EFP, 56)
; ----------------------------------------------------------------------------
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 
; CALCULATOR STACK: -1
; USES: MEM0 MEM1
; ----------------------------------------------------------------------------
; Divide mantissa (pre-top) by decimal exponent (top).
; Input in calculator stack: top number = decimal exponent, pre-top = mantissa
; Output: top number = normalised mantissa (divided by decimal exponent)
; L155A, ZX Spectrum L2D4F

.global CalcEfp
CalcEfp:

; ----- prepare sign of the exponent, absolute value of exponent

	rcall	Calc		; mantissa, exponent (m,e)
	.byte	C_DUP		; duplicate (m,e,e)
	.byte	C_LT0		; less than 0 (m,e,1/0)
	.byte	C_SETMEM(0)	; set memory 0 from stack (negative flag)
	.byte	C_DEL		; delete (m,e)
	.byte	C_ABS		; absolute value (m,+e)
	.byte	C_CONSTAB(CONST_10) ; get constant 10 (m,+e,10)
	.byte	C_EXC		; exchange (m,10,+e)
	.byte	C_END		; end
	.balign 2		; align

; ----- get exponent -> R24, R25
; OUTPUT: R24 = unsigned integer
;	  R31:R30 (Z) = pointer to new top number
;	  C flag is set = overflow valid range
;	  Z flag is set = number is positive or 0
; DESTROYS: R27, R26, R25, R20..R16
; STACK: 12 bytes
; CALCULATOR STACK: -1
	rcall	CalcUnstackB	; (m,10)

; ----- get next bit

CalcEfp2:
	lsr	r24		; get next bit of the exponent
	push	r24		; push exponent
	brcc	CalcEfp4	; bit not set

; ----- multiply/divide mantissa by 10

	rcall	Calc
; offset 0
	.byte	C_SETMEM(1)	; set memory 1 from stack (x,10^n)
	.byte	C_GETMEM(0)	; get memory 0 to stack (x,10^n,1/0)
	.byte	C_JUMPT		; jump if true (jump if negative)
	.byte	3		; jump to offset 7 (7-4=3)
; offset 4
	.byte	C_MUL		; multiply (x*10^n)
	.byte	C_JMP		; jump
	.byte	1		; jump to offset 8 (8-7=1)
; offset 7
	.byte	C_DIV		; division (x/10^n)
; offset 8
	.byte	C_GETMEM(1)	; get memory 1 to stack (x,10^n)
	.byte	C_END		; end
; offset 10
	.balign 2		; align
; offset 10

; ----- shift decimal accumulator

CalcEfp4:
	rcall	Calc		; (x,10^n)
	.byte	C_DUP		; duplicate (x,10^n,10^n)
	.byte	C_MUL		; multiply (x,10^n^2)
	.byte	C_END		; end
	.balign 2		; align

; ----- check zero exponent

	pop	r24
	tst	r24
	brne	CalcEfp2	; exponent is not 0

; ----- delete decimal accumulator

	rcall	Calc
	.byte	C_DEL		; delete
	.byte	C_END		; end
	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                       Series generator (C_SERIE, 57)
; ----------------------------------------------------------------------------
; INPUT: R24 = number of loops
;	 R_LITH:R_LITL = pointer to literals
;	 calculator stack: x value
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 
; CALCULATOR STACK:
; USES: MEM0 MEM1 MEM2
; ----------------------------------------------------------------------------
; L1A7F

.global CalcSerie
CalcSerie:

; ----- call calculator

	rcall	Calc		; call calculator, save number of loops from R24 to DATA_CALCPAR

; ----- initialization phase
; offset 0
	.byte	C_DUP		; duplicate (x,x)
	.byte	C_ADD		; addition (2*x)
	.byte	C_SETMEM(0)	; set memory 0 from stack (2*x)
	.byte	C_DEL		; delete (.)
	.byte	C_CONSTAB(CONST_0) ; stack constant 0 (0)
	.byte	C_SETMEM(2)	; set memory 2 from stack (0)

; ----- start loop
; offset 6
	.byte	C_DUP		; duplicate (v,v)
	.byte	C_GETMEM(0)	; get memory 0 to stack (v,v,2*x)
	.byte	C_MUL		; multiply (v,v*2*x)
	.byte	C_GETMEM(2)	; get memory 2 to stack (v,v*2*x,v)
	.byte	C_SETMEM(1)	; set memory 1 from stack
	.byte	C_SUB		; subtract
	.byte	C_END		; end
; offset 13
	.balign 2		; align
; offset 14

; ----- load number from main literals to calculator stack
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: +1

	rcall	CalcData	; load number from literals
; offset 16

; ----- continue calculator

	rcall	CalcEnter2	; re-enter calculator (with current parameter)
; offset 18
	.byte	C_ADD		; addition
	.byte	C_EXC		; exchange
	.byte	C_SETMEM(2)	; set memory 2 from stack
	.byte	C_DEL		; delete
	.byte	C_LOOP		; dec-jr-nz (count number of loops from input parameter)
	.byte	-18		; jump to offset 6 (6 - 24 = -18)
; offset 24

; ----- get result

	.byte	C_GETMEM(1)	; get memory 1 to stack
	.byte	C_SUB		; subtract
	.byte	C_END		; end

	.balign 2		; align
	ret

; ----------------------------------------------------------------------------
;                       Stack tabled constant (C_CONSTAB, 58)
; ----------------------------------------------------------------------------
; INPUT: R24 = offset of the constant in ConstTab
;	 R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 12 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------
; L1A51

; Format of 1st byte of the number C_DATA:
;  	B7,B6 = length - 1 (= length 1..4 bytes)
;	B5..B0 = exponent - 80 (range 81..143); if exponent=0 -> get exponent-80 from following byte
;  Follow 1..4 bytes of the number, rest bytes fill with 0.

.global CalcConsTab
CalcConsTab:

; ----- save literal pointer

	push	R_LITL
	push	R_LITH

; ----- prepare constant address -> R_LITH:R_LITL

	ldi	r25,0
	subi	r24,lo8(-(ConstTab))
	sbci	r25,hi8(-(ConstTab))
	movw	R_LITL,r24

; ----- load constant
; INPUT: R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R23, R1, R0
; STACK: 8 bytes
; CALCULATOR STACK: +1

	rcall	CalcData

; ----- return literal pointer

	pop	R_LITH
	pop	R_LITL
	ret

; ----------------------------------------------------------------------------
;                   Set memory from stack (C_SETMEM, 59)
; ----------------------------------------------------------------------------
; INPUT: R24 = offset of a number (should be multiply of 5)
;	 R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R24
; STACK: 6 bytes
; CALCULATOR STACK: 0
; ----------------------------------------------------------------------------
; L1A63

.global CalcSetMem
CalcSetMem:

; ----- get address of the number -> R27:R26
; INPUT: R24 = offset of a number (should be multiply of 5)
; OUTPUT: R31:R30 = address of a number in MemAddr
; STACK: 2 bytes
	rcall	CalcAddrMem	; get number address -> Z
	rcall	ExcXZ		; exchange registers X and Z

; ----- get address of last number
; OUTPUT: R31:R30 (Z) = last number on calculator stack (=STKEND-5)
; STACK: 4 bytes
	rcall	CalcTop		; get number in stack -> Z

; ----- copy number (Z -> X)
; INPUT: R31:R30 (Z) = source address in RAM
;	 R27:R26 (X) = destination address in RAM
; OUTPUT: R31:R30 (Z) = next source address in RAM
;	 R27:R26 (X) = next destination address in RAM
; DESTROYS: R25, R24
; STACK: 2 bytes
	rjmp	CalcCopyNum	; copy number

; ----------------------------------------------------------------------------
;             Get number from memory area into stack (C_GETMEM, 60)
; ----------------------------------------------------------------------------
; INPUT: R24 = offset of a number (should be multiply of 5)
;	 R_LITH:R_LITL = pointer to literals
; OUTPUT: R_LITH:R_LITL = new pointer to literals
; DESTROYS: R31, R30, R27..R24, R1, R0
; STACK: 10 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------
; L1A45

.global CalcGetMem
CalcGetMem:

; ----- get address of the number -> R31:R30
; INPUT: R24 = offset of a number (should be multiply of 5)
; OUTPUT: R31:R30 = address of a number in MemAddr
; STACK: 2 bytes
	rcall	CalcAddrMem

; CalcAddNum must follow

; ----------------------------------------------------------------------------
;                  Add number from RAM to calculator stack
; ----------------------------------------------------------------------------
; INPUT: R31:R30 = number in RAM
; DESTROYS: R31, R30, R27..R24, R1, R0
; STACK: 10 bytes
; CALCULATOR STACK: +1
; ----------------------------------------------------------------------------

CalcAddNum:

; ----- create new number on top of stack (and save Z pointer)
; OUTPUT: R31:R30 (Z) = end of calculator stack
;	  R27:R26 (X) = new number
; DESTROYS: R25, R24, R1, R0
; STACK: 6 bytes

	push	r30
	push	r31
	rcall	CalcNew		; create new number -> X
	pop	r31
	pop	r30

	rjmp	CalcCopyNum	; copy number from Z to X

; ----------------------------------------------------------------------------
;                              Jump table
; ----------------------------------------------------------------------------
; L1923

.global CalcJmpTab
CalcJmpTab:
; ... control operations
;	.word	CalcJumpT	; #define C_JUMPT	0	// 0x00 relative jump if true (redefined to 41 !)
	.word	CalcNop		; #define C_NOP		0	// 0x00 no function (required by byte align)
	.word	CalcSwap	; #define C_EXC		1	// 0x01 exchange 2 top numbers
	.word	CalcDel		; #define C_DEL		2	// 0x02 delete top number
; ... 2 operands (binary operations)
	.word	CalcSub		; #define C_SUB		3	// 0x03 - subtract
	.word	CalcMul		; #define C_MUL		4	// 0x04 * multiply
	.word	CalcDiv		; #define C_DIV		5	// 0x05 / division
	.word	CalcPow		; #define C_POW		6	// 0x06 ** power (uses MEM0 MEM1 MEM2 MEM3)
	.word	CalcOr		; #define C_OR		7	// 0x07 OR
	.word	CalcAnd		; #define C_AND		8	// 0x08 AND
	.word	CalcCmp		; #define C_LTEQ	9	// 0x09 <=
	.word	CalcCmp		; #define C_GREQ	10	// 0x0A >=
	.word	CalcCmp		; #define C_NEQU	11	// 0x0B <>
	.word	CalcCmp		; #define C_GR		12	// 0x0C >
	.word	CalcCmp		; #define C_LT		13	// 0x0D <
	.word	CalcCmp		; #define C_EQU		14	// 0x0E =
	.word	CalcAdd		; #define C_ADD		15	// 0x0F +
	.word	CalcSAnd	; #define C_SAND	16	// 0x10 string AND
	.word	CalcCmp		; #define C_SLTEQ	17	// 0x11 string <=
	.word	CalcCmp		; #define C_SGREQ	18	// 0x12 string >=
	.word	CalcCmp		; #define C_SNEQU	19	// 0x13 string <>
	.word	CalcCmp		; #define C_SGR		20	// 0x14 string >
	.word	CalcCmp		; #define C_SLT		21	// 0x15 string <
	.word	CalcCmp		; #define C_SEQU	22	// 0x16 string =
	.word	CalcSAdd	; #define C_SADD	23	// 0x17 string +
; ... 1 operand (unary operations)
	.word	CalcNeg		; #define C_NEG		24	// 0x18 unary- (NEG)
	.word	CalcCode	; #define C_CODE	25	// 0x19 CODE
	.word	CalcVal		; #define C_VAL		26	// 0x1A VAL
	.word	CalcLen		; #define C_LEN		27	// 0x1B LEN
	.word	CalcSin		; #define C_SIN		28	// 0x1C SIN (uses MEM0 MEM1 MEM2)
	.word	CalcCos		; #define C_COS		29	// 0x1D COS (uses MEM0 MEM1 MEM2)
	.word	CalcTan		; #define C_TAN		30	// 0x1E TAN (uses MEM0 MEM1 MEM2)
	.word	CalcAsn		; #define C_ASN		31	// 0x1F ASN (uses MEM0 MEM1 MEM2 MEM3)
	.word	CalcAcs		; #define C_ACS		32	// 0x20 ACS (uses MEM0 MEM1 MEM2 MEM3)
	.word	CalcAtn		; #define C_ATN		33	// 0x21 ATN (uses MEM0 MEM1 MEM2)
	.word	CalcLn		; #define C_LN		34	// 0x22 LN (uses MEM0 MEM1 MEM2)
	.word	CalcExp		; #define C_EXP		35	// 0x23 EXP (uses MEM0 MEM1 MEM2 MEM3)
	.word	CalcInt		; #define C_INT		36	// 0x24 INT (uses MEM0)
	.word	CalcSqr		; #define C_SQR		37	// 0x25 SQR (uses MEM0 MEM1 MEM2 MEM3)
	.word	CalcSgn		; #define C_SGN		38	// 0x26 SGN
	.word	CalcAbs		; #define C_ABS		39	// 0x27 ABS
	.word	CalcNop		; #define C_PEEK	40	// 0x28 PEEK ... unsupported
;	.word	CalcNop		; #define C_USR		41	// 0x29 USR ... unsupported, replaced by C_JUMPT function
	.word	CalcJumpT	; #define C_JUMPT	41	// 0x29 relative jump if true (redefined from code 0 !) (warning - offset is relative to next byte, not to offset byte as in ZX81!)
	.word	CalcStr		; #define C_STR		42	// 0x2A STR$
	.word	CalcChr		; #define C_CHR		43	// 0x2B CHR$
	.word	CalcNot		; #define C_NOT		44	// 0x2C NOT
; ... control operations
	.word	CalcDup		; #define C_DUP		45	// 0x2D duplicate
	.word	CalcMod		; #define C_MOD		46	// 0x2E modulus (uses MEM0 MEM1)
	.word	CalcJump	; #define C_JMP		47	// 0x2F relative jump (warning - offset is relative to next byte, not to offset byte as in ZX81!)
	.word	CalcData	; #define C_DATA	48	// 0x30 stack data
; Format of 1st byte of the number C_DATA:
;  	B7,B6 = length - 1 (= length 1..4 bytes)
;	B5..B0 = exponent - 80 (range 81..143); if exponent=0 -> get exponent-80 from following byte
;  Follow 1..4 bytes of the number, rest bytes fill with 0.
	.word	CalcLoop	; #define C_LOOP	49	// 0x31 dec jump_nz (warning - offset is relative to next byte, not to offset byte as in ZX81!)
	.word	CalcLt0		; #define C_LT0		50	// 0x32 less 0
	.word	CalcGr0		; #define C_GR0		51	// 0x33 greater 0
	.word	CalcEnd		; #define C_END		52	// 0x34 end calc
	.word	CalcArg		; #define C_ARG		53	// 0x35 get arg (uses MEM0)
	.word	CalcTrunc	; #define C_TRUNC	54	// 0x36 truncate
	.word	CalcTo		; #define C_TO		55	// 0x37 jump by register value (warning - offset is relative to next byte, not to offset byte as in ZX81!)
	.word	CalcEfp		; #define C_EFP		56	// 0x38 E to fp (uses MEM0 MEM1)
; ... groups (compound literals)
;	bit 7: flag of compound literal
;	bit 5..6: group 0..3
;	bit 0..4: parameter 0..31
	.word	CalcSerie	; #define C_SERIE_GRP	57	// 0x39 series (literal 0x80..0x9f) (uses MEM0 MEM1 MEM2)
	.word	CalcConsTab	; #define C_CONSTAB_GRP	58	// 0x3A stack tabled constant (literal 0xa0..0xbf, parameter is offset in ConstTab)
	.word	CalcSetMem	; #define C_SETMEM_GRP	59	// 0x3B set memory from stack (literal 0xc0..0xdf, parameter is offset of the number; Note: Multiply index from ZX81 by 5)
	.word	CalcGetMem	; #define C_GETMEM_GRP	60	// 0x3C get number from memory into stack (literal 0xe0..0xff, parameter is offset of the number; Note: Multiply index from ZX81 by 5)

; ----------------------------------------------------------------------------
;                        Floating Point Calculator
; ----------------------------------------------------------------------------
; INPUT: stack = RCALL return address 2 bytes, calculator literals follow RCALL.
;	 R24 = calculator parameter (number of loops or offset)
; DESTROYS: R31, R30, R27..R24, R1, R0 (saves R_LITH and R_LITL)
; STACK: ? bytes
; ----------------------------------------------------------------------------
; Return address will be word-aligned (use ".balign 2" after program block).
; L199D

; RCALL procedure: [SP] <- addr LOW, SP-1, [SP] <- addr HIGH, SP-1
; To load byte after rcall: pop ZH, pop ZL, add ZL, adc ZH, lpm r24,Z+
; To jump back: lsr ZH, ror ZL, ijmp (or push ZL, push ZH, ret)

.global Calc
Calc:

; ----- save parameter

	std	Y+DATA_CALCPAR,r24 ; save calculator parameter

; ----- get pointer to literals from the stack and push registers -> R_LITH:R_LITL

.global CalcEnter2
CalcEnter2:
	pop	r25		; (HIGH)
	pop	r24		; (LOW) get return address from the stack

	push	R_LITL		; push registers
	push	R_LITH

	movw	R_LITL,r24		; R_LITL <- return address
	add	R_LITL,R_LITL
	adc	R_LITH,R_LITH		; convert to byte offset

; ----- load next literal -> R24

.global CalcReEnter
CalcReEnter:
	rcall	CalcLit		; get literal -> R24 (destroys R31:R30)

; ----- compound literal (bit 7 is set)
; bit 7: flag of compound literal
; bit 5..6: subgroup 0..3
; bit 0..4: parameter 0..31

.global CalcEnter
CalcEnter:
	mov	r25,r24		; save literal
	tst	r24		; compound literal?
	brpl	Calc4		; no

	andi	r25,0x1f	; isolate parameter bits
	swap	r24		; swap bits
	lsr	r24		; rotate to bit position 0
	andi	r24,B0+B1	; isolate bits of the subgroup
	subi	r24,-C_GROUP_BASE ; add group base

; ----- jump to operation

Calc4:
	add	r24,r24		; R24 <- literal index * 2
	ldi	r30,lo8(CalcJmpTab) ; Z <- jump table
	ldi	r31,hi8(CalcJmpTab)
	add	r30,r24		; Z <- offset in jump table
	adc	r31,R_ZERO
	lpm	r24,Z+		; R24 <- load jump address LOW
	lpm	r31,Z		; R31 <- load jump address HIGH
	mov	r30,r24		; Z <- jump address (byte offset)
	lsr	r31
	ror	r30		; convert address to word index
	mov	r24,r25		; R24 <- function parameter or literal
	icall			; call function (R_LITH:R_LITL=literal pointer, R24=parameter or literal)
	rjmp	CalcReEnter	; process next literal
