OldComp.cz

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


Právě je 28.03.2024, 16:40

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




Odeslat nové téma Odpovědět na téma  [ Příspěvků: 585 ]  Přejít na stránku Předchozí  1 ... 27, 28, 29, 30, 31, 32, 33 ... 39  Další
Autor Zpráva
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 16.04.2023, 22:00 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Mym cilem bylo presunout to "eq drop" a "ne drop" do pomocnych maker. Protoze se ten problem opakuje ve vice spojenych slovech.

Takze ted jsem mohl vytvorit "push() eq if" nebo "push() eq while" nebo "push() eq until" jen jako takove male makro, ktere v sobe vola ten __eq_drop a samo resi jen ty rozdily zda FALSE vetev bude skakat na ELSE label, nebo TRUE na BEGIN label a nastavavovat jen ty rozdilne veci.

Pokracoval jsem uz o neco snazsim znamenkovym porovnanim >,>=,<,<=.

A u toho jsem omylem zadal jako vstup "PUSH(0x3333) GT IF" a vylezlo me neco, co na prvni pohled slo vylepsit. Takze jsem to vylepsil pro GT a doplnkovou LE. Ktere se lisi jen opacnym flagem u odskoku.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'BEGIN PUSH(0x3333) GT IF'
begin101:               ;           begin 101
                       ;[11:47]     0x3333 > if   ( x -- ) variant: default
    ld    A, 0x33       ; 2:7       0x3333 > if   HL>0x3333 --> 0>0x33-L
    cp    L             ; 1:4       0x3333 > if   HL>0x3333 --> 0>0x33-L
    sbc   A, H          ; 1:4       0x3333 > if   HL>0x3333 --> 0>0x33-H --> no carry if false
    rra                 ; 1:4       0x3333 > if
    xor   H             ; 1:4       0x3333 > if
    ex   DE, HL         ; 1:4       0x3333 > if
    pop  DE             ; 1:10      0x3333 > if
    jp    p, else101    ; 3:10      0x3333 > if
; seconds: 1           ;[11:47]

Jde o odstraneni dvojiho nacitani 0x33 do A diky zamene CP za SUB. Mimochodem to P u skoku se zameni za M kdyz by konstanta byla zaporna. Setri se jedno XOR.

To same jsem se pokousel u LT a GE a narazil. Normalne se to resi ze se prohodi konstanta s HL u odcitani, ale to nechci protoze si musim drzet konstantu v A, takze jsem si myslel, ze me staci to proste udelat druhou metodou pres nastaveny carry a pridat bajt a 4 takty. Ale jak jsem to psal tak me doslo, ze to CP neumi. Zadne CPC neni.

To bylo fakt divne, ze to je tak jednostranne. Nez mi doslo neco, co zacit resit jen LT a GE, by me nikdy nenapadlo. Ja mohu tuhle optimalizaci udelat u LT a GE ne v pripade ze HI = LO, ale kdyz HI = LO-1.


Protoze tak prevadim:

HL >= 0x3334 na HL > 0x3333

a

HL < 0x3334 na HL <= 0x3333


Dokonce to odecteni 1 je bezpecne protoze u 0x8000-1 neplati HI = LO-1
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x3334) LT IF'
                       ;[11:47]     0x3334 < if   ( x -- ) variant: default
    ld    A, 0x33       ; 2:7       0x3334 < if   HL<0x3334 --> HL<=0x3334-1 --> 0<=0x33-L
    cp    L             ; 1:4       0x3334 < if   HL<0x3334 --> HL<=0x3334-1 --> 0<=0x33-L
    sbc   A, H          ; 1:4       0x3334 < if   HL<0x3334 --> HL<=0x3334-1 --> 0<=0x33-H --> carry if false
    rra                 ; 1:4       0x3334 < if
    xor   H             ; 1:4       0x3334 < if
    ex   DE, HL         ; 1:4       0x3334 < if
    pop  DE             ; 1:10      0x3334 < if
    jp    m, else101    ; 3:10      0x3334 < if
; seconds: 1           ;[11:47]


Moc dalsich vetvi tam neni, jen kdyz je to ukazatel, pak resim neznamou hodnotu, min, max, nulu a 1 nebo -1.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH((addr)) LT IF'
                       ;[16:72]     (addr) < if   ( x -- ) variant: memory
    ld   BC, (addr)     ; 4:20      (addr) < if   BC = (addr)
    ld    A, L          ; 1:4       (addr) < if   HL<BC --> HL-BC<0 --> no carry if false
    sub   C             ; 1:4       (addr) < if   HL<BC --> HL-BC<0 --> no carry if false
    ld    A, H          ; 1:4       (addr) < if   HL<BC --> HL-BC<0 --> no carry if false
    sbc   A, B          ; 1:4       (addr) < if   HL<BC --> HL-BC<0 --> no carry if false
    rra                 ; 1:4       (addr) < if
    xor   H             ; 1:4       (addr) < if
    xor   B             ; 1:4       (addr) < if
    ex   DE, HL         ; 1:4       (addr) < if
    pop  DE             ; 1:10      (addr) < if
    jp    p, else101    ; 3:10      (addr) < if
; seconds: 0           ;[16:72]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) LT IF'
                        ;[7:32]     0 < if   ( x -- )  flag: x < 0
    bit   7, H          ; 2:8       0 < if
    ex   DE, HL         ; 1:4       0 < if
    pop  DE             ; 1:10      0 < if
    jp    z, else101    ; 3:10      0 < if
; seconds: 0           ;[ 7:32]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(1) LT IF'
                        ;[8:38]     1 < if   ( x -- ) variant: 1
    ld    A, H          ; 1:4       1 < if   HL< 0         --> no sign if false
    dec  HL             ; 1:6       1 < if   HL<=0         --> no sign if false
    or    H             ; 1:4       1 < if   HL<=0 && HL<0 --> no sign if false
    ex   DE, HL         ; 1:4       1 < if
    pop  DE             ; 1:10      1 < if
    jp    p, else101    ; 3:10      1 < if
; seconds: 0           ;[ 8:38]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(-1) GT IF'
                        ;[7:32]     -1 > if   ( x -- ) variant: -1
    rl    H             ; 2:8       -1 > if   HL>-1 --> sign if false
    ex   DE, HL         ; 1:4       -1 > if
    pop  DE             ; 1:10      -1 > if
    jp    c, else101    ; 3:10      -1 > if
; seconds: 0           ;[ 7:32]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) LT IF'
                       ;[13:54]     0x1234 < if   ( x -- ) variant: default
    ld    A, L          ; 1:4       0x1234 < if   HL<0x1234 --> L-0x34<0
    sub   0x34          ; 2:7       0x1234 < if   HL<0x1234 --> L-0x34<0
    ld    A, H          ; 1:4       0x1234 < if   HL<0x1234 --> H-0x12<0
    sbc   A, 0x12       ; 2:7       0x1234 < if   HL<0x1234 --> H-0x12<0 --> no carry if false
    rra                 ; 1:4       0x1234 < if
    xor   H             ; 1:4       0x1234 < if
    ex   DE, HL         ; 1:4       0x1234 < if
    pop  DE             ; 1:10      0x1234 < if
    jp    p, else101    ; 3:10      0x1234 < if
; seconds: 0           ;[13:54]


Min a max se vetsinou zmeni na vzdy TRUE nebo FALSE, popripade to jde zamenit za EQ/NE. Napr. >= max je to same co = max.

PS: U te nuly me to teda generuje shodny kod, ale s jinymi komentari, protoze to zmeni tokenove pravidla na neco co jsem uz umel _0LT_IF.
Kdyz to tam narvu natvrdo
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH_LT_IF(0)'
                        ;[7:32]     0 < if   ( x -- ) variant: 0
    rl    H             ; 2:8       0 < if   HL<0 --> no sign if false
    ex   DE, HL         ; 1:4       0 < if
    pop  DE             ; 1:10      0 < if
    jp   nc, else101    ; 3:10      0 < if
; seconds: 0           ;[ 7:32]

Tak temer shodny... .)

_________________
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: 20.04.2023, 22:39 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Dal jsem dohromady test na ty pomocna makra co ted nahrazuji casti kodu.
Musel jsem to trosku ohackovat, abych nemusel pouzit inline assembler, ale povedlo se.

Pouzil jsem IF(TRUE) PUTCHAR('+'); ELSE PUTCHAR('-');

V tech pomocnych makrech skacu pri nesplneni podminky na ELSE label. Jeho ID zjistuji tim ohackovanim, protoze ho musim zadat jeste nez pouziji to IF tim ze jako parametr pouziji else{}incr(IF_COUNT) ktery se zmeni na napr. "else105".

Testuji jak __MAKE_CODE_DUP_PUSH_podminka_JP_FALSE tak __MAKE_CODE_PUSH_podminka_DROP_JP_FALSE.

Hmm ten prvni nazev by mel byt spis __MAKE_CODE_DUP_PUSH_podminka_DROP_JP_FALSE. Protoze se vlastne ten flag odstranuje.

Testuji pro kazde makro 7 hodnot: min== -32768,-2,-1,0,1,2,max==32767. Protoze pro max,min, nulu a nekdy 1 nebo -1 to muze generovat jiny kod. Pak se to jeste testuje znovu, ze se tam vlozi neznama hodnota pro M4, definovana az v pasmu. Takze testuji vsechno krome pointeru na ktery jsem se vybodl... .)

Napr. pro -2 nebo m2 a > to vypada ve M4 Forthu takto:
Kód:
__ASM({; ---- -2 ------})
    PUSH(0) PUSH(6) DO I _2MUL PUSH(_max) ADD FETCH
      __ASM({
         define({__INFO},{ > -2})
         __MAKE_CODE_DUP_PUSH_GT_JP_FALSE(     -2,else{}incr(IF_COUNT))})
      PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN SPACE DROP
    PUSH(-1) ADDLOOP PRINT_Z({" > -2",0x0D})

    PUSH(0) PUSH(6) DO I _2MUL PUSH(_max) ADD FETCH
      __ASM({
         define({__INFO},{ > -2})
         __MAKE_CODE_PUSH_GT_DROP_JP_FALSE(    -2,else{}incr(IF_COUNT))})
      PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN SPACE
    PUSH(-1) ADDLOOP PRINT_Z({" > -2",0x0D})

    PUSH(0) PUSH(6) DO I _2MUL PUSH(_max) ADD FETCH
      __ASM({
         define({__INFO},{ > m2})
         __MAKE_CODE_DUP_PUSH_GT_JP_FALSE(     m2,else{}incr(IF_COUNT))})
      PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN SPACE DROP
    PUSH(-1) ADDLOOP PRINT_Z({" > m2",0x0D})

    PUSH(0) PUSH(6) DO I _2MUL PUSH(_max) ADD FETCH
      __ASM({
         define({__INFO},{ > m2})
         __MAKE_CODE_PUSH_GT_DROP_JP_FALSE(    m2,else{}incr(IF_COUNT))})
      PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN SPACE
    PUSH(-1) ADDLOOP PRINT_Z({" > m2",0x0D})


Kvuli tomu jsem vytvoril i spojene slovo "PUSH_IF", protoze se me zbytecne generovalo vlozeni TRUE a vzdy pravdivy test. Ale neni to tak nesmyslne, protoze parametr muze byt i ukazatel.

Samozrejme jsem odhalil neprijemnou chybu, kdy me to delalo presny opak, kdyz parametr byl nazev promenne o nezname hodnote. Nejak jsem si nevsiml ze ta podminka pro Pasmo konci "=0", takze jsem to mel presne naopak.

Na ukazku:
Nekde v kodu mam
max equ 0x8000
Kód:
  .warning: The condition "max" cannot be evaluated
  if ((max)>=0x8000 || (max)<0)
    jp    m, else212    ; 3:10       > max
  else
    jp    p, else212    ; 3:10       > max
  endif


Kdyz uz jsem si myslel jak to mam vsechno dobre, tak jsem to vlozil do puvodniho testu na IF a nestacil se divit. Mel jsem spatne = a <> u nekterych maker. Nekde uplne spatny nazev ..._2DROP_... misto ..._DROP_... a jedno uplne spatne FAIL misto FALSE a jeste neco k tomu, takze to automaticke nahrazeni nenaslo, kdyz jsem to menil z ...JP_FAIL na ..._JP_FALSE.

Test jsem jeste musel upravit, protoze pri hledani co je spatne me to generovalo nekolikrat ten samy kod, protoze nejake

DUP EQ IF
DUP EQ_IF
DUP_EQ IF
DUP_EQ_IF

uz pres tokenova pravidla muze skoncit na DUP_EQ_IF.

Takze jsem to musel mezi to umele dat nejake zarazky s cim si tokenova pravidla neporadi. Vlozil jsem tam prazdnou inline assembler fci, se kterou si uz nejaka pravidla neporadi, ani nemuze, pokud by nezjistoval co v ni je.
Musel jsem upravit i uplne zakladni makro pro test zda parametr je cislo, protoze jsem komentare vkladal taky jako inline assembler, aby byly na spravnych mistech a tokenova pravidla se to snazila spocitat co tam je i kdyz tam byl komentar. Pomohl pridat strednik mezi znaky co znamenaji ze to neni cislo.

DUP EQ IF
DUP EQ __ASM() IF
DUP __ASM() EQ IF
DUP __ASM() EQ __ASM() IF

U 16 bitu to teda generuje vysledek 4x misto puvodniho 3x.
To je asi tak vse. Docela narocny hledat co je spatne v komplexnim programu. Urcite vic nez pridavat dalsi makro.

PS: Uploadnu to az po (anglicke) pulnoci.

PPS: Mimochodem
Kód:
PUSH(-1) IF PUSH('+') ELSE PUSH('-') THEN EMIT

je o moc delsi nez
Kód:
PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN


Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Testing$ ../check_word.sh 'PUSH(-1) IF PUSH('+') ELSE PUSH('-') THEN EMIT'
                        ;[0:0]      -1 if
  .warning: : The condition is always True!
    push DE             ; 1:11      +
    ex   DE, HL         ; 1:4       +
    ld   HL, +          ; 3:10      +
    jp   endif101       ; 3:10      else
else101:                ;           else
    push DE             ; 1:11      -
    ex   DE, HL         ; 1:4       -
    ld   HL, 0-         ; 3:10      -
endif101:               ;           then
    ld    A, L          ; 1:4       emit   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      emit   putchar(reg A) with ZX 48K ROM
    ex   DE, HL         ; 1:4       emit
    pop  DE             ; 1:10      emit   ( a -- )
; seconds: 1           ;[17:89]
dworkin@dw-A15:~/Programovani/ZX/Forth/Testing$ ../check_word.sh 'PUSH(-1) IF PUSH('+') EMIT ELSE PUSH('-') EMIT THEN'
                        ;[0:0]      -1 if
  .warning: : The condition is always True!
    ld    A, +          ; 2:7       + emit   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      + emit   putchar(reg A) with ZX 48K ROM
    jp   endif101       ; 3:10      else
else101:                ;           else
    ld    A, -          ; 2:7       - emit   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      - emit   putchar(reg A) with ZX 48K ROM
endif101:               ;           then
; seconds: 1           ;[ 9:46]


Přílohy:
test_if_01.png
test_if_01.png [ 2.86 KiB | Zobrazeno 1508 krát ]
test_if_02.png
test_if_02.png [ 1.91 KiB | Zobrazeno 1508 krát ]
test_if_03.png
test_if_03.png [ 1.8 KiB | Zobrazeno 1508 krát ]

_________________
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: 30.04.2023, 20:07 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Pri testovani EQ a NE jsem pouzival smycku "PUSH(0) PUSH(17) DO PUSH(-1) ADDLOOP". Koukam na vygenerovany kod a nelibilo se mi, ze se testuje na nulu pres:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) PUSH(17) DO PUSH(-1) ADDLOOP'
    ld   BC, 0x0011     ; 3:10      0 17 do_101(xm)
do101save:              ;           0 217 do_101(xm)
    ld  (idx101),BC     ; 4:20      0 217 do_101(xm)
do101:                  ;           0 217 do_101(xm)
                        ;[9:54/34] -1 +loop_101(xm)   variant -1.A.0b: step -1 and run<=256 and lo(stop)==0, run 218x
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   217.. -1 ..0, real_stop:0xFFFF
    dec  BC             ; 1:6       -1 +loop_101(xm)   index--
    ld    A, C          ; 1:4       -1 +loop_101(xm)
    or    B             ; 1:4       -1 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 1           ;[16:64]

Protoze to neni efektivni, tak jsem pridal varianty:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) PUSH(17) DO PUSH(-1) ADDLOOP'
    ld   BC, 0x0011     ; 3:10      0 17 do_101(xm)
do101save:              ;           0 17 do_101(xm)
    ld  (idx101),BC     ; 4:20      0 17 do_101(xm)
do101:                  ;           0 17 do_101(xm)
                        ;[7:44/24]  -1 +loop_101(xm)   variant -1.A.0a: step -1 and run<=129 and lo(stop)==0, run 18x
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   17.. -1 ..0, real_stop:0xFFFF
    dec   C             ; 1:4       -1 +loop_101(xm)   index--
    jp    p, do101save  ; 3:10      -1 +loop_101(xm)
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 1           ;[14:54]

Pokud je vstup vetsi jak 129 vcetne tak se to zlepsi jen z "dec BC" na "dec C".
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) PUSH(129) DO PUSH(-1) ADDLOOP'
    ld   BC, 0x0081     ; 3:10      0 129 do_101(xm)
do101save:              ;           0 129 do_101(xm)
    ld  (idx101),BC     ; 4:20      0 129 do_101(xm)
do101:                  ;           0 129 do_101(xm)
                        ;[9:54/34] -1 +loop_101(xm)   variant -1.A.0b: step -1 and run<=256 and lo(stop)==0, run 130x
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   129.. -1 ..0, real_stop:0xFFFF
    dec  BC             ; 1:6       -1 +loop_101(xm)   index--
    ld    A, C          ; 1:4       -1 +loop_101(xm)
    inc   C             ; 1:4       -1 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 1           ;[16:64]

Mimochodem, tady stale vyhrava pouzit misto "0 17 do -1 +loop" kod "17 for next", ta nemusi resit pro FOR vsechny varianty jako DO, ktery musi sedet i pro jine kroky jak -1 a konec v nule.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(129) FOR NEXT'
    ld    A, 129        ; 2:7       129 for_101   ( -- )
for101:                 ;           129 for_101
    ld  (idx101),A      ; 3:13      129 for_101   save index
idx101 EQU $+1          ;           next_101
    ld    A, 0x00       ; 2:7       next_101   idx always points to a 16-bit index
    nop                 ; 1:4       next_101
    sub  0x01           ; 2:7       next_101   index--
    jp   nc, for101     ; 3:10      next_101
leave101:               ;           next_101
; seconds: 0           ;[13:48]


Pokud je konec -1 tak je to snazsi.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(1) PUSH(129) DO PUSH(-1) ADDLOOP'
    ld   BC, 0x0081     ; 3:10      1 129 do_101(xm)
do101save:              ;           1 129 do_101(xm)
    ld  (idx101),BC     ; 4:20      1 129 do_101(xm)
do101:                  ;           1 129 do_101(xm)
                        ;[7:44/24]  -1 +loop_101(xm)   variant -1.A.1: step -1 and run<256 and lo(stop)==1, run 129x
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   129.. -1 ..1, real_stop:0x0000
    dec   C             ; 1:4       -1 +loop_101(xm)   index--
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 1           ;[14:54]

Krok +1 a konec v nule (vyjma) jsem neresil, tam je to stale spatne.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) PUSH(-129) DO LOOP'
    ld   BC, 0xFF7F     ; 3:10      0 -129 do_101(xm)
do101save:              ;           0 -129 do_101(xm)
    ld  (idx101),BC     ; 4:20      0 -129 do_101(xm)
do101:                  ;           0 -129 do_101(xm)
                        ;[9:54/34]  loop_101   variant +1.G: stop == 0, run 129x
idx101 EQU $+1          ;           loop_101   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      loop_101   -129.. +1 ..(0), real_stop:0x0000
    inc  BC             ; 1:6       loop_101   index++
    ld    A, B          ; 1:4       loop_101
    or    C             ; 1:4       loop_101
    jp   nz, do101save  ; 3:10      loop_101
leave101:               ;           loop_101
exit101:                ;           loop_101
; seconds: 0           ;[16:64]

Protoze jsem pri nahodnem testovani nastavil do smycky misto konstanty promennou a zarvalo to na me spoustu chyb.
Podival jsem se na to bliz a koukam ze jak jsem presel na hlubsi analyzu smycky, kdy ji kazdou fakt prochazim krok za krokem (klidne 65536x) a delam statistiku, zjistuji jaka je posledni hodnota (klidne uz neplatna) na ktere se to ukonci (protoze nemusi mit Step rovny +-1). Jestli je hornich 8 bitu te hodnoty unikatni a nikdy se neopakuje, nebo kolikrat se to opakuje. To same pro spodnich 8 bitu.
Takze pak mohu provadet ruzne optimalizace.

Jenze, kdyz tomu dam ze pocatek je "abc" a konec 0x1234 a krok 1 tak s tim nic neudela.

Takze jsem postupne prepsal aspon pro "M" variantu smycek ze pokud neznam nejakou hodnotu tak se ma provest jiny kod. Nekdy je po prekladu shodny s tim kdy uz M4 zna hodnotu "abc", jidny horsi.

U kroku +-1 je snadne znat hodnotu na kterou se to testuje.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO LOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
  if (from+1 = 0x1234)
idx101 EQU do101save-2  ;           loop_101   variant +1.variable.null: positive step and no repeat
  else
                     ;[16:78/57/58] loop_101   variant +1.variable
idx101 EQU $+1          ;           loop_101   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      loop_101   from.. -1 ..0x1234
    inc  BC             ; 1:6       loop_101   index--
    ld    A, 0x34       ; 2:7       loop_101   lo(real_stop)
    xor   C             ; 1:4       loop_101
    jp   nz, do101save  ; 3:10      loop_101
   if ((0x1234-from)>256 || (from>=0x1234))
    ld    A, 0x12       ; 2:7       loop_101   hi(real_stop)
    xor   B             ; 1:4       loop_101
    jp   nz, do101save  ; 3:10      loop_101
   endif
  endif
leave101:               ;           loop_101
exit101:                ;           loop_101
; seconds: 1           ;[23:88]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO PUSH(-1) ADDLOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
  if (from = 0x1234)
idx101 EQU do101save-2  ;           -1 +loop_101(xm)   variant -1.variable.null: negative step and no repeat
  else
                     ;[16:78/57/58] -1 +loop_101(xm)   variant -1.variable
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   from.. -1 ..0x1234
    dec  BC             ; 1:6       -1 +loop_101(xm)   index--
    ld    A, 0x33       ; 2:7       -1 +loop_101(xm)   lo(real_stop)
    xor   C             ; 1:4       -1 +loop_101(xm)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
   if ((from-0x1234)>255 || (from<0x1234))
    ld    A, 0x12       ; 2:7       -1 +loop_101(xm)   hi(real_stop)
    xor   B             ; 1:4       -1 +loop_101(xm)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
   endif
  endif
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 0           ;[23:88]


U kroku +-2 se to da s trochou snahy udelat taky pres nejaky IF pro prekladac.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO PUSH(2) ADDLOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
                     ;[17:61/82/62] 2 +loop_101(xm)   variant +2.variable
idx101 EQU $+1          ;           2 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      2 +loop_101(xm)   from.. +2 ..(0x1234)
  if ((from) & 1)
    inc  BC             ; 1:6       2 +loop_101(xm)   index++
    inc   C             ; 1:4       2 +loop_101(xm)   index++
  else
    inc   C             ; 1:4       2 +loop_101(xm)   index++
    inc  BC             ; 1:6       2 +loop_101(xm)   index++
  endif
    ld    A, C          ; 1:4       2 +loop_101(xm)
    xor  low  0x1234+(1&((from)xor(0x1234))); 2:7       2 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      2 +loop_101(xm)
    ld    A, B          ; 1:4       2 +loop_101(xm)
    xor  high 0x1234+(1&((from)xor(0x1234))); 2:7       2 +loop_101(xm)   hi(real_stop)
    jp   nz, do101save  ; 3:10      2 +loop_101(xm)
leave101:               ;           2 +loop_101(xm)
exit101:                ;           2 +loop_101(xm)
; seconds: 1           ;[26:102]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO PUSH(-2) ADDLOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
                     ;[17:61/82/62] -2 +loop_101(xm)   variant -2.variable
idx101 EQU $+1          ;           -2 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -2 +loop_101(xm)   from.. -2 ..0x1234
  if ((from) & 1)
    dec   C             ; 1:4       -2 +loop_101(xm)   index--
    dec  BC             ; 1:6       -2 +loop_101(xm)   index--
  else
    dec  BC             ; 1:6       -2 +loop_101(xm)   index--
    dec   C             ; 1:4       -2 +loop_101(xm)   index--
  endif
    ld    A, C          ; 1:4       -2 +loop_101(xm)
    xor  low  0x1234-2+(1&((from)xor(0x1234))); 2:7       -2 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      -2 +loop_101(xm)
    ld    A, B          ; 1:4       -2 +loop_101(xm)
    xor  high 0x1234-2+(1&((from)xor(0x1234))); 2:7       -2 +loop_101(xm)   hi(real_stop)
    jp   nz, do101save  ; 3:10      -2 +loop_101(xm)
leave101:               ;           -2 +loop_101(xm)
exit101:                ;           -2 +loop_101(xm)
; seconds: 1           ;[26:102]

Pak uz jsem mel problem jak zjistit na 100% ve vsech pripadech hodnotu na ktere to skonci, mozna to jde spocitat nejakou matematickou funkci. Budu muset popremyslet. Protoze mit na konci test na EQ je mnohem snazsi nez zjistovat zda jsem prave preskocil nebo dosahl koncovou hodnotu.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO PUSH(20) ADDLOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
                       ;[24:119]    20 +loop_101(xm)   variant variable: positive step 3..n
    push HL             ; 1:11      20 +loop_101(xm)
idx101 EQU $+1          ;           20 +loop_101(xm)   idx always points to a 16-bit index
    ld   HL, 0x0000     ; 3:10      20 +loop_101(xm)   from.. +20 ..(0x1234)
    ld   BC, 20         ; 3:10      20 +loop_101(xm)   BC = step
    add  HL, BC         ; 1:11      20 +loop_101(xm)   HL = index+step
    ld  (idx101), HL    ; 3:16      20 +loop_101(xm)   save new index
    ld    A, low 0x1234-1; 2:7       20 +loop_101(xm)
    sub   L             ; 1:4       20 +loop_101(xm)
    ld    L, A          ; 1:4       20 +loop_101(xm)
    ld    A, high 0x1234-1; 2:7       20 +loop_101(xm)
    sbc   A, H          ; 1:4       20 +loop_101(xm)
    ld    H, A          ; 1:4       20 +loop_101(xm)   HL = (stop-1)-(index+step)
    add  HL, BC         ; 1:11      20 +loop_101(xm)   HL = (stop-1)-index
    pop  HL             ; 1:10      20 +loop_101(xm)
    jp   nc, do101      ; 3:10      20 +loop_101(xm)
leave101:               ;           20 +loop_101(xm)
exit101:                ;           20 +loop_101(xm)
; seconds: 1           ;[31:149]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from) DO PUSH(-20) ADDLOOP'
    ld   BC, from       ; 3:10      0x1234 from do_101(xm)
do101save:              ;           0x1234 from do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 from do_101(xm)
do101:                  ;           0x1234 from do_101(xm)
                       ;[24:119]    -20 +loop_101(xm)   variant variable: negative step 3..n
    push HL             ; 1:11      -20 +loop_101(xm)
idx101 EQU $+1          ;           -20 +loop_101(xm)   idx always points to a 16-bit index
    ld   HL, 0x0000     ; 3:10      -20 +loop_101(xm)   from.. -20 ..0x1234
    ld   BC, 0-20       ; 3:10      -20 +loop_101(xm)   BC = step
    add  HL, BC         ; 1:11      -20 +loop_101(xm)   HL = index+step
    ld  (idx101), HL    ; 3:16      -20 +loop_101(xm)   save new index
    ld    A, low 0x1234-1; 2:7       -20 +loop_101(xm)
    sub   L             ; 1:4       -20 +loop_101(xm)
    ld    L, A          ; 1:4       -20 +loop_101(xm)
    ld    A, high 0x1234-1; 2:7       -20 +loop_101(xm)
    sbc   A, H          ; 1:4       -20 +loop_101(xm)
    ld    H, A          ; 1:4       -20 +loop_101(xm)   HL = (stop-1)-(index+step)
    add  HL, BC         ; 1:11      -20 +loop_101(xm)   HL = (stop-1)-index
    pop  HL             ; 1:10      -20 +loop_101(xm)
    jp    c, do101      ; 3:10      -20 +loop_101(xm)
leave101:               ;           -20 +loop_101(xm)
exit101:                ;           -20 +loop_101(xm)
; seconds: 1           ;[31:149]


U toho jsem se dival ze sice mam kod u "M" na "DO I", ale neni aktivovany. Protoze jak jsem to sjednotil, tak bych ho prvne musel dopsat pro vsechny varianty "R" i "S".
Tak jsem se kouknul na "R" a tam neni, ale uz jsem tam osetroval Pointer, coz je jeste vetsi neprijemnost nez "abc". Tohle nevyresi ani IF v prekladaci.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO LOOP'
    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                     ;[16:78/57/58] loop_101   variant +1.variable
idx101 EQU $+1          ;           loop_101   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      loop_101   (from_ptr).. -1 ..0x1234
    inc  BC             ; 1:6       loop_101   index--
    ld    A, 0x34       ; 2:7       loop_101   lo(real_stop)
    xor   C             ; 1:4       loop_101
    jp   nz, do101save  ; 3:10      loop_101
    ld    A, 0x12       ; 2:7       loop_101   hi(real_stop)
    xor   B             ; 1:4       loop_101
    jp   nz, do101save  ; 3:10      loop_101
leave101:               ;           loop_101
exit101:                ;           loop_101
; seconds: 1           ;[24:98]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO PUSH(-1) ADDLOOP'
    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                     ;[16:78/57/58] -1 +loop_101(xm)   variant -1.variable
idx101 EQU $+1          ;           -1 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -1 +loop_101(xm)   (from_ptr).. -1 ..0x1234
    dec  BC             ; 1:6       -1 +loop_101(xm)   index--
    ld    A, 0x33       ; 2:7       -1 +loop_101(xm)   lo(real_stop)
    xor   C             ; 1:4       -1 +loop_101(xm)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
    ld    A, 0x12       ; 2:7       -1 +loop_101(xm)   hi(real_stop)
    xor   B             ; 1:4       -1 +loop_101(xm)
    jp   nz, do101save  ; 3:10      -1 +loop_101(xm)
leave101:               ;           -1 +loop_101(xm)
exit101:                ;           -1 +loop_101(xm)
; seconds: 1           ;[24:98]

Pro +-2
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO PUSH(2) ADDLOOP'    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                     ;[17:61/82/62] 2 +loop_101(xm)   variant +2.variable
idx101 EQU $+1          ;           2 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      2 +loop_101(xm)   (from_ptr).. +2 ..(0x1234)
  if (((from_ptr)) & 1)
    inc  BC             ; 1:6       2 +loop_101(xm)   index++
    inc   C             ; 1:4       2 +loop_101(xm)   index++
  else
    inc   C             ; 1:4       2 +loop_101(xm)   index++
    inc  BC             ; 1:6       2 +loop_101(xm)   index++
  endif
    ld    A, C          ; 1:4       2 +loop_101(xm)
    xor  low  0x1234+(1&(((from_ptr))xor(0x1234))); 2:7       2 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      2 +loop_101(xm)
    ld    A, B          ; 1:4       2 +loop_101(xm)
    xor  high 0x1234+(1&(((from_ptr))xor(0x1234))); 2:7       2 +loop_101(xm)   hi(real_stop)
    jp   nz, do101save  ; 3:10      2 +loop_101(xm)
leave101:               ;           2 +loop_101(xm)
exit101:                ;           2 +loop_101(xm)
; seconds: 1           ;[27:112]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO PUSH(-2) ADDLOOP'
    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                     ;[17:61/82/62] -2 +loop_101(xm)   variant -2.variable
idx101 EQU $+1          ;           -2 +loop_101(xm)   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      -2 +loop_101(xm)   (from_ptr).. -2 ..0x1234
  if (((from_ptr)) & 1)
    dec   C             ; 1:4       -2 +loop_101(xm)   index--
    dec  BC             ; 1:6       -2 +loop_101(xm)   index--
  else
    dec  BC             ; 1:6       -2 +loop_101(xm)   index--
    dec   C             ; 1:4       -2 +loop_101(xm)   index--
  endif
    ld    A, C          ; 1:4       -2 +loop_101(xm)
    xor  low  0x1234-2+(1&(((from_ptr))xor(0x1234))); 2:7       -2 +loop_101(xm)   lo(real_stop)
    jp   nz, do101save  ; 3:10      -2 +loop_101(xm)
    ld    A, B          ; 1:4       -2 +loop_101(xm)
    xor  high 0x1234-2+(1&(((from_ptr))xor(0x1234))); 2:7       -2 +loop_101(xm)   hi(real_stop)
    jp   nz, do101save  ; 3:10      -2 +loop_101(xm)
leave101:               ;           -2 +loop_101(xm)
exit101:                ;           -2 +loop_101(xm)
; seconds: 1           ;[27:112]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO PUSH(20) ADDLOOP'
    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                       ;[24:119]    20 +loop_101(xm)   variant variable: positive step 3..n
    push HL             ; 1:11      20 +loop_101(xm)
idx101 EQU $+1          ;           20 +loop_101(xm)   idx always points to a 16-bit index
    ld   HL, 0x0000     ; 3:10      20 +loop_101(xm)   (from_ptr).. +20 ..(0x1234)
    ld   BC, 20         ; 3:10      20 +loop_101(xm)   BC = step
    add  HL, BC         ; 1:11      20 +loop_101(xm)   HL = index+step
    ld  (idx101), HL    ; 3:16      20 +loop_101(xm)   save new index
    ld    A, low 0x1234-1; 2:7       20 +loop_101(xm)
    sub   L             ; 1:4       20 +loop_101(xm)
    ld    L, A          ; 1:4       20 +loop_101(xm)
    ld    A, high 0x1234-1; 2:7       20 +loop_101(xm)
    sbc   A, H          ; 1:4       20 +loop_101(xm)
    ld    H, A          ; 1:4       20 +loop_101(xm)   HL = (stop-1)-(index+step)
    add  HL, BC         ; 1:11      20 +loop_101(xm)   HL = (stop-1)-index
    pop  HL             ; 1:10      20 +loop_101(xm)
    jp   nc, do101      ; 3:10      20 +loop_101(xm)
leave101:               ;           20 +loop_101(xm)
exit101:                ;           20 +loop_101(xm)
; seconds: 0           ;[32:159]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO PUSH(-20) ADDLOOP'
    ld   BC, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xm)
do101save:              ;           0x1234 (from_ptr) do_101(xm)
    ld  (idx101),BC     ; 4:20      0x1234 (from_ptr) do_101(xm)
do101:                  ;           0x1234 (from_ptr) do_101(xm)
                       ;[24:119]    -20 +loop_101(xm)   variant variable: negative step 3..n
    push HL             ; 1:11      -20 +loop_101(xm)
idx101 EQU $+1          ;           -20 +loop_101(xm)   idx always points to a 16-bit index
    ld   HL, 0x0000     ; 3:10      -20 +loop_101(xm)   (from_ptr).. -20 ..0x1234
    ld   BC, 0-20       ; 3:10      -20 +loop_101(xm)   BC = step
    add  HL, BC         ; 1:11      -20 +loop_101(xm)   HL = index+step
    ld  (idx101), HL    ; 3:16      -20 +loop_101(xm)   save new index
    ld    A, low 0x1234-1; 2:7       -20 +loop_101(xm)
    sub   L             ; 1:4       -20 +loop_101(xm)
    ld    L, A          ; 1:4       -20 +loop_101(xm)
    ld    A, high 0x1234-1; 2:7       -20 +loop_101(xm)
    sbc   A, H          ; 1:4       -20 +loop_101(xm)
    ld    H, A          ; 1:4       -20 +loop_101(xm)   HL = (stop-1)-(index+step)
    add  HL, BC         ; 1:11      -20 +loop_101(xm)   HL = (stop-1)-index
    pop  HL             ; 1:10      -20 +loop_101(xm)
    jp    c, do101      ; 3:10      -20 +loop_101(xm)
leave101:               ;           -20 +loop_101(xm)
exit101:                ;           -20 +loop_101(xm)
; seconds: 0           ;[32:159]

No a kdyz jsem se koukal na ty "R" varianty tak nikde se nepouzival ten trik s ukladanim zmenene hodnoty pocitadla uz v kodu DO pres do???save label,

Mel jsem tam DO rozdelene na "from" je nula, ukazatel a nebo jina hodnota. Pritom ukazatel mel kod uplne pripraveny pro to predelat ho. Takze jsem to predelal z
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH(from_ptr) DO(R) LOOP'
    exx                 ; 1:4       0x1234 from_ptr do_101(xr)   ( 0x1234 from_ptr -- ) ( R: -- from_ptr )
    dec  HL             ; 1:6       0x1234 from_ptr do_101(xr)
    ld  (HL),high from_ptr; 2:10      0x1234 from_ptr do_101(xr)
    dec   L             ; 1:4       0x1234 from_ptr do_101(xr)
    ld  (HL),low from_ptr; 2:10      0x1234 from_ptr do_101(xr)
    exx                 ; 1:4       0x1234 from_ptr do_101(xr)
do101:                  ;           0x1234 from_ptr do_101(xr)
    exx                 ; 1:4       loop_101(xr)
    ld    E,(HL)        ; 1:7       loop_101(xr)
    inc   L             ; 1:4       loop_101(xr)
    ld    D,(HL)        ; 1:7       loop_101(xr)
                       ;[11:42/16]  loop_101(xr)
    ld    A, 0x33       ; 2:7       loop_101(xr)
    cp    E             ; 1:4       loop_101(xr)   x[1] = 0x33
    jr   nz, $+7        ; 2:7/12    loop_101(xr)
    ld    A, 0x12       ; 2:7       loop_101(xr)
    xor   D             ; 1:4       loop_101(xr)   x[2] = 0x12
    jr    z, leave101   ; 2:7/12    loop_101(xr)   exit
    inc  DE             ; 1:6       loop_101(xr)   index++
    ld  (HL), D         ; 1:7       loop_101(xr)
    dec   L             ; 1:4       loop_101(xr)
    ld  (HL), E         ; 1:7       loop_101(xr)
    exx                 ; 1:4       loop_101(xr)
    jp   do101          ; 3:10      loop_101(xr)
leave101:               ;           loop_101(xr)
    inc  HL             ; 1:6       loop_101(xr)
    exx                 ; 1:4       loop_101(xr)   R:( index -- )
exit101:                ; 1:4       loop_101(xr)
; seconds: 0           ;[33:148]

na (aspon u kroku +1)
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x1234) PUSH((from_ptr)) DO(R) LOOP'
    exx                 ; 1:4       0x1234 (from_ptr) do_101(xr)   ( 0x1234 (from_ptr) -- ) ( R: -- (from_ptr) )
    dec  HL             ; 1:6       0x1234 (from_ptr) do_101(xr)
    ld   DE, (from_ptr) ; 4:20      0x1234 (from_ptr) do_101(xr)
do101save:              ;           0x1234 (from_ptr) do_101(xr)
    ld  (HL),D          ; 1:7       0x1234 (from_ptr) do_101(xr)
    dec   L             ; 1:4       0x1234 (from_ptr) do_101(xr)
    ld  (HL),E          ; 1:7       0x1234 (from_ptr) do_101(xr)
    exx                 ; 1:4       0x1234 (from_ptr) do_101(xr)
do101:                  ;           0x1234 (from_ptr) do_101(xr)
    exx                 ; 1:4       loop_101(xr)
    ld    E,(HL)        ; 1:7       loop_101(xr)
    inc   L             ; 1:4       loop_101(xr)
    ld    D,(HL)        ; 1:7       loop_101(xr)
    inc  DE             ; 1:6       loop_101(xr)   index++
                       ;[11:42/16]  loop_101(xr)
    ld    A, 0x34       ; 2:7       loop_101(xr)
    cp    E             ; 1:4       loop_101(xr)   x[1] = 0x34
    jr   nz, $+7        ; 2:7/12    loop_101(xr)
    ld    A, 0x12       ; 2:7       loop_101(xr)
    xor   D             ; 1:4       loop_101(xr)   x[2] = 0x12
    jp   nz, do101save  ; 3:10      loop_101(xr)
leave101:               ;           loop_101(xr)
    inc  HL             ; 1:6       loop_101(xr)
    exx                 ; 1:4       loop_101(xr)   R:( index -- )
exit101:                ; 1:4       loop_101(xr)
; seconds: 0           ;[29:133]

Takhle by to slo udelat vsude. Kod bude kratsi, ale DO bude o 4 takty pomalejsi. Celkove vlastne jen 2 takty pomalejsi, protoze je tam skok za 10 misto za 12. Takze u jednoho opakovani je to rychlostne stejne a pak jen rychlejsi.

Jeste jsem se podival co by se stalo kdyby to koncilo v nule a moc se mi to nelibilo, protoze tam uz to zacina drit mit DO nastavene jak je. Musel jsem udelat nejakou kombinaci puvodni varianty a nove.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0) PUSH((from_ptr)) DO(R) LOOP'
    exx                 ; 1:4       0 (from_ptr) do_101(xr)   ( 0 (from_ptr) -- ) ( R: -- (from_ptr) )
    dec  HL             ; 1:6       0 (from_ptr) do_101(xr)
    ld   DE, (from_ptr) ; 4:20      0 (from_ptr) do_101(xr)
do101save:              ;           0 (from_ptr) do_101(xr)
    ld  (HL),D          ; 1:7       0 (from_ptr) do_101(xr)
    dec   L             ; 1:4       0 (from_ptr) do_101(xr)
    ld  (HL),E          ; 1:7       0 (from_ptr) do_101(xr)
    exx                 ; 1:4       0 (from_ptr) do_101(xr)
do101:                  ;           0 (from_ptr) do_101(xr)
    exx                 ; 1:4       loop_101(xr)
    inc (HL)            ; 1:11      loop_101(xr)   lo(index)++
    jp   nz, do101-1    ; 3:10      loop_101(xr)
    inc   L             ; 1:4       loop_101(xr)
    inc (HL)            ; 1:11      loop_101(xr)   hi(index)++
    jr    z, leave101   ; 2:7/12    loop_101(xr)   exit
    dec   L             ; 1:4       loop_101(xr)
    jp   do101-1        ; 3:10      loop_101(xr)
leave101:               ;           loop_101(xr)
    inc  HL             ; 1:6       loop_101(xr)
    exx                 ; 1:4       loop_101(xr)   R:( index -- )
exit101:                ; 1:4       loop_101(xr)
; seconds: 0           ;[26:127]

Ale asi je lepsi zpusob udelat na konci DO tesne pred EXX
Kód:
    inc   L             ; 1:4       0 (from_ptr) do_101(xr)
    dec   L             ; 1:4       0 (from_ptr) do_101(xr)

Spomalit to tak o 8 taktu, ale pak uz skakat bez meziskoku na leave101[/code]

Ty smycky jsou fakt komplikovane a budu to muset projit vsude a overit si ze to jde (a neni to horsi varianta), nez se odvazim zmenit to DO na ukladani pocitadla.

_________________
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: 05.05.2023, 17:07 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Pri vylepsovani smycek u kterych znam vsechny 3 parametry (i kdyby to byl pointer), tedy zacatek, konec a krok. Konkretneji R varianta, co prezije rekurzi, protoze si uklada promenne na RAS jsem mel trik u kroku +-1, kdy zjistuji ze opakovani je mensi nez 256x takze mohu testovat jen dolnich 8 bitu indexu na shodu s koncem. Nechtel jsem delat analyzu smycky, ale neco primitivnejsiho.

Mel jsem to udelane (krok +1) jako

__HEX_L(end-(begin)<=256) == 0x01

To "=" je bezpecne pokud pred porovnanim udelam prvne index++

__HEX_L vraci 0x00 nebo 0x01 nebo "" kdyz to neumi spocitat, protoze je to treba pointer nebo je tam jen jmeno promenne.

Ale vubec me nedoslo ze ta podminka je spatne a neco ji chybi, teprve az kdyz jsem potreboval vyvolat dlouhou variantu a porad se me ukazovala optimalizovana me to az pri testovani trklo. A to az po delsi dobe, kdy jsem nechapal ze me neco vrati TRUE a kdyz to drobne upravim tak spravne FALSE.

Proste jsem zapomnel ze zaporna cisla jsou mensi a rovna 256.

fungovalo by to teprve kdybych tam mel uvnitr dalsi fci

__HEX_L(__HEX_HL(end-(begin))<=256)) == 0x01

protoze __HEX_HL by me -1 prevadela na 0xFFFF.

To by ale nefungovalo, protoze v te casti jeste nenam rozdelene zda vstup je ukazatel, neznama nebo cislo.

A vsechny __HEX_neco fce vraci prazdny retezec kdyz to neumi spocitat, takze bych se nekdy dostal do

__HEX_L(<=256) == 0x01

a __HEX_L neni tak chytra aby me tohle odchytla, takze by to poslala na eval a az ten by slelhal s vypisem chyby na stderr. Nakonec by se to teda vyhodnotilo spravne, ale s chybou.

Nakonec jsem to rozdelil na 2 podminky, kde dodatecna podminka je __HEX_L(end>begin) == 0x01


PS: Chyba v tisku retezce je tam stale, je to neprijemne protoze u testovani jsem tiskl neco jako "2.I" a me se ten retezec nekde odescapuje a z I udela slovo pro nacteni indexu. V M4 se to fakt blbe debuguje. Jediny co me napadlo misto I tam dat _$(0) aby me to vypsalo makro a napsalo to:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PRINT({"_$0($@)"})'
    push DE             ; 1:11      print     "_$0($@)"
    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

STRING_SECTION:
string101:
    db "___STRING_STACK()"
size101              EQU $ - string101
; seconds: 0           ;[11:58]

Ale to moc nepomohlo. Takze jsem I zmenil na i a zatim to nechal na dobu az budu mit dost vule se nekolik hodin tyrat a hledat kde to je a pak jak to opravit.

PPS: Jinak ta neuplna podminka u smycky prosla uspesne uplne vsemi testy!!! Vsude jsem mel opakovani 5x,100x,1000x.

_________________
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.05.2023, 02:48 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Uvedomil jsem si ze ta podminka je stale spatne, protoze vstup muze byt jak -5 tak treba 0xFFFB a pak to selze...

Takze nakonec jsem upravil makro pro testovani zda je parametr cislo... pridal jsem 2 radky

__{}eval( regexp({$1},{^[ ]*[<>=*/]}) == 0 ),{1},{0},dnl # math operator for two variables, but the left is missing
__{}eval( regexp({$1},{[<>=+-/*][ ]*$}) != -1 ),{1},{0},dnl # math operator for two variables, but the right is missing

prvni zjistuje zda to nezacina (ignoruje mezery) < nebo > nebo = nebo * nebo /
druhy dela to same jen pro konec a pridava kontrolu pro + a -

Tady je problem ze +- muze byt i unarni a nejde tak poznat zda to uz neni chyba

Takze ted kdyz udelam

__HEX_L(__HEX_HL(__HEX_HL(konec)-__HEX_HL(pocatek))<=256)

mimochodem __HEX_HL(-) = ""

Tak to funguje spravne pokud je konec a pocatek cislo v jakemkoliv formatu.
Spravne failne pokud je pocatek cokoliv mimo cislo.
Pokud je ale konec cokoliv mimo cislo tak je problem.

Protoze pokud se za pocatek dosadi napriklad -200 tak vysledek bude:

__HEX_L(__HEX_HL(-0xFF38)<=256)
__HEX_L(0x00C8<=256)
0x01

Nastesti jsem si uvedomil, ze u toho konce nemenim znamenko a nemusim to prevadet na 16 bitovy hex format.

__HEX_L(__HEX_HL(konec-__HEX_HL(pocatek))<=256)

uz funguje spravne pro jakykoliv vstup. (snad)

Hmmm... vlastne by ted melo stacit i

__HEX_L(__HEX_HL(konec-(pocatek))<=256)

PS: Takze nakonec jsem ani nemusel menit to makro na zjisteni cisla a mohl rovnou napsat

__HEX_L((0xFFFF &(konec-(pocatek)))<=256)

_________________
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: 07.05.2023, 05:03 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Podarilo se mi aspon castecne opravit tisk retezce.

Sice jsem nenasel chybu, ale aspon jsem se to pokusil fixnout, ze jsem postupne pridaval {} na ruzna mista, a nakonec nasel jedno vhodne.
Tim me ale vylezl vysledek taky zazavorkovany, takze jsem upravil jen konecny vystup, abych to zrusil az tam.

Pak jsem jeste musel predelat vsechny vychytavky kde u vsech typu retezcu kontroluji zda to nekoncni nejak takto

"retezec", "" , "" , ""

co se opravi na "retezec".

U ukonceni nulou se jeste pridava "retezec",0

A u ukonceni na 7 bit se "odsekne" posledni znak a pricite +0x80. Neco jako "reteze","c"+0x80. Tam se jeste resi zda to uz neni rozsekane a nebo zda to neni pole cisel.

Moc jsem se s tim nestval a do regularniho vyrazu jsme zmenil zacatek na ^{ a konec na }$. Obalil vysledek {} a nejak to funguje.

Jeste jsem tam nasel chybu kdy jsme, pridal do regularniho vyrazu u konce mozny vyskyt mezery protoze me to

Kód:
zmenilo "retezec","","" -na-> "retezec"

ale

"retezec",   "" ,   "" -selhalo-na-nic->


Takze skoro vse funguje a dokaze me to najit shodne retezce atd.

Jen... jsem nasel jednu chybu a mozna tam byla i driv...

PRINT({"DO I LOOOP"}) me v pohode vytiskne a nic me neutece z retezce a nemeni na tokeny.

Ale jakmile tam dam neco jako $1 nebo $@ nebo $# tak se to aktivuje. I kdyz to obalim nekolikrat.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PRINT_I({"DO I LOOP"   ,   "" ,"" ,  ""  ,}) PRINT_I({"DO I LOOP"})'
    ld   BC, string101  ; 3:10      print_i   Address of string101 ending with inverted most significant bit
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string101  ; 3:10      print_i   Address of string102 ending with inverted most significant bit == string101
    call PRINT_STRING_I ; 3:17      print_i
;------------------------------------------------------------------------------
; Print string ending with inverted most significant bit
; In: BC = addr string_imsb
; Out: BC = addr last_char + 1
    rst   0x10          ; 1:11      print_string_i   putchar(reg A) with ZX 48K ROM
PRINT_STRING_I:         ;           print_string_i
    ld    A,(BC)        ; 1:7       print_string_i
    inc  BC             ; 1:6       print_string_i
    or    A             ; 1:4       print_string_i
    jp    p, $-4        ; 3:10      print_string_i
    and  0x7f           ; 2:7       print_string_i
    rst   0x10          ; 1:11      print_string_i   putchar(reg A) with ZX 48K ROM
    ret                 ; 1:10      print_string_i

STRING_SECTION:
string102   EQU  string101
  size102   EQU    size101
string101:
    db "DO I LOO","P" + 0x80
size101              EQU $ - string101
; seconds: 0           ;[23:120]

_________________
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: 08.05.2023, 01:03 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Udelal jsem nove slovo pro tisk n-bajtoveho dekadickeho pointeru, protoze jsem se uz sam v tom starem nevyznal.

Bylo to na me nejak moc slozite ten popis... .)
Puvodne na zasobniku vyzadoval 3 ukazatele.

TOS=ukazatel na pomocne cislo
NOS=to co se bude tisknout
NNOS=ukazatel na cislo 10 (kterym se to postupne deli)

Po tisku je zasobnik stejny. Ale... pomocne cislo je nastaveno na nula a to co se tiskne je jedina cifra a to nejvyssi rad puvodniho cisla.

Kdyz jsem se to ted pokousel pouzit tak to byl strasne slozite a to jsem jeste vytvoril nejaka dalsi pomocna slova diky tomu, protoze jsem nasel nejake kombinace co by se zrovna hodily a jeste jsem je nemel.

Takze jsem udelal slovo ktere ma na zasobniku jen ukazatel na co chce tisknout, s tim ze ta hodnota je premazana stejne jako v prvnim pripade a to co se drive cetlo z NOS a NNOS je ted dalsi parametr.
Moc lepe to nejde udelat, protoze kvuli nejakemu pomocnemu cislu nebudu alokovat tu pamet s tim ze uz nikde nepujde pouzit, takhle to ma programator pod kontrolou.
Ukazatel na 10 je taky promenna. To same co predchozi, plus navic kdyz je tam treba 8 tak to tiskne oktalove.

A hlavne ta slozitost s zonglovanim na zasobniku fakt klesla na minimum.

Puvodne: https://pastebin.com/PvY3EDri

ted:
Kód:
include(`../M4/FIRST.M4')dnl
ORG 0x8000
INIT(60000)
define({USE_FONT_5x8})

PCONSTANT(22,10,_10)
PCONSTANT(22,99,_99)
PCONSTANT(22,0, _tmp_print)
PCONSTANT(22,0, _tmp2)
PPUSH_VALUE(22,99,_tmp3)

PUSH(_99)
PUSH(_tmp3)
PUSH(_tmp2)

PUSH(20) FOR

dnl #PUMUL(b)   ( p3 p2 p1 -- p3 p2 p1 )   [p1] = [p3] * [p2]
    PUMUL(22)

dnl # ( 99 old new -- 99 new old new old )

    _2DUP SWAP
   
dnl # ( 99 new old new old -- 99 new old )

   PUSH(22) MOVE
   
dnl # ( 99 new old -- 99 new old )
dnl # DEC_PUDOT(b)   ( p1 -- p1 )   print [p1], [p1]=first_number
   
   DEC_PUDOT(22,_10,_tmp_print) CR

NEXT
 
DROP DROP DROP
DEPTH UDOT CR

STOP


Příloha:
mul99.png
mul99.png [ 4.19 KiB | Zobrazeno 1215 krát ]


PS: Ale stale si jeste nejsem jisty zda bych napriklad uz v tom prvnim slove nemel mit prohozeny TOS s NOS a v druhem zda bych nemel kopirovat tu tisknutou hodnotu, aby se zachovala.

_________________
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: 08.05.2023, 16:27 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Opravil jsem situaci kdy mam vic jak jedno PUSH a za tim FOR.
Ted uz to rozsekne PUSHS na dve casti a posledni hodnotu prida k PUSH_FOR. Zapomnel jsem to udelat v tokenovych pravidlech.
Pred:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(alfa) PUSH(from) FOR NEXT'
                        ;[8:42]     alfa from   ( -- alfa from )
    push DE             ; 1:11      alfa from
    push HL             ; 1:11      alfa from
    ld   DE, alfa       ; 3:10      alfa from
    ld   HL, from       ; 3:10      alfa from
    ld    B, H          ; 1:4       for_101   ( i -- )
    ld    C, L          ; 1:4       for_101
    ex   DE, HL         ; 1:4       for_101
    pop  DE             ; 1:10      for_101   index
for101:                 ;           for_101
    ld  (idx101),BC     ; 4:20      for_101   save index
idx101 EQU $+1          ;           next_101
    ld   BC, 0x0000     ; 3:10      next_101   idx always points to a 16-bit index
    ld    A, B          ; 1:4       next_101
    or    C             ; 1:4       next_101
    dec  BC             ; 1:6       next_101   index--, zero flag unaffected
    jp   nz, for101     ; 3:10      next_101
leave101:               ;           next_101
; seconds: 0           ;[25:118]

Po:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(alfa) PUSH(from) FOR NEXT'
    push DE             ; 1:11      alfa from drop
    ex   DE, HL         ; 1:4       alfa from drop
    ld   HL, alfa       ; 3:10      alfa from drop
    ld   BC, from       ; 3:10      from for_101   ( -- )
for101:                 ;           from for_101
    ld  (idx101),BC     ; 4:20      from for_101   save index
idx101 EQU $+1          ;           next_101
    ld   BC, 0x0000     ; 3:10      next_101   idx always points to a 16-bit index
    ld    A, B          ; 1:4       next_101
    or    C             ; 1:4       next_101
    dec  BC             ; 1:6       next_101   index--, zero flag unaffected
    jp   nz, for101     ; 3:10      next_101
leave101:               ;           next_101
; seconds: 1           ;[21:89]


Vsiml jsem si toho kdyz jsem se dival na ten predchozi kod pro opakovane nasobeni 99. Jak je tam to
Kód:
PUSH(_99)
PUSH(_tmp3)
PUSH(_tmp2)

PUSH(20) FOR

Je tam jeste stale neco spatne v tom pocitani bajtu a taktu, ted to ukazuje spravne [8:42], ale v tom nasobeni ne. Asi jsem zapomnel jen neco vynulovat. Ale uz me zvoni budik do prace, takze umyvani nadobi ma prednost. Hmm... ale mozna je to jen soucet k predchozimu slovu.


Přílohy:
Snímek obrazovky_2023-05-08_15-35-48.png
Snímek obrazovky_2023-05-08_15-35-48.png [ 85.99 KiB | Zobrazeno 1185 krát ]

_________________
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: 10.05.2023, 00:54 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Opravil jsem zpusob jaky me generoval M4 Forth hodnotu do pameti.

PPUSH_VALUE(20,0,name)

Nejak me kdyz jsem to delal nedosla jedna vec. Delal jsem analyzu co tam vkladam, zda to neni nejaka posloupnost. Zda se nezvysuje nebo nesnizuje treba jen dolni bajt, nebo horni bajt, atd. A ukoncil to tim kdy jsou vsechny hodnoty stejne.

Pak jsem se pred dvema dny dival co me to generuje u nuly a nestacil se divit.
Prekladac nasel shodu, ze kazda nasledujici hodnota je dvojnasobkem predchozi a tak to pekne vygeneroval.
Vubec mu nevadilo ze jsou to vsechno nuly.

_________________
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: 12.05.2023, 02:23 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Pridal jsem dalsi smycky pokud pri inicializaci dat se zjisti ze je to nejaka posloupnost.

Pokud je to +1 a konci to v jednicce jde usetrit 2 bajty za nastavovani registru A, protoze se nemusi vubec pouzit a pocitadlo smycky je rovnou ukladanou hodnotou. Ale zase smycka je pomalejsi protoze je to djnz.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0533,0x0433,0x0333,0x0233,0x0133)'
X                    EQU __create_X
    push HL             ; 1:11      0x0533 , 0x0433 , ... 0x0133 ,   step:-256 to hi=1
    ld   HL, __create_X ; 3:10      0x0533 , 0x0433 , ... 0x0133 ,
    ld   BC, 0x0533     ; 3:10      0x0533 , 0x0433 , ... 0x0133 ,
    ld  (HL),C          ; 1:7       0x0533 , 0x0433 , ... 0x0133 ,
    inc  HL             ; 1:6       0x0533 , 0x0433 , ... 0x0133 ,
    ld  (HL),B          ; 1:7       0x0533 , 0x0433 , ... 0x0133 ,
    inc  HL             ; 1:6       0x0533 , 0x0433 , ... 0x0133 ,
    djnz $-4            ; 2:8/13    0x0533 , 0x0433 , ... 0x0133 ,
    pop  HL             ; 1:10      0x0533 , 0x0433 , ... 0x0133 ,
                        ;[14:231]   0x0533 , 0x0433 , ... 0x0133 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0533           ;           0x0533 comma
    dw 0x0433           ;           0x0433 comma
    dw 0x0333           ;           0x0333 comma
    dw 0x0233           ;           0x0233 comma
    dw 0x0133           ;           0x0133 comma
; seconds: 1           ;[14:75]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x3305,0x3304,0x3303,0x3302,0x3301)'
X                    EQU __create_X
    push HL             ; 1:11      0x3305 , 0x3304 , ... 0x3301 ,   step:-1 to 1
    ld   HL, __create_X ; 3:10      0x3305 , 0x3304 , ... 0x3301 ,
    ld   BC, 0x0533     ; 3:10      0x3305 , 0x3304 , ... 0x3301 ,
    ld  (HL),B          ; 1:7       0x3305 , 0x3304 , ... 0x3301 ,
    inc  HL             ; 1:6       0x3305 , 0x3304 , ... 0x3301 ,
    ld  (HL),C          ; 1:7       0x3305 , 0x3304 , ... 0x3301 ,
    inc  HL             ; 1:6       0x3305 , 0x3304 , ... 0x3301 ,
    djnz $-4            ; 2:8/13    0x3305 , 0x3304 , ... 0x3301 ,
    pop  HL             ; 1:10      0x3305 , 0x3304 , ... 0x3301 ,
                        ;[14:231]   0x3305 , 0x3304 , ... 0x3301 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x3305           ;           0x3305 comma
    dw 0x3304           ;           0x3304 comma
    dw 0x3303           ;           0x3303 comma
    dw 0x3302           ;           0x3302 comma
    dw 0x3301           ;           0x3301 comma
; seconds: 0           ;[14:75]


Pokud to zacina v jednicce tak to same jen se to uklada odzadu.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0133,0x0233,0x0333,0x0433,0x0533)'
X                    EQU __create_X
    push HL             ; 1:11      0x0133 , 0x0233 , ... 0x0533 ,   step:+256 from hi=1
    ld   HL, __create_X+9; 3:10      0x0133 , 0x0233 , ... 0x0533 ,
    ld   BC, 0x0533     ; 3:10      0x0133 , 0x0233 , ... 0x0533 ,
    ld  (HL),B          ; 1:7       0x0133 , 0x0233 , ... 0x0533 ,
    dec  HL             ; 1:6       0x0133 , 0x0233 , ... 0x0533 ,
    ld  (HL),C          ; 1:7       0x0133 , 0x0233 , ... 0x0533 ,
    dec  HL             ; 1:6       0x0133 , 0x0233 , ... 0x0533 ,
    djnz $-4            ; 2:8/13    0x0133 , 0x0233 , ... 0x0533 ,
    pop  HL             ; 1:10      0x0133 , 0x0233 , ... 0x0533 ,
                        ;[14:231]   0x0133 , 0x0233 , ... 0x0533 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0133           ;           0x0133 comma
    dw 0x0233           ;           0x0233 comma
    dw 0x0333           ;           0x0333 comma
    dw 0x0433           ;           0x0433 comma
    dw 0x0533           ;           0x0533 comma
; seconds: 0           ;[14:75]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x3301,0x3302,0x3303,0x3304,0x3305)'
X                    EQU __create_X
    push HL             ; 1:11      0x3301 , 0x3302 , ... 0x3305 ,   step:+1 from 1
    ld   HL, __create_X+9; 3:10      0x3301 , 0x3302 , ... 0x3305 ,
    ld   BC, 0x0533     ; 3:10      0x3301 , 0x3302 , ... 0x3305 ,
    ld  (HL),C          ; 1:7       0x3301 , 0x3302 , ... 0x3305 ,
    dec  HL             ; 1:6       0x3301 , 0x3302 , ... 0x3305 ,
    ld  (HL),B          ; 1:7       0x3301 , 0x3302 , ... 0x3305 ,
    dec  HL             ; 1:6       0x3301 , 0x3302 , ... 0x3305 ,
    djnz $-4            ; 2:8/13    0x3301 , 0x3302 , ... 0x3305 ,
    pop  HL             ; 1:10      0x3301 , 0x3302 , ... 0x3305 ,
                        ;[14:231]   0x3301 , 0x3302 , ... 0x3305 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x3301           ;           0x3301 comma
    dw 0x3302           ;           0x3302 comma
    dw 0x3303           ;           0x3303 comma
    dw 0x3304           ;           0x3304 comma
    dw 0x3305           ;           0x3305 comma
; seconds: 0           ;[14:75]

Pridal jsem identifikaci i kdyz je ten prirustek jiny nez +-1. A pro +-2 udelal vlastni kod, to se muze hodit a zase jde pouzit djnz.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0933,0x0733,0x0533,0x0333,0x0133)'
X                    EQU __create_X
    push HL             ; 1:11      0x0933 , 0x0733 , ... 0x0133 ,   step:-512 to hi=2
    ld   HL, __create_X ; 3:10      0x0933 , 0x0733 , ... 0x0133 ,
    ld   BC, 0x0A33     ; 3:10      0x0933 , 0x0733 , ... 0x0133 ,
    dec   B             ; 1:4       0x0933 , 0x0733 , ... 0x0133 ,
    ld  (HL),C          ; 1:7       0x0933 , 0x0733 , ... 0x0133 ,
    inc  HL             ; 1:6       0x0933 , 0x0733 , ... 0x0133 ,
    ld  (HL),B          ; 1:7       0x0933 , 0x0733 , ... 0x0133 ,
    inc  HL             ; 1:6       0x0933 , 0x0733 , ... 0x0133 ,
    djnz $-5            ; 2:8/13    0x0933 , 0x0733 , ... 0x0133 ,
    pop  HL             ; 1:10      0x0933 , 0x0733 , ... 0x0133 ,
                        ;[15:251]   0x0933 , 0x0733 , ... 0x0133 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0933           ;           0x0933 comma
    dw 0x0733           ;           0x0733 comma
    dw 0x0533           ;           0x0533 comma
    dw 0x0333           ;           0x0333 comma
    dw 0x0133           ;           0x0133 comma
; seconds: 1           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x3309,0x3307,0x3305,0x3303,0x3301)'
X                    EQU __create_X
    push HL             ; 1:11      0x3309 , 0x3307 , ... 0x3301 ,   step:-2 to 2
    ld   HL, __create_X ; 3:10      0x3309 , 0x3307 , ... 0x3301 ,
    ld   BC, 0x0A33     ; 3:10      0x3309 , 0x3307 , ... 0x3301 ,
    dec   B             ; 1:4       0x3309 , 0x3307 , ... 0x3301 ,
    ld  (HL),B          ; 1:7       0x3309 , 0x3307 , ... 0x3301 ,
    inc  HL             ; 1:6       0x3309 , 0x3307 , ... 0x3301 ,
    ld  (HL),C          ; 1:7       0x3309 , 0x3307 , ... 0x3301 ,
    inc  HL             ; 1:6       0x3309 , 0x3307 , ... 0x3301 ,
    djnz $-5            ; 2:8/13    0x3309 , 0x3307 , ... 0x3301 ,
    pop  HL             ; 1:10      0x3309 , 0x3307 , ... 0x3301 ,
                        ;[15:251]   0x3309 , 0x3307 , ... 0x3301 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x3309           ;           0x3309 comma
    dw 0x3307           ;           0x3307 comma
    dw 0x3305           ;           0x3305 comma
    dw 0x3303           ;           0x3303 comma
    dw 0x3301           ;           0x3301 comma
; seconds: 0           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0133,0x0333,0x0533,0x0733,0x0933)'
X                    EQU __create_X
    push HL             ; 1:11      0x0133 , 0x0333 , ... 0x0933 ,   step:+512 from hi=2
    ld   HL, __create_X+9; 3:10      0x0133 , 0x0333 , ... 0x0933 ,
    ld   BC, 0x0A33     ; 3:10      0x0133 , 0x0333 , ... 0x0933 ,
    dec   B             ; 1:4       0x0133 , 0x0333 , ... 0x0933 ,
    ld  (HL),C          ; 1:7       0x0133 , 0x0333 , ... 0x0933 ,
    dec  HL             ; 1:6       0x0133 , 0x0333 , ... 0x0933 ,
    ld  (HL),B          ; 1:7       0x0133 , 0x0333 , ... 0x0933 ,
    dec  HL             ; 1:6       0x0133 , 0x0333 , ... 0x0933 ,
    djnz $-5            ; 2:8/13    0x0133 , 0x0333 , ... 0x0933 ,
    pop  HL             ; 1:10      0x0133 , 0x0333 , ... 0x0933 ,
                        ;[15:251]   0x0133 , 0x0333 , ... 0x0933 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0133           ;           0x0133 comma
    dw 0x0333           ;           0x0333 comma
    dw 0x0533           ;           0x0533 comma
    dw 0x0733           ;           0x0733 comma
    dw 0x0933           ;           0x0933 comma
; seconds: 0           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x3301,0x3303,0x3305,0x3307,0x3309)'
X                    EQU __create_X
    push HL             ; 1:11      0x3301 , 0x3303 , ... 0x3309 ,   step:+2 from 2
    ld   HL, __create_X+9; 3:10      0x3301 , 0x3303 , ... 0x3309 ,
    ld   BC, 0x0A33     ; 3:10      0x3301 , 0x3303 , ... 0x3309 ,
    dec   B             ; 1:4       0x3301 , 0x3303 , ... 0x3309 ,
    ld  (HL),B          ; 1:7       0x3301 , 0x3303 , ... 0x3309 ,
    dec  HL             ; 1:6       0x3301 , 0x3303 , ... 0x3309 ,
    ld  (HL),C          ; 1:7       0x3301 , 0x3303 , ... 0x3309 ,
    dec  HL             ; 1:6       0x3301 , 0x3303 , ... 0x3309 ,
    djnz $-5            ; 2:8/13    0x3301 , 0x3303 , ... 0x3309 ,
    pop  HL             ; 1:10      0x3301 , 0x3303 , ... 0x3309 ,
                        ;[15:251]   0x3301 , 0x3303 , ... 0x3309 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x3301           ;           0x3301 comma
    dw 0x3303           ;           0x3303 comma
    dw 0x3305           ;           0x3305 comma
    dw 0x3307           ;           0x3307 comma
    dw 0x3309           ;           0x3309 comma
; seconds: 0           ;[15:79]


A obdobne to jde udelat i kdyz to konci nebo zacina na cisle 2.
Kód:
workin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0A33,0x0833,0x0633,0x0433,0x0233)'
X                    EQU __create_X
    push HL             ; 1:11      0x0A33 , 0x0833 , ... 0x0233 ,   step:-512 to hi=2
    ld   HL, __create_X ; 3:10      0x0A33 , 0x0833 , ... 0x0233 ,
    ld   BC, 0x0A33     ; 3:10      0x0A33 , 0x0833 , ... 0x0233 ,
    ld  (HL),C          ; 1:7       0x0A33 , 0x0833 , ... 0x0233 ,
    inc  HL             ; 1:6       0x0A33 , 0x0833 , ... 0x0233 ,
    ld  (HL),B          ; 1:7       0x0A33 , 0x0833 , ... 0x0233 ,
    inc  HL             ; 1:6       0x0A33 , 0x0833 , ... 0x0233 ,
    dec   B             ; 1:4       0x0A33 , 0x0833 , ... 0x0233 ,
    djnz $-5            ; 2:8/13    0x0A33 , 0x0833 , ... 0x0233 ,
    pop  HL             ; 1:10      0x0A33 , 0x0833 , ... 0x0233 ,
                        ;[15:251]   0x0A33 , 0x0833 , ... 0x0233 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0A33           ;           0x0A33 comma
    dw 0x0833           ;           0x0833 comma
    dw 0x0633           ;           0x0633 comma
    dw 0x0433           ;           0x0433 comma
    dw 0x0233           ;           0x0233 comma
; seconds: 0           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x330A,0x3308,0x3306,0x3304,0x3302)'
X                    EQU __create_X
    push HL             ; 1:11      0x330A , 0x3308 , ... 0x3302 ,   step:-2 to 2
    ld   HL, __create_X ; 3:10      0x330A , 0x3308 , ... 0x3302 ,
    ld   BC, 0x0A33     ; 3:10      0x330A , 0x3308 , ... 0x3302 ,
    ld  (HL),B          ; 1:7       0x330A , 0x3308 , ... 0x3302 ,
    inc  HL             ; 1:6       0x330A , 0x3308 , ... 0x3302 ,
    ld  (HL),C          ; 1:7       0x330A , 0x3308 , ... 0x3302 ,
    inc  HL             ; 1:6       0x330A , 0x3308 , ... 0x3302 ,
    dec   B             ; 1:4       0x330A , 0x3308 , ... 0x3302 ,
    djnz $-5            ; 2:8/13    0x330A , 0x3308 , ... 0x3302 ,
    pop  HL             ; 1:10      0x330A , 0x3308 , ... 0x3302 ,
                        ;[15:251]   0x330A , 0x3308 , ... 0x3302 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x330A           ;           0x330A comma
    dw 0x3308           ;           0x3308 comma
    dw 0x3306           ;           0x3306 comma
    dw 0x3304           ;           0x3304 comma
    dw 0x3302           ;           0x3302 comma
; seconds: 0           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x0233,0x0433,0x0633,0x0833,0x0A33)'
X                    EQU __create_X
    push HL             ; 1:11      0x0233 , 0x0433 , ... 0x0A33 ,   step:+512 from hi=2
    ld   HL, __create_X+9; 3:10      0x0233 , 0x0433 , ... 0x0A33 ,
    ld   BC, 0x0A33     ; 3:10      0x0233 , 0x0433 , ... 0x0A33 ,
    ld  (HL),C          ; 1:7       0x0233 , 0x0433 , ... 0x0A33 ,
    dec  HL             ; 1:6       0x0233 , 0x0433 , ... 0x0A33 ,
    ld  (HL),B          ; 1:7       0x0233 , 0x0433 , ... 0x0A33 ,
    dec  HL             ; 1:6       0x0233 , 0x0433 , ... 0x0A33 ,
    dec   B             ; 1:4       0x0233 , 0x0433 , ... 0x0A33 ,
    djnz $-5            ; 2:8/13    0x0233 , 0x0433 , ... 0x0A33 ,
    pop  HL             ; 1:10      0x0233 , 0x0433 , ... 0x0A33 ,
                        ;[15:251]   0x0233 , 0x0433 , ... 0x0A33 ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x0233           ;           0x0233 comma
    dw 0x0433           ;           0x0433 comma
    dw 0x0633           ;           0x0633 comma
    dw 0x0833           ;           0x0833 comma
    dw 0x0A33           ;           0x0A33 comma
; seconds: 0           ;[15:79]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'CREATE(X)PUSHS_COMMA(0x3302,0x3304,0x3306,0x3308,0x330A)'
X                    EQU __create_X
    push HL             ; 1:11      0x3302 , 0x3304 , ... 0x330A ,   step:+2 from 2
    ld   HL, __create_X+9; 3:10      0x3302 , 0x3304 , ... 0x330A ,
    ld   BC, 0x0A33     ; 3:10      0x3302 , 0x3304 , ... 0x330A ,
    ld  (HL),B          ; 1:7       0x3302 , 0x3304 , ... 0x330A ,
    dec  HL             ; 1:6       0x3302 , 0x3304 , ... 0x330A ,
    ld  (HL),C          ; 1:7       0x3302 , 0x3304 , ... 0x330A ,
    dec  HL             ; 1:6       0x3302 , 0x3304 , ... 0x330A ,
    dec   B             ; 1:4       0x3302 , 0x3304 , ... 0x330A ,
    djnz $-5            ; 2:8/13    0x3302 , 0x3304 , ... 0x330A ,
    pop  HL             ; 1:10      0x3302 , 0x3304 , ... 0x330A ,
                        ;[15:251]   0x3302 , 0x3304 , ... 0x330A ,

VARIABLE_SECTION:

__create_X:             ;
    dw 0x3302           ;           0x3302 comma
    dw 0x3304           ;           0x3304 comma
    dw 0x3306           ;           0x3306 comma
    dw 0x3308           ;           0x3308 comma
    dw 0x330A           ;           0x330A comma
; seconds: 0           ;[15:79]

_________________
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: 12.05.2023, 15:17 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Opravil jsem nejake smycky kdy se to uklada odzadu protoze to zacina na 1 nebo 2 (lo i hi bajt).

Mel jsme prohozeny B a C. Prvne se uklada totiz vzdy vyssi bajt (je posledni) a az pak nizsi, pokid adresu postupne snizujeme.

PS: a opravil jsem i popisky, kdy jsem mel "to 2" misto "to 1" pokud je krok 2.

_________________
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: 14.05.2023, 19:16 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Ten kod provadejici analyzu PUSHS_COMMA jsem nakonec, kvuli testovani preskupil a "opismenkoval", abych si byl jisty ze mam vsechny varianty.

Mohl jsem pro test vyuzit toho ze mam tu podporu "big number" a kazdou hodnotu jsem deklaroval 2x.
Jednou pres PCONSTANT(bytes,value,name), ktery jen vygeneruje "dw x,y,z" a pak pres PUSHS_VALUE(bytes,value,name), ktery navic provede inicializaci hodnot v te pameti, aby pri opakovanem spusteni se tam vratili puvodni hodnoty.

U toho jsem narazil na to ze PCONSTANT ma chybu kdyz se za "value" dosadi hexadecimalni hodnota. Pak vnitrne nevygenerovalo ctvrty parametr, co ma byt puvodni hodnota pouzivana pro komentar. Takze __ASM_TOKEN_PCONSTANT selhal a tvrdil ze mu chybi 4. parametr. Opraveno.

Dale jsem si vsiml, ze slovo __ASM({blablabla}) me taky rozbalovalo slova jako I J K a zacyklilo se. Opraveno, stejne jako retezce, pridal jsem 2x {{ }} a u konecnem tisku jeden odeberu..

Po case jsem si vsiml, ze me to __ASM pri vicenasobnem pouzivani vypisuje porad ten prvni. Takze opraveno chybne. .))) Nastesi jsem jen udelal chybu v te casti kde odebiram {}.
Delal jsem to pres to ze si deklaruji dalsi promennou/makro a tisknu az to.

define(TEMP,puvodni_vstup)
TEMP

kazde pouziti "puvodni_vstup" smaze jedno {} a chyba byla v tom ze jsem zapomnel TEMP dat do {}, takze se me zamnenil za prvni vstup. Spravne to je

define({TEMP},puvodni_vstup)
TEMP

Pri testovani jsem nasel nejake "vetve" co nebyly udelany a nektere zase 2x... lol
A u nekterych jsem mel ty chyby jak jsem neuhlidal kde je HI a kde LO.

Takze posledni chyba byla, ze me to zacalo obcas rvat neco jako

m4:psub.m4:54: bad expression in eval (excess input): 01330333053307330933
m4:psub.m4:63: bad expression in eval (excess input): 09330733053303330133

Protoze ta hodnota se prevadi na hex retezec bez "hlavicky".

Vedel jsem, ze me fce/makro __IS_NUM neco neodchytla. Premyslel jsem zda M4 vadi ze je to vic jak 64 bit, ale ne... Delalo to jen nekdy. Jakmile v cisle bylo A..F tak to nedelalo.

Kdyz se na to kouknete pozorne tak si vsimnete ze to zacina nulou a pak to obsahuje 9. Fajn, opraveno. snad bez nove chyby...

S timhle jsem ani nepocital, jakmile to neni pointer a pak to neni cislo tak je to proste jmeno promenne. Ale tady by mohlo zarvat pasmo, snad.

ld HL,0999

Hmm... tak pasmo to vezme ze je to dekadicky.

0000:21E703 LD HL, 03E7

To neni az tak spatne.

Příloha:
psub1.png
psub1.png [ 2.89 KiB | Zobrazeno 909 krát ]

Příloha:
psub2.png
psub2.png [ 2.94 KiB | Zobrazeno 909 krát ]


https://github.com/DW0RKiN/M4_FORTH/blob/master/Testing/psub.m4
https://github.com/DW0RKiN/M4_FORTH/blob/master/Testing/psub.asm

PS: Nektere kombinace by mozna jeste staly za to dodelat. Napriklad to posledni 0x112233445566778899AA je stale posloupnost. Jen v analyze tohle nezjistuji. Stacilo by najit 16 bitovou (posloupnost) a pak u toho zjistit ze ta je 8 bitova.

_________________
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: 14.05.2023, 23:38 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Lol, skoro po dvou letech jsem asi nasel zpusob jak se v M4 vyporadat s carkama a nechtenym rozbalovanim slov.

Pokud mam nejakou promennou ktera obsahuje text s carkama nebo dalsimi nazvy maker a s tou promennou musim pracovat a dopredu nevim kolikrat ji budu editovat a menit tak jsem mel problem.

Pokud jsem to vedel tak jsem mohl tu carku hodit do tolika {} kolik bylo potreba

napr:

define({__CODE_1},{
ex DE{{,}}HL})

...

define({__BEST_CODE},__CODE_1)


se me postupne ty zavorky rusi. Pri vypisu je to v M4 tak ze se pri pouziti pokazde jeden level zrusi a pokud by zbyl jen jeden tak ten se netiskne.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},x) X'
     x
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{x}) X'
     x
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{x}}) X'
     x
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{{x}}}) X'
     {x}
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{{{{x}}}}}) X'
     {{{x}}}
; seconds: 0           ;[ 0:0]


Kdyz je tam carka tak bude vyhodnocena v tom define a ten rekne ze na to kasle protoze ma vic jak 2 parametry a ze bude define ignorovano.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{{{{,}}}}}) X'
     {{{,}}}
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{{{,}}}}) X'
     {{,}}
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{{,}}}) X'
     {,}
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{,}}) X'
     ,
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{,}) X'
     ,
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},,) X'
m4:stdin:1: Warning: excess arguments to builtin `define' ignored
; seconds: 0           ;[ 0:0]


A me se nedarilo nijak obalit napriklad to makro X tak abych tam pridal dalsi {}, protoze kdyz to udelam tak vznikne dalsi chyba...
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{1,}) define({Y},{X}) define({X},{2,})  Y'
        2,
; seconds: 0           ;[ 0:0]

Carku to prezije, ale ta predavana hodnota uz nebude "1,", protoze to vzalo jako parametr zabaleny {X} a rozbali ho pozde.

A bez obaleni to spadne
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{1,}) define({Y},X) define({X},{2,})  Y'
m4:stdin:1: Warning: excess arguments to builtin `define' ignored
        1
; seconds: 0           ;[ 0:0]


Jen pokud zdroj obalim presne kolik potrebuji (+-1) tak
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{1,}}) define({Y},X) define({X},{{2,}})  Y'
        1,
; seconds: 0           ;[ 0:0]


A dnes me doslo jak jsem osetroval ty retezce, ze $1 atd se rozbaluje v jakekoliv hloubce zanoreni {}...

To znamena ze kdyz potrebuji neco obalit tak na to mohu mit makro, kde vstup bude jmeno makra ale v tom pomocnem makru uz mohu pouzit $1 jako prvni parametr a tam si to obalim kolikrat chci!

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({escaping},{{{$1}}}) define({X},{{1,}}) define({Y},escaping(X)) define({X},{{2,}})  Y X'
         1, 2,
; seconds: 0           ;[ 0:0]


2 roky me to trvalo! Jak jsem s tim v ruznych castech bojoval tak ted to mam zbytecne slozite a neefektivne a opravit to bude prace.

PS: Tohle je prukaznejsi
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({escaping},{{{$1}}}) define({X},{{1,}}) define({Y},escaping(X)) define({Z},escaping(Y)) define({A},escaping(Z)) define({X},{{2,}})  A Z Y X'
           1, 1, 1, 2,
; seconds: 0           ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({X},{{1,}}) define({Y},X) define({Z},Y) define({A},Z) define({X},{{2,}})  A Z Y X'
m4:stdin:1: Warning: excess arguments to builtin `define' ignored
          1 1 1, 2,
; seconds: 0           ;[ 0:0]

_________________
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: 17.05.2023, 01:50 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Predelal jsem novou metodou asi vsechny situace kdy se neco uklada do ALL_VARIABLE.
U toho jsem si vsimnul navic ze mam jeste bokem jeden pristup do ALL_VARIABLE a to v souboru ktery resi "komunikaci" s floating point aritmetikou romky ZX Spectra. Tam mam slovo ZVARIABLE (name,floating_point_value), ktere vytvori 5 bajtovou promennou a teda musi taky provest vsechnu omacku okolo, jako nastavit nove jmeno aktualniho labelu, ze uz ma alokovanych 5 bajtu atd.

Kdyz jsem to testoval tak jsem si neuvedomil, ze tohle jen alokuje to misto a ne, ze to haze hodnotu na zasobnik spektra, takze jsem se ve vypoctu dostal do situace, ze jsem podtekl a ZDEPTH me pak ukazoval -5/5 = 0xFFFB/5=13106. Misto aby ukazoval -1. Musel jsem pridat docela dost bajtu kodu abych tohle osetril... a u toho si overoval zda ve slove DEPTH to mam dobre.

No tam to spravne ukazuje -1 ale...

ALE JA NECHAPU PROC???

Protoze tam mam dejme tomu

-2/2=-1

A ja to resim tak, ze odectu dve 16 bitove cisla (vyskoci me carry) a udelam jen bitovy posun doprava.

Jenze prvni instrukce u HI bajtu (= reg. H) je:

srl H ; 2:8 depth

Takze by to nemelo fungovat! Mela by se tam vlozit do 7. bitu nula a z -2 (0xFE) udelat cislo +127 (0x7F).

Neco je spatne, aspon tohle tvrdi: https://clrhome.org/table/

Kód:
Opcode CB 3C
Bytes 2
Cycles 8
C as defined
N reset
P/V detects parity
H reset
Z as defined
S as defined
The contents of H are shifted right one bit position. The contents of bit 0 are copied to the carry flag and a zero is put into bit 7.


http://z80-heaven.wikidot.com/instructions-set:srl
Kód:
Like SRA, except a 0 is put into bit 7. The bits are all shifted right, with bit 0 put into the carry flag.

A u SRA rika
Kód:
Arithmetic shift right 1 bit, bit 0 goes to carry flag, bit 7 remains unchanged.
Coz tvrdi obe tabulky.


Pasmo me vygeneruje

802D:CB3C SRL H

takze opcode sedi

a FUSE me ukaze -1. Nechapu... Jeste teda muzu mit chybu v tisku cisla... (ale zkousel jsem i tisk pres hexadecimalni hodnotu a ukazuje to FFFF a to je uplne jiny typ rutiny)

Dival jsem se jak to mam u optimalizaci u ciselneho deleni dvema.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh '_2DIV'
    sra   H             ; 2:8       2/   with sign
    rr    L             ; 2:8       2/

To by melo sedet. U meho kodu by melo stacit zamenit "SRL H" za "RR H", protoze nemusim resit 15.bit cisla. Ve skutecnosti odcitam dve unsigned 16 bitove cisla a ze me vyskoci CARRY je nejdulezitejsi signal.

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'DEPTH'
                        ;[13:72]    depth   ( -- +n )
    push DE             ; 1:11      depth
    ex   DE, HL         ; 1:4       depth
    ld   HL,(Stop+1)    ; 3:16      depth
    or    A             ; 1:4       depth
    sbc  HL, SP         ; 2:15      depth
    srl   H             ; 2:8       depth !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    rr    L             ; 2:8       depth
    dec  HL             ; 1:6       depth
; seconds: 0           ;[13:72]


Ale proc to funguje i kdyz nema a kde delam chybu je stejne dulezite, protoze pak muzu mit zase neco naopak spatne i kdyz si myslim ze je to dobre...

PS:
Na zacatku zkontroluji ze mam v zasobniku nula polozek.
Vrznu tam 1234 a zkontroluji ze tam mam 1 polozku
Odstranim ji pres DROP a zkontroluji ze mam nula polozek
Odstranim dalsi (navratovou adresu do basicu, takze se program bugne) a zkontroluji ze tam mam -1 polozek (a fakt mam -1 a ne 0x7FFF, omg!)
Kód:
include(`../M4/FIRST.M4')dnl
ORG 0x8000
INIT(60000)


DEPTH HEX UDOT CR
PUSH(1234)
DEPTH HEX UDOT CR
DROP
DEPTH HEX UDOT CR
DROP
DEPTH HEX UDOT CR


STOP


Kód:
    ORG 0x8000



   

   

   

   




;   ===  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
                        ;[13:72]    depth   ( -- +n )
    push DE             ; 1:11      depth
    ex   DE, HL         ; 1:4       depth
    ld   HL,(Stop+1)    ; 3:16      depth
    or    A             ; 1:4       depth
    sbc  HL, SP         ; 2:15      depth
    srl   H             ; 2:8       depth
    rr    L             ; 2:8       depth
    dec  HL             ; 1:6       depth
    call PRT_HEX_U16    ; 3:17      hex u.   ( u -- )
    ex   DE, HL         ; 1:4       hex u.
    pop  DE             ; 1:10      hex u.
    ld    A, 0x0D       ; 2:7       cr   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      cr   putchar(reg A) with ZX 48K ROM
    push DE             ; 1:11      1234
    ex   DE, HL         ; 1:4       1234
    ld   HL, 1234       ; 3:10      1234
                        ;[13:72]    depth   ( -- +n )
    push DE             ; 1:11      depth
    ex   DE, HL         ; 1:4       depth
    ld   HL,(Stop+1)    ; 3:16      depth
    or    A             ; 1:4       depth
    sbc  HL, SP         ; 2:15      depth
    srl   H             ; 2:8       depth
    rr    L             ; 2:8       depth
    dec  HL             ; 1:6       depth
    call PRT_HEX_U16    ; 3:17      hex u.   ( u -- )
    ex   DE, HL         ; 1:4       hex u.
    pop  DE             ; 1:10      hex u.
    ld    A, 0x0D       ; 2:7       cr   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      cr   putchar(reg A) with ZX 48K ROM
    ex   DE, HL         ; 1:4       drop
    pop  DE             ; 1:10      drop   ( a -- )
                        ;[13:72]    depth   ( -- +n )
    push DE             ; 1:11      depth
    ex   DE, HL         ; 1:4       depth
    ld   HL,(Stop+1)    ; 3:16      depth
    or    A             ; 1:4       depth
    sbc  HL, SP         ; 2:15      depth
    srl   H             ; 2:8       depth
    rr    L             ; 2:8       depth
    dec  HL             ; 1:6       depth
    call PRT_HEX_U16    ; 3:17      hex u.   ( u -- )
    ex   DE, HL         ; 1:4       hex u.
    pop  DE             ; 1:10      hex u.
    ld    A, 0x0D       ; 2:7       cr   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      cr   putchar(reg A) with ZX 48K ROM
    ex   DE, HL         ; 1:4       drop
    pop  DE             ; 1:10      drop   ( a -- )
                        ;[13:72]    depth   ( -- +n )
    push DE             ; 1:11      depth
    ex   DE, HL         ; 1:4       depth
    ld   HL,(Stop+1)    ; 3:16      depth
    or    A             ; 1:4       depth
    sbc  HL, SP         ; 2:15      depth
    srl   H             ; 2:8       depth
    rr    L             ; 2:8       depth
    dec  HL             ; 1:6       depth
    call PRT_HEX_U16    ; 3:17      hex u.   ( u -- )
    ex   DE, HL         ; 1:4       hex u.
    pop  DE             ; 1:10      hex u.
    ld    A, 0x0D       ; 2:7       cr   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      cr   putchar(reg A) with ZX 48K ROM
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  =====
;------------------------------------------------------------------------------
;   Input: 16-bit unsigned number in HL
;   Output: Print Hex HL
; Pollutes: A
PRT_HEX_U16:            ;           prt_hex_u16
    ld    A, H          ;  1:4      prt_hex_u16
    call PRT_HEX_A      ;  3:17     prt_hex_u16
    ld    A, L          ;  1:4      prt_hex_u16
    ; fall to prt_hex_a
;------------------------------------------------------------------------------
;    Input: A
;   Output: 00 .. FF
; Pollutes: A
PRT_HEX_A:              ;           prt_hex_a
    push AF             ; 1:11      prt_hex_a
    rra                 ; 1:4       prt_hex_a
    rra                 ; 1:4       prt_hex_a
    rra                 ; 1:4       prt_hex_a
    rra                 ; 1:4       prt_hex_a
    call PRT_HEX_NIBBLE ; 3:17      prt_hex_a
    pop  AF             ; 1:10      prt_hex_a
    ; fall to prt_hex_nibble
;------------------------------------------------------------------------------
;    Input: A = number, DE = adr
;   Output: (A & $0F) => '0'..'9','A'..'F'
; Pollutes: AF, AF',BC',DE'
PRT_HEX_NIBBLE:         ;           prt_hex_nibble
    or      $F0         ; 2:7       prt_hex_nibble   reset H flag
    daa                 ; 1:4       prt_hex_nibble   $F0..$F9 + $60 => $50..$59; $FA..$FF + $66 => $60..$65
    add   A, $A0        ; 2:7       prt_hex_nibble   $F0..$F9, $100..$105
    adc   A, $40        ; 2:7       prt_hex_nibble   $30..$39, $41..$46   = '0'..'9', 'A'..'F'
    rst   0x10          ; 1:11      prt_hex_nibble   putchar(reg A) with ZX 48K ROM
    ret                 ; 1:10

Příloha:
depth.png
depth.png [ 754 bajtů | Zobrazeno 762 krát ]

_________________
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: 17.05.2023, 03:47 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Uz jsem to nasel... uplny nesmysl. Stacilo se podivat dal do kodu DEPTH. Nasleduje DEC HL... Proc jsem to resil tak slozite?

Omg! Tak je to jeste jinak...

V dobe kdy delam odecet mam uz zasobnik posunuty, protoze tam je udelane misto pro tu vyslednou hodnotu DEPTH. Takze pokud ma byt vysledek:

1 tak rozdil bude 4, c=0
0 tak rozdil bude 2, c=0
-1 tak rozdil bude 0, c=0
-2 tak rozdil bude -2, c=1
-3 tak rozdil bude -4. c=1

Tzn. ze jsem to mel stejne blbe, ale projevilo by se to az od -2, kde uz to vypisuje 0x7FFE misto 0xFFFE. Chtelo to vic testovat...

Takze DEC HL vraceno a zamena SRL za RR.

PS: Uz to vypisuje krasne

0001
0000
FFFF
FFFE
FFFD
FFFC

podle ocekavani a svet se vratil do normalu, lol.

_________________
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ů: 585 ]  Přejít na stránku Předchozí  1 ... 27, 28, 29, 30, 31, 32, 33 ... 39  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 3 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:  
cron
Založeno na phpBB® Forum Software © phpBB Group
Český překlad – phpBB.cz