Welcome, Guest
You have to register before you can post on our site.

Username
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 385
» Latest member: DayanaAmoni
» Forum threads: 1,028
» Forum posts: 6,212

Full Statistics

Online Users
There are currently 506 online users.
» 0 Member(s) | 505 Guest(s)
Bing

Latest Threads
Includes in ASM
Forum: How-To & Tutorials
Last Post: bracckets
04-04-2024, 12:17 AM
» Replies: 2
» Views: 556
Intermittent errors
Forum: Help & Support
Last Post: zarsoft
03-12-2024, 12:39 PM
» Replies: 0
» Views: 311
Store array information i...
Forum: Help & Support
Last Post: rbiondi
03-10-2024, 09:42 PM
» Replies: 0
» Views: 401
ScrollLeft function scrol...
Forum: Bug Reports
Last Post: rbiondi
03-07-2024, 03:57 PM
» Replies: 2
» Views: 804
string.bas errors when co...
Forum: Bug Reports
Last Post: rbiondi
03-01-2024, 10:10 AM
» Replies: 2
» Views: 718
Using Beepola with ZX BAS...
Forum: How-To & Tutorials
Last Post: edtoo
02-29-2024, 09:47 AM
» Replies: 15
» Views: 32,755
Johnny Bravo
Forum: Gallery
Last Post: zarsoft
02-11-2024, 11:20 PM
» Replies: 0
» Views: 478
Compiling +D G+DOS progra...
Forum: ZX Basic Compiler
Last Post: boriel
01-22-2024, 08:32 AM
» Replies: 4
» Views: 8,660
VAL = ? (solved)
Forum: Bug Reports
Last Post: zarsoft
01-03-2024, 11:44 PM
» Replies: 8
» Views: 3,218
Wrong math (solved)
Forum: Bug Reports
Last Post: zarsoft
01-03-2024, 11:38 PM
» Replies: 4
» Views: 1,752

 
  Faster Square Roots
Posted by: britlion - 02-13-2010, 01:16 AM - Forum: How-To & Tutorials - Replies (12)

I've got a version that does LONG as well as uInteger later in this thread.

I note that the compiler uses the Spectrum ROM square root routine. This routine is hideously slow. It actually calculates x^(0.5) instead, and takes ages about it. The Newton-Raphson method would be a lot faster, and pretty easy to put in.

If you are willing to sacrifice accuracy, an integer square root would be faster still. For a lot of situations, an integer root would be just fine - for example, if I had to calculate the nearest of two objects on screen, I'm going to have to use pythagoras' theorum to calculate distances. [ A^2 = B^2 + C^2 ] that needs square roots to make a distance. But probably the nearest whole pixel would be a perfectly good enough result!

So, here are two functions, and some code to demonstrate them. One is a perfect replacement for sqr.asm in the library, actually - it's full floating point compatible, 100% accurate, and about 3-6 times faster. It actually uses the FP-Calculator in the rom. It just doesn't use the SQR command. [Note: It comes back with something instead of an error in case of a negative square root request. Boriel - you might want to change that behavor. Not sure.] The integer version... well - look for yourself! I reckon it's about 40 times faster than the fast version.

Also: Should be able to do a something similar for a 32 bit LONG integer.

Copy and compile this program. I hope you like it:

Code:
FUNCTION FASTCALL SQRT (radicand as FLOAT) as FLOAT
ASM
; FLOATS arrive in A ED CB
;A is the exponent.
          
          AND   A               ; Test for zero argument
          RET   Z               ; Return with zero.
          
          ;Strictly we should test the number for being negative and quit if it is.
          ;But let's assume we like imaginary numbers, hmm?
          ; If you'd rather break it change to a jump to an error below.
          ;BIT   7,(HL)          ; Test the bit.
          ;JR    NZ,REPORT       ; back to REPORT_A
                                ; 'Invalid argument'
          RES 7,E               ; Now it's a positive number, no matter what.
          
          call __FPSTACK_PUSH   ; Okay, We put it on the calc stack. Stack contains ABS(x)
                    
          ;   Halve the exponent to achieve a good guess.(accurate with .25 16 64 etc.)

                                ; Remember, A is the exponent.
          XOR   $80             ; toggle sign of exponent
          SRA   A               ; shift right, bit 7 unchanged.
          INC   A               ;
          JR    Z,ASIS          ; forward with say .25 -> .5
          JP    P,ASIS          ; leave increment if value > .5
          DEC   A               ; restore to shift only.
ASIS:     XOR   $80             ; restore sign.
          
          call __FPSTACK_PUSH   ; Okay, NOW we put the guess on the stack
          rst  28h    ; ROM CALC    ;;guess,x
          DEFB $C3              ;;st-mem-3              x,guess
          DEFB $02              ;;delete                x

SLOOP:    DEFB  $31             ;;duplicate             x,x.
          DEFB  $E3             ;;get-mem-3             x,x,guess
          DEFB  $C4             ;;st-mem-4              x,x,guess
          DEFB  $05             ;;div                   x,x/guess.
          DEFB  $E3             ;;get-mem-3             x,x/guess,guess          
          DEFB  $0F             ;;addition              x,x/guess+guess          
          DEFB  $A2             ;;stk-half              x,x/guess+guess,.5
          DEFB  $04             ;;multiply              x,(x/guess+guess)*.5
          DEFB  $C3             ;;st-mem-3              x,newguess
          DEFB  $E4             ;;get-mem-4             x,newguess,oldguess
          DEFB  $03             ;;subtract              x,newguess-oldguess
          DEFB  $2A             ;;abs                   x,difference.
          DEFB  $37             ;;greater-0             x,(0/1).
          DEFB  $00             ;;jump-true             x.

          DEFB  SLOOP - $       ;;to sloop              x.

          DEFB  $02             ;;delete                .
          DEFB  $E3             ;;get-mem-3             retrieve final guess.
          DEFB  $38             ;;end-calc              sqr x.

          jp __FPSTACK_POP
          
END ASM
END FUNCTION


FUNCTION FASTCALL SQRT16(radicand as uInteger) as uByte
asm
    XOR A
    AND A
    
    ld  a,l
    ld  l,h
    ld    de,0040h    ; 40h appends "01" to D
    ld    h,d

    ld b,7
sqrt16loop:
    sbc    hl,de        ; IF speed is critical, and you don't mind spending the extra bytes, you could unroll this loop 7 times instead of DJNZ.
    jr    nc,$+3    
    add    hl,de        
    ccf            
    rl    d        
    rla            
    adc    hl,hl        
    rla            
    adc    hl,hl        
    DJNZ sqrt16loop
    
    sbc    hl,de        ; optimised last iteration
    ccf
    rl    d

    ld a,d
end asm
END FUNCTION


FUNCTION t AS ULONG
   RETURN INT((65536 * PEEK (23674) + 256 * PEEK(23673) + PEEK (23672)))
END FUNCTION

CLS

DIM a,b as float
DIM i as uInteger
DIM time as long

PRINT "ROM","FAST"

REM show it's as accurate
for i=1 to 15
    LET a=rnd * 32768
    PRINT SQR(a),SQRT(a)
next i

PRINT
PRINT "Over 500 Cycles:"
PRINT

REM ROM version 500 times.
LET time=t()
for i=1 to 500
    b=SQR(a)
next i
PRINT "Rom routine: ";t()-time;" Frames."

REM MY version 500 times.
LET time=t()
for i=1 to 500
    b=SQRT(a)
next i
PRINT "Fast routine: ";t()-time;" Frames."

PRINT
PRINT "PRESS A KEY"

PAUSE 1: PAUSE 0

CLS

PRINT "NUM   FAST      INTEGER"

REM show it's as accurate
for i=1 to 15
    LET a=INT(rnd * 32768)
    PRINT a;TAB 6;SQRT(a);TAB 16;SQRT16(a)
next i

PRINT
PRINT "Over 500 Cycles:"
PRINT

REM MY version 500 times.
LET time=t()
for i=1 to 500
    b=SQRT(a)
next i
PRINT "Fast routine: ";t()-time;" Frames."

REM MY Integer version 500 times.
LET time=t()
for i=1 to 500
    b=SQRT16(a)
next i
PRINT "Integer routine: ";t()-time;" Frames."

Print this item

  How to make your code faster
Posted by: britlion - 02-11-2010, 12:20 AM - Forum: How-To & Tutorials - Replies (5)

One of the reasons you are probably looking at this is that you have some idea how to program in Sinclair Basic, and no idea how to code in machine code (or z80 assembler as it's sometimes called). You want to go play with the old spectrum stuff, and want faster programs - and it must be easier these days, right?

Well, with Boriel's compiler, it is. Most programs can be put into the compiler in a form almost identical to an original sinclair basic program, and it will work. It will be faster. But you want to make it as fast as you can, right?

First thing then: variable types. (see http://www.boriel.com/wiki/en/index.php/ZX_BASIC:Types for details on what variable types the compiler supports.)

Nothing you can do to your program will make as big a speed increase as making sure you use the smallest variable type possible in every case. A byte is better than an integer is better than a long and all those are better than using floating point numbers if you can avoid them.

Have a look at this program:

Code:
FUNCTION t AS ULONG
    RETURN INT((65536 * PEEK (23674) + 256 * PEEK(23673) + PEEK (23672)))
END FUNCTION

DIM i,j,k,fake as <insert type here>
DIM time as uLong
let fake=0

CLS

PRINT "Loop Start"
LET TIME=t()
for k=1 to 20    
    for j=1 to 125
        for i = 1 to 125
        LET fake=fake+1-(fake/2)
        next i
    next j
next k

PRINT "loop End"

print t()-TIME

If we set the type of variable for i,j,k,fake as FLOAT up there at the top, this program will disappear for ages before it reports that it took 119,551 frames to come back. That's almost 40 minutes! If you change the type of variable there to UBYTE it comes back in 839 frames. That's under 17 seconds. To put it another way, the code runs over 142 times faster. Variable types make a BIG difference!

NOTE: The nearest Sinclair BASIC equivalent of this program runs in 235,726 frames, or just over 78 minutes to do the same thing. Even using the same variable types as Sinclair BASIC (Which always uses five byte FLOAT types), a compiled program is quite a lot faster!

For the above program, here are the times, in frames (a frame is 1/50th of a second. Divide by 50 to get a time in seconds if you want - I left it this way to make a speed comparison)

Code:
uByte =     839
Byte  =     861
uinteger=  1126
integer =  1178
uLong =   31792
Long  =   32895
Fixed =   36711
Float =  119551

The rule is use the smaller one every time you can, especially in loops! If you're only going round a for/next loop about 10 times, use uByte.

If you can get away with positive numbers, unsigned types (uByte, uIntger and uLong) are a little bit faster than signed ones.

You may also be able to eliminate floating point numbers by multiplying up - for example store $3.02 as 302 pennies.

[Note: In computing terms generally (not just on the spectrum) there are good reasons not to store money in floating point numbers anyway - floating point numbers are NOT perfectly accurate and you may get rounding errors that could cause problems later on. Just as in decimal you can't write 1/3 without an infinitely long 0.33333333->forever happening, you can't store something like 0.1 in binary without an infinitely long binary number. So, far better to store currency as the smaller unit in an integer or long type. A long would allow you to keep track of up to +/- 2,147,483,647 pennies - or about 21 million currency units. If you want to track more than that you can definitely afford a more powerful computer than a Spectrum!]

Print this item

  Forum problems fixed / Problema resueltos en el foro
Posted by: boriel - 02-09-2010, 08:01 PM - Forum: ZX Basic Compiler - Replies (11)

There has been several forum technical problems regarding to cache and template issues. All of them seems to be fixed now.
Please read here for more info: <!-- l --><a class="postlink-local" href="http://www.boriel.com/forum/viewtopic.php?f=9&t=375">viewtopic.php?f=9&t=375</a><!-- l -->

Sorry again, and thanks to Britlion for notifying me. 8)

Print this item

  Forum problems fixed / Problema resueltos en el foro
Posted by: boriel - 02-09-2010, 07:57 PM - Forum: News - No Replies

=== English ===

There has been several problems regarding to this site styles and template caches, all of them has been fixed now:

  • New users could not register, because Captcha code was failing! Sad (Fixed)
  • Private mensajes and Forum email notifications were not working so I was not aware about new users questions! Sorry. Thes has been fixed!
  • Template glitches and misbehaviour (Fixed)
I hope everything works as expected now. If you notice any problem, please send mi a private message.

Remember: If you don't like the current theme (Dark, Spectrum-retro like style), you can switch to the previous theme (cyan/lighter backgruound) in your preferences account panel.


=== Español ===

Ha habido varios problemas en el foro relativos a los temas y estilos utilizados, así como las cachés de las plantillas. Todos ellos resueltos ya:
  • No se podían dar de alta nuevos usuarios, porque el código visual de Captcha estaba fallando! Sad (Arreglado)
  • Los mensajes privados y las notificaciones por email no estaban funcionando, así que no me estaba enterando de los nuevos mensajes de los usuarios. Lo siento. Eso está arreglado!
  • Diversos fallos en la plantilla así como comportamientos erráticos. (Arreglado)
Espero que ahora todo vaya bien. Si notas algún problema, envíame un privado por este foro.

Recuerda: Este sitio usa un tema oscuro (al estilo Spectrum/Retro), pero si no te gusta, lo puedes cambiar por uno más claro (fondo azul celeste, etc..) en tu panel de preferencias de tu cuenta de usuario.

Print this item

  Summary of stuff not working [V1.2.4]
Posted by: britlion - 02-06-2010, 12:05 PM - Forum: Bug Reports - Replies (24)

Okay, I've made several posts and it's all getting confusing. Here's what seems to be wrong:

  • * [Tested Fixed in 1.25 Beta r1489]@variablename - Seems to point at one byte BELOW the correct one.

    * [Can't replicate cleanly. Needs proved example of error.] [This was probably caused by the stack erorr which is fixed in r1489 ] CHR / CHR$ - CHR$(variable) seems to crash sometimes. CHR$(number) works fine.

    * [Tested Fixed in 1.25 Beta r1489] BOLD and ITALIC cannot be used as temporary attributes (BOLD 1 works. PRINT BOLD 1;"Hello" does not.) The compiler issues some very cryptic error messages about this.

    * -O2 and -O3 are likely to fail to compile what -O1 and no optimization compiles perfectly. (Seems to fail in 'update_goes_and_comes' in optimizer.pyc on larger files)

    * [Tested Fixed in 1.25 Beta r1489]SHL and SHR don't work for Integers (reported by LCD)

    *[Tested Fixed in 1.25 Beta 1] Comparisons : the Boolean logic for >= for type FIXED is bugged. (it always returns true)

    *[Tested Fixed in 1.25 Beta 1] uByte seem to have something wrong on the comparison front as well:
    Code:
    DIM ub as uByte
    DIM b as byte
    DIM ui as uInteger
    DIM i as integer
    DIM ul as uLong
    DIM l as LONG
    DIM fi as fixed
    DIM fl as float

    print ub,b,ui,i,ul,l,fi,fl

    if 0<=20 then print "0<=20" : END IF
    if ub <= 20 then print "ub <= 20" : END IF
    if b <= 20 then print "b <= 20"   : END IF
    if ui <= 20 then print "ui <= 20" : END IF
    if i <= 20 then print "i <= 20"   : END IF
    if ul <= 20 then print "ul <= 20" : END IF
    if l <= 20 then print "l <= 20"   : END IF
    if fi <= 20 then print "fi <= 20" : END IF
    if fl <= 20 then print "fl <= 20" : END IF

    NOT strictly speaking broken, but serious "Quality of life" issues:

    * The compiler's errors could be a lot more helpful!
    1> Instead of "unexpected end of file" how about "You started a FOR loop on line 30 that never finished" and "You have an IF on line 100 that doesn't have an END IF" - if the compiler could say what statement or parenthesis isn't closed that would help me track down about 90% of my bugs. As it is, I type a line, compile, type a line, compile and so on - otherwise I'd never find the problem! [I'm REALLY bad at forgetting END IF]

    2> Could we get a warning any time a variable is used that hasn't been DIM first? Or just plain not allow it, even? A mistyped variable (vectory instead of vectorY) is very hard to find if the compiler simply creates it without telling me. So the program compiles and runs, but the math isn't working right...

    * The assembler seems to be very slow - zxb --asm program.bas returns to the command prompt within a few seconds. If we ask the assembler to assemble the file as well, it can stay away for several minutes.

Print this item

  42 Character Printing
Posted by: britlion - 02-06-2010, 06:52 AM - Forum: How-To & Tutorials - Replies (9)

The following two subroutines will support 42 character printing. Colour is allowed, but be aware that the characters are NOT guaranteed to fit into an attribute square, and as such, may cause colour clash.

Set colour with the permanent colour statements (ink/paper not in a print line).

The 42 character printing routine maintains its own X,Y coordinates for printing. Printing on all 24 lines is supported.

X values can range from 0 to 41 (0 <= X <= 42) and Y values can range from 0 to 24 (0 <= Y <= 24). Use the printAt42(y,x) call to change the current position of the printing, otherwise successive prints carry on where the last one left off (with runover to the next line, correctly after the 42nd character).

Size is kept to a minimum, because the routine uses the ROM character set and cuts out lines from it in order to reduce to 6 pixels wide; with a couple of exceptions that are improved by being thus defined here. A redesigned character set is possible, but only for about 31 characters, owing to space limitations in the data design.

Characters ARE vertically aligned to the 42 character grid, however. This is not proportional printing. Therefore this routine can be used safely for tables and other such gridded arrangements.

Original routine this is based on was written by Paul Wardle.

printat42 routine

Code:
SUB printat42 (y as uByte, x as uByte)
    POKE @printAt42Coords,x
    POKE @printAt42Coords+1,y
END sub

The main print42 routine, with assembly and documentation
Code:
SUB print42 (characters$ as string)


asm

        POP BC ; Grab this
        POP DE ; Grab the return address                    
        POP HL ; grab our string address
        PUSH DE ; put the return address back where we found it
      
        
        LD C,(HL)
        INC HL
        LD B,(HL)       ; all told, LD BC with the length of the string.

        INC HL          ;Puts HL to the first real character in the string.

        LD A,C
        OR B
        RET Z           ; Is the length of the string 0? If so, quit.

examineChar:
        LD A,(HL)       ; Grab the character at our pointer position
        CP 128          ;Too high to print?
        JR NC, nextChar ; Then we go to the next

        CP 22           ; Is this an AT?
        JR NZ, isNewline ; If not jump over the AT routine to isNewline

isAt:
        EX DE,HL        ; Get DE to hold HL for a moment
        AND A           ; Plays with the flags. One of the things it does is reset Carry.
        LD HL,00002
        SBC HL,BC       ; Subtract length of string from HL.
        EX DE,HL        ; Get HL back from DE
        RET NC          ; If the result WASN'T negative, return. (We need AT to have parameters to make sense)

        INC HL          ; Onto our Y co-ordinate
        LD D,(HL)       ; Put it in D
        DEC BC          ; and move our string remaining counter down one                
        INC HL          ; Onto our X co-ordinate
        LD E,(HL)       ; Put the next one in E
        DEC BC          ; and move our string remaining counter down one
        CALL nxtchar      ; Call routine to shuffle right a char
        JR newline      ; Hop over to

isNewline:
        CP 13           ; Is this character a newline?
        JR NZ,checkvalid     ; If not, jump forward
        

newline:
        LD DE,(63536)
        CALL nxtline       ; move to next line

        LD (63536),DE     ; and go on to next character
        JR nextChar
        
checkvalid:
        CP 31           ; Is character <31?
        JR C, nextChar  ; If not go to next character

prn:    PUSH HL          ; Save our position
        PUSH BC          ; Save our countdown of chars left
        CALL printachar       ; Go print a character
        POP BC           ; Recover our count
        POP HL           ; Recover our position                              
nextChar:
        INC HL           ; Move to the next position
        DEC BC           ; count off a character
        LD A,B
        OR C            ; Did we hit the end of our string? (BC=0?)
        JR NZ, examineChar    ; If not, we need to go look at the next character.
        RET               ; End the print routine        
basicVariableName:
         defb "z$"        ; The name of the variable we are looking at.


; This routine forms the new 6-bit wide characters and
;alters the colours to match the text. The y,x co-ordinates and eight
;bytes of workspace are located at the end of this chunk.
; it starts with the character ascii code in the accumulator

printachar:
        EXX
        PUSH HL ; Store H'L' where we can get it.
        EXX              

       ld c, a    ; Put a copy of the character in C
       ld h, 0    
       ld l, a    ; Put the Character in HL
      
       ld de, whichcolumn-32 ; the character is at least 32, so space = 0th entry.      
       add hl, de         ; HL -> table entry for char.
       ld a, (hl)         ; Load our column slice data from the table.
       cp 32             ; Is it less than 32?
       jr nc, calcChar   ; If so, go to the calculated character subroutine


; This is the special case 'we defined the character in the table' option    
       ld de, characters ; Point DE at our table
       ld l, a             ; Put our character number from our table lookup that's in HL in a
       call mult8         ; multiplies L by 8 and adds in DE [so HL points at our table entry]
       ld b, h            
       ld c, l             ; Copy our character data address into BC
       jr printdata         ; We have our data source, so we print it.

calcChar: ; this is the calculate from the ROM data option
            ; a holds the column kill data
       ld de, 15360         ; Character set-256. We could use CHARS here, maybe; but might not work with a redefiend character set.
       ld l, c             ; Get our character back from C
       call mult8         ; Multiply l by 8 and add to DE. (HL points at the ROM data for our character now)
      
       ld de, workspace  ; Point DE at our 8 byte workspace.
       push de             ; Save it
       exx                 ;
       ld c, a             ; Put our kill column in C'
       cpl                 ; Invert
       ld b, a             ; Put the inverse in B'
       exx                 ;
       ld b, 8             ; 8 bytes to a character loop counter

loop1:
       ld a, (hl)         ; Load a byte of character data
       inc hl             ; point at the next byte
       exx                 ;
       ld e, a             ; Put it in e'
       and c             ; keep the left column block we're using
       ld d, a             ; and put it in d'
       ld a, e             ; grab our original back
       rla                 ; shift it left (which pushes out our unwanted column)
       and b             ; keep just the right block
       or d                 ; mix with the left block
       exx                 ;
       ld (de), a         ; put it into our workspace
       inc de             ; next workspace byte
       djnz loop1         ; go round for our other bytes
    
       pop bc             ; Recover a pointer to our workspace.

printdata:
       call testcoords     ; check our position, and wrap around if necessary. [returns with d=y,e=x]
       inc e             ; Bump along to next co-ordinate
       ld (xycoords), de ; Store our coordinates for the next character
       dec e             ; Bump back to our current one
       ld a, e             ; get x
       sla a             ;  Shift Left Arithmetic - *2
       ld l, a             ; put x*2 into L
       sla a             ; make it x*4
       add a, l             ; (x*2)+(x*4)=6x
       ld l, a             ; put 6x into L [Since we're in a 6 pixel font, L now contains the # of first pixel we're interested in]
       srl a             ; divide by 2
       srl a             ; divide by another 2 (/4)
       srl a             ; divide by another 2 (/8)
       ld e, a             ; Put the result in e (Since the screen has 8 pixel bytes, pixel/8 = which char pos along our first pixel is in)
       ld a, l             ; Grab our pixel number again
       and 7             ; And do mod 8 [So now we have how many pixels into the character square we're starting at]
       push af             ; Save A
       ex af, af'          
       ld a, d             ; Put y Coord into A'
       sra a             ; Divide by 2
       sra a             ; Divide by another 2 (/4 total)
       sra a             ; Divide by another 2 (/8) [Gives us a 1/3 of screen number]
       add a, 88         ; Add in start of screen attributes high byte
       ld h, a             ; And put the result in H
       ld a, d             ; grab our Y co-ord again
       and 7             ; Mod 8 (why? *I thought to give a line in this 1/3 of screen, but we're in attrs here)
       rrca                 ;
       rrca                  
       rrca                 ; Bring the bottom 3 bits to the top - Multiply by 32(since there are 32 bytes across the screen), here, in other words. [Faster than 5 SLA instructions]
       add a, e             ; add in our x coordinate byte to give us a low screen byte
       ld l, a                ; Put the result in L. So now HL -> screen byte at the top of the character
      
       ld a, (23693)     ; ATTR P      Permanent current colours, etc (as set up by colour statements).
       ld e, a             ; Copy ATTR into e
       ld (hl), e         ; Drop ATTR value into screen
       inc hl             ; Go to next position along
       pop af             ; Pull how many pixels into this square we are
       cp 3                 ; It more than 2?
       jr c, hop1         ; No? It all fits in this square - jump changing the next attribute
    
       ld (hl), e         ; 63446 Must be yes - we're setting the attributes in the next square too.
hop1:
       dec hl             ; Back up to last position
       ld a, d             ; Y Coord into A'
       and 248             ; Turn it into 0,8 or 16. (y=0-23)
       add a, 64         ; Turn it into 64,72,80  [40,48,50 Hex] for high byte of screen pos
       ld h, a             ; Stick it in H
       push hl             ; Save it
       exx                 ; Swap registers
       pop hl             ; Put it into H'L'
       exx                 ; Swap Back
       ld a, 8              
hop4:
       push af             ; Save Accumulator
       ld a, (bc)         ; Grab a byte of workspace
       exx                 ; Swap registers
       push hl             ; Save h'l'
       ld c, 0             ; put 0 into c'
       ld de, 1023         ; Put 1023 into D'E'
       ex af, af'         ; Swap AF
       and a             ; Flags on A
       jr z, hop3         ; If a is zero jump forward

       ld b, a             ; A -> B
       ex af, af'         ; Swap to A'F'
hop2:; Slides a byte right to the right position in the block (and puts leftover bits in the left side of c)
       and a             ; Clear Carry Flag
       rra                 ; Rotate Right A
       rr c                 ; Rotate right C (Rotates a carry flag off A and into C)
       scf                 ; Set Carry Flag
       rr d                 ; Rotate Right D
       rr e                 ; Rotate Right E (D flows into E, with help from the carry bit)
       djnz hop2         ; Decrement B and loop back
      
       ex af, af'        
hop3:
       ex af, af'        
       ld b, a            
       ld a, (hl)        
       and d            
       or b                
       ld (hl), a         ; Write out our byte
       inc hl             ; Go one byte right
       ld a, (hl)         ; Bring it in
       and e            
       or c                 ; mix those leftover bits into the next block
       ld (hl), a         ; Write it out again
       pop hl            
       inc h                ; Next line
       exx                
       inc bc              ; Next workspace byte
       pop af            
       dec a             
       jr nz, hop4         ; And go back!
    
       exx                 ; Tidy up
       pop hl             ; Clear stack leftovers
       exx                 ; And...
       ret                 ; Go home.

mult8: ; Multiplies L by 8 -> HL and adds it to DE. Used for 8 byte table vectors.
        ld h, 0            
        add hl, hl        
        add hl, hl        
        add hl, hl          
        add hl, de        
        ret
                    
testcoords:
        ld de, (xycoords)    ; get our current screen co-ordinates (d=y,e=x - little endian)
nxtchar:
        ld a, e             ;
        cp 42             ; Are we >42?
        jr c, ycoord     ; if not, hop forward
nxtline:
       inc d             ; if so, so bump us to the next line down
       ld e, 0             ; and reset x to left edge
ycoord:
        ld a, d             ;
       cp 24             ; are we >24 lines?
       ret c             ; if no, exit subroutine
       ld d, 0             ; if yes, wrap around to top line again.
       ret                 ; exit subroutine
end asm
printAt42Coords:
asm      
xycoords:
        defb 0      ; x coordinate      
        defb 0      ; y coordinate

workspace:
        defb 0      
        defb 0        
        defb 0
        defb 0        
        defb 0         
        defb 0
        defb 0        
        defb 0        
    
; The data below identifies a column in the character to remove. It consists of 1's
; from the left edge. First zero bit is the column we're removing.
; If the leftmost bit is NOT 1, then the byte represents a redefined character position
; in the lookup table.
    
whichcolumn:            
    defb 254         ; SPACE
    defb 254         ; !
    defb 128         ; "
    defb 224         ; #
    defb 128         ; $
    defb 0           ; % (Redefined below)
    defb 1           ; &  (Redefined below)
    defb 128         ; '
    defb 128         ; (
    defb 128         ; )
    defb 128         ; *
    defb 128         ; +
    defb 128         ; ,
    defb 128         ; -
    defb 128         ; .
    defb 128         ; /
    defb 2           ; 0 (Redefined below)
    defb 128       ; 1
    defb 224       ; 2
    defb 224       ; 3
    defb 252       ; 4
    defb 224        ; 5
    defb 224        ; 6
    defb 192       ; 7
    defb 240       ; 8
    defb 240       ; 9
    defb 240       ; :
    defb 240       ; ;
    defb 192       ; <
    defb 240       ; =
    defb 192       ; >
    defb 192       ; ?
    defb 248       ; @
    defb 240       ; A
    defb 240       ; B
    defb 240       ; C
    defb 240       ; D
    defb 240       ; E
    defb 240       ; F
    defb 240       ; G
    defb 240       ; H
    defb 128       ; I
    defb 240       ; J
    defb 192       ; K
    defb 240       ; L
    defb 240       ; M
    defb 248       ; N
    defb 240       ; O
    defb 240       ; P
    defb 248       ; Q
    defb 240       ; R
    defb 240       ; S
    defb 3         ; T
    defb 240       ; U
    defb 240       ; V
    defb 240       ; W
    defb 240       ; X
    defb 4         ; Y
    defb 252       ; Z
    defb 224       ; [
    defb 252       ; \
    defb 240        ; ]    
    defb 252        ; ^
    defb 240        ; _
    defb 240        ; UK Pound (Currency) Symbol
    defb 255        ; a
    defb 128        ; b
    defb 255        ; c    
    defb 255        ; d    
    defb 255        ; e    
    defb 255        ; f    
    defb 255        ; g    
    defb 255        ; h    
    defb 255        ; i    
    defb 255        ; j    
    defb 255        ; k    
    defb 255        ; l    
    defb 255        ; m    
    defb 255        ; n    
    defb 255        ; o    
    defb 255        ; p    
    defb 255        ; q    
    defb 255        ; r    
    defb 255        ; s    
    defb 255        ; t    
    defb 255        ; u    
    defb 255        ; v    
    defb 255        ; w    
    defb 255        ; x    
    defb 255        ; y    
    defb 255        ; z    
    defb 128        ; {
    defb 128        ; |
    defb 255        ; }    
    defb 128        ; ~
    defb 5            ; (c)  end column data
    
    
    
characters:    
    defb 0           ; %            
    defb 0            
    defb 100        
    defb 104        
    defb 16
    defb 44
    defb 76
    defb 0
    
    defb 0              ; &
    defb 32
    defb 80              
    defb 32
    defb 84              
    defb 72            
    defb 52        
    defb 0        
    
    defb 0             ; digit 0
    defb 56
    defb 76         
    defb 84            
    defb 84            
    defb 100        
    defb 56          
    defb 0
    
    defb 0             ; Letter T
    defb 124        
    defb 16
    defb 16          
    defb 16
    defb 16          
    defb 16
    defb 0          
    
    defb 0             ; Letter Y
    defb 68          
    defb 68            
    defb 40
    defb 16         
    defb 16
    defb 16         
    defb 0            
    
    defb 0             ; (c) symbol
    defb 48            
    defb 72            
    defb 180        
    defb 164        
    defb 180                                    
    defb 72            
    defb 48            
    
end asm    
END SUB

A little program to test and demonstrate:
Code:
DIM n as uByte
CLS
PRINT "01234567890123456789012345678901"
FOR n=1 to 6
    printat42(n+1,0)
    INK n
    print42("012345678901234567890123456789012345678901")
NEXT n

Print this item

  Weirdness 4
Posted by: britlion - 01-31-2010, 05:49 AM - Forum: Bug Reports - Replies (1)

Okay, this one is pretty small. It crashes.

Code:
FUNCTION RAND () as uInteger : REM Code by Jon Ritman
    random: REM add 46 bytes to this location to hit the store "Lion"
    asm
    RANDOM:     LD HL,(SEED+2)
                LD D,L
                ADD HL,HL
                ADD HL,HL
                LD C,H
                LD HL,(SEED)
                LD B,H
                RL B
                LD E,H
                RL E
                RL D
                ADD HL,BC
                LD (SEED),HL
                LD HL,(SEED+2)
                ADC HL,DE
                RES 7,H
                LD (SEED+2),HL
                JP M,RANDOM3
                LD HL,SEED
    RANDOM2:    INC (HL)
                    INC HL
                JR Z,RANDOM2
    RANDOM3:    LD HL,(SEED)              
                RET
    SEED:       DB "Lion"
    end asm
    
END FUNCTION
CLS                        
DIM  a as uInteger
    let a=@random
    PRINT a
    let a=a+46
    PRINT a

DIM n as uInteger
DIM result as uByte

FOR n=a to a+4
    LET result=peek n
    print n;"=";result;"=";CHR$ (result)
next n

IF I change the last line to:
Code:
print n;"=";result;"=";CHR$ (76)

It doesn't crash. What's the problem with CHR$(uByte) suddenly?

Can anyone else replicate this?

All I was trying to do was put in a nice shiny new random number generator...

Print this item

  Disassembler
Posted by: britlion - 01-31-2010, 03:34 AM - Forum: ZX Basic Compiler - Replies (4)

Just a thought...but since ZXB is based on python, and the SkoolKit is python, and it has a disassembler built in python...

it would be very cool to have the option of disassembling other people's programs to steal routines from.


<!-- m --><a class="postlink" href="http://www.worldofspectrum.org/forums/showthread.php?t=28326&highlight=disassembler">http://www.worldofspectrum.org/forums/s ... sassembler</a><!-- m -->


Now I have NO clue about python, but to my mind it can't be too difficult to joint the dots there and make ZXB an assembler AND a disassembler all in one.

asm in -> .bin file out and .bin file in to .asm out!?

Print this item

  Logical Bitwise Functions - AND, OR, XOR, NOT
Posted by: britlion - 01-31-2010, 12:21 AM - Forum: How-To & Tutorials - Replies (4)

These items do seem to be quite high on a few people's wish list. I hope they help!

Right now I only know how to use FASTCALL with a single parameter. If anyone knows how standard multi parameter calls work when we get into m/c please let me know. For the moment, these work and are pretty fast, even though AND and OR cheat a little.

Binary NOT (8 bit version)

Code:
FUNCTION FASTCALL bNOT (sentIn as uByte) as uByte
    asm
    CPL
    end asm
END FUNCTION

USAGE: bNOT(byte value or ubyte value)

Binary NOT (16 bit version)
Code:
FUNCTION FASTCALL bNOT (sentIn as uInteger) as uInteger
    asm
    LD a,h
    CPL
    ld h,a
    ld a,l
    CPL
    ld l,a
    end ASM
END FUNCTION

USAGE: bNOT(uInteger value)

How about this as a compromise: A NOT function that does an 8 bit not for any value that fits in 8 bits, a 16 bit NOT for any value that fits in 16 bits, and a 32 bit NOT for any larger value.

Code:
FUNCTION FASTCALL bNOT(sentIn as uLONG) as uLONG
    asm

    LD A,D    
    OR E
    JR Z,word  ; if DE = 0, assume it's NOT a long!
    LD A, D
    CPL
    LD D, A
    LD A,E
    CPL
    LD E,A

word:
    LD A,H
    AND A      ; if H=0 assume it's not 16 bit.
    JR Z, byte
    CPL
    LD H,A

byte:
    LD A,L
    CPL
    LD L,A

    END asm

END Function



Binary AND (8 bit)
Code:
FUNCTION bAND (byte1 as uByte, byte2 as uByte) as uByte
       return bANDHL(byte1*256+byte2)
END function

FUNCTION FASTCALL  bANDHL (HL as uInteger) as uByte
    asm
    LD a,h
    AND l
    end asm
END FUNCTION

USAGE bAND (byte value1, byte value2)
NOTE: Yes, this is one function that calls another. It cheats by putting two 8 bit values into a 16 bit. It's definitely possible to have something better optimized, and if I learn how standard calls work, I'll use that.
In the meantime, this does work.

Binary OR (8 bit)
NOTE: This uses the same sneaky methods as bAND. I'm sure better code will turn up later.
Code:
FUNCTION bOR (byte1 as uByte, byte2 as uByte) as uByte
      return bORHL(byte1*256+byte2)
END function

FUNCTION FASTCALL bORHL (HL as uInteger) as uByte
    asm
    LD a,h
    OR l
    end asm
END FUNCTION
USAGE bOR(byte value,byte value)

Print this item

  Weirdness 3
Posted by: britlion - 01-28-2010, 08:04 AM - Forum: Bug Reports - Replies (14)

Code:
FOR i=0 to 7
    LET charASave(i)=PEEK (23675+i)
    BEEP 1,1
NEXT i

This is a snippet of the same program as previously mentioned. I didn't think it was working right with loops. So, I added a beep. It duly beeps once, clears the screen (with NO cls command) and moves on. If I add a print charASave command, it crashes instead. Shouldn't try to catch it out, I guess.

Boriel, a little while ago,[a version or two back] this was far more stable and predictable...what is going on here?

Best clue I have is that when installing it said something about a newer version being there already. So I uninstalled completely and reinstalled. Is my SDK corrupt?? Is there something completely broken about the 'latest version' on the ftp site?

Am I quietly going insane?

Print this item