OldComp.cz

Komunitní diskuzní fórum pro fanoušky historických počítačů


Právě je 27.04.2024, 08:46

Všechny časy jsou v UTC + 1 hodina [ Letní čas ]




Odeslat nové téma Odpovědět na téma  [ Příspěvků: 598 ]  Přejít na stránku Předchozí  1 ... 35, 36, 37, 38, 39, 40  Další
Autor Zpráva
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 11.08.2023, 23:35 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Pri testovani smycek jsem odhalil nejake chyby. Zda se ze je to na me uz dost slozite... .) To myslim fakt vazne jak me hlava vubec nefunguje...

Kód:
positive step:
-6 + +5 = -1  nc
-5 + +5 =  0   c -> stop!
-4 + +5 =  1   c -> stop!
-3 + +5 =  2   c -> stop!
-2 + +5 =  3   c -> stop!
-1 + +5 =  4   c -> stop!
 0 + +5 =  5  nc
 1 + +5 =  6  nc
 2 + +5 =  7  nc

negative step:
 6 + -5 =  1   c
 5 + -5 =  0   c
 4 + -5 = -1  nc -> stop!
 3 + -5 = -2  nc -> stop!
 2 + -5 = -3  nc -> stop!
 1 + -5 = -4  nc -> stop!
 0 + -5 = -5  nc -> stop!
-1 + -5 = -6   c
-2 + -5 = -7   c


Zakladni princip aby ta smycka fungovala pro jakekoliv vstupy je videt v ukazce.


BEGIN ... +-STEP ... END

Aby to fungovalo pro jakykoliv znamenko KROKu a BEGIN a END se mohly klidne prohazovat a byt s jakymkoliv znamenkem. S tim ze v jednom pripade se to krokuje od BEGIN do END a podruhe je to jakoby doplnek do 64k.

Jeste navic ma Forth v definici ze pokud je STEP kladny tak je to vyjma END a pokud je STEP zaporny tak je to vcetne END.

Staci kdyz od aktualniho indexu odectete vzdy END a ta smycka se zmeni na...

BEGIN-END ...+-STEP ... 0

presneji

AKTUALNI_INDEX-END +-STEP ...0

A vy pak vite ze polkud je kladny krok a (index-stop)+step vyvola CARRY tak uz je konec, pripadne pokud je zaporny krok a (index-stop)+(-step) nevyvola CARRY tak je to konec. Protoze v obou pripadech jste prekrocili nulu.

Pokud STEP znate tak proste generuji spravnou variantu "jp p/m do101save". Pokud je to promenna jejiz hodnotu zna az Pasmo tak to jde osetrit pomoci "if else endif" kde se zkompiluje spravna varianta.

Ja se ale nechal nachytat ve variante kdy STEP je pointer, takze nevim zda je kladny a nebo zaporny pokud bychom nedelali v kodu nejake vetveni, nebo nahradni aritmeticky vypocet.
Problem je ze na vypocet uz neni moc volnych registru.
Resil jsem to ulozenim do A znamenka pred prictenim +-STEP a udelal XOR s vysledkem. Takze pokud se behem pricteni znamenko zmenilo tak jsem vedel ze je konec, bez ohledu jake znamenko ma krok.

Vubec me nedoslo ze me to selze v pripade kdy to prekracuje hranici 32767..32768(=-32768). Tam se totiz zmeni znamenko taky... a ukonci se to tak predcasne.

Spravny postup je tedy az pote co prictenem +-STEP si ulozit CARRY pomoci "sbc A,A" a provest "XOR hi(STEP)".

Ani nebudu rikat kolikrat jsem to udelal blbe nez jsem se dostal k tomuto i kdyz jsem vedel co presne chci.

Ve skutecnosti je to jeste slozitejsi protoze

nactu puvodni index
mam provest pricteni STEP a zjisteni zda mohu pokracovat a skoceni na konec slova DO kde se ulozi aktualizovany index.

Takze je to nejake
Kód:
DE = [HL++]
push hl
ld HL, stop
ld BC, step
ex de,hl
or a
sbc hl,de    ; index-stop
add hl,bc    ; index-stop+step
sbc a,a

; a ted musim jeste provest nejaky vypocet abych mel na konci v DE = index+step
add hl,de

xor B

ex de,hl
pop hl
jp p, do101save


To pricteni a odecteni STOP se muze totiz provade i jinak nez pres DE

Pokud je STOP nula tak nemusim delat nic, pokud je to +-1 tak staci "inc/dec hl"

Pokud je to +-256 tak staci "inc/dec h"

a nebo jine kombinace. Pricemz i inc/dec by me to smazalo sign flag, proto je dobre ze to xor mohu dat az za tuhle operaci plus STOP.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 18.08.2023, 02:30 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Opravil jsem smycky se vstupem s pointery pro memory variantu.
Kdyz jsem to poprve prohnal pres svuj testovaci program tak skoro nic nefungovalo... .)
I kdyz testuji vlastne jen jednu smycku.
Kód:
include(`../M4/FIRST.M4')dnl
ORG 0x8000
INIT(0x8000)

PRINT_I({"+10000     4321..54321      ", 0x0D})                 

VARIABLE(_counter,0)
VARIABLE(_index,0)

VARIABLE(from,4321)
VARIABLE(stop,54321)
VARIABLE(step,10000)

PUSH(54321)        PUSH(4321)       DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH(54321)  __ASM PUSH(4321)       DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH([stop])       PUSH(4321)       DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH(54321)        PUSH(4321) __ASM DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH([stop])       PUSH([from])     DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH(4321)   __ASM PUSH(54321) SWAP DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
PUSH(54321)        PUSH([from])     DO I CALL(_test) PUSH(10000)       ADDLOOP CALL(_show)
CR
PUSH(54321)       PUSH(4321)       DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH(54321) __ASM PUSH(4321)       DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH([stop])      PUSH(4321)       DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH(54321)       PUSH(4321) __ASM DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH([stop])      PUSH([from])     DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH(4321)  __ASM PUSH(54321) SWAP DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
PUSH(54321)       PUSH([from])     DO I CALL(_test) PUSH(10000) __ASM ADDLOOP CALL(_show)
CR
PUSH(54321)       PUSH(4321)       DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH(54321) __ASM PUSH(4321)       DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH([stop])      PUSH(4321)       DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH(54321)       PUSH(4321) __ASM DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH([stop])      PUSH([from])     DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH(4321)  __ASM PUSH(54321) SWAP DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)
PUSH(54321)       PUSH([from])     DO I CALL(_test) PUSH([step])       ADDLOOP CALL(_show)


STOP

COLON(_test)
    PUSH(_counter) FETCH _1ADD PUSH(_counter) STORE
    PUSH(_index) STORE
SEMICOLON

COLON(_show)
    PUSH(_index)   FETCH        DOT
    PUSH(_counter) FETCH SPACE UDOT
    PUSH(0) PUSH(_index)   STORE
    PUSH(0) PUSH(_counter) STORE
    CR
SEMICOLON


Kdyz jsem se kouknul na puvodni kod tak me to ani nedavalo smysl.

Misto zjistovani jak vypada situace s carry pro ruzne znamenka "step" pri:

"index-stop" + "step"

Jsem tam resil "stop" - "index+step". No asi to smysl dava pro zakladni situace, ale urcite to nefunguje pokazde.

Takze napriklad kdyz znate STEP a START

Kód:
dworkin@dw-A15:~/Programovani/ZX/M4_FORTH-Version-2023-7-23-$ ./check_word.sh 'PUSH(pocatek) DO PUSH(1000) ADDLOOP'
    dec  HL             ; 1:6       pocatek do_101(m)
    ld    A, L          ; 1:4       pocatek do_101(m)
    ld  (stp_lo101), A  ; 3:13      pocatek do_101(m)   lo stop-1
    ld    A, H          ; 1:4       pocatek do_101(m)
    ld  (stp_hi101), A  ; 3:13      pocatek do_101(m)   hi stop-1
    ld   HL, pocatek    ; 3:10      pocatek do_101(m)
    ld  (idx101), HL    ; 3:16      pocatek do_101(m)
    pop  HL             ; 1:10      pocatek do_101(m)
    ex   DE, HL         ; 1:4       pocatek do_101(m)
do101:                  ;           pocatek do_101(m)
    push HL             ; 1:11      1000 +loop_101(m)
idx101 EQU $+1          ;           1000 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      1000 +loop_101(m)
    ld   BC, 1000       ; 3:10      1000 +loop_101(m) BC = step
    add  HL, BC         ; 1:11      1000 +loop_101(m) HL = index+step
    ld  (idx101), HL    ; 3:16      1000 +loop_101(m) save index
stp_lo101 EQU $+1       ;           1000 +loop_101(m)
    ld    A, 0xFF       ; 2:7       1000 +loop_101(m)   lo stop-1
    sub   L             ; 1:4       1000 +loop_101(m)
    ld    L, A          ; 1:4       1000 +loop_101(m)
stp_hi101 EQU $+1       ;           1000 +loop_101(m)
    ld    A, 0xFF       ; 2:7       1000 +loop_101(m)   hi stop-1
    sbc   A, H          ; 1:4       1000 +loop_101(m)
    ld    H, A          ; 1:4       1000 +loop_101(m) HL = stop-(index+step)
    add  HL, BC         ; 1:11      1000 +loop_101(m) HL = stop-index
    xor   H             ; 1:4       1000 +loop_101(m)
    pop  HL             ; 1:10      1000 +loop_101(m)
    jp    p, do101      ; 3:10      1000 +loop_101(m)
leave101:               ;           1000 +loop_101(m)
exit101:                ;           1000 +loop_101(m)
; seconds: 1           ;[42:203]



Zrusil jsem pracne v DO, aby v techto pripadech se "stop" rozdelil na 2 bajty a mel kod nejak:

Kód:
dworkin@dw-A15:~/Stažené/M4_FORTH-master$ ./check_word.sh 'PUSH(pocatek) DO PUSH(1000) ADDLOOP'
    ld  [stp101], HL    ; 3:16      pocatek do_101(m)   ( stop pocatek -- )
    ld   HL, pocatek    ; 3:10      pocatek do_101(m)   HL = index
    ld  [idx101], HL    ; 3:16      pocatek do_101(m)   save index
    ex   DE, HL         ; 1:4       pocatek do_101(m)
    pop  DE             ; 1:10      pocatek do_101(m)
do101:                  ;           pocatek do_101(m)
                       ;[25:143]    1000 +loop_101(m)   version stop from stack
    push DE             ; 1:11      1000 +loop_101(m)
    push HL             ; 1:11      1000 +loop_101(m)
idx101 EQU $+1          ;           1000 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      1000 +loop_101(m)   HL = index
stp101 EQU $+1          ;           1000 +loop_101(m)
    ld   BC, 0x0000     ; 3:10      1000 +loop_101(m)   BC = stop
    ld   DE, 0x03E8     ; 3:10      1000 +loop_101(m)   DE = step
    or    A             ; 1:4       1000 +loop_101(m)
    sbc  HL, BC         ; 2:15      1000 +loop_101(m)   HL = index-stop
    add  HL, DE         ; 1:11      1000 +loop_101(m)   HL = index-stop+step
    sbc   A, A          ; 1:4       1000 +loop_101(m)
    add  HL, BC         ; 1:11      1000 +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      1000 +loop_101(m)   save index
    pop  HL             ; 1:10      1000 +loop_101(m)
    pop  DE             ; 1:10      1000 +loop_101(m)
    jp    p, do101      ; 3:10      1000 +loop_101(m)   positive step
; seconds: 1           ;[36:199]


A v tehle chvili jsem ale vyzkousel co se stane kdyz u memory varianty nepotrebuji mit na konci v nejakem registru vyslednou hodnotu "index+step" a mohu to vypocitat jako prvni hodnotu

index+step
ulozit novy index
"index+step" - "stop"
a ted teprve zjistovat carry pro operaci
"index+step-stop" - "step"

Kdyz to funguje opacne pro "index-stop" + "step" a zjistujeme zda to prelezlo nulu tak musi fungovat i zase ten step odecist od vysledku.
Jen se teda ta hodnota carry otoci, protoze misto odecitani "step" efektivneji pricitam zapornou hodnotu "step".

U predchoziho vypoctu jsem musel mit 3 volne 16-bitove registry. Pro index a mezivysledky a pro stop a 2x pouzity step. Ten "stop" jde vyhodit a resit to 8-bitove pomoci akumulatoru ale to je delsi a myslim max o jeden takt rychlejsi a nebo ani to ne. Tam se komplikuje i DO slovo.

Tady vychazi kupovidu rychleji kdyz se "step" nacte znova do BC, jednou zaporne. Dalsi vyhoda je ze po otestovani carry uz nemusim nic pocitat a nic me tak nemaze priznaky.

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(pocatek) DO PUSH(step) ADDLOOP'
    ld  [stp101], HL    ; 3:16      pocatek do_101(m)   ( stop pocatek -- )
    ld   HL, pocatek    ; 3:10      pocatek do_101(m)   HL = index
    ld  [idx101], HL    ; 3:16      pocatek do_101(m)   save index
    ex   DE, HL         ; 1:4       pocatek do_101(m)
    pop  DE             ; 1:10      pocatek do_101(m)
do101:                  ;           pocatek do_101(m)
                       ;[25:128]    step +loop_101(m)   version stop from stack
    push HL             ; 1:11      step +loop_101(m)
idx101 EQU $+1          ;           step +loop_101(m)
    ld   HL, 0x0000     ; 3:10      step +loop_101(m)   HL = index
    ld   BC, step       ; 3:10      step +loop_101(m)   BC = step
    add  HL, BC         ; 1:11      step +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      step +loop_101(m)   save index
stp101 EQU $+1          ;           step +loop_101(m)
    ld   BC, 0x0000     ; 3:10      step +loop_101(m)   BC = stop
    or    A             ; 1:4       step +loop_101(m)
    sbc  HL, BC         ; 2:15      step +loop_101(m)   HL = index+step-stop
    ld   BC, 0-step     ; 3:10      step +loop_101(m)
    add  HL, BC         ; 1:11      step +loop_101(m)   HL = index-stop
    pop  HL             ; 1:10      step +loop_101(m)
  if ((0x8000 & (step)) = 0)
    jp    c, do101      ; 3:10      step +loop_101(m)   positive step
  else
    jp   nc, do101      ; 3:10      step +loop_101(m)   negative step
  endif
leave101:               ;           step +loop_101(m)
exit101:                ;           step +loop_101(m)
; seconds: 1           ;[39:194]



+LOOP je stejne velky, ale kod je rychlejsi.

Vtip je v tom ze v tomto pripade mohu ten prvni vypocet "index+step" provest pres makro __ADD_R16_CONST a to me to umi jeste zoptimalizovat kdyz je tam nejake pekna hodnota jako je napriklad "step" = -2

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH([konec]) DO PUSH(-2) ADDLOOP'
    ld  [stp101], HL    ; 3:16      [konec] do_101(m)   ( stop [konec] -- )
    ld   HL,[konec]     ; 3:16      [konec] do_101(m)   HL = index
    ld  [idx101], HL    ; 3:16      [konec] do_101(m)   save index
    ex   DE, HL         ; 1:4       [konec] do_101(m)
    pop  DE             ; 1:10      [konec] do_101(m)
do101:                  ;           [konec] do_101(m)
                       ;[23:119]    -2 +loop_101(m)   version stop from stack
    push HL             ; 1:11      -2 +loop_101(m)
idx101 EQU $+1          ;           -2 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      -2 +loop_101(m)   HL = index
    dec  HL             ; 1:6       -2 +loop_101(m)
    dec  HL             ; 1:6       -2 +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      -2 +loop_101(m)   save index
stp101 EQU $+1          ;           -2 +loop_101(m)
    ld   BC, 0x0000     ; 3:10      -2 +loop_101(m)   BC = stop
    or    A             ; 1:4       -2 +loop_101(m)
    sbc  HL, BC         ; 2:15      -2 +loop_101(m)   HL = index+step-stop
    ld   BC, 0x0002     ; 3:10      -2 +loop_101(m)
    add  HL, BC         ; 1:11      -2 +loop_101(m)   HL = index-stop
    pop  HL             ; 1:10      -2 +loop_101(m)
    jp   nc, do101      ; 3:10      -2 +loop_101(m)   negative step
leave101:               ;           -2 +loop_101(m)
exit101:                ;           -2 +loop_101(m)
; seconds: 1           ;[34:181]


Tak to zameni za 2x "dec HL".

Pokud je "stop" misto ze zasobniku brano z ukazatele tak to vypada obdobne. Vice se to zmeni kdyz je to cislo a nebo promenna.

Puvodne:
Kód:
dworkin@dw-A15:~/Programovani/ZX/M4_FORTH-Version-2023-7-23-$ ./check_word.sh 'PUSH(konec) SWAP DO PUSH(1000) ADDLOOP'
    ld  (idx101), HL    ; 3:16      konec swap do_101(m)   ( konec index -- )
    pop  HL             ; 1:10      konec swap do_101(m)
    ex   DE, HL         ; 1:4       konec swap do_101(m)
do101:                  ;           konec swap do_101(m)
    push HL             ; 1:11      1000 +loop_101(m)
idx101 EQU $+1          ;           1000 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      1000 +loop_101(m)
    ld   BC, 1000       ; 3:10      1000 +loop_101(m) BC = step
    add  HL, BC         ; 1:11      1000 +loop_101(m) HL = index+step
    ld  (idx101), HL    ; 3:16      1000 +loop_101(m) save index
stp_lo101 EQU $+1       ;           1000 +loop_101(m)
    ld    A, low +(konec)-1; 2:7       1000 +loop_101(m)   lo stop-1
    sub   L             ; 1:4       1000 +loop_101(m)
    ld    L, A          ; 1:4       1000 +loop_101(m)
stp_hi101 EQU $+1       ;           1000 +loop_101(m)
    ld    A, high +(konec)-1; 2:7       1000 +loop_101(m)   hi stop-1
    sbc   A, H          ; 1:4       1000 +loop_101(m)
    ld    H, A          ; 1:4       1000 +loop_101(m) HL = stop-(index+step)
    add  HL, BC         ; 1:11      1000 +loop_101(m) HL = stop-index
    xor   H             ; 1:4       1000 +loop_101(m)
    pop  HL             ; 1:10      1000 +loop_101(m)
    jp    p, do101      ; 3:10      1000 +loop_101(m)
leave101:               ;           1000 +loop_101(m)
exit101:                ;           1000 +loop_101(m)
; seconds: 1           ;[30:153]


Nove:
Kód:
dworkin@dw-A15:~/Stažené/M4_FORTH-master$ ./check_word.sh 'PUSH(konec) SWAP DO PUSH(1000) ADDLOOP'
    ld  [idx101], HL    ; 3:16      konec swap do_101(m)   ( konec index -- )
    ex   DE, HL         ; 1:4       konec swap do_101(m)
    pop  DE             ; 1:10      konec swap do_101(m)
do101:                  ;           konec swap do_101(m)
                       ;[25:143]    1000 +loop_101(m)   version default
    push DE             ; 1:11      1000 +loop_101(m)
    push HL             ; 1:11      1000 +loop_101(m)
idx101 EQU $+1          ;           1000 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      1000 +loop_101(m)   HL = index
    ld   DE, 0x03E8     ; 3:10      1000 +loop_101(m)   DE = step
    ld   BC, konec      ; 3:10      1000 +loop_101(m)   BC = stop
    or    A             ; 1:4       1000 +loop_101(m)
    sbc  HL, BC         ; 2:15      1000 +loop_101(m)   HL = index-stop
    add  HL, DE         ; 1:11      1000 +loop_101(m)   HL = index-stop+step
    sbc   A, A          ; 1:4       1000 +loop_101(m)   carry to sign
    add  HL, BC         ; 1:11      1000 +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      1000 +loop_101(m)   save index
    pop  HL             ; 1:10      1000 +loop_101(m)
    pop  DE             ; 1:10      1000 +loop_101(m)
    jp    p, do101      ; 3:10      1000 +loop_101(m)   positive step
; seconds: 1           ;[30:173]


Po vylepseni:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(konec) SWAP DO PUSH(1000) ADDLOOP'
    ld  [idx101], HL    ; 3:16      konec swap do_101(m)   ( konec index -- )
    ex   DE, HL         ; 1:4       konec swap do_101(m)
    pop  DE             ; 1:10      konec swap do_101(m)
do101:                  ;           konec swap do_101(m)
                       ;[23:120]    1000 +loop_101(m)   version default
    push HL             ; 1:11      1000 +loop_101(m)
idx101 EQU $+1          ;           1000 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      1000 +loop_101(m)   HL = index
    ld   BC, 0x03E8     ; 3:10      1000 +loop_101(m)   BC = step
    add  HL, BC         ; 1:11      1000 +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      1000 +loop_101(m)   save index
    ld   BC, 0-konec    ; 3:10      1000 +loop_101(m)   BC = -stop
    add  HL, BC         ; 1:11      1000 +loop_101(m)   HL = index+step-stop
    ld   BC, 0xFC18     ; 3:10      1000 +loop_101(m)   BC = -step
    add  HL, BC         ; 1:11      1000 +loop_101(m)   HL = index-stop
    pop  HL             ; 1:10      1000 +loop_101(m)
    jp    c, do101      ; 3:10      1000 +loop_101(m)   positive step
leave101:               ;           1000 +loop_101(m)
exit101:                ;           1000 +loop_101(m)
; seconds: 1           ;[28:150]


S tim ze jde optimalizovat i to odecteni "stop" pri vhodnych hodnotach.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(256) SWAP DO PUSH(-2) ADDLOOP'
    ld  [idx101], HL    ; 3:16      256 swap do_101(m)   ( 256 index -- )
    ex   DE, HL         ; 1:4       256 swap do_101(m)
    pop  DE             ; 1:10      256 swap do_101(m)
do101:                  ;           256 swap do_101(m)
                       ;[18:94]     -2 +loop_101(m)   version default
    push HL             ; 1:11      -2 +loop_101(m)
idx101 EQU $+1          ;           -2 +loop_101(m)
    ld   HL, 0x0000     ; 3:10      -2 +loop_101(m)   HL = index
    dec  HL             ; 1:6       -2 +loop_101(m)
    dec  HL             ; 1:6       -2 +loop_101(m)   HL = index+step
    ld  [idx101], HL    ; 3:16      -2 +loop_101(m)   save index
    dec  H              ; 1:4       -2 +loop_101(m)   HL = index+step-stop
    ld   BC, 0x0002     ; 3:10      -2 +loop_101(m)   BC = -step
    add  HL, BC         ; 1:11      -2 +loop_101(m)   HL = index-stop
    pop  HL             ; 1:10      -2 +loop_101(m)
    jp   nc, do101      ; 3:10      -2 +loop_101(m)   negative step
leave101:               ;           -2 +loop_101(m)
exit101:                ;           -2 +loop_101(m)
; seconds: 1           ;[23:124]

atd.

PS: Hlavni teda je ze to prochazi novymi testy.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 22.08.2023, 02:59 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Opravil jsem i "stack verzi" smycek pro podporu pointeru.

A jeste nejake opravy v "memory" verzi.

Mozna jsou tam jeste nejake chyby v "?do" slove. Nemam to moc testovane.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 25.08.2023, 02:43 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Prekompilovaval jsem benchmark "fib1.m4" a ukazalo me to zmenu u

DUP PUSH2) LE IF

misto puvodniho:
Kód:
                       ;[13:20/47]
    ld    A, H          ; 1:4       dup 2 < if
    add   A, A          ; 1:4       dup 2 < if
    jr    c, $+11       ; 2:7/12    dup 2 < if    negative HL < positive constant ---> true
    ld    A, L          ; 1:4       dup 2 < if    HL<2 --> HL-2<0 --> carry if true
    sub   low 2         ; 2:7       dup 2 < if    HL<2 --> HL-2<0 --> carry if true
    ld    A, H          ; 1:4       dup 2 < if    HL<2 --> HL-2<0 --> carry if true
    sbc   A, high 2     ; 2:7       dup 2 < if    HL<2 --> HL-2<0 --> carry if true
    jp   nc, else101    ; 3:10      dup 2 < if


me to ukazovalo jiny obecny test:
Kód:
                       ;[11:40]     dup 2 <= if   ( x -- x )  flag: x <= 2 ;#variant: default, change: "define({_TYP_SINGLE},{sign_first})"
    ld    A, 0x02       ; 2:7       dup 2 <= if   HL<=2 --> 0<=0x02-L --> false if carry
    sub   L             ; 1:4       dup 2 <= if   HL<=2 --> 0<=0x02-L --> false if carry
    ld    A, 0x00       ; 2:7       dup 2 <= if   HL<=2 --> 0<=0x00-H --> false if carry
    sbc   A, H          ; 1:4       dup 2 <= if   HL<=2 --> 0<=0x00-H --> false if carry
    rra                 ; 1:4       dup 2 <= if
    xor   H             ; 1:4       dup 2 <= if   invert sign if HL is negative
    jp    m, else101    ; 3:10      dup 2 <= if   positive constant --> false if sign


Napadlo me to napsat jeste lepe jako:
Kód:
                        ;[9:38]     dup 2 < if   ( x -- x )  flag: x < 2 variant: <2
    ld    B, H          ; 1:4       dup 2 < if
    ld    C, L          ; 1:4       dup 2 < if
    dec  BC             ; 1:6       dup 2 < if   zero to negative
    dec  BC             ; 1:6       dup 2 < if   one to negative
    ld    A, B          ; 1:4       dup 2 < if
    or    H             ; 1:4       dup 2 < if
    jp    p, else101    ; 3:10      dup 2 < if


tak jsem pridel tento specialni pripad a jeste me doslo ze to jde napsat bez 16 bitove aritmetiky. To jsem ale 2x napsal spatne, protoze to neni az tak jednoduche. .) Nakonec skoncil s:
Kód:
                        ;[9:34]     dup 2 < if   ( x -- x )  flag: x < 2 variant: <2
    ld    A, L          ; 1:4       dup 2 < if
    srl   A             ; 2:8       dup 2 < if
    or    H             ; 1:4       dup 2 < if
    dec   A             ; 1:4       dup 2 < if
    or    H             ; 1:4       dup 2 < if
    jp    p, else101    ; 3:10      dup 2 < if


Fib1 benchmark se diky tomu zrychlil z 32m 40.27s na 30m 26.87s.

PS: Dobre na tom je, ze jsem to udelal v pomocne rutine, takze se to automaticky vylepsi nejen pro IF ale i pro WHILE a UNTIL.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 29.08.2023, 02:27 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Aktualizoval jsem skoro cely adresar Benchmark, chybi asi uz jen "filllin". Zase neslo vsechno jen zkompilovat a musel jsem prepisovat uz zastarale veci co uz se delaji jinak.

Narazil jsem na kod z rossetacode co vypada ze pouziva "zmenu standardniho slova". Pri ktere se asi zjistuje adresa na funkci co vykonava slova "+" a "*" a ty pak meni. To je vlastnost co me ani nenapadla a vzhledem k tomu ze scitani neni u me funkce (ale provede se to inline) to ani nemuze fungovat. A myslim i nasobeni ma problem protoze ne vsechny runtime fce se volaji pouhym "call" ale nekdy maji i nejakou rezii okolo, takze to taky nebude fungovat.
Slo by to proste obejit ze by se vytvorilo nove slovo a v nem by se provedlo to pricitani a zjistovala by se adresa toho noveho slova, ale to uz si musi ohlidat programator.
To jsem fakt necekal ze by nekdo takhle ohybal Forth program pres "execute".

Mam problem!
Citace:
GitHub users are now required to enable two-factor authentication as an additional security measure. Your activity on GitHub includes you in this requirement. You will need to enable two-factor authentication on your account before October 12, 2023, or be restricted from account actions.


Uz se o tom zminovali pred casem na rootu a ja to zatim ignoroval.
Fakt nevim jak to budu resit. Nejsnazsi reseni je proste skoncit.
Nechce se mi urcite instalovat nejaky program ani kupovat nejake hw klice, ani prilis propojovat tento hoby projekt s mou osobou.
Nevim co udelam, trosku mam strach ze se zaseknu jak se znam.

PS: Napadlo me najit email na github a poslat je do p*dele a nebo je pozadat o vyjimku a nasel jsem na foru prvni vlakno kde se ukazuje ze nejsem sam kdo to nechce. https://github.com/orgs/community/discussions/64182

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 02.09.2023, 18:49 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Pokusil jsem se migrovat aspon 3 repozitare z Githubu na Codeberg. Gitlab po me chtel uz pri registraci kreditku...

Vypada to ze maji trosku jiny markdown, takze uz nefunguje Osnova. Nevim jak fungovala na githubu ze zvladla najit nadpisy s mezerema, ted uz to nefunguje.

Nevim jak se tam tvori adresare a pri pretahovani pomoci html to nema limit 50 souboru, ale asi 5?

Nejak se s tim budu muset poprat...

PS: Ale dobra zprava je ze aspon podpis na Oldcompu se aktualizuje retrospektivne... .)

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 06.09.2023, 02:39 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Pri prekompilaci benchmarku fillin_v06 jsem narazil na to ze nova verze smycky je horsi nez puvodni.
Příloha:
8-bit_loop.png
8-bit_loop.png [ 187.29 KiB | Zobrazeno 4065 krát ]

Rychla kontrola ukazala ze puvodne jsem pouzival slovo DO_DROP_I a po rozsekani na jednotliva slova, protoze je to prace az tokenovych pravidel to nejsem schopen spojit. Protoze v dobe tvoreni DO jeste nevim ze staci pouzit jen registr A.

Tak jsem pridal do informaci do smycky dalsi polozku. Krome nove REAL_END ktera pokud to jde ukazuje presnou hodnotu co ma index po pricteni posledniho STEP, kdy uz mam opustit smycku, je tam ted i 8-BIT ktera ma hodnotu 0 nebo 1.

Je to uplne nejsnazsi reseni co jde. Protoze pokud fakt staci menit jen spodni registr tak je to vzdy rychlejsi resit pres A.

Takze nove DO kdyz narazi na to ze je to 8-bit loop tak save provadi pres A.

Dodelal jsem zatim jen varianty pro STEP +1, kdy je horni bajt nula, 0x3c nebo neco jineho. Pokazde s podvariantou kdy REAL_END konci na spodni nulovy bajt, takze se nemusi testovat konec.

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(256,10) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 256
;real end: 256
;   begin: 10
;    step: 1
    ld    A, 0x0A       ; 2:7       256 10 do_101(xm)   8-bit loop
do101saveA:             ;           256 10 do_101(xm)
    ld  [idx101],A      ; 3:13      256 10 do_101(xm)
                        ;[7:38/25]  1 +loop_101(xm)   variant +1.A: 8-bit loop and hi(index)=0, run 246x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       1 +loop_101(xm)   10.. +1 ..(256), real_stop:0x0100
    nop                 ; 1:4       1 +loop_101(xm)   hi(index) = 0 = nop -> idx always points to a 16-bit index.
    inc   A             ; 1:4       1 +loop_101(xm)   index++
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[12:45]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(56,10) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 56
;real end: 56
;   begin: 10
;    step: 1
    ld    A, 0x0A       ; 2:7       56 10 do_101(xm)   8-bit loop
do101saveA:             ;           56 10 do_101(xm)
    ld  [idx101],A      ; 3:13      56 10 do_101(xm)
                        ;[9:45/32]  1 +loop_101(xm)   variant +1.B: 8-bit loop and real_stop=256, run 46x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       1 +loop_101(xm)   10.. +1 ..(56), real_stop:0x0038
    nop                 ; 1:4       1 +loop_101(xm)   hi(index) = 0 = nop -> idx always points to a 16-bit index.
    inc   A             ; 1:4       1 +loop_101(xm)   index++
    cp   0x38           ; 2:7       1 +loop_101(xm)   lo(real_stop)
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[14:52]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(0x3d00,0x3c50) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 0x3d00
;real end: 15616
;   begin: 0x3c50
;    step: 1
    ld    A, 0x50       ; 2:7       0x3d00 0x3c50 do_101(xm)   8-bit loop
do101saveA:             ;           0x3d00 0x3c50 do_101(xm)
    ld  [idx101],A      ; 3:13      0x3d00 0x3c50 do_101(xm)
                        ;[6:34/21]  1 +loop_101(xm)   variant +1.C: 8-bit loop and hi(index) = 0x3C, run 176x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       1 +loop_101(xm)   0x3c50.. +1 ..(0x3d00), real_stop:0x3D00
    inc   A             ; 1:4       1 +loop_101(xm)   = hi(index) = 0x3c = inc A -> idx always points to a 16-bit index
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[11:41]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(0x3c80,0x3c50) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 0x3c80
;real end: 15488
;   begin: 0x3c50
;    step: 1
    ld    A, 0x50       ; 2:7       0x3c80 0x3c50 do_101(xm)   8-bit loop
do101saveA:             ;           0x3c80 0x3c50 do_101(xm)
    ld  [idx101],A      ; 3:13      0x3c80 0x3c50 do_101(xm)
                        ;[8:41/28]  1 +loop_101(xm)   variant +1.D: 8-bit loop and real_stop=0x3D00, run 48x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       1 +loop_101(xm)   0x3c50.. +1 ..(0x3c80), real_stop:0x3C80
    inc   A             ; 1:4       1 +loop_101(xm)   = hi(index) = 0x3c = inc A -> idx always points to a 16-bit index
    cp   0x80           ; 2:7       1 +loop_101(xm)   lo(real_stop)
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[13:48]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(512,400) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 512
;real end: 512
;   begin: 400
;    step: 1
    ld    A, 0x90       ; 2:7       512 400 do_101(xm)   8-bit loop
do101saveA:             ;           512 400 do_101(xm)
    ld  [idx101],A      ; 3:13      512 400 do_101(xm)
                        ;[8:41/28]  1 +loop_101(xm)   variant +1.E: 8-bit loop, run 112x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0190     ; 3:10      1 +loop_101(xm)   400.. +1 ..(512), real_stop:0x0200
    ld    A, C          ; 1:4       1 +loop_101(xm)
    inc   A             ; 1:4       1 +loop_101(xm)   index++
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[13:48]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSHS(500,400) DO PUSH(1) ADDLOOP __SHOW_LOOP(101)'
;      id: 101
;    type: M   ;# M,R,S = memory, recursive, stack
;   8-bit: 1
;     end: 500
;real end: 500
;   begin: 400
;    step: 1
    ld    A, 0x90       ; 2:7       500 400 do_101(xm)   8-bit loop
do101saveA:             ;           500 400 do_101(xm)
    ld  [idx101],A      ; 3:13      500 400 do_101(xm)
                       ;[10:48/35]  1 +loop_101(xm)   variant +1.F: 8-bit loop and lo(real_stop)=0, run 100x
idx101 EQU $+1          ;           1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0190     ; 3:10      1 +loop_101(xm)   400.. +1 ..(500), real_stop:0x01F4
    ld    A, C          ; 1:4       1 +loop_101(xm)
    inc   A             ; 1:4       1 +loop_101(xm)   index++
    cp   0xF4           ; 2:7       1 +loop_101(xm)   lo(real_stop)
    jp   nz, do101saveA ; 3:10      1 +loop_101(xm)   index-real_stop
leave101:               ;           1 +loop_101(xm)
exit101:                ;           1 +loop_101(xm)
; seconds: 1           ;[15:55]


Koukal jsem se i na jine smycky a nekdy je to stale hruza... .) Takze prace je jeste dost...

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 11.11.2023, 03:14 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Dlouho jsem tu nepsal, ale pracuji na prekladaci kazdy den. Nepamatuji si ani co jsem delal vcera... .) takze nebudu vykladat o vsem, ale hlavni body byly, ze jsem hodne pracoval opet na smyckach. Doslo me, ze smycka kde za "DO" nasleduje "I" je dost odlisna od pouhe "DO ... LOOP" a oddelil jsem to do samostane casti. Pokud je to "M" (memory) smycka, tak se vetsinou index nacita do BC, ale pokud bude nacten do HL, tak to meni situaci.

Zapracoval jsem i na 8-bitovych smyckach a udelal par pomocnych maker:

__INC_R8_CP_CONST
__DEC_R8_CP_CONST

kde se hodnota zvysuje/snizuje a pak testuje na nejakou hodnotu. Diky te predchozi zmene existuji specialni pripady kdy misto CP jde testovat jen vlajky na C,P nebo Z. S tim pretecenim (nemyslim carry) jsem hodne pracoval, protoze jsem to predtim opomijel. Pritom je to tak mocne jako carry ktere signalizuje preteceni/podteceni nuly a PO signalizuje preteceni/podteceni 0x80 a na rozdil od carry to nastavuje i "INC/DEC reg8".

__ADD_R8_CONST_CROSS_CONST

je slozitejsi pripad kdy je krok libovolny.

Vsechno se to hodilo pro nektere specialni pripady smycek. A je snazsi si vyladit generovany kod, nez to delat opakovane.

U toho jsem zasadne zmenil zjisteni co ten kod meni za priznaky z textoveho "c", "z", "zcA" jsem presel na vhodnejsi metodu s maskama.
Vygeneroval jsem si konstany pro kazdy priznak a i zmenu hodnot registru a to jde pak snadneji testovat.
Kód:
define({__FLAG_SET_A},256){}dnl
define({__FLAG_SET_B},512){}dnl
define({__FLAG_SET_C},1024){}dnl
define({__FLAG_SET_D},2048){}dnl
define({__FLAG_SET_E},4096){}dnl
define({__FLAG_SET_H},8192){}dnl
define({__FLAG_SET_L},16384){}dnl
dnl
define({__FLAG_SET_BC},eval(__FLAG_SET_B+__FLAG_SET_C)){}dnl
define({__FLAG_SET_DE},eval(__FLAG_SET_D+__FLAG_SET_E)){}dnl
define({__FLAG_SET_HL},eval(__FLAG_SET_H+__FLAG_SET_L)){}dnl
dnl
define({__FLAG_C},1){}dnl
define({__FLAG_PO},4){}dnl
define({__FLAG_Z},64){}dnl
define({__FLAG_S},128){}dnl
dnl
Dalsi masky jsou uz jen pomocne a pouzivam je pri vytvareni kodu, pro snazsi nastaveni co se meni.
Kód:
define({__FLAG_CP8},eval(__FLAG_C | __FLAG_PO | __FLAG_Z | __FLAG_S)){}dnl
dnl
dnl ;# use reg A
define({__FLAG_ADD8},eval(__FLAG_CP8 |  __FLAG_SET_A)){}dnl
define({__FLAG_SUB8},__FLAG_ADD8){}dnl
define({__FLAG_XOR8},__FLAG_ADD8){}dnl
define({__FLAG_OR8}, __FLAG_ADD8){}dnl
define({__FLAG_AND8},__FLAG_ADD8){}dnl
dnl
define({__FLAG_BIT8},eval(__FLAG_PO | __FLAG_Z)){}dnl
define({__FLAG_INC8},eval(__FLAG_PO | __FLAG_Z | __FLAG_S)){}dnl
define({__FLAG_DEC8},__FLAG_INC8){}dnl
dnl
define({__FLAG_ADD16},__FLAG_C){}dnl
define({__FLAG_ADC16},eval(__FLAG_C | __FLAG_PO | __FLAG_Z | __FLAG_S)){}dnl
define({__FLAG_SBC16},__FLAG_ADC16){}dnl

Takze si vygenerujete kod a zjistite zda se zmenil Carry priznak a pokud ne pouzijete kod. Pokud se zmenil, zjistite zda zustal aspon Sign a upravite svuj kod pomoci "sbc A,A". Pokud ani ten tak mozna se nezmenila hodnota "A" takze muzete pouzit "sbc A,A" pozdeji, atd. Pro me je to mnohem prehlednejsi.

Dalsi vetsi veci byla prace na podpore ROM kalkulacky. Podarilo se mi to z opakovanych volani ROM kalkulacky a navratu v hodne situacich pospojovat tak, aby ten kod zustal v tem ROM kalkulacce dokud to jde, nez se vrati do "normalniho" kodu.

Delal jsem toho mnohem vic, plus opravy chyb atd. ale jak jsem rekl, nepamatuji si to.

Vcera jsem dodelal do odevzdatelne podoby program z Euler project 21: Amicable numbers. Nasel jsem na netu nejaky C kod a resili tam optimalizaci protoze je to hodne vypocetne narocne. Nedalo me to, a protoze se pracuje jen s 16 bity tak to zkusil i prevest na forthu. Jak dlouho to bude pocitat ZX Spectrum. A vysledek byl dost slusny:

- https://projecteuler.net/problem=21
- https://euler.beerbaronbill.com/en/late ... ns/21.html
- https://users.rust-lang.org/t/executabl ... s-c/4496/3

vstupni zdrojaky:

- https://codeberg.org/DW0RKiN/M4_FORTH/s ... ler_21_c.c
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... r_21_b.bas
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... ler_21.fth
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... uler_21.m4
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... 21_fast.m4

vysledne asm soubory:

- https://codeberg.org/DW0RKiN/M4_FORTH/s ... r_21_c.asm
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... 21_c.c.asm
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... r_21_b.asm
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... ler_21.asm
- https://codeberg.org/DW0RKiN/M4_FORTH/s ... 1_fast.asm

Kód:
|              Forth / C              |   Benchmark   | Time (sec/round) |   bin size   |
| :---------------------------------: | :-----------: | :--------------- | :----------: |
| z88dk.zcc v19766-9ffe2042c-20220722 | euler_21      | 3h 47m 15.41s    | 3314 B (include 4x8 font)
| Boriel Basic zxbc.py 1.16.4         | euler_21      | 5h 0m 42.19s     | 1356 B
| M4_FORTH                            | euler_21      | 1h 47m 12.43s    | 318 B
| M4_FORTH TYPDIV:fast                | euler_21      | 1h 41m 36.85s    | 429 B


Je to teda dost zavisle na rychlosti deleni. Boriel me trochu prekvapil, ze je to horsi nez z88dk. Cekal jsem to opacne. Ale 5 hodin a 4 hodiny bez 10 minut neni az tak velky rozdil.

PS: Mel jsem napad, proc neprevest indexy ze smycek, aspon u "memory" verze na pouhe ukazatele. Stejne se to prevadi na [idx"cislo_smycky"]. Aspon pokud to neni hned za DO. Mam par vylepsenych spojenych slov s "I", ale podpora oproti PUSH je radove vetsi. A v kazdem PUSH se drbu s variantou ze parametr je pointer. Vyzkousel jsem to a funguje to skvele. Dokonce lepe nez jsem cekal. Mel jsem treba "DO J I ..." a to me z "J" udela "PUSH[J]" a nasledne "I" me to zkombi do "PUSH_I" a to jeste zjisti ze pred tim je "DO" takze si "I" netaha z pameti ale najde v BC. Uplne jsem ziral. Protoze to vklinene "J" mezi "DO I" rozbijelo tuhle optimalizaci.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSH(300,100) DO PUSH(100) SWAP DO J I LOOP LOOP'
    ld   BC, 0x0064     ; 3:10      300 100 do_101(xm)
do101save:              ;           300 100 do_101(xm)
    ld  [idx101],BC     ; 4:20      300 100 do_101(xm)
    ld    C, L          ; 1:4       100 swap do_102(m)   ( 100 index -- )
    ld    B, H          ; 1:4       100 swap do_102(m)
    ex   DE, HL         ; 1:4       100 swap do_102(m)
    pop  DE             ; 1:10      100 swap do_102(m)
do102save:              ;           100 swap do_102(m)
    ld  [idx102], BC    ; 4:20      100 swap do_102(m)   save index
do102:                  ;           100 swap do_102(m)
                        ;[8:50]     j_101 i_102   ( -- i i )
    push DE             ; 1:11      j_101 i_102
    push HL             ; 1:11      j_101 i_102
    ld    L, C          ; 1:4       j_101 i_102
    ld    H, B          ; 1:4       j_101 i_102
    ld   DE,[idx101]    ; 4:20      j_101 i_102
idx102 EQU $+1         ;[15:61]     loop_102(m)   ( 100 index -- )
    ld   BC, 0x0000     ; 3:10      loop_102(m)   idx always points to a 16-bit index
    inc  BC             ; 1:6       loop_102(m)   index++
qdo102:                 ;           loop_102(m)
    ld    A, 0x64       ; 2:7       loop_102(m)
    xor   C             ; 1:4       loop_102(m)   x[1] = 0x64
    or    B             ; 1:4       loop_102(m)   x[2] = 0
    jp   nz, do102save  ; 3:10      loop_102(m)
leave102:               ;           loop_102(m)
exit102:                ;           loop_102(m)
                        ;[10:57/37] loop_101(xm)   variant +1.H: step one with lo(real_stop) exclusivity, run 200x
idx101 EQU $+1          ;           loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      loop_101(xm)   100.. +1 ..(300), real_stop:0x012C
    inc  BC             ; 1:6       loop_101(xm)   index++
    ld    A, C          ; 1:4       loop_101(xm)
    xor  0x2C           ; 2:7       loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      loop_101(xm)
leave101:               ;           loop_101(xm)
exit101:                ;           loop_101(xm)
; seconds: 2           ;[44:200]


A fungovalo napoprve i kdyz smycka zjisti ze ji staci 8 bitu.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'PUSH(300,100) DO PUSH(200,0) DO J I LOOP LOOP'
    ld   BC, 0x0064     ; 3:10      300 100 do_101(xm)
do101save:              ;           300 100 do_101(xm)
    ld  [idx101],BC     ; 4:20      300 100 do_101(xm)
    ld    A, 0x00       ; 2:7       200 0 do_102(xm)   8-bit loop
do102saveA:             ;           200 0 do_102(xm)
    ld  [idx102],A      ; 3:13      200 0 do_102(xm)
                        ;[9:53]     j_101 i_102   ( -- i i )
    push DE             ; 1:11      j_101 i_102
    push HL             ; 1:11      j_101 i_102
    ld    L, A          ; 1:4       j_101 i_102
    ld    H, high 0     ; 2:7       j_101 i_102
    ld   DE,[idx101]    ; 4:20      j_101 i_102
                        ;[9:45/32]  loop_102(xm)   variant +1.nop: 8-bit loop and hi(index)=0, run 200x
idx102 EQU $+1          ;           loop_102(xm)   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       loop_102(xm)   0.. +1 ..(200), real_stop:0x00C8
    nop                 ; 1:4       loop_102(xm)   hi(index) = 0 = nop -> idx always points to a 16-bit index.
    inc   A             ; 1:4       loop_102(xm)   index++
    cp   0xC8           ; 2:7       loop_102(xm)   lo(real_stop)
    jp   nz, do102saveA ; 3:10      loop_102(xm)   index-real_stop
leave102:               ;           loop_102(xm)
exit102:                ;           loop_102(xm)
                        ;[10:57/37] loop_101(xm)   variant +1.H: step one with lo(real_stop) exclusivity, run 200x
idx101 EQU $+1          ;           loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      loop_101(xm)   100.. +1 ..(300), real_stop:0x012C
    inc  BC             ; 1:6       loop_101(xm)   index++
    ld    A, C          ; 1:4       loop_101(xm)
    xor  0x2C           ; 2:7       loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      loop_101(xm)
leave101:               ;           loop_101(xm)
exit101:                ;           loop_101(xm)
; seconds: 1           ;[40:172]

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.11.2023, 05:51 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Nasel jsem tohle rok stare video o programovani 1 bitove hudby na ZX Spectru. Je v anglictine, ale jdou zapnout ceske titulky.
phpBB [video]

https://www.youtube.com/watch?v=N5ACJd2LvbY
Skoda ze jsem ho nevidel jeste drive nez jsem delal prikaz PLAY do FORHu.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.11.2023, 07:50 
Offline
Óm Nejvyšší

Registrován: 22.05.2013, 21:14
Příspěvky: 3675
Bydliště: Bratislava
Has thanked: 373 times
Been thanked: 798 times
_dworkin píše:
Kód:
|              Forth / C              |   Benchmark   | Time (sec/round) |   bin size   |
| :---------------------------------: | :-----------: | :--------------- | :----------: |
| z88dk.zcc v19766-9ffe2042c-20220722 | euler_21      | 3h 47m 15.41s    | 3314 B (include 4x8 font)
| Boriel Basic zxbc.py 1.16.4         | euler_21      | 5h 0m 42.19s     | 1356 B
| M4_FORTH                            | euler_21      | 1h 47m 12.43s    | 318 B
| M4_FORTH TYPDIV:fast                | euler_21      | 1h 41m 36.85s    | 429 B
Je to teda dost zavisle na rychlosti deleni. Boriel me trochu prekvapil, ze je to horsi nez z88dk. Cekal jsem to opacne. Ale 5 hodin a 4 hodiny bez 10 minut neni az tak velky rozdil.
Kolko by to trvalo ak by sa to uz od zakladu napisalo priamo a optimalne v asembleri ?


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.11.2023, 08:37 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Busy píše:
_dworkin píše:
Kód:
|              Forth / C              |   Benchmark   | Time (sec/round) |   bin size   |
| :---------------------------------: | :-----------: | :--------------- | :----------: |
| z88dk.zcc v19766-9ffe2042c-20220722 | euler_21      | 3h 47m 15.41s    | 3314 B (include 4x8 font)
| Boriel Basic zxbc.py 1.16.4         | euler_21      | 5h 0m 42.19s     | 1356 B
| M4_FORTH                            | euler_21      | 1h 47m 12.43s    | 318 B
| M4_FORTH TYPDIV:fast                | euler_21      | 1h 41m 36.85s    | 429 B
Je to teda dost zavisle na rychlosti deleni. Boriel me trochu prekvapil, ze je to horsi nez z88dk. Cekal jsem to opacne. Ale 5 hodin a 4 hodiny bez 10 minut neni az tak velky rozdil.
Kolko by to trvalo ak by sa to uz od zakladu napisalo priamo a optimalne v asembleri ?



Tahle otazka me trosku zmatla, protoze jsem uz pracoval a dokoncil uplne jiny benchmark, jen jsem o nem jeste nepsal. Takze jsem myslel ze mluvis o problemu n-teles a floating point aritmetice.
Pokud jde o tento benchmark tak obecne to vypada ze asm muze byt cca 2x rychlejsi.
V tomto pripade si to nemyslim.
Zdrojak je takovy jednoduchy: https://codeberg.org/DW0RKiN/M4_FORTH/s ... ler_21.fth
A vysledny kod je docela pekny: https://codeberg.org/DW0RKiN/M4_FORTH/s ... ler_21.asm
Aby taky nebyl, kdyz to pouzivam na zjisteni co je jeste potreba poladit.
Nejpomalejsi klicova cast je (asi) fce divmod ze ktere se ziska mod.
Ale rozdil mezi obycejnym divmod a rychlym je cca 5 minut.
Takze i kdyz ostatni casti programu zrychlim 2x tak mi to nepomuze kdyz neprispivaji tolik k celkovemu casu.
Mozna by sla napsat nejaka efektivnejsi fce ciste pro mod kdybych nastudoval nejaky matematicky texty...
Muj odhad je ze by to slo asi snizit asi o 10 minut na 1h a 30m.
Mozna vic, ale musel bych zmenit algoritmus (puvodni dela neustale opakovane deleni a slo by si pomoct i tabulkou) a zachovat jen co chci ziskat. Jenze to u benchmarku nesmim delat, protoze pak to postrada smysl porovnani. Musel bych prepsat znovu i forth, basic a c.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 15.12.2023, 01:10 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Porad si hraji s tim prekladacem a predelaval jsem test pro nasobeni s matoucim nazvem prime.m4 na originalni forth, aby prime.m4 vzniklo az pomoci automaticke konverze pomoci skriptu.

Kod vypadal nejak takto:
Kód:
1 2 * 3 * 5 * 7 * ...

Proste se postupne nasobi prvocisla a pak se vytiskne vysledek (orezany na 16 bitu).

Po case kdyz jsem zavedl "constant propagation" / "constant folding" prestal byt program funkcni protoze se me misto nasobeni pri kompilaci spocital vysledek, takze se to smrsklo na ulozeni jednoho cisla.

V M4 programu to mohu rozseknout pomoci slova/fce pro vkladany assembler __ASM, takze pri
Kód:
PUSH(1) PUSH(2) __ASM MUL PUSH(3) __ASM MUL ...

me to vygeneruje kod co testuje zda ta fce pro nasobeni a dalsi veci pracuji spravne.

Mel jsem i variantu, ktera testuje X * constanta, neboli slovo PUSH_MUL().
To jsem mohl testovat tak ze jsem krome pocatecniho cisla 1 to vlozil do fce, takze pocatecni hodnotu neznal a rozlozil to na
PUSH_MUL(2) PUSH_MUL(3) PUSH_MUL(5)... atd.
To se da prepsat do forthu bez problemu.

Jen me to vrtalo trosku hlavou kdyz jsem ten kod videl v cistem forthu...
Kód:
: mul_prime 2 * 3 * 5 * 7 * ... ;

protoze je tam hned videt ze i kdyz neznam prvni cislo tak by se to melo jit spocitat. (Dosadte si ted nejaky cool latinske slovo co vas ucili na vysoke skole v matematice. Asociativiata? Komutativita? Nastesti na tom nezalezi. Ani z filozofickeho hlediska, a ani nezastavam nazor ze bez slov neexistuje mysleni, to by psi nemohli myslet. Mozna by meli udelat experiment kdy se mas vypsat s dvema holkama a s tou osklivou te predstavi a zda muzes mit sex s tou co ma jmeno, s peknou, s obema nebo s zadnou. .) No nic to uz je dost offtopic)

Taky ze ano, sice je forth postfix, ale u toho hromadneho nasobeni fakt nezalezi jak to vynasobite...
(((X*2)*3)*5)*7... = X * (2*3*5*7...) = X * (((2*3)*5)*7)...

Takze jsem pridal tokenove pravidlo pro PUSH_MUL(x) + PUSH_MUL(y) = PUSH_MUL(x*y)

Citace:
Ve skutecnosti je to trosku slozitejsi, protoze se musi testovat ze x a y jsou cisla a ne nejake nezname promenne nebo ukazatele. A jeste druhe PUSH_MUL jeste neexistuje takze to je PUSH_MUL(x) + PUSHS(y) + MUL = PUSH_MUL(x*y) kde x a y jsou hodnoty a PUSHS(y) ma jen jeden parametr. Ale to odbiham...


Jenze po kompilaci se me to ted vsechno zredukuje na
Kód:
: mul_prime 321432... * ;


A __ASM proste nemohu pouzit. Takze jsem to vyresil tak ze to oddelim slovem "CREATE xxx" . CREATE vytvori label xxx a dela to nestastne az v tokenech kvuli pripadnemu hrani se zasobnikem. Aby bylo zaruceno ze to hodi chybu jako pravy forth kdyz jeste nema existovat a je na nej odkazovano. Vlastne to asi nefunguje... no nic, proste to ma schonost rusit optimalizace a v binarce nebude nadbytecny label poznat.
Kód:
2 label x 3 * label y 5 *

pak vytvari testovani inline nasobeni pomoci PUSH_MUL.

Uplne neoptimalizovanou variantu jsem udelal proste tak ze jsem prevedl
Kód:
2 3 5 7 11 13 ... * * * * * * * *
na
Kód:
2 3 5 7 11 13 ... 1200 mul_x_times
kde fce mul_xtimes ma smycku ktera se opakuje podle parametru a jedine co dela ze nasobi prvni 2 hodnoty na stacku.

To se ukazalo docela problematicke protoze opakovane PUSH jsem optimalizoval castecne i pomoci prohledavani stavoveho prostoru pro nejefektivnejsi moznou kombinaci nacitani hodnot do BC, DE, HL aby na konci bylo v zasobniku co ma a v DE byl NOS a v HL byl TOS. Mel jsem to trosku orezane pro vetsi pocet hodnot, ale cca 1200 je proste hodne... dny kompilace. Takze jsem hloubku prohledavani dost orezal a uz se to zkompiluje za nekolik hodin a vyslede je snad podobny tomu co byl predtim.

Kvuli tomu jsem se pokusil pridat do vysledneho souboru na konec i nejake info, aby to vypadalo vic profesionalne a bylo tam napsano M4 FORTH kvuli propagaci. Ale nevim presne co by tam vse melo byt.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Testing$ cat hello.fth
." Hello World!"

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Testing$ cat hello.asm
  ifdef __ORG
    org __ORG
  else
    org 32768
  endif
 

 

;   ===  b e g i n  ===
    ld  [Stop+1], SP    ; 4:20      init   storing the original SP value when the "bye" word is used
    ld    L, 0x1A       ; 2:7       init   Upper screen
    call 0x1605         ; 3:17      init   Open channel
    ld   HL, 0xEA60     ; 3:10      init   Return address stack = 60000
    exx                 ; 1:4       init
    push DE             ; 1:11      print     "Hello World!"
    ld   BC, size101    ; 3:10      print     Length of string101
    ld   DE, string101  ; 3:10      print     Address of string101
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
Stop:                   ;           stop
    ld   SP, 0x0000     ; 3:10      stop   restoring the original SP value when the "bye" word is used
    ld   HL, 0x2758     ; 3:10      stop
    exx                 ; 1:4       stop
    ret                 ; 1:10      stop
;   =====  e n d  =====

STRING_SECTION:
string101:
    db "Hello World!"
size101              EQU $ - string101

; M4_FORTH compiler
; Thu 14 Dec 22:55:11 GMT 2023
; compilation time: 0.269769176 second

Takze je tam datum a pak doba trvani kompilace. Tentokrat to nejde pres awk ale bash takze jsem musel najit jiny zpusob zobrazeni casu. Vhodny byl prikaz DATE ktery umi zobrazit pocet sekund od pocatku sveta (podle unixu :D zadne prestupne sekundy). No prislo me to malo, tak jsem hledal co to jeste umi a umi to nanosekundy. Ale podle formatu je jasne ze to ukazuje rozsah 0 az 0.999... sekund. Nejak spojit? Ale musim to udelat dohromady v jedne okamzik... nastesti to jde podobne jako printf nastavit na +%s.%N kde teckou oddelim sekundy od nanosekund.
Odcitani byl problem protoze ty nanosekundy jsou napevno na 9 cifer aby to slo takhle s teckou pekne zobrazovat... ale ja to musim rozseknout, protoze realna cisla bash neumi zpracovat a cisla zacinajici nulou jsou oktalove... proste troska testovani a uz to funguje a lepe nez v awku.

Nezustal jsem u toho a jeste opravil basicovy zavadec, kde jsem pred vypis kolik casu program bezel pridal PRINT: aby to bylo na novem radku a jeste opravil resetovani pocitadla z
Kód:
20 POKE 23672,0: POKE 23673,0: POKE 23674,0

na
Kód:
20 POKE 23674,0: POKE 23672,0: POKE 23673,0: POKE 23674,0

Proste jsem pridal jeste jednou resetovani bajtu co se aktualizuje kazdou padesatinu sekundy (pokud je zaple preruseni a ne ze bezi BEEP nebo tak neco).
Myslenka je ta ze pri vynulovani by snad mohl byt BASIC dost rychly na to aby to nepreteklo 255 nez se to resetuje znovu co uz ma vyresetovany dalsi 2 bajty. 3 sekundy ty pouky podle me netrvaji.
Predtim jsem obcas videl nejaky nesmysl a neresil to, az kdyz jsem resil ty nanosekundy se me zkratovaly nejake zbyvajici mozkove spoje.

To je asi vse co jsem chtel rici.

PS: Proste obraceni resetovani jsem nemohl udelat protoze to pridava konstantni chybu k vysledku.

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 15.12.2023, 02:25 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
Myslim ze tam mam chybu. Budu ty nuly muset resit jinak. Verit ze pocet cifer je konstantni a pridavat 1 na zacatek. Protoze pokud ted obe cisla zacinaji nulama tak misto vysledku ".00xx" budu vracet ".xx". Zajimave jak to cloveku dojde i kdyz na to nemysli a dela neco jineho...

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 15.12.2023, 20:28 
Offline
Óm Nejvyšší

Registrován: 22.05.2013, 21:14
Příspěvky: 3675
Bydliště: Bratislava
Has thanked: 373 times
Been thanked: 798 times
_dworkin píše:
jeste opravil resetovani pocitadla z
Kód:
20 POKE 23672,0: POKE 23673,0: POKE 23674,0
na
Kód:
20 POKE 23674,0: POKE 23672,0: POKE 23673,0: POKE 23674,0
Proste jsem pridal jeste jednou resetovani bajtu co se aktualizuje kazdou padesatinu sekundy
To je uplne zbytocne. Tri tri POKE sa stihnu vykonat dostatocne rychlo na to, aby si nemusel najvyssi bajt resetovat viackrat.
Ale ak ti mozem poradit, pouzivaj taketo resetovanie:
Kód:
20 PAUSE 1: POKE 23672,0: POKE 23673,0: POKE 23674,0
To PAUSE ti zosynchronizuje beh resetovania s prerusenim, takze budes mat presne definovanu startovaciu podmienku pre meranie casu, bez akejkolvek neurcitosti. A istotu, ze vsetky tri POKE sa vykonaju v ramci toho isteho frejmu, takze realne budes zacinat s 24-bitovou nulou.

Ak budes merat cas kratsi ako 21 minut, tak aktualny stav FRAMES citaj pomocou USR 7766. Tam mas istotu, ze oba bajty precitas naraz atomicky.
Ale pokial potrebujes viac ako 21 minut, tam uz musis citat vsetky tri bajty, bez dalsieho PAUSE 1 sa nezaobides:
Kód:
PAUSE 1 : LET t=USR 7766 + 65536 * PEEK 23674
Teda, zaobides, napr. tak ze si to nacitas 2x a porovnas, ale naco sa skrabat pravou rukou na lavom uchu, ze ;)


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 15.12.2023, 23:44 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1120
Has thanked: 100 times
Been thanked: 161 times
To resetovani 23672 --> 23673 --> 23674 prave nechci delat protoze to pri resetovani 23673 a 23674 uz bezi cas. A ja to obcas porovnavam i s jinym merenim, ktere uz probehlo a ja ho nedelal. Takze bych pridaval konstantni zpozdeni. Proto jsem to zmenil na to ze zacnu 23672 co se podle me meni 50x za vterinu a pak je jedno v jakem poradi udelam zbytek a opet resetnu 23672.

To s tim PAUSE 1 je asi dobry napad pokud to sesynchronizuje preruseni zase na nejakou konstantu.

Cteni jsem....eeh... zapomnel opravit, pritom tam mohou taky vznikat chyby kdyz to ctu po castech a ne "atomicky". A testuje se to od 0 do nekolik hodin, takze musim resit vsechny 3 bajty.

Koukam ze tam je dokonce nejake PAUSE 1 pred ctenim.. Ani nevim proc to tam mam. To se nikdy nedostanu pod 0.01 s ne?
Kód:
20 POKE 23674,0: POKE 23672,0: POKE 23673,0: POKE 23674,0
30 RANDOMIZE USR ${addr}
40 PAUSE 1: LET s=PEEK 23672+256*PEEK 23673+65536*PEEK 23674


Tve cteni
Kód:
PAUSE 1 : LET t=USR 7766 + 65536 * PEEK 23674
vypada o doste lepe, pokud se tim nacte 16-bitova hodnota na adrese 23672 najednou, tak problem muze nastat jen jednou za cca 22 minut. Dokonce chyba muze nastat az od 22 minut a ne 3 vterin.

Cist 2x se me asi nechce, i kdyz by to byl nejlepsi zpusob imho. Pokud je prvni cteni vyssi nez druhe tak od prvniho odectu konstantu a mam to spravne.

Takze nove podle tvych rad vylepseno na:
Kód:
    load=loader.bas
    printf "Generate basic loader...\n"
    printf "10 LOAD \"\" CODE:CLS\n" > "${load}"
    printf "20 PAUSE 1: POKE 23674,0: POKE 23672,0: POKE 23673,0: POKE 23674,0\n" >> "${load}"
    printf "30 RANDOMIZE USR ${addr}\n" >> "${load}"
    printf "40 PAUSE 1: LET s=USR 7766+65536*PEEK 23674: LET s=s/50: LET m=INT (INT s/60): LET h=INT (m/60): PRINT: PRINT \"Time: \";h;\"h \";m-60*h;\"min \";INT ((s-60*m)*100)/100;\"s \";: PAUSE 0: STOP\n" >> "${load}"

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH


Nahoru
 Profil  
 
Zobrazit příspěvky za předchozí:  Seřadit podle  
Odeslat nové téma Odpovědět na téma  [ Příspěvků: 598 ]  Přejít na stránku Předchozí  1 ... 35, 36, 37, 38, 39, 40  Další

Všechny časy jsou v UTC + 1 hodina [ Letní čas ]


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 26 návštevníků


Nemůžete zakládat nová témata v tomto fóru
Nemůžete odpovídat v tomto fóru
Nemůžete upravovat své příspěvky v tomto fóru
Nemůžete mazat své příspěvky v tomto fóru
Nemůžete přikládat soubory v tomto fóru

Hledat:
Přejít na:  
Založeno na phpBB® Forum Software © phpBB Group
Český překlad – phpBB.cz