Programming the 80’s way #3

Introduction to Integers.

One of my favorite tasks using a small system like our ZX Spectrum is to overcome limitations imposed on integers and floating-point numbers.

In ZX Basic, integers have a width of 16 bits (plus sign) allowing you to manipulate numbers between -65.535 and 65.535, and once out of this range, you’re venturing into floating point numbers wilderness.

In Forth, unless you can rely on some floating-point library, all math is integer math, and usually Z80 implementations uses 16-bits single-precision integers and 32-bits double-precision integers, so expanding the range to a wider interval of integers that lie between -2.147.483.648 and 2.147.483.647.

The lack of floating-point and engineering notation is not so bad because the trade-off is a faster speed and great simplicity, by defining suitable fine-grained unit-of-measure like “millimeters” instead of “thousandth of meter”, for instance.

On the other hand, irrational constant numbers, like “Greek-Pi”, that have an infinite number of decimal places, cannot be exactly represented neither using floating-points nor double precision integers, and in Forth, it is very common to exploit irrational constant numbers via Rational Approximation.

The concept behind this useful technique is that any irrational number can be represented by a rational approximation. For example, 355/113 is a very good approximation of “pi” with an error of less than one part in a million.

For instance, the formula to calculate the circumference of a circle can be coded directly as

    : CIRCUMFERENCE  ( n1 -- n2 ) 
      2* 355 113 */ 
    ;

in particular, the definition  */   is the typical scaling operator that takes a single-precision integer multiplies it by a number (355 in our case) and divides it by another (113 in our case) but ensuring a double-precision intermediate result to avoid loss of precision.

 

Triple-precision integers

My v-Forth implementation provides a definition  UM* to multiply two single-precision numbers and get a double-precision number, and a definition  UM/MOD  to divide a double-precision number and get two single-precision numbers quotient and reminder.

It seems there is little way to use some “triple-precision” [1] integer i.e. 48-bits of precision, but I’ll show how I had the chance to code an improved definition of  */   that operates on a double-precision integer passing through a “triple-precision” integer so we can improve our previous version of CIRCUMFERENCE to cope with “double-precision” integer and use a “triple-precision”  intermediate result using this new definition  M*/   

    : CIRCUMFERENCE  ( d1 -- d2 )  
      2DUP D+      \ double the radius
      355 113 M*/ 
    ;

Here below, I expose the implementation of such  M*/   using the math definitions already available UM* and UM/MOD.

In the following definition explanation, each symbol represents a single-precision unsigned integer, that is a number between 0 and 65535, so we can think of it as we were using some “65536-based” math.

  1. we can split the double-precision integer  d  into its two components dH and dL and then multiply them by m separately getting two double-precision integer a and b, we split in aH, aL and bH, bL.
  2. we have to add  aH part to b obtaining c, we split in cH, cL. This way we now have three single-precision integers cH, cL, aL, that represents our triple-precision intermediate value integer.
  3. We can perform one first division, dividing c by n obtaining quotient q1 and reminder r1.
  4. We compose r1 and aL that is the double-precision number we now divide by n to obtain quotient q2, while remainder r2 is discarded for our purposes.
\     dH dL  x
\         m  =
\ ----------
\     aH aL
\  bH bL   
\ ----------
\  cH cL aL  :  n  =  q1  q2
\     r1 aL
\ 
: M*/     ( d m n -- d2 ) 
  2dup xor 3 pick xor >R     \ keep track of final sign
  abs >R abs >R 
  swap R@ UM* rot R> UM*     \ 1. multiply by m and get a and b
  rot 0 D+                   \ 2. obtain c
  R@ UM/MOD                  \ 3. divide n into c giving quotient and reminder
  rot rot R> UM/MOD          \ 4. divide n into the composition r1+aL 
  nip swap                   \ discard reminder r2 and reorder the two partial-quotients
  R> D+-                     \ determine final sign.
;

 

For example:

500000. CIRCUMFERENCE D.

prints

3141592

In conclusion, using just some Arithmetic we overcame the native 32-bit Forth limitation.

[1] Forth Application Techniques – Elizabeth D. Rather and the technical staff of FORTH Inc. – 2000 Forth Inc.

 

35 Comments

  • peter bierbach says:

    Hi good afternoon.

    next vforth :
    why are only about 4800 bytes free when loading the image ?

    ——————————–
    NEEDS OPEN<
    NEEDS J
    needs layer11

    layer11
    : DATEN-LOAD< ( — )
    OPEN< >R

    6912 0 DO
    16384 6912
    J
    F_READ
    DROP
    LOOP
    R> F_CLOSE 42 ?ERROR ;

    DATEN-LOAD< ../../fth/bild.scr

    : los
    ;
    ——————————

    thanks, the new version (27.08.) is now running without any flaws.

    there are no defects with me.
    my english skills are not good.

    to switch off the blinking cursor you have to explain to me.

    thanks
    greeting

  • Hi Peter
    If I understand what you wish to do, you don’t need a DO-LOOP structure to display a .SCR file.
    Let me show my example to load, for instance, /DOT/KEYBOARD.SCR keymap file.


    NEEDS LAYER11
    DECIMAL
    : WAIT-BREAK ( -- ) \ wait for [BREAK] while cursor is hidden
    BEGIN ?TERMINAL UNTIL
    ;
    : SHOW-SCR
    LAYER11
    OPEN< \ this leaves file-handle number on TOS
    DUP \ for later f_close
    16384 6912 \ address and length to be read
    ROT \ bring file-handle on TOS
    F_READ DROP DROP \ ingore status and actual byte read
    F_CLOSE DROP \ ignore status
    ;

    SHOW-SCR /DOT/KEYBOARD.SCR WAIT-BREAK

    (The above code is copied by hand while I was testing it on CSpect emulator, it should work, but beware any typo)

    ( output )

    Regards
    _M.

  • peter bierbach says:

    hello tanks for : show-scr.
    is wonderful.

    how do I get this under : wait-break ?
    —————————
    : starte
    case
    119 of oben endof
    101 of rechts endof
    113 of links endof
    115 of unten endof
    endcase ;

    : los
    SPRITE 0 SPRITE-UPDATE

    begin
    key
    dup 13 – while
    starte
    repeat drop ;
    ————————

    thanks
    greeting

    • Peter,
      the problem is KEY that “stops execution, shows a flashing cursor and waits for a keypress”.
      To avoid such a stop, you have to scan the keyboard yourself or check “LASTK” system variable at 23560 which is updated during standard interrupt routine: vForth much relies on any standard ZX-Spectrum behavior.
      To see an example of Pac-Man like game, give a look to my “Chomp-Chomp” example available in Screens# 600-670: you can just give :
      600 LOAD
      and after a minute, when compilation is done:
      GAME

  • peter bierbach says:

    please can you help save f_write?

    the datentest.bin is “0”

    danke.
    gruss
    ———————————-
    NEEDS OPEN<
    256 CONSTANT BUFLEN
    CREATE BUFER BUFLEN ALLOT
    BUFER BUFLEN ERASE

    : voll
    buflen 0 do
    i dup bufer + c!
    loop ;

    : daten-save
    OPEN<
    DUP
    BUFER BUFLEN
    ROT
    F_WRITE DROP DROP
    F_CLOSE DROP
    ;

    voll
    DATEN-save ../../fth/datentest.bin

    : los
    ;
    ————————-

  • peter bierbach says:

    —————–
    600-670: you can just give :
    600 LOAD
    ——————
    thank you, I had read that 10 times.
    but could not find my solution.
    can you please give a tip where that can be found in there?

    thanks.
    greeting

  • peter bierbach says:

    hello my great master.
    I’ve already learned some important things from you.
    thanks.

    this is ok:
    ……..
    ………
    bufer 255 Filename “/daten/test.dat” save-bytes
    : starte
    ;

    this is not ok, how do you have to write it in there please?
    …….
    …….
    : starte
    bufer 255 Filename “/daten/test.dat” save-bytes
    ;

    this is also not ok:
    : starte
    show-scr ../../fth/bild.scr
    ;

    greeting

    • Hi Peter,
      There must be no space between Filename and ” since the word is FILENAME” (notice the final “).
      Then there must be a space after FILENAME” and your filename that must be terminated with a double-quote ” .
      So your phrase should be
      bufer 255 Filename” /daten/test.dat” save-bytes

      As per LASTK variable, see Screen # 660 where is defined MOVE-PACMAN.

      Beware that Screen# 600-668 names “SPRITE” anything that moves, but in reality they are all old-fashion UDGs.

  • peter bierbach says:

    Hi, Thank You.
    this is ok.
    or do you have another tip please?

    greeting

    ————————
    ……….
    ……….
    ……….
    : los
    SPRITE 0 SPRITE-UPDATE

    begin
    23560 c@
    2000 0 do loop
    starte
    again ;

    los
    ——————————–

    • My tip: You are using a DO-LOOP to produce some delay…. I prefer synchronize everything at some point using SYNC that executes an HALT op-code. There is a few examples of it in Screen # 63, # 239 or # 601.

  • peter bierbach says:

    my sprite loop
    ——————————–
    ……….
    ……….
    : starte
    case
    dup 119 of oben endof
    dup 101 of rechts endof
    dup 113 of links endof
    dup 115 of unten endof
    dup 104 of 0 xsprite-hide 1 xsprite-hide 2 xsprite-hide endof
    dup 97 of sprnr 1 + to sprnr sprnr SPRITE _spriteid ! SPRITE 0 SPRITE-UPDATE endof
    dup 98 of sprnr 1 – to sprnr sprnr SPRITE _spriteid ! SPRITE 0 SPRITE-UPDATE endof
    dup 99 of 1 sprite _pattern ! SPRITE 1 SPRITE-UPDATE endof
    100 of 2 sprite _pattern ! SPRITE 2 SPRITE-UPDATE endof
    endcase ;

    : los
    SPRITE 0 SPRITE-UPDATE
    begin
    23560 c@
    3000 0 do loop
    starte
    again ;

    los

  • peter bierbach says:

    hello tanks for info.
    I use the sprite definition from #scr 400.

    this is ok :
    …….
    …….
    bufer 255 Filename” /daten/test.dat” save-bytes
    ……
    ……

    ——————————————————–

    this not funktion:
    …….
    …….
    : starte
    bufer 255 Filename” /daten/test.dat” save-bytes
    ;
    ……
    ……

    thanks
    greeting

    • for safety reason (and because i am often dumb) the example SAVE-BYTES cannot overwrite a file: only new files please.
      If you need to overwrite a file you have open it in read/write mode and do that by using the correct “flags-number” used by F_OPEN primitive-word:

      f_open ( a1 a2 b — u f )
      \ open a file
      \ a1 (filespec) is a null-terminated string, such as produced by ,” definition
      \ a2 is address to an 8-byte header data used in some cases.
      \ b is access mode-byte, that is a combination of:
      \ any/all of:
      \ esx_mode_read $01 request read access
      \ esx_mode_write $02 request write access
      \ esx_mode_use_header $40 read/write +3DOS header
      \ plus one of:
      \ esx_mode_open_exist $00 only open existing file
      \ esx_mode_open_creat $08 open existing or create file
      \ esx_mode_creat_noexist $04 create new file, error if exists
      \ esx_mode_creat_trunc $0c create new file, delete existing
      \ Return file-handle u and 0 on success, True flag on error

  • peter bierbach says:

    thank you for your great description of the handling of the files.

    a file in here ” : start … ; ” calling with start does not work:
    : start
    bufer 255 Filename ” /daten/test.dat” save-bytes
    ;

    why not ?

    greeting

    thanks
    greeting

    • FILENAME” is quite experimental and for now can be used only interactively , i.e. it cannot be compiled as you’re trying to do. I hope improving it in the future.

      In general (and in your case), first you need to declare a string containing the filename:

      CREATE DATEN-FILE ," /daten/test.dat"

      this create a new variable called DATEN-FILE that is a ‘counted-and-zero-terminated’ string suitable to be used with NextZXOS I/O primitives.
      You can see its content using

      DATEN-FILE COUNT TYPE

      or

      DATEN-FILE 20 DUMP

      Then, I would define something like this


      : SAVE-BUFER ( a -- ) \ save bufer to filename given by the counted-zero-terminated-string a
      1+ 0 ( a 0 ) \ just to agree with F_OPEN syntax
      [ HEX ] 0E [ DECIMAL ] ( a 0 b ) \ option to create or overwrite file
      F_OPEN 41 ?ERROR ( fh ) \
      DUP BUFER 255 ROT ( fh buf 255 fh )
      F_WRITE 47 ?ERROR ( fh n ) \ write file
      DROP ( fh ) \ ignore number of bytes written
      F_CLOSE 42 ?ERROR ( ) \ close
      ;

      you can use it anywhere as

      DATEN-FILE SAVE-BUFFER

  • peter bierbach says:

    thanks for the information.

    I would like to invite data several times after you have done it in a game.
    i am looking forward to this change

    thanks.
    greeting.

  • peter bierbach says:

    this : SAVE-BUFER ( a — ) is ok !!!

    tanks
    greeting

  • peter bierbach says:

    Hi, Thank You.
    loading an image also works great
    your program

    greeting

    ——————————-
    NEEDS J
    NEEDS VALUE
    NEEDS TO
    needs layer11

    220 load
    down

    layer11

    100 mmu7!
    : load-bild ( a — )
    1+ 0
    [ HEX ] 01 [ DECIMAL ]
    F_OPEN 41 ?ERROR
    DUP [ hex ] e000 1b00 [ decimal ] ROT
    F_READ 47 ?ERROR
    DROP
    F_CLOSE 42 ?ERROR
    ;

    CREATE DATEN-FILE ,” /fth/bild.scr”

    : los
    100 mmu7!
    DATEN-FILE COUNT TYPE DATEN-FILE load-bild

    [ hex ] 1b00 0 do i e000 + c@ 4000 i + c! loop [ decimal ]
    ;
    ————————————–

  • peter bierbach says:

    hello you good man ….
    why are they going :
    Scr# 400 ( Sprite struct definition )

    not by layer2:
    if I have set to layer2 and then invite the sprites, the program jumps back to layer12.

    thanks
    greeting

    • The reason is in Screen# 409 where i did

      BINARY 00001011 HEX 15 REG!

      that sets the Layers priority to “SUL” i.e. (Sprite over ULA over Layer2). Change it to “SLU” with

      BINARY 00000011 HEX 15 REG!

  • peter bierbach says:

    Hello, thanks for your help.
    now it works with the sprite.

    greeting

  • peter bierbach says:

    hello you specialist from vforth, good afternoon.
    i am happy that with me that vforth always
    can do more thanks to your help.

    I can’t get this sin-cos down to work with vforth.
    can you please help
    or do you already have another idea for the future of sin-cos with integrity?

    thanks
    greeting

    ————————————-
    \ Sinus und Cosinus
    \ Tabellengestützte Berechnung für ganze Zahlen.
    \ Ergibt auf 10K skalierte Werte.

    \ Prototypische Lösung mittels:
    \ Gforth 0.6.2, Copyright (C) 1995-2003 Free Software Foundation, Inc.

    vocabulary sinus sinus definitions decimal

    create sinustabelle \ 0…90 Grad, Index in Grad
    0000 , 0175 , 0349 , 0523 , 0698 , 0872 ,
    1045 , 1219 , 1392 , 1564 , 1736 , 1908 ,
    2079 , 2250 , 2419 , 2588 , 2756 , 2924 ,
    3090 , 3256 , 3420 , 3584 , 3746 , 3907 ,
    4067 , 4226 , 4384 , 4540 , 4695 , 4848 ,
    5000 , 5150 , 5299 , 5446 , 5592 , 5736 ,
    5878 , 6018 , 6157 , 6293 , 6428 , 6561 ,
    6691 , 6820 , 6947 , 7071 , 7193 , 7314 ,
    7431 , 7547 , 7660 , 7771 , 7880 , 7986 ,
    8090 , 8192 , 8290 , 8387 , 8480 , 8572 ,
    8660 , 8746 , 8829 , 8910 , 8988 , 9063 ,
    9135 , 9205 , 9272 , 9336 , 9397 , 9455 ,
    9511 , 9563 , 9613 , 9659 , 9703 , 9744 ,
    9781 , 9816 , 9848 , 9877 , 9903 , 9925 ,
    9945 , 9962 , 9976 , 9986 , 9994 , 9998 ,
    10000 ,

    : sinus@ cell * sinustabelle + @ ;
    : sin ( grad — sinus )
    dup 0r abs
    360 mod
    dup 180 > if 180 – true >r else false >r then
    dup 90 > if 180 swap – then
    sinus@
    r> if negate then
    r> if negate then ;
    : cos 90 + sin ;
    ————————————-

    • I suggest to move all these discussion within SpecNext Forum
      https://www.specnext.com/forum/
      Maybe we can add someone else’s contribution.

      Here is my working version with a little optimization:

      : sin ( grad -- sinus )
      dup >r \ save grad sign
      abs 360 mod
      dup 180 > if 180 - -1 else 0 then >r
      dup 90 > if 180 swap - then
      sinus@
      r> +- \ apply sign -1 or 0
      r> +- \ apply grad sign

      Also needs CELL :
      2 constant cell

      _M.

  • peter bierbach says:

    Hi, Thank You.

    sine-cosine now works wonderfully with vforth.
    maybe you can include that in your list?

    greeting

  • peter bierbach says:

    try again here!!!

    NEEDS VALUE
    NEEDS TO
    NEEDS CASE
    NEEDS J

    include /fth/spriteload3.f
    SPRITE-LOADr
    abs 360 mod
    dup 180 > if 180 – -1 else 0 then >r
    dup 90 > if 180 swap – then
    sinus@
    r> +-
    r> +- ;

    : cos 90 + sin ;

    : los
    SPRITE 0 SPRITE-UPDATE

    80 to weg
    360 0 do
    wx i sin weg 10000 */ + to x
    wy i cos weg 10000 */ + to y

    x SPRITE _xcoord !
    y SPRITE _ycoord !
    SPRITE 0 SPRITE-UPDATE
    1 pause
    loop

    80 to weg
    360 0 do
    wx 360 i – sin weg 10000 */ + to x
    wy 360 i – cos weg 10000 */ + to y

    x SPRITE _xcoord !
    y SPRITE _ycoord !
    SPRITE 0 SPRITE-UPDATE
    1 pause
    loop ;

  • peter bierbach says:

    everything is chaotic, the sine table does not appear and some other things also do not.
    can you completely delete all three of this demo spritesinus?

    thanks.

  • peter bierbach says:

    can you open a new title there “vforth”?
    greeting

    —————————————–
    I suggest to move all these discussion within SpecNext Forum
    https://www.specnext.com/forum/
    Maybe we can add someone else’s contribution.
    ——————————————

  • peter bierbach says:

    Hi good afternoon.
    the cursor has to be somewhere in vforth as a char.
    how can you draw the cursor-char “empty”?

    thanks.
    greeting

  • peter bierbach says:

    hello thanks for info for cursor.

    greeting

  • peter bierbach says:

    hello, good afternoon vforth fachman.

    I also read something about float in the vforth.
    but unfortunately I can’t find a demo that I understand.

    can you please help?
    thanks.
    greeting

  • peter bierbach says:

    the vforth is very interesting, that’s why my many questions.

    thank you for your work for this float.

    another question about the flash.
    you have set the software flash to 32 with me.
    ——————————–
    \ software-flash: flips face every 320 ms
    LDN A’| HEX 10 N,
    ANDA (IY+ HEX 3E )|
    \ LDN A’| HEX 8F N,
    LDA() HEX 026 org^ + AA,
    JRF NZ’| HOLDPLACE \ IF,
    \ LDN A’| HEX 88 N,
    LDA() HEX 027 org^ + AA,
    BIT 3| (IY+ HEX 30 )|
    JRF Z’| HOLDPLACE \ IF,
    \ LDN A’| 5F N,
    LDA() HEX 028 org^ + AA,
    HERE DISP, \ THEN,
    HERE DISP, \ THEN,
    —————————————

    can you do an emit without the flash being set to the right?

    thanks.
    greeting

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.