
**********************************************************************
files: Numbers.TXT, Numbers.TAP
       Bases.BAS, Percent.BAS, Percent.ASM
       http://www.users.globalnet.co.uk/~jg27paw4/type-ins/zx-comp/mccalc.zip
      [mccalc.z80,]FPform.BAS, NegExp.BAS
       Target.BAS, TargetBSTR.BAS, TargetCSTR.ASM
       LMUL.BAS, LMUL_Input.BAS, LMUL_10.ASM, Massive-BCD3.asm
**********************************************************************


** Testing Recursive Functions
   ===========================


Getting recursive functions to work, with all their nested "" and (), can be quite difficult. It would be nice to have a "recursive DEF FN visualisation utility" which can take a great long string of gubbins as in some of the examples below and produce a clear picture of how that would be evaluated by the FN call, making it a lot easier to fix a broken DEF FN.

In fact, the "visualisation utility" is there in the function definition itself. Just write out the function in "long hand" as a loop, then stick the DEF FN in the middle, replacing the "DEF FN...=" with a PRINT, quote any VAL/VAL$ tokens, and each pass round the loop will print out what the function sees at that time, which can be handy for debugging.

A point of caution is that, although using a recursive DEF FN might save space in the BASIC listing compared to the same function written out as a loop, and is more flexible in its use (as a FN can be used as an expression in a statement) compared to an explicit loop, the FN will require more memory resource at runtime, as the ROM has to allocate space for all iterations when evaluating the FN, as each one is a child process of the previous one, whereas a loop only needs resource for the current iteration. The most signficant effect of this is that it constrains the number of levels which can be evaluated in a recursive FN, whereas a loop can be repeated as  many times as you like. A recursive FN will usually be slower than the equivalent loop, as it has to repeatedly search for the DEF FN each time it is referenced.


**********************************************************************


** Number Base 2 through 10 Conversion (short numbers, max. 8 digits output)
   ===================================

FN b() converts between base 10 and any base between 2 and 10;
which can be used to give:
FN n() converts between any two bases between 2 and 10;
using FN b() to convert the "from" number to base 10 embedded as the "from" parameter in a nested FN b() to convert that result to the "to" base.

[code]
     DEF FN b(n,f,t)=(n-INT (n/t)*t)
         +VAL (("f*FN b(INT (n/t),f,t)" AND n)+("0" AND NOT n))

     DEF FN n(n,f,t)=FN b(FN b(n,f,10),10,t)
[/code]

This function will only print up to 8 digit numbers before switching to scientific notation. For printing larger numbers in full see FN n$() below. To clarify the steps involved, "FN b(n,f,t)" can be written out as:

[code]
     LET n={number}: LET f={frombase}: LET t={tobase}
     LET a=n: LET b=0: LET g=1
     FOR i=0 TO 1
       LET i=NOT n
       LET b=b+g*(n-INT (n/t)*t)
       PRINT (n-INT (n/t)*t);
       "+VAL"; (("f*FN b(INT (n/t),f,t)" AND n)+("0" AND NOT n))
       LET g=g*f: LET n=INT (n/t)
     NEXT i
     PRINT a,b
[/code]


**********************************************************************


** Number Base 10 to 2 Conversion (long numbers, max. 9 digits input)
   ==============================

The b$ parameter is always "", as it's used as a base on which to build the binary string. The "("0" AND NOT (n+LEN b$))" clause is so that FN b$(0,"") returns zero rather than blank.

[code]
 100 DEF FN b$(n,b$)
   =("0" AND NOT (n+LEN b$))
   +VAL$ (("FN b$("+STR$ INT (n/2)+","""
                   +STR$ (n-INT (n/2)*2)+b$+""")" AND n)
                +(""""+b$+"""" AND NOT n))
[/code]

Strangely enough it works reasonably well with numbers bigger than the Spectrum can display in full as decimals; eg. PRINT 999999999 prints as just 1E+9 but FN b$(999999999,"") prints the (almost) correct 30-digit full binary number (it converts back to decimal 1000000001).

What the plethora of "" and () evaluate to is that on each pass:

[code]
 (if n<>0) : FN b$(INT (n/2),STR$ (n-INT (n/2)*2))+b$
 (if n=0)  : b$
[/code]

where n and b$ are the values passed from the previous iteration. Each pass adds one binary digit to b$, from right to left (ie. starting at bit zero).


**********************************************************************


** Number Base 2 through 36 Conversion (long numbers, max. 8 digits input)
   ======================

Building on what has gone before, here's FN n$(n$,o,p) which converts a positive integer 'n$' from base 'o' to base 'p'; 'o' & 'p' can be in the range 2 to 36. It can take a few seconds to produce an answer.

The two primary functions are:
FN f(n$,b,c) - convert 'n$' From base 'b' to decimal
FN t$(n,b)   - convert 'n'  from decimal  To base 'b'

The four subordinate functions are:
FN k$(n)     - get character representing number 'n' from d$
FN m(n$,c)   - get position-1 of character 'n$' in d$
FN l(n,b)    - remainder of n/b
FN h(n,b)    - quotient of n/b (INT)

The accuracy goes slightly astray when converting very large numbers;
eg. 36^6 = 2176782336, but FN n$("1000000",36,10) gives 2176782350.
FN n$("1000000",36,2) gives 10000001101111110001000000001110 - which is also 2176782350.

The functions FN f(n$,b,c) and FN m(n$,c) need a string pointer 'c' which is passed as a parameter with an initial value of 1. All the digits are in a string so that they occur in a simple ascending order, so the character's position in the string determines its value rather than its ASCII code.

[code]
DEF FN n$(n$,o,p)=FN t$(FN f(n$,o,1),p)

DEF FN f(n$,b,c) =FN m(n$(c),1)*b^(LEN n$-c)
                 +VAL (("FN f(n$,b,c+1)" AND c<LEN n$)
                       +("0" AND c=LEN n$))
DEF FN t$(n,b)   =VAL$ (("FN k$(n)" AND n<b)
                        +(("FN t$(FN h(n,b),b)+FN k$("
                          +STR$ FN l(n,b)+")") AND n>=b))

DEF FN k$(n)     =d$(n+1)
DEF FN m(n$,c)   =VAL (("FN m(n$,c+1)" AND d$(c)<>n$)
                       +("c-1" AND d$(c)=n$))
DEF FN l(n,b)    =n-FN h(n,b)*b:
DEF FN h(n,b)    =INT (n/b)

LET d$="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
[/code]


**********************************************************************


** Calculating Percentages
   =======================

Here's a little demo showing a few ways of handling the answer as a floating point number.

Percent.BAS [code]
10 CLEAR: LET a=0: LET pct=25000:
20 FOR p=0 TO 0 STEP 0: FOR o=1 TO 3
30 LET divisor=INT (RND*1000): LET dividend=INT (RND*500)
40 PRINT o;": ";dividend;" is ";USR pct,o,divisor,dividend;"% of ";divisor
50 IF o=3 THEN PRINT TAB 3;"a=";a
60 NEXT o: NEXT p
[/code]

Percent.ASM [code]
SCANNING: equ  $24fb           ;the SCANNING subroutine
FETCHS:   equ  $2bf1           ;from calculator stack: AEDCB
STAKBC:   equ  $2d2b           ;to calculator stack: BC
FPTOA:    equ  $2dd5           ;from calculator stack: A

PCT:    ld   hl,14
        add  hl,sp
        ld   sp,hl           ;undo USR
GETARG: rst  $20
        call SCANNING
        rst  $18
        cp   ","
        jr   z,GETARG
        ld   bc,100
        call STAKBC
        rst  $28
        defb $04,$01,$05,$01,$38
        ; multiply dividend by 100 : exchange
        ; divide product by divisor: exchange
        ; the option number 'o' is now at the top of the stack
        call FPTOA
        ; the answer is still on the stack
        cp   2
        jr   z,OPTION2
        jr   nc,OPTION3
OPTION1:;just print the answer
        call $2de3           ;PRINT_FP
        ret
OPTION2:;stack the answer as a string and print the string
        call $361f           ;STR$
        call FETCHS
        call $203c           ;PR_STRING
        ret
OPTION3:;copy the answer to a BASIC variable to be printed from BASIC
        ld   hl,(23627)      ;(VARS)
        ld   bc,6
        add  hl,bc           ;+6 = 1st byte after 'a'
        call $2b59 ;L_NUMERIC;copy answer to 'a'
        ld   hl,(23653)      ;(STKEND)
        ld   bc,5
        add  hl,bc
        ld   (23653),hl      ;reclaim answer
        jr   OPTION1
[/code]



**********************************************************************


** Updating BASIC variables from assembler
   =======================================

An simple example of using the ROM's calculator; multiply register B by 7 and put the answer in A (ignoring possible overflow):

[code]
        LD   A,B
        CALL $2d28           ;STACK_A
        LD   A,7
        CALL $2d28           ;STACK_A
        RST  $28             ;FP_CALC
        DEFB $04,$38         ;multiply,end_calc
        CALL $2dd5           ;FP_TO_A
[/code]

   =======================================

So, to take the value from a BASIC variable B, multiply it by 7 and assign the answer to BASIC variable A, using the ROM's calculator, typical steps would be:

* Point CH_ADD to the name of the multiplier variable B
* Call $28b2 LOOK_VARS to find it
* Put the value on the calculator stack
* Put the multiplicand (in this case 7) on the calculator stack
* Call $28 FP_CALC to do the multiplication
* Leave the product on the calculator stack
* Point CH_ADD to the name of the product variable A
* Call $1c1f CLASS_01 to set up the required system variables for LET
* Call $2aff LET to make the assignment

(Although, for small calculations there are quicker ways to do them by just using simple register arithmetic.)

If I'm referencing BASIC variables in assembler I'll put the names in a DEFM string - eg. "a:b:c:s$():" - and point CH_ADD to the relevant name in the string as needed. Always remember to preserve CH_ADD and restore it's initial value before returning to BASIC otherwise disaster will ensue.

This method can be used for any supported mathematical calculation with BASIC variables. FP values can be stacked prior to a RST $28 with $2ab6 STK_STORE (from registers AEDBC) or $33b4 STACK_NUM (from RAM at (HL)), and while within the calculator by using the STK_DATA instruction, which is thoroughly explained in Toni Baker's excellent series of [url=http://www.users.globalnet.co.uk/~jg27paw4/type-ins/zx-comp/mccalc.zip]Machine Code Calculator[/url] articles published in ZX Computing magazine. Interim working storage can use the calculator's memory registers, of which six are avaiable by default, although up to 32 are possible.


**********************************************************************


** Unravelling the Spectrum's Floating Point Number Format
   =====================================================

A decimal fraction literal may not match (from the Spectrum's viewpoint) the result of a calculation which gives the same number as the answer. Doing the same conversions that are done by the Spectrum should clarify the reason for the discrepancy. For example, consider these numbers and their floating point equivalent forms:

[code]
0.3  = 7f 19 99 99 99
3    = 00 00 03 00 00
10   = 00 00 0a 00 00
3/10 = 7f 19 99 99 9a
[/code]

Hence 0.3 <> 3/10.

Dividing by reciprocals can help: 10-100/(1/0.1) gives zero.

The number 3 is a tricky customer; eg.:

[code]
0.3 * 10  =  3  =  82 3f ff ff ff
3/10 * 10 =  3  =  82 40 00 00 01
10 * 3/10 =  3  =  00 00 03 00 00
[/code]

So they're all equal to three but all different from each other!
Applying the reciprocal calculation to both problems eliminates the error.

Instead of [b]a - b * 0.1[/b] use [b]a - b / (1/0.1)[/b] .

Instead of [b]0.n <> n/10[/b] use [b]0.n <> n * (1/10)[/b] .

Where a*10=b and n=n they both return zero. The () are essential, even in the second example where they could be expected not to make any difference.

The error is introduced by the two elements in each expression having slightly different values in the last mantissa byte. The alternative versions wangle it so that the last byte works out the same.

   =====================================================

Get Toni Baker's [url=http://www.users.globalnet.co.uk/~jg27paw4/type-ins/zx-comp/mccalc.zip]Machine Code Calculator[/url] articles. They include a thorough explanation of the topic. I've also included a BASIC program mccalc.z80 which does the conversions:

* RUN 1000 : decimal to FP
* RUN 2000 : FP to decimal
* RUN 3000 : decimal to FP & calculator "stack number" format

   =====================================================

Here's a little program which assigns 0.5/0.25/0.125 to variables h/i/j, firstly as literal values and secondly as expressions which result in those values (ie. with line 9005 disabled or enabled). The printed values are all the same, but the stored values are different depending upon the procedure involved in arriving at those values.

FPform.BAS [code]
9000>LET z=0: LET h=0.5: LET i=0.25: LET j=0.125:
     RESTORE 9000: DEF FN p(a)=PEEK a+256*PEEK (a+1)
9001 FOR a=FN p(23639) TO FN p(23627)-1:
       IF PEEK a=241 AND PEEK (a+3)=CODE "0" THEN LET z=PEEK (a+1)
9002   IF PEEK a=14 AND z THEN GO SUB 9020
9003 NEXT a
9004 PRINT '"h=";h'"i=";i'"j=";j''
9005 LET h=1+h-1: LET i=2+i-2: LET j=3+j-3
9011 FOR a=FN p(23627) TO FN p(23641)-2:
       LET p=PEEK a: LET z=p-(128 AND p>=128): GO SUB 9020:
       LET a=a+(13 AND p>=128):
     NEXT a
9014 PRINT '"h=";h'"i=";i'"j=";j'':
     STOP
9020 PRINT CHR$ z;TAB 3;: LET z=0:
     FOR b=a+1 TO a+5: PRINT PEEK b;",";: NEXT b:
     PRINT : LET a=a+5:
     RETURN
[/code]

[center][img]http://www.users.globalnet.co.uk/~jg27paw4/pourri/a001fpa.gif[/img] : [img]http://www.users.globalnet.co.uk/~jg27paw4/pourri/a001fpb.gif[/img][/center]


**********************************************************************


** Exponentiation of Negative Numbers
   ==================================

The Spectrum will not correctly calculate exponents of negative numbers. For example: -6 ^2 gives -36 as '^' has a higher precedence than unary '-'.
    whereas:(-6)^2 gives an "A Invalid argument" error.

The Spectrum ROM calculates X^Y as EXP (Y*LN X). Thus to calculate (-X)^Y it would attempt EXP (Y*LN -X). As LN -X is the power to which 'e' has to be raised to give -X and as 'e' is a positive number (approx. 2.718) it's impossible to raise it to any power to give a negative number, and therefore the Spectrum '^' function won't work for negative numbers.

Solutions are:

NegExp.BAS [code]
1000 REM A simple loop to repeatedly multiply the number by itself
1001 INPUT "Number ";a,"Exponent ";e:
     LET n=1: LET e=ABS e-INT (ABS e/10)*10
1002 FOR b=1 TO e: LET n=n*a: NEXT b
1003 PRINT a;" ^ ";e;" = ";n

2000 REM A recursive function to do the same thing
2002 DEF FN p(a,e)
     =a*VAL (("FN p("+STR$ a+","+STR$ (e-1)+")" AND e>1)+(STR$ e AND e<=1))
2003 PRINT a;" ^ ";e;" = ";FN p(a,e)+NOT e

3000 REM A non-recursive function just to correct the sign
3002 DEF FN q(a,e)=ABS a^e * (-1 OR (INT (e/2)*2=e OR a>0))
3003 PRINT a;" ^ ";e;" = ";FN q(a,e)

4000 PRINT "--": GO TO 1000
[/code]

Keyword tokens in strings can't be entered with the 128k editor, so the DEF FN p(a,e) function can only be entered with the 48k editor (although see Plus128.TXT for a way around this restriction). Each iteration of FN p(a,e) adds an extra 48 bytes to the stack.


**********************************************************************


** Using the ROM's FP Calculator's Memory Area
   ===========================================

Here's a summary of calculator memory usage, from the series by Toni Baker which was mentioned above:

M0-M0 : int, mod_div, get_argt
M0-M2 : sin, cos, tan, asn, acs, atn, ln, series
M0-M3 : power, exp, sqr
M0-M5 : str$

So the indicated memory banks aren't available if a calculator program is using one of the associated functions.


**********************************************************************


** Calculating an Expression to Give a Target Number
   =================================================

This is the sort of thing they do on Countdown(tm). Here's a routine which works out the expression on the right using the four numbers on the left which will give the answer 24.

[code]
4,4,4,4 = (4*4)+(4+4)  :  3 answers
2,2,4,5 = (2*2)+(4*5)  : 24 answers
2,2,3,8 = (2/2)*(3*8)  : 48 answers
3,3,5,5 = (5*5)-(3/3)  :  1 answer
[/code]

Line 40 is to check that each number is used just once.
Lines 110 & 130 are to avoid dividing by zero.

Target.BAS [code]
  10 DIM a(4): DIM a$(11): DIM z$(60,11): LET z1=0:
     FOR e=1 TO 4: INPUT "#";(e);" ";a(e): NEXT e:
     INPUT "Target# ";target
  20 DIM b$(4): LET b$="*/+-"
  30 FOR a=1 TO 4: FOR b=1 TO 4: FOR c=1 TO 4: FOR d=1 TO 4
  40   IF a=b OR a=c OR a=d OR b=c OR b=d OR c=d THEN GO TO 1000
  50   PRINT #0;AT 0,0;"a=";a;" : b=";b;" : c=";c;" : d=";d,
  60   FOR x=1 TO 4: FOR y=1 TO 4: FOR z=1 TO 4
 100     LET c$="("+STR$ a(a)+b$(x)+STR$ a(b)+")"
 102     LET e$="("+STR$ a(c)+b$(z)+STR$ a(d)+")"
 103     LET f$="("+STR$ a(b)+b$(y)+STR$ a(c)+")"
 110     IF b$(y)="/" AND VAL e$=0 THEN GO TO 130
 115     LET a$=c$+b$(y)+e$
 120     GO SUB 1120
 130     IF b$(x)="/" AND VAL f$=0 THEN GO TO 900
 135     LET a$=STR$ a(a)+b$(x)+f$+b$(z)+STR$ a(d)
 140     GO SUB 1120
 900   NEXT z: NEXT y: NEXT x
1000 NEXT d: NEXT c: NEXT b: NEXT a
1010 LET a$=STR$ z1:
     PRINT ''"NO " AND NOT z1;a$+" " AND z1;"ANSWER";"S" AND z1<>1:
     STOP
1120 PRINT #0;AT 1,0;a$,
1130 IF VAL a$<>target THEN RETURN
1131 FOR w=1 TO z1: IF a$=z$(w) THEN RETURN
1132 NEXT w
1133 LET z1=z1+1: LET z$(z1)=a$: IF z1/20=INT (z1/20) THEN PAUSE 0: CLS
1134 PRINT "ANSWER #";z1;TAB 12;"= ";a$;" = ";target
1140 RETURN
[/code]

   =================================================

I updated that routine to include bracketing of the middle pair of numbers in addition to the outer pairs. Bracketing only one outer pair or none at all might produce more distinct answers, although my suspicion is that it wouldn't, as it would just give variations where the bracketing made no difference; eg. [code](5*5)-(3/3) = 5*5-3/3[/code].

   =================================================

Here's an assembler version. Replace lines 60-900 above with:
	RANDOMIZE target: LET bc=USR org
where 'org' is the location of the routine.

TargetCSTR.ASM [code]
       ;RANDOMIZE target: LET bc=USR org

        org  40000

DEST:   equ  23629
                             ;              0   4    9  C
CH_ADD: equ  23645           ;VARS:   defm "a():z$():z1:a:"
STKEND: equ  23653
FLAGX:  equ  23665
TARGET: equ  23670           ;SEED
       ;all the BASIC numeric variables used are smallints
       ;which are held in 5 bytes as: 00 00 lo hi 00

TARGETUSR:
        ld   bc,(DEST)       ;save system variables
        ld   de,(CH_ADD)     ;needed to complete
        ld   hl,(FLAGX)      ;LET bc=USR org
        push bc              ;on return to BASIC
        push de
        push hl

        ld   hl,VARS+$0c
        ld   (CH_ADD),hl
        call $28b2           ;LOOK_VARS
        ld   bc,3
        add  hl,bc
        push hl
        pop  ix              ;IX=lo-byte address of FOR...NEXT control a
        ld   a,(ix+00)
        ld   b,(ix+19)
        ld   c,(ix+38)
        ld   d,(ix+57)       ;A,B,C,D = FOR...NEXT controls a,b,c,d
        call $2ab6           ;STK_STORE

        ld   hl,VARS
        ld   (CH_ADD),hl
        call $28b2           ;LOOK_VARS
        ld   bc,8
        add  hl,bc
        push hl
        pop  ix              ;IX=lo-byte address of 1st a() value

        ld   hl,VARS+$04
        ld   (CH_ADD),hl
        call $28b2           ;LOOK_VARS
        ld   bc,4
        add  hl,bc           ;HL=address of 1st z$() dimension
        ld   a,(hl)
        ld   (DIM1Z),a
        add  hl,bc           ;HL=address of 1st z$() element
        ld   (FIRSTZ),hl

        ld   hl,VARS+$09
        ld   (CH_ADD),hl
        call $28b2           ;LOOK_VARS
        inc  hl
        inc  hl
        inc  hl
        ld   a,(hl)
        ld   (Z1),a

;  60   FOR x=1 TO 4: FOR y=1 TO 4: FOR z=1 TO 4
        xor  a               ;use range 0-3
X_LOOP:
        ld   (LX),a

        xor  a
Y_LOOP:
        ld   (LY),a

        xor  a
Z_LOOP:
        ld   (LZ),a

       ;MAIN PRINTING SECTION
       ;a$=c$+b$(y)+e$
       ;  ="("+STR$ a(a)+b$(x)+STR$ a(b)+")"
       ;  +b$(y)
       ;   "("+STR$ a(c)+b$(z)+STR$ a(d)+")"
       ;ALL NUMBERS ARE SINGLE DIGITS (max.value 9)
        call GETABCD

; 100     LET c$="("+STR$ a(a)+b$(x)+STR$ a(b)+")"
; 102     LET e$="("+STR$ a(c)+b$(z)+STR$ a(d)+")"
; 110     IF b$(y)="/" AND VAL e$=0 THEN GO TO 130
; 115     LET a$=c$+b$(y)+e$
        ld   (hl),"("
        call ELEMENT           ;A =a(a)
        ld   a,(LX)
        call OPCODE          ;b$(x)
        ld   a,b
        call ELEMENT         ;A =a(b)
        inc  hl
        ld   (hl),")"

        ld   a,(LY)
        call OPCODE          ;b$(y)
        push af

        inc  hl
        ld   (hl),"("
        ld   a,c
        call ELEMENT         ;A =a(c)
        ld   a,(LZ)
        call OPCODE          ;b$(z)
        ld   a,d
        call ELEMENT         ;A =a(d)
        inc  hl
        ld   (hl),")"

        pop  af
        cp   "/"
        jr   nz,VAL1OK
        ld   bc,6            ;divisor offset
        call STR1NUM         ;check divisor for zero
        jr   z,VAL1NXT

; 120     GO SUB 1120
VAL1OK: call STR2NUM

       ;a$=STR$ a(a)+b$(x)
       ;  +"("+STR$ a(b)+b$(y)+STR$ a(c)+")"
       ;  +b$(z)+STR$ a(d)
       ;ALL NUMBERS ARE SINGLE DIGITS (max.value 9)
VAL1NXT:call GETABCD
        dec  hl

; 103     LET f$="("+STR$ a(b)+b$(y)+STR$ a(c)+")"
; 130     IF b$(x)="/" AND VAL f$=0 THEN GO TO 900
; 135     LET a$=STR$ a(a)+b$(x)+f$+b$(z)+STR$ a(d)
        call ELEMENT         ;A =a(a)
        ld   a,(LX)
        call OPCODE          ;b$(x)
        push af

        inc  hl
        ld   (hl),"("
        ld   a,b
        call ELEMENT         ;A =a(b)
        ld   a,(LY)
        call OPCODE          ;b$(y)
        ld   a,c
        call ELEMENT         ;A =a(c)
        inc  hl
        ld   (hl),")"

        ld   a,(LZ)
        call OPCODE          ;b$(z)
        ld   a,d
        call ELEMENT         ;A =a(d)
        inc  hl
        ld   (hl)," "
        inc  hl
        ld   (hl)," "

        pop  af
        cp   "/"
        jr   nz,VAL2OK
        ld   bc,2            ;divisor offset
        call STR1NUM         ;check divisor for zero
        jr   z,VAL2NXT

; 140     GO SUB 1120
VAL2OK: call STR2NUM

; 900   NEXT z: NEXT y: NEXT x
VAL2NXT:ld   c,4
        ld   a,(LZ)
        inc  a
        cp   c
        jp   c, Z_LOOP

        ld   a,(LY)
        inc  a
        cp   c
        jp   c, Y_LOOP

        ld   a,(LX)
        inc  a
        cp   c
        jp   c, X_LOOP

        ld   a,(Z1)
        ld   hl,VARS+$09
        ld   (CH_ADD),hl     ;HL=address of name; A=new value
        call $2d28           ;STACK_A   to calculator stack: A
        call $1c1f           ;CLASS_01
        call $2aff           ;LET

        pop  hl
        pop  de
        pop  bc
        ld   (FLAGX),hl
        ld   (CH_ADD),de
        ld   (DEST),bc
        ret

GETABCD:ld   hl,(STKEND)
        push hl
        call $2bf1           ;STK_FETCH from calculator stack: A.DCB
        pop  hl
        ld   (STKEND),hl     ;restore last entry
        ld   hl,AEXP11
        ret

ELEMENT:push ix              ;IX=lo-byte address of 1st a() value
        dec  a
        ld   e,a
        sla  a
        sla  a
        add  a,e
        ld   e,a             ;E =a() element offset = A * 5
        ld   a,d
        ld   d,0             ;DE=a() element offset
        add  ix,de
        ld   d,a
        ld   a,(ix+00)       ;A =a(n)
        add  a,$30           ;change to ASCII value
        pop  ix
        inc  hl
        ld   (hl),a
        ret

OPCODE: push hl
        ld   e,a
        ld   a,d
        ld   d,0
        ld   hl,BOPC
        add  hl,de
        ld   d,a
        ld   a,(hl)          ;A =arithmetic operator
        pop  hl
        inc  hl
        ld   (hl),a          ;A =arithmetic operator
        ret

STR1NUM:xor  a               ;check divisor for zero
        ld   hl,AEXP11
        add  hl,bc
        ex   de,hl
        ld   bc,5
        call $2ab6           ;STK-STORE to calculator stack: AEDCB
        ld   b,$1d
        call $35de           ;VAL
        rst  $28
        defb $30             ;eq_z
        defb $38             ;end_calc
        call $2dd5           ;FP-TO-A   from calculator stack: A
        xor  1
        ret

STR2NUM:xor  a
        ld   de,AEXP11
        ld   bc,11
        call $2ab6           ;STK-STORE to calculator stack: AEDCB
        ld   b,$1d
        call $35de           ;VAL
        call GS1120
        ret

GS1120:
;1120 PRINT #0;AT 1,0;a$,
        xor  a
        call $1601           ;CHAN_OPEN
        ld   a,$16
        rst  $10
        ld   a,1
        rst  $10
        xor  a
        rst  $10
        ld   de,AEXP11
        ld   bc,11
        call $203c           ;PR-STRING print a string length BC from DE
;1130 IF VAL a$<>target THEN RETURN
        call $2da2           ;FP_TO_BC  from calculator stack: BC
        ret  nz              ;ignore -ve numbers
        ld   hl,(TARGET)
        sbc  hl,bc
        ret  nz              ;doesn't match target
;1131 FOR w=1 TO z1: IF a$=z$(w) THEN RETURN
        ld   a,(Z1)
        ld   c,a
        inc  c
        ld   de,(FIRSTZ)
        ld   a,(DIM1Z)
        cp   c
        jp   c,$2a20         ;"3 Subscript wrong"
ZLOOP1:
        ld   hl,AEXP11
        dec  c
        jr   z,ZNEW2
        ld   b,11
ZLOOP2:
        ld   a,(de)
        cp  (hl)
        jr   nz,ZNEXT
        inc  de
        inc  hl
        djnz ZLOOP2
        ret
;1132 NEXT w
ZNEXT:
        inc  de
        djnz ZNEXT
        jr   ZLOOP1
;1133 LET z1=z1+1: LET z$(z1)=a$: IF z1/20=INT (z1/20) THEN CLS
ZNEW2:
        ld   a,(Z1)
        inc  a
        ld   (Z1),a
        ld   hl,AEXP11
        ld   bc,11
        ldir                 ;DE set at ZLOOP1 or ZNEW1
CheckCLS:
        sub  20
        jr   c,NOCLS
        push af
        call z,$1f3d         ;PAUSE_1
        pop  af
        push af
        call z,$0d6b         ;CLS
        pop  af
        jr   nz,CheckCLS

;1134 LET answers=answers+1:
NOCLS:
        ld   a,(Z1)
        ld   b,0
        ld   c,a
        push bc
;     PRINT "ANSWER #";answers;TAB 12;"= ";a$;" = ";target
        ld   a,2
        call $1601           ;CHAN_OPEN
        ld   a,$16
        ld   de,ANSWERP
        ld   bc,8
        call $203c           ;PR-STRING "ANSWER #"
        pop  bc              ;BC=z1
        call $1a1b           ;OUT_NUM_1 print integer BC 0-9999
        ld   a,$17           ;TAB
        rst  $10
        ld   a,12
        rst  $10
        xor  a
        rst  $10
        ld   a,"="
        rst  $10
        ld   a," "
        rst  $10
        ld   de,AEXP11
        ld   bc,11
        call $203c           ;PR-STRING a$
        ld   a," "
        rst  $10
        ld   a,"="
        rst  $10
        ld   a," "
        rst  $10
        ld   bc,(TARGET)
        call $1a1b           ;OUT_NUM_1 target
        ld   a,$0d
        rst  $10             ;print ENTER

;1140 RETURN
        ret

BOPC:   defm "*/+-"
VARS:   defm "a():z$():z1:a:"
FIRSTZ: defw 0000            ;address of 1st z$() element
DIM1Z:  defb 00              ;1st z$() dimension
Z1:     defb 00              ;number of z$() entries
AEXP11: defs 11
LX:     defb 00
LY:     defb 00
LZ:     defb 00
ANSWERP:defm "ANSWER #"

; END
[/code]


**********************************************************************


** Z80 Math Routines
   =================

Here's another couple of handy pages:

http://map.grauw.nl/articles/fast_loops.php
http://map.grauw.nl/articles/mult_div_shifts.php


**********************************************************************


** Full 16*16-digit BASIC multiplication
   =====================================

I liked Andre Adrian's 32-bit long multiplication routine so much that I decided to a decimal version. After all, 2^63 is only 9223372036854775808, and a decimal version, even restricted to numbers which will fit on a line, could handle up to 99999999999999999999999999999999, a whole extra 13 digits, and give the exact answer - no 'e' notation approximations. The URL for the page with AA's original assembler version is in the listing.

I've done this BASIC version, which follows the original routine quite closely (AA's comments are on the right), starting at line 1000. The loop is only half the length as the decimal "registers" are only 4-digits long as opposed to 8-bits for the assembler version.

The biggest number it will handle correctly is:
9999999999999999 * 9999999999999999 = 99999999999999980000000000000001
which takes about a minute to calculate - and that's what prints, not "1E+32". Each number is entered as 4x4-digit elements. There's no explicit check to stop an element being entered with more than four digits (having less than  four is OK - it's not necessary to pad them, that's done by the program), but because of the way the numbers are handled the ROM will give an "Integer out of range" error anyway if an element is too long.

LMUL.BAS [code]
   3 DEF FN R(r$)=RR: DEF FN p(a)=PEEK a+256*PEEK (a+1):
     DEF FN b$(r)="0000"(TO 4-LEN STR$ r)+STR$ r
  10 GO SUB 810

 100 INPUT "Enter two 16-digit numbers"'
           "in two 4x4 blocks"'
           "Number 1:"'
           V;TAB 8;X;TAB 16;B;TAB 24;C'
           "Number 2:"'
           S;TAB 8;W;TAB 16;D;TAB 24;E
 102 LET G=0: LET K=0: GO SUB 1000: GO TO 100

 400 REM EXX:
 401 LET Z=B: LET B=V: LET V=Z
 402 LET Z=C: LET C=X: LET X=Z
 403 LET Z=D: LET D=S: LET S=Z
 404 LET Z=E: LET E=W: LET W=Z
 405 LET Z=H: LET H=G: LET G=Z
 406 LET Z=L: LET L=K: LET K=Z
 409 RETURN

 810 REM initialise FN R(r$)
 814 RESTORE 3: LET fnr=FN p(23639)+8: LET RR=900: LET EXX=400
 815 RESTORE 903: LET var=FN p(23639)+6
 816 RANDOMIZE fnr: POKE 23563,PEEK 23670: POKE 23564,PEEK 23671
 819 RETURN

 900 REM RR
 902 LET s$=STR$ I+FN b$(VAL r$): LET I=VAL s$(LEN s$): POKE var,CODE r$
 903 LET r=VAL s$(TO LEN s$-1)
 909 RETURN

 980 REM Thanks to Andre Adrian for the original assembler version
 981 REM http://www.andreadrian.de/oldcpu/Z80_number_cruncher.html#mozTocId269826
 991 REM MULTIPLY ROUTINE 32*32BIT=64BIT
 992 REM GKHLVXBC = VXBC * SWDE
 993 REM NEEDS REGISTER A, CHANGES FLAGS
 994 REM ALT REG FOR B,C,D,E,H,L
 995 REM ARE ....... V,X,S,W,G,K (KEY TO THE LEFT)
 996 REM Carry = I
1000 REM LMUL:
1001 PRINT "  ";FN b$(V)+FN b$(X)+FN b$(B)+FN b$(C)
1002 PRINT "* ";FN b$(S)+FN b$(W)+FN b$(D)+FN b$(E)
1010 LET I=0:                : REM  AND  A      ; RESET CARRY FLAG
1020 LET H=0: LET L=0:       : REM  SBC  HL,HL  ; RESULT BITS 32..47 = 0
1030 GO SUB EXX              : REM  EXX
1040 LET H=0: LET L=0:       : REM  SBC  HL,HL  ; RESULT BITS 48..63 = 0
1050 GO SUB EXX              : REM  EXX
1060                         : REM  LD   A,B    ; MPR IS B'C'AC
1070 LET A=17                : REM  LD   B,33   ; INITIALIZE LOOP COUNTER
1080 GO TO 1300              : REM  JR   LMULSTART
1100 REM LMULLOOP:
1110 IF NOT I THEN GO TO 1200: REM  JR   NC,LMULNOADD
1115 LET I2=0: FOR m=1 TO I
1120 LET I=0                 : REM  ADD  HL,DE  ; RESULT += MPD
1121 LET L=L+E: IF L>9999 THEN LET L=L-10000: LET H=H+1
1122 LET H=H+D: IF H>9999 THEN LET H=H-10000: LET I=I+1
1130 GO SUB EXX              : REM  EXX
1140 LET L=L+I: LET I=0      : REM  ADC  HL,DE
1141 LET L=L+E: IF L>9999 THEN LET L=L-10000: LET H=H+1
1142 LET H=H+D: IF H>9999 THEN LET H=H-10000: LET I2=I2+1
1150 GO SUB EXX              : REM  EXX
1155 NEXT m: LET I=I+I2
1200 REM LMULNOADD:
1210 GO SUB EXX              : REM  EXX
1220 GO SUB FN R("H")        : REM  RR   H      ; RIGHT SHIFT UPPER
1230 GO SUB FN R("L")        : REM  RR   L      ; 32BIT OF RESULT
1240 GO SUB EXX              : REM  EXX
1250 GO SUB FN R("H")        : REM  RR   H
1260 GO SUB FN R("L")        : REM  RR   L
1300 REM LMULSTART:
1310 GO SUB EXX              : REM  EXX
1320 GO SUB FN R("B")        : REM  RR   B      ; RIGHT SHIFT MPR/
1330 GO SUB FN R("C")        : REM  RR   C      ; LOWER 32BIT OF RESULT
1340 GO SUB EXX              : REM  EXX
1350 GO SUB FN R("B")        : REM  RRA         ; EQUIVALENT TO RR A
1360 GO SUB FN R("C")        : REM  RR   C
1370 LET A=A-1: IF A THEN GO TO 1100 : REM  DJNZ LMULLOOP
1390 REM RESULT IN H'L'HLB'C'AC
1391 LET a$=FN b$(G)+FN b$(K)+FN b$(H)+FN b$(L)+
            FN b$(V)+FN b$(X)+FN b$(B)+FN b$(C)
1392 FOR a=1 TO 32: IF a$(a)="0" THEN NEXT a
1393 PRINT "= "'a$(a TO)'32-a+1;" digits"''
1399 RETURN
[/code]

   =====================================

I've done an assembler version now. I wrote a mini-STR$ and mini-VAL that just deal with 2-byte decimal numbers; ie. up to 9999, as using the ROM routines was too slow. They're called NewSTR and NewVAL in the listing. Calculations now take less than a second.

There are two entry points, depending upon whether the numbers are entered as numbers or strings. The variable names can be anything; just change the names in the NUMBERS and STRINGS statements; but they must be declared sequentially in the BASIC, as the program expects them to be adjacent in memory. It just looks for the first one and expects the others to follow on. So there's no parameters to pass, as it just looks for the names declared in the listing. The USR call returns a 32-digit string with the answer and so "STR$ USR" must be used to call it.

It works with fractions as well. It's easiest to imagine the virtual decimal point as being between the 8th & 9th digits, which allows up to:
99999999.99999999 * 99999999.99999999 = 9999999999999999.9999999999999999
with the VDP in the product being 16 digits in from the right; but it can be placed anywhere, as long as both multiplier & multiplicand use the same alignment, otherwise it just gets confusing.

For negative numbers it's only necessary to consider the product sign when the mpr & mpd have different signs and the mpr is odd, in which case the product is -ve; everything else gives a +ve answer.

LMUL_Input.BAS [code]
 100 INPUT "Enter two 16-digit numbers"'
           "in two 4x4 blocks"'
           "Number 1:"'
           V;TAB 8;X;TAB 16;B;TAB 24;C'
           "Number 2:"'
           S;TAB 8;W;TAB 16;D;TAB 24;E
 102 PRINT STR$ USR LMUL10: GO TO 100

-OR-

 100 DIM C$(16): DIM E$(16)
 101 INPUT "Enter two 16-digit numbers"'
           "Number 1: ";C$'
           "Number 2: ";E$
 102 PRINT STR$ USR (LMUL10+3): GO TO 101
[/code]

LMUL_10.ASM [code]
        org  64000

CH_ADD: equ  23645
SAVEHL: equ  23680

LMUL_10:jp   LMUL_10_NUM
        jp   LMUL_10_STR

LMUL_10_NUM:
        exx
        ld   (SAVEHL),hl
        ld   de,NUMBERS
        call FIND
        ;transfer the 8 BASIC variables into 8*2-byte registers
        ;starting from the beginning of WORKSP
        ld   de,Ba
        call NUMCOPY_twice
        ld   de,BB
        call NUMCOPY_twice
        ld   de,Da
        call NUMCOPY_twice
        ld   de,DDD
        call NUMCOPY_twice
        jp   GKHL00

NUMCOPY_twice:
        call NUMCOPY
NUMCOPY:push de
        ld   a,(hl)          ;A =exponent byte
        or   a
        jr   nz,NUMSTACK
        inc  hl              ;get number in SMALLINT form
        inc  hl
        ld   c,(hl)
        inc  hl
        ld   b,(hl)
        inc  hl
        inc  hl
NUMSTACK:
        call nz,$33b4        ;STACK_NUM if number in FP form
        push hl
        call c,$2da2         ;FP_TO_BC
        pop  hl
        pop  de
        ex   de,hl
        ld   (hl),c
        inc  hl
        ld   (hl),b
        inc  hl
        ex   de,hl
        inc  hl              ;skip over next variable letter
        ret

;**********

LMUL_10_STR:
        exx
        ld   (SAVEHL),hl
        ld   de,STRINGS
        call FIND
        ld   bc,5
        add  hl,bc           ;skip past header
        push hl
        call PADSTR          ;zero pad C$
        ld   hl,Ba
        call NewVAL_twice
        ld   hl,BB
        call NewVAL_twice
        pop  hl
        ld   bc,22
        add  hl,bc
        call PADSTR          ;zero pad E$
        ld   hl,Da
        call NewVAL_twice
        ld   hl,DDD
        call NewVAL_twice
        jp   GKHL00

PADSTR: ;right-justify and left zero-pad a 16-char string
        ld   de,PADDATA
        ld   b,16
PADLOOP:ld   a,(hl)
        cp   " "
        jr   z,PADPAD
        ld   (de),a
        inc  hl
        inc  de
        djnz PADLOOP
PADPAD: and  a
        ld   bc,16
        ex   de,hl
        sbc  hl,bc
        ex   de,hl           ;DE=start of 16-digit decimal
        ret

NewVAL_twice:
        call NewVAL
NewVAL: ;convert a 4-digit decimal to a 2-byte binary
        push hl
        ld   a,4
        ex   de,hl           ;HL=decimal pointer
        ld   bc,0000         ;BC=binary sum
DoDigit:ld   d,0
        ld   e,(hl)          ;DE=decimal digit
        push de
        exx
        pop  hl
        ld   b,a
        ex   af,af'          ;save A counter
        ld   a,l
        sub  $30
        ld   l,a
        dec  b
        jr   z,NoTimes
Times10:ld   de,10
        call $30a9           ;HL=HL*DE (preserves BC, changes A)
        djnz Times10
NoTimes:push hl              ;HL=digit * 10^(A-1)
        ex   af,af'
        exx
        ex   de,hl
        pop  hl
        add  hl,bc           ;update sum
        ld   b,h
        ld   c,l             ;BC=value
        ex   de,hl
        inc  hl
        dec  a
        jr   nz,DoDigit
        ex   de,hl           ;DE=decimal pointer
        pop  hl              ;HL=register pointer
        ld   (hl),c
        inc  hl
        ld   (hl),b
        inc  hl
        ret                  ;BC=value, DE=DE+4

GKHL00:
        ;The two entry paths have now converged.
        ;All the initial register values are in WORKSP.
        di
        ld   ix,WORKSP

; - - - - -
; 980 REM Thanks to Andre Adrian for the original assembler version
; 981 REM http://www.andreadrian.de/oldcpu/Z80_number_cruncher.html#mozTocId269826
; 991 REM MULTIPLY ROUTINE 32*32BIT=64BIT
; 992 REM GKHLVXBC = VXBC * SWDE
; 993 REM NEEDS REGISTER A, CHANGES FLAGS
; 994 REM ALT REG FOR B,C,D,E,H,L
; 995 REM ARE ....... V,X,S,W,G,K (KEY TO THE LEFT)
; 996 REM Carry = I
;1000 REM LMUL:
;1001 PRINT "  ";FN b$(V)+FN b$(X)+FN b$(B)+FN b$(C)
;1002 PRINT "* ";FN b$(S)+FN b$(W)+FN b$(D)+FN b$(E)

        ld   (ix+40),0       ; 1010 LET I=0
        ld   hl,$0000        ; 1020 LET H=0: LET L=0
        ld   (HH),hl
        ld   (LL),hl
        call gsEXX           ; 1030 GO SUB EXX
        ld   hl,$0000
        ld   (HH),hl         ; 1040 LET H=0: LET L=0
        ld   (LL),hl
        call gsEXX           ; 1050 GO SUB EXX
                             ; 1060
        ld   (ix+42),17      ; 1070 LET A=17
        jp   LM10_Start      ; 1080 GO TO 1300

LM10_Loop:                   ; 1100 REM LMULLOOP:
        ld   a,(ix+40)       ; 1110 IF NOT I THEN GO TO 1200
        or   a
        jr   z,LM10_NoAdd
        ld   (ix+41),0       ; 1115 LET I2=0: FOR m=1 TO I
        ld   a,(ix+40)
LM10_LoopM:
        call LM10_DoAdd
        jr   c,LM10_LoopMC2
        inc  (ix+40)         ;     (IF H>9999 THEN)LET I=I+1
LM10_LoopMC2:
        call gsEXX           ; 1130 GO SUB EXX
        ld   hl,(LL)         ; 1140 LET L=L+I:
        ld   d,0
        ld   e,(ix+40)
        add  hl,de
        ld   (LL),hl
        call LM10_DoAdd
        jr   c,LM10_LoopMC3
        inc  (ix+41)         ;      (IF H>9999 THEN)LET I2=I2+1
LM10_LoopMC3:
        call gsEXX           ; 1150 GO SUB EXX
        dec  a               ; 1155 NEXT m: LET I=I+I2
        jr   nz,LM10_LoopM
        ld   a,(ix+40)
        add  a,(ix+41)
        ld   (ix+40),a

LM10_NoAdd:                  ; 1200 REM LMULNOADD:
        call LM10_RotateHL
        call LM10_RotateHL

LM10_Start:                  ; 1300 REM LMULSTART:
        call LM10_RotateBC
        call LM10_RotateBC
        dec  (ix+42)         ; 1370 LET A=A-1: IF A THEN GO TO 1100
        jp   nz,LM10_Loop

;1390 REM RESULT IN H'L'HLB'C'AC
;1391 LET a$=FN b$(G)+FN b$(K)+FN b$(H)+FN b$(L)+
;            FN b$(V)+FN b$(X)+FN b$(B)+FN b$(C)
        ld   de,ANSWER
        ld   hl,Ha
        call BuildResult
        ld   hl,La
        call BuildResult
        ld   hl,HH
        call BuildResult
        ld   hl,LL
        call BuildResult
        ld   hl,Ba
        call BuildResult
        ld   hl,Ca
        call BuildResult
        ld   hl,BB
        call BuildResult
        ld   hl,CC
        call BuildResult

;1392 FOR a=1 TO 32: IF a$(a)="0" THEN NEXT a
;1393 PRINT "= "'a$(a TO)'32-a+1;" digits"''
;1399 RETURN
; - - - - -

OUTPUT: call $16bf           ;SET_WORK reset WORKSP & STKEND
        xor  a
        ld   de,ANSWER
        ld   bc,32
        call $2ab1           ;STK_ST_0
        ;reorganise the machine stack so that this string
        ;becomes the output from the function instead of BC
        pop  bc              ;BC=$2d2b (discard)
        pop  bc              ;BC=$3365
        pop  de              ;DE=$0000
        inc  sp
        inc  sp
        pop  hl              ;HL=$000D
        ex   (sp),hl         ;HL=$106E
        push hl
        push de
        push bc
        ld   hl,(SAVEHL)
        exx
        ld   de,(23653)      ;DE=(STKEND) (for RE_ENTRY)
        ei
        ret                  ;return via $3365 RE_ENTRY

;**********

LM10_DoAdd:
        ld   bc,10000        ;BC=$2710
        ld   (ix+40),0       ; 1120 LET I=0
        ld   hl,(LL)         ; 1121 LET L=L+E:
        ld   de,(EE)
        add  hl,de
        ld   (LL),hl         ;      IF L>9999 THEN LET L=L-10000: LET H=H+1
        sbc  hl,bc
        jp   c,LM10_LoopMC1
        ld   (LL),hl
        ld   hl,(HH)
        inc  hl
        ld   (HH),hl
LM10_LoopMC1:
        ld   hl,(HH)         ; 1122 LET H=H+D:
        ld   de,(DDD)
        add  hl,de
        ld   (HH),hl         ;      IF H>9999 THEN LET H=H-10000:
        sbc  hl,bc
        ret  c
        ld   (HH),hl
        ret

LM10_RotateHL:
        call gsEXX           ; 1210 GO SUB EXX
        ld   hl,HH           ; 1220 GO SUB FN R("H")
        call gsRR
        ld   hl,LL           ; 1230 GO SUB FN R("L")
        call gsRR
        ret

LM10_RotateBC:
        call gsEXX           ; 1310 GO SUB EXX
        ld   hl,BB           ; 1320 GO SUB FN R("B")
        call gsRR
        ld   hl,CC           ; 1330 GO SUB FN R("C")
        call gsRR
        ret

FIND:   ld   bc,(CH_ADD)
        push bc
        ld   (CH_ADD),de
        call $28b2           ;LOOK_VARS
        pop  bc
        ld   (CH_ADD),bc
        jp   c,$1c2e         ;2 - Variable not found
        inc  hl
        ret

NUMBERS:defm "V:X:B:C:S:W:D:E:"
STRINGS:defm "C$():E$():"

WORKSP: defs 44
        ;6 alternate registers (2 bytes, 0-9999)
Ba:     equ  WORKSP+00
Ca:     equ  WORKSP+02
Da:     equ  WORKSP+04
Ea:     equ  WORKSP+06
Ha:     equ  WORKSP+08
La:     equ  WORKSP+10
        ;6 number registers (2 bytes, 0-9999)
BB:     equ  WORKSP+12
CC:     equ  WORKSP+14
DDD:    equ  WORKSP+16
EE:     equ  WORKSP+18
HH:     equ  WORKSP+20
LL:     equ  WORKSP+22
        ;16 bytes copy area
COPY:   equ  WORKSP+24

I1:     equ  WORKSP+40       ;Carry flag#1 (1 byte, 0-9)
I2:     equ  WORKSP+41       ;Carry flag#2 (1 byte, 0-9)
LC:     equ  WORKSP+42       ;loop counter

gsEXX:                       ;  400 REM EXX:
        ld   hl,BB           ;  401 LET Z=B: LET B=V: LET V=Z
        ld   de,COPY
        ld   bc,12
        ldir
        ld   hl,Ba
        ld   de,BB
        ld   bc,12
        ldir
        ld   hl,COPY
        ld   de,Ba
        ld   bc,12
        ldir
                             ;  402 LET Z=C: LET C=X: LET X=Z
                             ;  403 LET Z=D: LET D=S: LET S=Z
                             ;  404 LET Z=E: LET E=W: LET W=Z
                             ;  405 LET Z=H: LET H=G: LET G=Z
                             ;  406 LET Z=L: LET L=K: LET K=Z
        ret                  ;  409 RETURN

gsRR:                        ;  900 REM RR
        push hl              ;save decimal register address
        ld   de,PADDATA+1
        call NewSTR          ;  902 LET s$=STR$ I+FN b$(VAL r$):
        ld   a,(ix+40)       ;A =I1
        add  a,$30
        ld   (PADDATA),a     ;put Carry on 1st digit
        dec  de
        ld   a,(de)          ;get Carry from 5th digit
        sub  $30
        ld   (I1),a          ;      LET I=VAL s$(LEN s$): POKE var,CODE r$
        ld   de,PADDATA      ;  903 LET r=VAL s$(TO LEN s$-1)
        pop  hl
        call NewVAL          ;new 2-byte value stored at (HL)
        ret                  ; 909 RETURN

BuildResult: ;HL=decimal register address, DE=address in ANSWER area
        push de
        ld   de,PADDATA
        call NewSTR
        ld   hl,PADDATA      ;4-byte left zero-pad
        pop  de
        ld   bc,4
        ldir
        ret

NewSTR: ;convert BC to a 4-digit decimal number string
        ld   c,(hl)
        inc  hl
        ld   b,(hl)          ;BC=decimal register value
        ld   h,b
        ld   l,c
        ld   bc,-1000
        call GetDigit
        ld   bc,-100
        call GetDigit
        ld   bc,-10
        call GetDigit
        ld   a,l
        call LastDigit
        ret

GetDigit:
        xor  a
SubDigit:
        add  hl,bc           ;BC is a -ve power of 10
        inc  a
        jr   c,SubDigit
        sbc  hl,bc
        dec  a
LastDigit:
        add  a,$30
        ld   (de),a
        inc  de
        ret

PADDING:defm "0000000000000000"
PADDATA:defs 16
ANSWER: defs 32
[/code]


**********************************************************************


** Print a large binary integer as a decimal
   =========================================

Massive-BCD.ASM [code]
; print a large binary integer as a decimal
; size = 234 bytes (excluding number string), 3.91 seconds

        org  40000

DEC2040:;start here to use 2040 binary 1s
        ld   hl,BIN2040
        ld   (hl),$ff
        ld   de,BIN2040+1
        ld   bc,(BYTsize)
        dec  bc
        ldir
DECnnnn:;start here (=DEC2040+15) if pre-loading different values
        ;initialise max.length for 2040 bit decimal number (615 digits)
        ;plus one for terminator
        exx
        ld   (23680),hl      ;save H'L'
        ld   hl,$ffff
        ld   (hl),0
        ld   de,$fffe
        ld   bc,615
        lddr
        ld   a,2
        call $1601           ;CHAN_OPEN
        ld   bc,(COUNTIX)    ;BC=(BINsize)/3 (LoopIX counter)
        ld   de,$ffff        ;DE=decimal LHS address (MSD)

        exx
        ld   hl,BIN2040      ;H'L'=address of binary number
LoopIX: ld   b,8             ;B =octal digit counter (within 24 bits)
        ld   c,(hl)          ;take 8 octal (3-bit) numbers from 3 bytes
        inc  hl
        ld   d,(hl)
        inc  hl
        ld   e,(hl)
        inc  hl
Loop0a: xor  a               ;move 3 bits at a time (1 octal digit) ...
        sla  e
        rl   d
        rl   c
        rla                  ;... into A
        sla  e
        rl   d
        rl   c
        rla                  ;... into A
        sla  e
        rl   d
        rl   c
        rla                  ;... into A
        exx

        ;convert octal to decimal
        ;d from o(123...n) = ( ( ( o(1) *8+o(2) )*8+o(3) )*8 ... +o(n) )
        ;first, add in the next octal digit from the left
        ld   hl,$ffff
        add  a,(hl)
        daa
        ld   (hl),a
CarryOn:dec  hl
        ld   a,(hl)
        adc  a,0
        daa
        ld   (hl),a
        jr   c,CarryOn
        dec  bc              ;octal digit counter (within BINsize bits)
        ld   a,b
        or   c
        jr   z,EndLoop       ;if it's the last digit, then don't ...

        push bc
        ld   b,0             ;B=b/fwd carry
        ld   hl,$ffff        ;HL=digit pointer, starting at RHS (LSD)
Loop5:  ld   a,(hl)          ;.... multiply cumulative decimal total by 8
        ld   c,0             ;C=c/fwd carry
        add  a,a             ;3 instances for A*2*2*2
        daa
        rl   c               ;save Carry
        add  a,a
        daa
        rl   c
        add  a,a
        daa
        rl   c
        add  a,b             ;add b/fwd carry
        daa
        ld   (hl),a
        ld   a,c
        adc  a,0             ;move c/fwd carry to b/fwd carry
        daa
        ld   b,a
        dec  hl
        jp   nz,Loop5        ;if carry to b/fwd (JP here quicker than JR)

        ld   a,h             ;exit Loop5 if DE>=HL
        cp   d
        jr   c,Exit5         ;if D>H
        jr   nz,Loop5        ;if D<H
        ld   a,e             ;D=H
        cp   l
        jr   c,Loop5         ;if E<L

Exit5:  ld   d,h
        ld   e,l             ;DE=LHS address
        pop  bc

        exx
        djnz Loop0a
        jp   LoopIX

EndLoop:ld   hl,$ffff
        sbc  hl,de
        sla  l
        rl   h
        ex   de,hl           ;DE=number of decimal digits
        inc  hl              ;HL=LHS address
        ld   c,$3f
        exx
        ld   de,16384        ;reset print position
        exx

BCD2ASC:ld   a,$0f
        cp   (hl)
        jr   c,BCD2ALH       ;if LH digit non-zero
        dec  de              ;don't count a leading zero
        rld

BCD2ALH:ld   a,c
        rld                  ;A+=$30 = range $30-$39
        cp   c
        jr   z,BCD2AHL

PrintA: exx    ;print character A at D'E'
        ld   bc,(23606)      ;DE=(CHARS)
        ld   h,0
        ld   l,a
        add  hl,hl
        add  hl,hl
        add  hl,hl
        add  hl,bc           ;HL=start of char's bit pattern
        push de              ;DE=display file address
        ld   b,8             ;copy char to display
PRINTAB:ld   a,(hl)
        ld   (de),a
        inc  hl
        inc  d
        djnz PRINTAB
        pop  de              ;calculate next position
        inc  e
        jr   nz,PRINTEX
        ld   a,d
        add  a,8
        ld   d,a
PRINTEX:exx
        jp   BCD2ALH

BCD2AHL:inc  hl
        bit  7,h
        jp   nz,BCD2ALH      ;finished when HL=$0000

EndProg:push de
        ld   hl,(23680)      ;restore H'L'
        exx
        pop  bc              ;BC=number of decimal digits
        ret

BINsnum:equ  2040
BINsize:defw BINsnum         ;length of binary number in bits (min.24, max.2040)
                             ;must = 8*BYTsize
BYTsnum:equ  255
BYTsize:defw BYTsnum         ;length of binary number in bytes (min.3, max.255)
                             ;must be a multiple of 3
COUNTER:equ  BINsnum/3
COUNTIX:defw COUNTER

BIN2040:                     ;start address of binary number


;111111111111111111111111111111111111111111111111 (48 bits)
;281474976710655
[/code]


**********************************************************************
