OldComp.cz

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


Právě je 28.03.2024, 12:26

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 ... 10, 11, 12, 13, 14, 15, 16 ... 39  Další
Autor Zpráva
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.06.2022, 14:04 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Busy píše:
_dworkin píše:
Kód:
    jr   nz, $+18       ; 2:7/12    2dup 0x45352515 D<> if
Kam skoci to $+18 ? 18 je uz dost velka hodnota, uz to zacina byt neintuitivne a nachylne na chyby (clovek medzi tym nieco doplni a zabudne zmenit tu 18-ku). Podla mna, preto pouzivame asembler, aby sme taketo skoky nemuseli prepocitavat rucne. Navrhujem pozivat labely...
(vnutri makra samozrejme lokalne labely, ktore dnes uz vie kazdy poriadny asembler)


Tohle si nastesti pocita samo makro a skace samozrejme VZDY JEN UVNITR SEBE, a hranice slova je v kodu krasne videt podle zmeny komentaru. Musely by za sebou byt 2 stejna slova, aby to mohlo mast, a to se u techle slov nestava a i tak je tam ten uvodni radek se sumou taktu a bajtu.

Pokud si to budu rucne editovat, tak uz to chce mozna znat zakladni principy jak je to delane. Asi bych mohl pridat aspon komentar do popisu, kdyz uz ne label.

Ja ty lokalni labely v pasmu proste neumim..., proto pouzivam tenhle zapis. A snazim se udelat ten kod prelozitelny vsude. Predpokladam ze by to vyzadovalo neustele pridavani 2 radku, ktere by slova obalovala.

Jinak to makro si to pocita presne na konec sebe, ale da se to upravit pres parametry, protoze...

...to makro dela jen tu zakladni, shodnou cast a pak ji obalujeme dodatecnym kodem. Hezky je to asi videt na prikladu double EQ a double NE.

DEQ volam vnitrne takto ( jinak "dnl" je znacka pro komentar do konce radku, nic z toho nebude ve vysledku, zadne mezery, ani ten konec radku, zadne rozbalovnai maker atd.)
Kód:
dnl Prvne nadefinuji makra, ktera pouzije makro generujici kod jako globalni promenne.
dnl Neni to uplne ciste, ale prehlednejsi, puvodne to byly primo parametry.
dnl Mimochodem to nesmi obsahovat zadne carky, jinak mam problem a musim je pravdepodobne opakovane obalovat do {}.
dnl Tu carku co vidite je zrusena makrem format.
dnl
define({_TMP_INFO},{2dup $1 D= if})dnl
define({_TMP_STACK_INFO},{ _TMP_INFO   ( d1 -- d1 )   format({0x%08X},eval($1)) == DEHL})dnl
dnl
dnl Pak volam to makro generujici kod
dnl   1 parametr $1 se doplni na cislo na ktere to porovnavam
dnl   2 parametr je pocet dodatecnych bajtu co ma pricist k tomu prvnimu radku kde je sumace
dnl   3 parametr je pocet dodatecnych taktu co ma pricist k tomu prvnimu radku kde je sumace
dnl   4 parametr je pocet dodatecnych bajtu co ma pricist k relativnim skokum
dnl   5 parametr je pocet dodatecnych taktu co ma pricist k relativnim skokum u tomu prvnimu radku kde je sumace, zadavam zaporne cislo
dnl
____DEQ_MAKE_BEST_CODE($1,3,10,0,0){}dnl
dnl Ted uz jen zadam makro, ktere se nahradi za vygenerovany kod
_TMP_BEST_CODE
dnl Ted to obalim zespoda
; -----------------------
    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO

Bez komentaru to vypada takto
Kód:
define({_TMP_INFO},{2dup $1 D= if})dnl
define({_TMP_STACK_INFO},{ _TMP_INFO   ( d1 -- d1 )   format({0x%08X},eval($1)) == DEHL})dnl
____DEQ_MAKE_BEST_CODE($1,3,10,0,0){}dnl
_TMP_BEST_CODE
; -----------------------
    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO

A vysledek vypada takto
Kód:
               ;[21:75/33,51,69,75] 2dup 0x45352515 D= if   ( d1 -- d1 )   0x45352515 == DEHL
    ld    A, 0x15       ; 2:7       2dup 0x45352515 D= if
    cp    L             ; 1:4       2dup 0x45352515 D= if   x[1] = 0x15
    jr   nz, $+15       ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x25       ; 2:7       2dup 0x45352515 D= if
    cp    H             ; 1:4       2dup 0x45352515 D= if   x[2] = 0x25
    jr   nz, $+10       ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x35       ; 2:7       2dup 0x45352515 D= if
    cp    E             ; 1:4       2dup 0x45352515 D= if   x[3] = 0x35
    jr   nz, $+5        ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x45       ; 2:7       2dup 0x45352515 D= if
    xor   D             ; 1:4       2dup 0x45352515 D= if   x[4] = 0x45
; -----------------------
    jp   nz, else101    ; 3:10      2dup 0x45352515 D= if
                       ;[21:75]

Tohle by jeste stalo za komentar, protoze u tehle varianty chci nahradit relativni skoky primo skoky absolutnimy na "else101", aspon ten prvni skok, nebo to nastavit podle prepinace. Kod bude delsi a u TRUE varianty vzdy pomalejsi, ale u skoku rychlejsi. Uplne nejlepsi by bylo relativne skakat primo na "else101", a kdyz by to bylo mimo rozsah tak na to JP jako meziskok. Ale to je spis vlhky sen, o tom jsem nikdy neslysel, ze by to nejaky prekladac umel. Mit 2 parametry pro relativni skok.

DNE volam pres s bajty +3 a takty -10, protoze chci aby to skocilo az za JP, nepotrebuji zadny meziskok, vim ze skaci kousek dolu.
Kód:
define({_TMP_INFO},{2dup $1 D<> if})dnl
define({_TMP_STACK_INFO},{ _TMP_INFO   ( d1 -- d1 )   format({0x%08X},eval($1)) <> DEHL})dnl
____DEQ_MAKE_BEST_CODE($1,3,10,3,-10){}dnl
_TMP_BEST_CODE
; .......................
    jp    z, else{}IF_COUNT    ; 3:10      _TMP_INFO
; -----------------------

Vysledek vypada takto:
Kód:
               ;[21:75/23,41,59,75] 2dup 0x45352515 D<> if   ( d1 -- d1 )   0x45352515 <> DEHL
    ld    A, 0x15       ; 2:7       2dup 0x45352515 D<> if
    cp    L             ; 1:4       2dup 0x45352515 D<> if   x[1] = 0x15
    jr   nz, $+18       ; 2:7/12    2dup 0x45352515 D<> if
    ld    A, 0x25       ; 2:7       2dup 0x45352515 D<> if
    cp    H             ; 1:4       2dup 0x45352515 D<> if   x[2] = 0x25
    jr   nz, $+13       ; 2:7/12    2dup 0x45352515 D<> if
    ld    A, 0x35       ; 2:7       2dup 0x45352515 D<> if
    cp    E             ; 1:4       2dup 0x45352515 D<> if   x[3] = 0x35
    jr   nz, $+8        ; 2:7/12    2dup 0x45352515 D<> if
    ld    A, 0x45       ; 2:7       2dup 0x45352515 D<> if
    xor   D             ; 1:4       2dup 0x45352515 D<> if   x[4] = 0x45
; .......................
    jp    z, else101    ; 3:10      2dup 0x45352515 D<> if
; -----------------------
                       ;[21:75]

Jeste jedna informace k tomu generovanemu kodu je, ze pokud je nulovy priznak nastaven, tak vzdy je zaroven akumulator nulovy. Nikdy neni posledni instrukce CP, jen kdyz neni vysledek nula.

A v realite to dnes vypada ve skutecnosti takto pro slovo _2DUP_PUSHDOT_DEQ_IF.
Kód:
dnl
dnl 2dup D. D= if
dnl ( d -- d )
define({_2DUP_PUSHDOT_DEQ_IF},{dnl
__{}define({IF_COUNT}, incr(IF_COUNT))dnl
__{}pushdef({ELSE_STACK}, IF_COUNT)dnl
__{}pushdef({THEN_STACK}, IF_COUNT)dnl
__{}define({_TMP_INFO},{2dup $1 D= if})dnl
__{}define({_TMP_STACK_INFO},{ _TMP_INFO   ( d1 -- d1 )   format({0x%08X},eval($1)) == DEHL})dnl
__{}ifelse($1,{},{
__{}__{}    .error {$0}(): Missing parameter!},
__{}$#,{1},{dnl
__{}__{}ifelse(index({$1},{(}),{0},{
__{}__{}__{}                        ;[19:108]   _TMP_INFO    ( d1 -- d1 )   (addr) == DEHL
__{}__{}__{}    push HL             ; 1:11      _TMP_INFO
__{}__{}__{}    xor   A             ; 1:4       _TMP_INFO
__{}__{}__{}    ld   BC, format({%-11s},$1); 4:20      _TMP_INFO   lo16($1)
__{}__{}__{}    sbc  HL, BC         ; 2:15      _TMP_INFO   lo16(d1)-BC
__{}__{}__{}    jp   nz, $+7        ; 2:7/12    _TMP_INFO
__{}__{}__{}    ld   HL,format({%-12s},($1+2)); 3:16      _TMP_INFO   hi16($1)
__{}__{}__{}    sbc  HL, DE         ; 2:15      _TMP_INFO   HL-hi16(d1)
__{}__{}__{}    pop  HL             ; 1:10      _TMP_INFO
__{}__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO},
__{}__{}eval($1),{},{
__{}__{}__{}   .error {$0}($@): M4 does not know $1 parameter value!},
__{}__{}{dnl
__{}__{}__{}____DEQ_MAKE_BEST_CODE($1,3,10,0,0){}dnl
__{}__{}__{}ifelse(eval((_TMP_BEST_B<=18) || ifelse(_TYP_DOUBLE,{small},{0},{1})),{1},{
__{}__{}__{}__{}_TMP_BEST_CODE
__{}__{}__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO},
__{}__{}__{}{
__{}__{}__{}__{}                     ;[18:92/72,92] _TMP_INFO   ( d1 -- d1 )   format({0x%08X},eval($1)) -->  default version
__{}__{}__{}__{}    push HL             ; 1:11      _TMP_INFO
__{}__{}__{}__{}    xor   A             ; 1:4       _TMP_INFO
__{}__{}__{}__{}    ld   BC, format({0x%04X},eval(($1) & 0xFFFF))     ; 3:10      _TMP_INFO   lo16
__{}__{}__{}__{}    sbc  HL, BC         ; 2:15      _TMP_INFO   lo16(d1)-BC
__{}__{}__{}__{}    jr   nz, $+7        ; 2:7/12    _TMP_INFO
__{}__{}__{}__{}    ld   HL, format({0x%04X},eval((($1)>>16) & 0xFFFF))     ; 3:10      _TMP_INFO   hi16
__{}__{}__{}__{}    sbc  HL, DE         ; 2:15      _TMP_INFO   HL-hi16(d1)
__{}__{}__{}__{}    pop  HL             ; 1:10      _TMP_INFO
__{}__{}__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO})})},
__{}{
__{}__{}    .error {$0}($@): $# parameters found in macro!})}){}dnl
dnl

Nastesti tohle nikdo nevidi a tohle neni jeste hrozne. .)

Tady bych vypichl tu cast kde M4 nema zadne vetveni jen strukturu ifelse.
Ktera je definovana tak ze se porovnavaji na shodnost 2 retezce a pokud jsou shodne tak se provede prvni vetev, jinak druha.
Pred tu druhou vetev lze zase vlozit znovu 3 retezce, kdy prvni 2 jsou zase na porovnani a posledni jako prvni vetev. Je to oddelene carkami.
Kód:
ifelse(porovnavany_retezec_1,porovnavany_retezec_2,pokud jsou shodne tohle se zobrazi/vykona,
pokud nejsou tohle se zobrazi)

ifelse(porovnavany_retezec_1,porovnavany_retezec_2,pokud jsou shodne tohle se zobrazi/vykona,
porovnavany_retezec_3,porovnavany_retezec_4,pokud jsou shodne tohle se zobrazi/vykona,
porovnavany_retezec_4,porovnavany_retezec_5,pokud jsou shodne tohle se zobrazi/vykona,
pokud nejsou tohle se zobrazi)

Bezne pouziti je s pomoci makra eval, ktere se snazi text interpetovat jako cisla a vraci vysledek, napriklad 1 kdyz je to pouzito na porovnani a vysledek je TRUE, nebo 0 kdyz FALSE. Obaluji $1 do zavorek protoze vstupem je retezec, klidne "5+10", a pro korektni vysledky je potreba to prvne secist.
Kód:
ifelse(eval(($1) & 0xFFFF),{0},{2 spodni bajty jsou nulove},
eval(($1) & 0xFF),{0},{Spodni bajt je nulovy},
eval((($1)>>8) & 0xFF),{0},{Druhy bajt je nulovy},
{Ani jeden ze dvou spodnich bajtu neni nulovy}){}dnl


Tak a ten vtip je v tom ze eval neumi porovnat retezce, to umi jen ifelse a ja potrebuji zjistit zda makro _TYP_DOUBLE neni "small". No tak tam vlozim navic dalsi ifelse, ktere to zjisti a vraci 1 nebo 0 podle vysledku.
Kód:
ifelse(_TYP_DOUBLE,{small},{0},{1})

To uz jsem fakt uplne mimo tema... :D

PS: __ je makro ktere nedela nic define({__},{}), jen mi umoznuje udelat odsazeni jinak nez pomoci {}.

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


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.06.2022, 15:58 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Vlastne pokud dam duraz na prvni test "L" a nechci zvetsovat kod, mohu presunout JP na prvni pozici a mohlo by to vypadat takhle
Kód:
; price 1209
               ;[21:75/21,54,72,90] 2dup 0x45352515 D= if   ( d1 -- d1 )   0x45352515 == DEHL
    ld    A, 0x15       ; 2:7       2dup 0x45352515 D= if
    cp    L             ; 1:4       2dup 0x45352515 D= if   x[1] = 0x15
    jp   nz, else101    ; 3:10      2dup 0x45352515 D= if
    ld    A, 0x25       ; 2:7       2dup 0x45352515 D= if
    cp    H             ; 1:4       2dup 0x45352515 D= if   x[2] = 0x25
    jr   nz, $-6        ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x35       ; 2:7       2dup 0x45352515 D= if
    cp    E             ; 1:4       2dup 0x45352515 D= if   x[3] = 0x35
    jr   nz, $-11       ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x45       ; 2:7       2dup 0x45352515 D= if
    xor   D             ; 1:4       2dup 0x45352515 D= if   x[4] = 0x45
    jr   nz, $-16       ; 2:7/12    2dup 0x45352515 D= if
                       ;[21:75]

Mohlo by to byt az o 56.52% rychlejsi u FALSE vetve oproti soucasnemu kodu
(pokud ma L vahu 256x vetsi nez H a to 256x vetsi nez E a ...
(((21×256)+54)×256+72)×256+90 = 355879002
(((33×256)+51)×256+69)×256+75 = 557008203)
Kód:
; price 1200
               ;[21:75/33,51,69,75] 2dup 0x45352515 D= if   ( d1 -- d1 )   0x45352515 == DEHL
    ld    A, 0x15       ; 2:7       2dup 0x45352515 D= if
    cp    L             ; 1:4       2dup 0x45352515 D= if   x[1] = 0x15
    jr   nz, $+15       ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x25       ; 2:7       2dup 0x45352515 D= if
    cp    H             ; 1:4       2dup 0x45352515 D= if   x[2] = 0x25
    jr   nz, $+10       ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x35       ; 2:7       2dup 0x45352515 D= if
    cp    E             ; 1:4       2dup 0x45352515 D= if   x[3] = 0x35
    jr   nz, $+5        ; 2:7/12    2dup 0x45352515 D= if
    ld    A, 0x45       ; 2:7       2dup 0x45352515 D= if
    xor   D             ; 1:4       2dup 0x45352515 D= if   x[4] = 0x45
    jp   nz, else101    ; 3:10      2dup 0x45352515 D= if
                       ;[21:75]

To by si ale vyzadalo uplne prepsani makra, protoze ted ho generuji odspodu nahoru. Takze vim kolik pricitat bajtu k relativnim skokum a zaroven dokazi rici "predchozimu" kodu, zda ma skoncit jako nula a hodnotu v akumulatoru uz nepouziji. Ze ma pouzit XOR/DEC/INC misto CP. Generovani odspodu ale neumoznuje zjistit ktery skok je prvni.

Tak me napada, ze bych mel zmenit ten vypocet pro CENU. U FALSE vetve misto
PRICE_FALSE = (21+54+72+90)/4 = 59.25
PRICE_FALSE = (33+51+69+75)/4 = 57
na
PRICE_FALSE = (21+(54+(72+90)/2)/2)/2 = 44.25
PRICE_FALSE = (33+(51+(69+75)/2)/2)/2 = 47.25
a hned se to otoci. S tim principem ze pokazde vsechny dalsi skoky maji polovicni vahu jako ten co provadim. Ze pravdepodobnost skoku je vzdy 0.5. To dava smysl. Nechapu, jak me mohou takovy blbosti potesit... Na neco prijit. A jine veci uplne ignorovat, jako carky v souvetich, to musi nekoho iritovat me cist... .)

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


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 23.06.2022, 23:12 
Offline
Pan Generální
Uživatelský avatar

Registrován: 13.05.2013, 09:15
Příspěvky: 2278
Bydliště: Brno
Has thanked: 842 times
Been thanked: 302 times
Píšeš úplně v pohodě, jen tomu technicky nerozumím, ale i tak fajn někdy relax pro mně.

_________________
Amiga - PMD 85


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Divam se tak na svuj kod, co na nem delam blbe a co bych mohl vylepsit...
Kód:
../check_word.sh 'define({_TYP_DOUBLE},{small}) _2DUP_PUSHDOT_DNE_IF(0x25152515)'
 
                     ;[15:62,82/82] 2dup 0x25152515 D<> if   ( d1 -- d1 )   # hi16(d1) == lo16(d1)
    push HL             ; 1:11      2dup 0x25152515 D<> if
    xor   A             ; 1:4       2dup 0x25152515 D<> if   A = 0
    sbc  HL, DE         ; 2:15      2dup 0x25152515 D<> if   lo16(d1)-hi16(d1)
    jr   nz, $+7        ; 2:7/12    2dup 0x25152515 D<> if
    ld   HL, 0x2515     ; 3:10      2dup 0x25152515 D<> if   hi16(0x25152515)
    sbc  HL, DE         ; 2:15      2dup 0x25152515 D<> if   hi16(d1)-lo16(d1)
    pop  HL             ; 1:10      2dup 0x25152515 D<> if
    jp    z, else101    ; 3:10      2dup 0x25152515 D<> if   price: 2192
                       ;[15:82]

Je to varianta kdy se snazim pouzit HL i za cenu toho ze musim pouzit "push HL" a pak "pop HL". Diky tomu ani nemuzu u toho relativniho skoku pouzit $+11 a uplne vyskocit do TRUE vetve. Ale prvne udelat pop a pak znovu JP u ktereho uz vim ze neskoci.

Ten kod je dost jednoduchy a kratky, na tom se neda uz nic vylepsit. Divam se na to a nic, delam neco jineho a vracim se. Opakovane...

A pak mam jeden napad co vypada, ze bude zase marny. Ohledne toho ze ADD HL, 16reg nemeni nulovy priznak. Coz nastve, protoze to je presne to co chci a ta instrukce je o polovinu kratsi jak SBC HL, 16reg a nemusite ani nulovat carry. To je dalsi bajt a dalsi 4 takty.

Divam se na to push a pop. Hm... 11 taktu a 10 taktu, pokazde jeden bajt.

ADD HL, reg16 ma 11 taktu a jeden bajt...

A jak jsem resil tu cenu toho kodu, tak vidim ze i kdyz je to o jeden takt delsi... ale prvni skok ma vyssi vahu... a vlastne uz nemusim relativne skakat na POP HL a znovu JP.

Aaaaa....

OR A
SBC HL, 16reg
ADD HL, 16reg

je takovy sestnactibitovy CP HL, 16 reg ; 4:30 !!! :o

Pak se divam na dalsi slova a vidim
Kód:
../check_word.sh 'define({_TYP_DOUBLE},{small}) _2DUP_PUSHDOT_DNE_IF(0x45002515)'
 
                     ;[16:27,78/78] 2dup 0x45002515 D<> if   ( d1 -- d1 )   # 3th byte zero
    ld    A, 0x45       ; 2:7       2dup 0x45002515 D<> if
    xor   D             ; 1:4       2dup 0x45002515 D<> if   D = 0x45
    or    E             ; 1:4       2dup 0x45002515 D<> if   E = 0
    jr   nz, $+12       ; 2:7/12    2dup 0x45002515 D<> if
    push HL             ; 1:11      2dup 0x45002515 D<> if
    ld   BC, 0x2515     ; 3:10      2dup 0x45002515 D<> if   lo16(0x45002515)
    sbc  HL, BC         ; 2:15      2dup 0x45002515 D<> if   HL-lo16(d1)
    pop  HL             ; 1:10      2dup 0x45002515 D<> if
    jp    z, else101    ; 3:10      2dup 0x45002515 D<> if   price: 2068
                       ;[16:78]


A to same jinde... znova a znova...

push HL
Pouze 1x SBC HL, BC
pop HL

A to se da vsude nahradit za

SBC HL, BC
ADD HL, BC

To je proste nadhera.

PS: Cas jit spat, ale jeste chci videt zda to neni dokonce i rychlejsi jak variatna s pouze osmibitovou aritmetikou.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Tak je to stale o fous drazsi. Ale pokud vynutite co nejkratsi variantu pomoci "small", tak uz to vede o 2 bajty.
Kód:
../check_word.sh 'define({_TYP_DOUBLE},{small}) _2DUP_PUSHDOT_DNE_IF(0x45002515)'
 
                     ;[15:27,68/68] 2dup 0x45002515 D<> if   ( d1 -- d1 )   # 3th byte zero
    ld    A, 0x45       ; 2:7       2dup 0x45002515 D<> if
    xor   D             ; 1:4       2dup 0x45002515 D<> if   D = 0x45
    or    E             ; 1:4       2dup 0x45002515 D<> if   E = 0
    jr   nz, $+11       ; 2:7/12    2dup 0x45002515 D<> if
    ld   BC, 0x2515     ; 3:10      2dup 0x45002515 D<> if   lo16(0x45002515)
    sbc  HL, BC         ; 2:15      2dup 0x45002515 D<> if   HL-lo16(d1)
    add  HL, BC         ; 1:11      2dup 0x45002515 D<> if
    jp    z, else101    ; 3:10      2dup 0x45002515 D<> if   price: 1884
                       ;[15:68]

../check_word.sh '_2DUP_PUSHDOT_DNE_IF(0x45002515)'
 
               ;[17:61/23,41,61,61] 2dup 0x45002515 D<> if   ( d1 -- d1 )   0x45002515 <> DEHL
    ld    A, 0x15       ; 2:7       2dup 0x45002515 D<> if
    cp    L             ; 1:4       2dup 0x45002515 D<> if   x[1] = 0x15
    jr   nz, $+14       ; 2:7/12    2dup 0x45002515 D<> if
    ld    A, 0x25       ; 2:7       2dup 0x45002515 D<> if
    cp    H             ; 1:4       2dup 0x45002515 D<> if   x[2] = 0x25
    jr   nz, $+9        ; 2:7/12    2dup 0x45002515 D<> if
    ld    A, 0x45       ; 2:7       2dup 0x45002515 D<> if
    xor   D             ; 1:4       2dup 0x45002515 D<> if   x[3] = 0x45
    or    E             ; 1:4       2dup 0x45002515 D<> if   x[4] = 0
    jp    z, else101    ; 3:10      2dup 0x45002515 D<> if   price: 1872
                       ;[17:61]


A jeste doplnim na ukazku tu prvni rutinu, je videt jak to prida celkove ten jeden takt, protoze POP ma "jen" 10 taktu. Ale ve skutecnosti je ten kod rychlejsi.
Kód:
../check_word.sh 'define({_TYP_DOUBLE},{small}) _2DUP_PUSHDOT_DNE_IF(0x25152515)'
 
                     ;[15:42,83/83] 2dup 0x25152515 D<> if   ( d1 -- d1 )   # hi16(d1) == lo16(d1)
    xor   A             ; 1:4       2dup 0x25152515 D<> if   A = 0
    sbc  HL, DE         ; 2:15      2dup 0x25152515 D<> if   lo16(d1)-hi16(d1)
    add  HL, DE         ; 1:11      2dup 0x25152515 D<> if
    jr   nz, $+11       ; 2:7/12    2dup 0x25152515 D<> if
    ld   BC, 0x2515     ; 3:10      2dup 0x25152515 D<> if   lo16(0x25152515)
    sbc  HL, BC         ; 2:15      2dup 0x25152515 D<> if   HL-lo16(d1)
    add  HL, BC         ; 1:11      2dup 0x25152515 D<> if
    jp    z, else101    ; 3:10      2dup 0x25152515 D<> if   price: 2124
                       ;[15:83]

../check_word.sh '_2DUP_PUSHDOT_DNE_IF(0x25152515)'
 
               ;[17:61/20,34,49,61] 2dup 0x25152515 D<> if   ( d1 -- d1 )   0x25152515 <> DEHL
    ld    A, L          ; 1:4       2dup 0x25152515 D<> if   the beginning of identical values
    cp    E             ; 1:4       2dup 0x25152515 D<> if   x[1] = x[2]
    jr   nz, $+15       ; 2:7/12    2dup 0x25152515 D<> if
    cp    0x15          ; 2:7       2dup 0x25152515 D<> if   x[2] = 0x15  termination of identical values
    jr   nz, $+11       ; 2:7/12    2dup 0x25152515 D<> if
    ld    A, D          ; 1:4       2dup 0x25152515 D<> if
    cp    H             ; 1:4       2dup 0x25152515 D<> if   x[3] = x[4] the beginning of identical values
    jr   nz, $+7        ; 2:7/12    2dup 0x25152515 D<> if
    xor   0x25          ; 2:7       2dup 0x25152515 D<> if   x[4] = 0x25  termination of identical values
    jp    z, else101    ; 3:10      2dup 0x25152515 D<> if   price: 1834
                       ;[17:61]

_________________
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: 27.06.2022, 14:52 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Dival jsem se, kde vsude jeste jsem mohl pouzit to emulovane "CP HL, 16bitreg" a pridal jsem funkci FCE_DEQ. Pouzivam tyto funkce pokud existuje makro _TYP_DOUBLE a ma hodnotu function, tedy pri zadani define({_TYP_DOUBLE},{function}). A u nekterych slov je pouzivam vzdy, jen mam moznost zvolit zda je budu volat zkracene, ale o dost pomaleji a nebo si pred volanim nactu vsechny parametry do registru a nebudu muset resit ze mi na zasobnik prijde navratova adresa.

Predtim jsem to preskocil, protoze jsem to ani nebyl schopen rozumne napsat. I kdyz jediny problem je tam vlastne jen se zasobnikem, jak ho mit cisty, aby se dalo pouzit efektivni "ret nz".
32 bitove cislo d1 je ulozeno v DEHL a dalsi 32 bitove cislo d2 je ulozeno v AFBC. Problem je ta cast AF, kterou kdyz hodite na zasobnik, tak zakryje navratovou adresu.
Kód:
ifdef({USE_FCE_DEQ},{
;==============================================================================
; ( d2 ret d1 -- d1 )
; set zero if d2==d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set zero if true
ifelse(USE_FCE_DEQ,{small},{dnl
__{}FCE_DEQ:           ;[11:100/70,100] fce_deq   ( d2 ret d1 -- d2 d1 )   # small version because "define({_USE_FCE_DEQ},{small})"
__{}    push AF             ; 1:11      fce_deq   h2 l2 rt h2 h1 l1
__{}    ex  (SP),HL         ; 1:19      fce_deq   h2 l2 rt l1 h1 h2
__{}    or    A             ; 1:4       fce_deq   h2 l2 rt l1 h1 h2
__{}    sbc  HL, DE         ; 2:15      fce_deq   h2 l2 rt l1 h1 --  hi16(d2)-hi16(d1) --> nz if false
__{}    pop  HL             ; 1:10      fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    sbc  HL, BC         ; 2:15      fce_deq   h2 l2 rt .. h1 --  lo16(d1)-lo16(d2) --> nz if false
__{}    add  HL, BC         ; 1:11      fce_deq   h2 l2 rt .. h1 l1
__{}    ret                 ; 1:10      fce_deq   h2 l2 .. .. h1 l1},
USE_FCE_DEQ,{fast},{dnl
__{}FCE_DEQ:       ;[16:86/23,36,74,86] fce_deq   ( d2 ret d1 -- d2 d1 )   # fast version because "define({_USE_FCE_DEQ},{fast})"
__{}    ex   AF, AF'        ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ld    A, L          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  lo8(d1) ^ lo8(d2) --> nz if false
__{}    xor   C             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    ld    A, H          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  lo16(d1)^lo16(d2) --> nz if false
__{}    xor   B             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    ex   AF, AF'        ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    push AF             ; 1:11      fce_deq   h2 l2 rt h2 h1 l1
__{}    pop  BC             ; 1:10      fce_deq   h2 l2 rt .. h1 l1
__{}    ld    A, E          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  lo24(d1)^lo24(d2) --> nz if false
__{}    xor   C             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    ld    A, D          ; 1:4       fce_deq   h2 l2 rt .. h1 l1       d1 ^ d2      --> nz if false
__{}    xor   B             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret                 ; 1:10      fce_deq   h2 l2 .. .. h1 l1},
__{}{dnl
__{}FCE_DEQ:          ;[13:95/70,83,95] fce_deq   ( d2 ret d1 -- d2 d1 )   # default version, changes using "define({_USE_FCE_DEQ},{small})" or fast
__{}    push AF             ; 1:11      fce_deq   h2 l2 rt h2 h1 l1 
__{}    ex  (SP),HL         ; 1:19      fce_deq   h2 l2 rt l1 h1 h2
__{}    or    A             ; 1:4       fce_deq   h2 l2 rt l1 h1 h2
__{}    sbc  HL, DE         ; 2:15      fce_deq   h2 l2 rt l1 h1 --  hi16(d2)-hi16(d1) --> nz if false
__{}    pop  HL             ; 1:10      fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    ld    A, L          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  lo8(d1) ^ lo8(d2) --> nz if false
__{}    xor   C             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
__{}    ld    A, H          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  lo16(d1)^lo16(d2) --> nz if false
__{}    xor   B             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
__{}    ret                 ; 1:10      fce_deq   h2 l2 .. .. h1 l1})}){}dnl


A kdyz uz jsem byl v tehle casti tak jsem zkontroloval i ostatni fce na porovnani 32 bitovych cisel a zacal psat konkretne DLT (D<) znovu s tim, ze pouziji jinou metodu nez postupne odcitani od nejnizsich bajtu. Mel jsem to:
d2<d1 --> d2-d1<0 --> carry if true
S tim ze se jedna o cisla se znamenkem, takze se to musi nejak osetrit. Jedna z metod je, ze se invertuje u obou cisel znamenkovy bit a tim se zaporna cisla stanou mensi jak kladna. 0x80000000 se stane nulou, ale to nevadi, protoze nula se zmeni na 0x80000000. Nebo se zjisti jestli maji cisla opacne znamenka, nejlepe pres xor a pak konkretne u DLT se posune d2 o jeden bit doleva a ze znamenka se stane carry, coz je je spravny vysledek. U DGT by se posouvalo cislo d1. Nebo se to udela tak jak to delam ja a nikde jsem to nevidel, ze se udela rozdil, carry se nacte zpet do znamenkoveho bitu a xoruje se to pres d1 i d2, takze pokud maji cisla opacna znamenka tak se vysledek otoci. Protoze pokud maji opacna znamenka tak je vysledek presne naopak, protoze zaporne cislo je o 0x80000000 vyssi a kladne je o tu samou hodnotu nizsi. Proto se invertuje u te prvni hodnoty znamenkovy bit. Invertuje nebo pricte 0x80000000.
Kód:
;==============================================================================
; ( d2 ret d1 -- d1 )
; set carry if d2>d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_DLT:               ;[15:79]     fce_dlt   ( d2 ret d1 -- d2 d1 )
    push AF             ; 1:11      fce_dlt   h2 l2 rt h2 h1 l1
    ld    A, C          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  lo(d2)<lo(d1) --> BC<HL --> BC-HL<0 --> carry if true
    sub   L             ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  lo(d2)<lo(d1) --> BC<HL --> BC-HL<0 --> carry if true
    ld    A, B          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  lo(d2)<lo(d1) --> BC<HL --> BC-HL<0 --> carry if true
    sbc   A, H          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  lo(d2)<lo(d1) --> BC<HL --> BC-HL<0 --> carry if true
    pop  BC             ; 1:10      fce_dlt   h2 l2 rt .. h1 l1
    ld    A, C          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  hi(d2)<hi(d1) --> BC<DE --> BC-DE<0 --> carry if true
    sbc   A, E          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  hi(d2)<hi(d1) --> BC<DE --> BC-DE<0 --> carry if true
    ld    A, B          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  hi(d2)<hi(d1) --> BC<DE --> BC-DE<0 --> carry if true
    sbc   A, D          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  hi(d2)<hi(d1) --> BC<DE --> BC-DE<0 --> carry if true
    rra                 ; 1:4       fce_dlt   h2 l2 rt .. h1 l1                                      --> sign  if true
    xor   B             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    xor   D             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    add   A, A          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1                                      --> carry if true
    ret                 ; 1:10      fce_dlt   h2 l2 .. .. h1 l1
                       ;[15:79]

A moje idea byla, ze pro porovnani neni potreba cely rozdil. U neznamenkovych cisel pri porovnani d2<d1 by stacilo se postupne divat na bity odshora a v okamziku kdy by byly rozdilne tak by byl vysledek shodny s tim odlisnym bitem u d1. Ostatni nizsi bity uz to neovlivni.
Takze bez rotaci staci odecit nejvyssi bajt a kdyz je nulovy tak pokracovat, kdyz nenulovy tak uz mame vysledek v carry. Takze staci po kazdem odecteni udelat "ret nz". Vznikne neco takoveho
Kód:
CE_DLT:       ;[22:45,43,81,93] fce_deq   ( d2 ret d1 -- d2 d1 )   # fast version because "define({_USE_FCE_DLT},{fast})"
    ex   AF, AF'        ; 1:4       fce_deq   h2 l2 rt .. h1 l1  d2 < d1 --> d2-d1<0 --> BCAF-DEHL --> carry if true
    ld    A, B          ; 1:4       fce_deq   h2 l2 rt .. h1 l1
    sub   D             ; 1:4       fce_deq   h2 l2 rt .. h1 l1  B-D<0 --> carry if true
    jr    z, $+7        ; 2:7/12    fce_dlt   h2 l2 rt .. h1 l1
    rra                 ; 1:4       fce_dlt   h2 l2 rt .. h1 l1        --> sign  if true
    xor   B             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    xor   D             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    add   A, A          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1        --> carry if true
    ret                 ; 1:10      fce_dlt   h2 l2 .. .. h1 l1
    ld    A, C          ; 1:4       fce_deq   h2 l2 rt .. h1 l1  C-E<0 --> carry if true
    sub   E             ; 1:4       fce_deq   h2 l2 rt .. h1 l1
    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
    ex   AF, AF'        ; 1:4       fce_deq   h2 l2 rt .. h1 l1
    push AF             ; 1:11      fce_deq   h2 l2 rt l1 h1 l1
    pop  BC             ; 1:10      fce_deq   h2 l2 rt .. h1 l1
    ld    A, B          ; 1:4       fce_deq   h2 l2 rt .. h1 l1
    sub   H             ; 1:4       fce_deq   h2 l2 rt .. h1 l1  B-H<0 --> carry if true
    ret  nz             ; 1:5/11    fce_deq   h2 l2 .. .. h1 l1
    ld    A, C          ; 1:4       fce_deq   h2 l2 rt .. h1 l1
    sub   L             ; 1:4       fce_deq   h2 l2 rt .. h1 l1  C-L<0 --> carry if true
    ret                 ; 1:10      fce_deq   h2 l2 .. .. h1 l1
                       ;[22:114]

Ale to je o dost delsi kod a kdyz se bude vysledek listit spis v poslednim bajtu tak i pomalejsi. A jeste se prohazuje nacitani d2 cisla misto AFBC to musi byt BCAF, takze bych to vusede musel pro volani zohlednit podle nastaveni makra.
Takze zvitezil kompromis, kdyz nejvyssi bajt delam zvlast a vyuzivam toho ze uz je prednacteny v registru A, a zbyvajici 24bitove cislo postaru, kde se uz zase nemusi resit znamenko. Nenechte se zmast celkovym case 102 taktu co spocita automaticky skript, ten kod nikdy nepobezi cely.
Kód:
;==============================================================================
; ( d2 ret d1 -- d1 )
; set carry if d2>d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_DLT:               ;[18:58,71]  fce_dlt   ( d2 ret d1 -- d2 d1 )   # default version, changes using "define({_USE_FCE_DLT},{small})"
    push AF             ; 1:11      fce_dlt   h2 l2 rt h2 h1 l1  d2<d1 --> d2-d1<0 --> AFBC-DEHL<0 --> carry if true
    sub   D             ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  A-D<0 --> carry if true
    jr    z, $+8        ; 2:7/12    fce_dlt   h2 l2 rt h2 h1 l1
    rra                 ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1        --> sign  if true
    pop  BC             ; 1:10      fce_dlt   h2 l2 rt .. h1 l1
    xor   B             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    xor   D             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    add   A, A          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1        --> carry if true
    ret                 ; 1:10      fce_dlt   h2 l2 .. .. h1 l1
    ld    A, C          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1
    sub   L             ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  C-L<0 --> carry if true
    ld    A, B          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1
    sbc   A, H          ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  B-H<0 --> carry if true
    pop  BC             ; 1:10      fce_dlt   h2 l2 rt .. h1 l1  BC = hi16(d2)
    ld    A, C          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1
    sbc   A, E          ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  C-E<0 --> carry if true
    ret                 ; 1:10      fce_dlt   h2 l2 .. .. h1 l1
                       ;[18:102]


Posledni vec co jsem se rozhodl zmenit je ze mam definovany fce pro FCE_DLT, FCE_DGE, FCE_DGT, FCE_DLE a pokud jsou potreba tak se pridaji do kodu. Ale u slov jako DLT_IF a DGE_IF by me stacila jen fce FCE_DLT. Protoze pokud FCE_DGE vraci carry tak je to shodny s tim kdyz FCE_DLT nevraci carry. Takze staci v DGE_IF volat call FCE_DLT a zmenit skok z carry na no carry a naopak. FCE_DGE je dokonce delsi o jeden bajt protoze resi
d2>=d1 --> d2+1>d1 --> 0>d1-d2-1 a tu minus jednicku dela ze prida carry pomoci instrukce scf.
Kód:
;==============================================================================
; ( d2 ret d1 -- d1 )
; set carry if d2>d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_DGE:               ;[16:83]     fce_dge   ( d2 ret d1 -- d2 d1 )
    push AF             ; 1:11      fce_dge   h2 l2 rt h2 h1 l1
    scf                 ; 1:4       fce_dge   h2 l2 rt h2 h1 l1  set carry
    ld    A, L          ; 1:4       fce_dge   h2 l2 rt h2 h1 l1  lo(d2)>=lo(d1) --> BC>HL-1 --> 0>HL-BC-1 --> carry if true
    sbc   A, C          ; 1:4       fce_dge   h2 l2 rt h2 h1 l1  lo(d2)>=lo(d1) --> BC>HL-1 --> 0>HL-BC-1 --> carry if true
    ld    A, H          ; 1:4       fce_dge   h2 l2 rt h2 h1 l1  lo(d2)>=lo(d1) --> BC>HL-1 --> 0>HL-BC-1 --> carry if true
    sbc   A, B          ; 1:4       fce_dge   h2 l2 rt h2 h1 l1  lo(d2)>=lo(d1) --> BC>HL-1 --> 0>HL-BC-1 --> carry if true
    pop  BC             ; 1:10      fce_dge   h2 l2 rt .. h1 l1
    ld    A, E          ; 1:4       fce_dge   h2 l2 rt .. h1 l1  hi(d2)>=hi(d1) --> BC>DE --> 0>DE-BC     --> carry if true
    sbc   A, C          ; 1:4       fce_dge   h2 l2 rt .. h1 l1  hi(d2)>=hi(d1) --> BC>DE --> 0>DE-BC     --> carry if true
    ld    A, D          ; 1:4       fce_dge   h2 l2 rt .. h1 l1  hi(d2)>=hi(d1) --> BC>DE --> 0>DE-BC     --> carry if true
    sbc   A, B          ; 1:4       fce_dge   h2 l2 rt .. h1 l1  hi(d2)>=hi(d1) --> BC>DE --> 0>DE-BC     --> carry if true
    rra                 ; 1:4       fce_dge   h2 l2 rt .. h1 l1                                           --> sign  if true
    xor   B             ; 1:4       fce_dge   h2 l2 rt .. h1 l1
    xor   D             ; 1:4       fce_dge   h2 l2 rt .. h1 l1
    add   A, A          ; 1:4       fce_dge   h2 l2 rt .. h1 l1                                           --> carry if true
    ret                 ; 1:10      fce_dge   h2 l2 .. .. h1 l1
                       ;[16:83]

Takze jediny rozdil bude u slov jako je primo DGT, ktere provedou porovnani a pak ulozi vlajku. Kde potrebuji po volani FCE_DLT jeste invertovat pokazde carry. Pokud se to provede jednou tak to vyjde nastejno, ale pokud vickrat tak uz by se setril vzdy jeden bajt, kdyby to resila primo fce a ne "inline" slovo. Ale to me tak netrapi, protoze se snazim samostatne slovo DGE co nejvic eliminovat, protoze ulozit do HL 0xFFFF nebo 0x0000 a pak to hned testovat napriklad v IF a zase odstranit nedava smysl. Proto existuje spojeni slov DGE_IF nebo DGW_WHILE atd.

Posledni co jeste ukazi jak se to vola
Kód:
../check_word.sh '_4DUP_DLT_IF'
 
                        ;[6:181]    4dup D< if   ( d2 d1 -- d2 d1 )
    call FCE_4DUP_DLT   ; 3:17      4dup D< if   carry if true
    jp   nc, else101    ; 3:10      4dup D< if

...

;==============================================================================
; ( d2 ret d1 -- d2 d1 )
;  In: (SP+4) = h2, (SP+2) = l2, (SP) = ret
; Out: (SP+2) = h2, (SP)   = l2, (SP) = ret, AF = h2, BC = l2
FCE_4DUP_DLT:           ;[9:75]     fce_4dup_dlt   ( d2 ret d1 -- d2 d1 )
    pop  AF             ; 1:10      fce_4dup_dlt   h2 l2 .. ..  AF = ret
    pop  BC             ; 1:10      fce_4dup_dlt   h2 .. .. ..  BC = l2
    ex   AF, AF'        ; 1:4       fce_4dup_dlt   h2 .. .. ..
    pop  AF             ; 1:10      fce_4dup_dlt   .. .. .. ..  AF'= h2
    push AF             ; 1:11      fce_4dup_dlt   h2 .. .. ..
    push BC             ; 1:11      fce_4dup_dlt   h2 l2 .. ..
    ex   AF, AF'        ; 1:4       fce_4dup_dlt   h2 l2 .. ..
    push AF             ; 1:11      fce_4dup_dlt   h2 l2 rt ..
    ex   AF, AF'        ; 1:4       fce_4dup_dlt   h2 l2 rt ..  AF = h2
    ; fall to fce_dlt

Kód:
../check_word.sh 'define({TYP_DOUBLE},{fast}) _4DUP_DLT_IF'
 
                       ;[10:148]    4dup D< if   ( d2 d1 -- d2 d1 )
    pop  BC             ; 1:10      4dup D< if
    pop  AF             ; 1:10      4dup D< if
    push AF             ; 1:11      4dup D< if
    push BC             ; 1:11      4dup D< if
    call FCE_DLT        ; 3:17      4dup D< if   carry if true
    jp   nc, else101    ; 3:10      4dup D< if

Koukam ze tam mam chybu, jednou pouzivam _TYP_DOUBLE a pak jen TYP_DOUBLE, musim to sjednotit.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Příloha:
Snímek obrazovky_2022-06-27_13-58-32.png
Snímek obrazovky_2022-06-27_13-58-32.png [ 911.86 KiB | Zobrazeno 1451 krát ]


Pokud neco programujete co vlastne pouzivate. Ja bych bez nejake znalosti regularnich vyrazu ani nemohl fungovat. Musim si treba u tech zdrojaku hlidat mezery pred koncem radku, protoze pokud nejsou za "dnl" tak se vkladaji do vysledku. A delam to v kwrite ze zadam najit " $" a nahradit (rezim regularni vyraz) za nic. Kwrite umi i blokovy rezim takze mohu pridavat odsazeni __{} hromadne pro vice radku.
Nebo ted kdyz potrebuji najit kde vsude mam to TYP_DOUBLE pouziji rekurzivne grep.
Pak casto mam tuhle vedeckou kalkulacku, protoze ma i hex rezim. Hodne v ni pocitam ty takty u skoku, protoze se to musi delat rucne.
Pouzivam i ruzne bash skripty, naposledy jsem se snazil pouzit awk pro prevod forth zdrojaku na M4 FORTH, ale jeste jsem to nedodel. Neco by slo delat primo v bashi, ale to uz jsou roky, nebo desitky let co jsem v nem neco psal, takze uz to v hlave nemam.
Na win bych byl dost ztraceny, ale zase bych mohl mit ruzne zx emulatory a mraky jineho softwaru, co ted nespustim nebo jen kdybych instaloval wine.
Nejaky velky IDE se me nechce ucit, kwrite s bash scripty na kompilaci me staci. VIM etc. se me takty nechce ucit.

PS: Ten obrazek jsem musel zmensit na 1600 px, ale na bajty je to vetsi. :) Taky je divne ze se me zobrazuje po rozkliknuti stejne velky nebo i vetsi jako moje rozliseni... .) Tak nevim zda to neni tim ze gimp zachoval "pro tisk" puvodni rozliseni nebo to dela primo web.

_________________
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: 27.06.2022, 16:40 
Offline
Óm Nejvyšší

Registrován: 22.05.2013, 21:14
Příspěvky: 3642
Bydliště: Bratislava
Has thanked: 371 times
Been thanked: 788 times
_dworkin píše:
...Na win bych byl dost ztraceny...
Bash a (temer) vsetky unixove cmdline utilitky existuju aj pre win (napr. cygwin) takze tam by si urcite strateny nebol ;)
Skvele prostredie je VS-CODE a spolu so Z80-macroasm-vscode predstavuje velmi dobre a komfortne prostredie pre pisanie asemblerovych programov.

Inak ja mam na rozne, nielen "regularno-vyrazove" ucely narobenych spustu malickych vlastnych utilitiek (napisanych obvykle v cecku) ktore spolu s windowsovym cmd.exe predstavuju mocny nastroj na pracu a skriptovanie. A ked mi nieco chyba, tak si to napisem, alebo prekompilujem z unixu ;)

Kalkulacku pouzivam klasicku windowsacku, ta uz od (tusim) Win98 vie aj hex/oct/bin, najviac som si zvykol na tu z WinXP, pouzivam ju aj pod Win7 a Win10. Tie novsie mi uz pridu skor ako vitazstvo dizajnu nad funkcnostou...


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Busy píše:
_dworkin píše:
...Na win bych byl dost ztraceny...
Bash a (temer) vsetky unixove cmdline utilitky existuju aj pre win (napr. cygwin) takze tam by si urcite strateny nebol ;)
Skvele prostredie je VS-CODE a spolu so Z80-macroasm-vscode predstavuje velmi dobre a komfortne prostredie pre pisanie asemblerovych programov.

Inak ja mam na rozne, nielen "regularno-vyrazove" ucely narobenych spustu malickych vlastnych utilitiek (napisanych obvykle v cecku) ktore spolu s windowsovym cmd.exe predstavuju mocny nastroj na pracu a skriptovanie. A ked mi nieco chyba, tak si to napisem, alebo prekompilujem z unixu ;)

Kalkulacku pouzivam klasicku windowsacku, ta uz od (tusim) Win98 vie aj hex/oct/bin, najviac som si zvykol na tu z WinXP, pouzivam ju aj pod Win7 a Win10. Tie novsie mi uz pridu skor ako vitazstvo dizajnu nad funkcnostou...


Zajimave videt.
Koukam ze si kazdy nakonec bud neco nauci nebo udela, pokud to pouziva casto.
Tech utilitek je fakt spousta. Po zbeznem nahlednuti a je jich dost obdobou unixovych a nebo jdou nahradit necim standartnim v linuxu.
Zaujalo me to zapn.exe z roku 1996. To by slo urcite i ve win pomoci presmerovani a >> jednoducheho skriptu, nebo pokud se melo jednat o dukladne smazani z disku tak na to je taky neco v linuxu. Nevim co by to udelalo s zivotnosti ssd v dnesni dobe. .)

left.exe
zamena.exe vypada jako prace pro sed.

VS-CODE se da koukam doinstalovat https://linuxize.com/post/how-to-install-visual-studio-code-on-ubuntu-20-04/. Ja tu nejake IDE mam co jsem zkousel kvuli necemu myslim v Cecku. Nasel jsem Code::Blocks IDE coz je moloch a jeste uzitecny DDD (Display Data Debugger) na C programky. Valgrind me to ani neukazuje, protoze je to prikazova utilitka, proto asi ani nic ohledne spektra jako pasmo atd. Musel bych lezt do Synapticu videt co vsechno mam navic.

Cygwin - mas pravdu, win ma nejakou nastavbu pro unix shell, spousta lidi co byla zvykla odmalicka na win a studovala na FITu v Brne, kdyz musela delat neco v bashi tak to zkousela psat v tom, prece win neopusti, kdyz se v nem citi jako doma. Melo to tehdy myslim jeste nejake mouchy, ale vetsinou to slo. Pripadne virtualizovala. Nektere veci zase nesli bez wine v linuxu. .)
Nikdy jsem to ale nezkousel, protoze win je pro me prece ten system, kde muzes hrat ty dalsi hry ze Steamu, tak proc v nem zkouset to co delas v linuxu. To je jako zkouset hrat hry v linuxu, kdyz bezne pouzivas win. Jo jde to, vetsinou. A nekdy ne, nebo s problemy. Proc to teda zkouset. Skutecnych duvodu proc uplne zmenit system je fakt malo.

PS: Par tech her mam, protoze me treba minuly a nikdy jsem je nehral. A ted je proste mam, protoze jsem je kdysi chtel, ale nejak se me nechteji hrat... nastesti jsem do toho zas tolik nevrazil.

_________________
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: 27.06.2022, 18:58 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Napsat DGT (D>) jako obdobu DLT (D<) nejde, protoze na zacatku potrebuji udelat D-A a ne A-D. Jde to napsat o bajt delsi a 4 takty pomalejsi, ze tam pridam ccf, ktery invertuje carry. Nebo jsem vypotil
Kód:
;==============================================================================
; ( d2 ret d1 -- d1 )
; carry if d2>d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_DGT:               ;[22:60,71]  fce_dgt   ( d2 ret d1 -- d2 d1 )   # default version, changes using "define({_USE_FCE_DGT},{small})"
    push AF             ; 1:11      fce_dgt   h2 l2 rt h2 h1 l1  d2>d1 --> 0>d1-d2 --> 0>DEHL-AFBC --> carry if true
    xor   D             ; 1:4       fce_dlt   h2 l2 rt h2 h1 l1  A==D?
    jr    z, $+12       ; 2:7/12    fce_dlt   h2 l2 rt h2 h1 l1
    pop  BC             ; 1:10      fce_dlt   h2 l2 rt .. h1 l1
    jp    p, $+6        ; 3:10      fce_dlt   h2 l2 rt .. h1 l1
    ld    A, B          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  opposite signs
    sub   D             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  B-D<0 --> carry if true
    ret                 ; 1:10      fce_dgt   h2 l2 .. .. h1 l1
    ld    A, D          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  identical signs
    sub   B             ; 1:4       fce_dlt   h2 l2 rt .. h1 l1  D-B<0 --> carry if true
    ret                 ; 1:10      fce_dgt   h2 l2 .. .. h1 l1
    ld    A, L          ; 1:4       fce_dgt   h2 l2 rt h2 h1 l1
    sub   C             ; 1:4       fce_dgt   h2 l2 rt h2 h1 l1  0>L-C --> carry if true
    ld    A, H          ; 1:4       fce_dgt   h2 l2 rt h2 h1 l1
    sbc   A, B          ; 1:4       fce_dgt   h2 l2 rt h2 h1 l1  0>H-B --> carry if true
    pop  BC             ; 1:10      fce_dgt   h2 l2 rt .. h1 l1
    ld    A, E          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1
    sbc   A, C          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  0>E-C --> carry if true
    ret                 ; 1:10      fce_dgt   h2 l2 .. .. h1 l1
                       ;[22:122]
To je jen o 2 takty pomalejsi, ale za cenu 4 bajtu navic.
S tim asi nic udelat lepsiho nejde.

_________________
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: 27.06.2022, 21:46 
Offline
Pan Generální
Uživatelský avatar

Registrován: 13.05.2013, 09:15
Příspěvky: 2278
Bydliště: Brno
Has thanked: 842 times
Been thanked: 302 times
Já používám kalkulačku z win 10. A vadí mi, že když si ji zvětšuji, jediné co se mi z velikosti písma/čísla zvětšuje je pouze část hlavního výpočtu, ale přepočty co se dělají souběžně v dalších soustavách jsou pořád stejně malé, můžete si zvětšit kalkulačku jak chcete. Asi by se dala najít taková kde by se zvětšovalo vše, ale vámi zde uváděné dle všeho fungují v zobrazení stejně jako ta na win 10.

_________________
Amiga - PMD 85


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 27.06.2022, 22:32 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Kód:
./check_word.sh 'BEGIN _4DUP_DEQ_WHILE'
 
begin101:               ;           begin 101
                  ;[18:135/125,135] 4dup D= while 101   ( d2 d1 -- d2 d1 )
    pop  BC             ; 1:10      4dup D= while 101   h2          . h1 l1  BC= lo(d2) = l2
    pop  AF             ; 1:10      4dup D= while 101               . h1 l1  AF= hi(d2) = h2
    push AF             ; 1:11      4dup D= while 101   h2          . h1 l1
    push BC             ; 1:11      4dup D= while 101   h2 l2       . h1 l1
    push HL             ; 1:11      4dup D= while 101   h2 l2 l1    . h1 l1
    push AF             ; 1:11      4dup D= while 101   h2 l2 l1 h2 . h1 l1
    xor   A             ; 1:4       4dup D= while 101   h2 l2 l1 h2 . h1 l1
    sbc  HL, BC         ; 2:15      4dup D= while 101   h2 l2 l1 h2 . h1 --  lo(d1)-lo(d2)
    pop  HL             ; 1:10      4dup D= while 101   h2 l2 l1    . h1 h2
    jr   nz, $+4        ; 2:7/12    4dup D= while 101   h2 l2 l1    . h1 h2
    sbc  HL, DE         ; 2:15      4dup D= while 101   h2 l2 l1    . h1 --  hi(d2)-hi(d1)
    pop  HL             ; 1:10      4dup D= while 101   h2 l2       . h1 l1
    jp   nz, break101   ; 3:10      4dup D= while 101   h2 l2       . h1 l1
                       ;[18:135]
Nahrazeno za
Kód:
./check_word.sh 'BEGIN _4DUP_DEQ_WHILE'
 
begin101:               ;           begin 101
                   ;[16:132/73,132] 4dup D= while 101   ( d2 d1 -- d2 d1 )
    or   A              ; 1:4       4dup D= while 101   h2 l2 . h1 l1
    pop  BC             ; 1:10      4dup D= while 101   h2    . h1 l1  BC = l2 = lo16(d2)
    sbc  HL, BC         ; 2:15      4dup D= while 101   h2    . h1 --  cp l1-l2
    add  HL, BC         ; 1:11      4dup D= while 101   h2    . h1 l1  cp l1-l2
    jr   nz, $+7        ; 2:7/12    4dup D= while 101   h2    . h1 h2
    ex  (SP),HL         ; 1:19      4dup D= while 101   l1    . h1 h2  HL = h2 = hi16(d2)
    sbc  HL, DE         ; 2:15      4dup D= while 101   l1    . h1 --  cp h2-h1
    add  HL, DE         ; 1:11      4dup D= while 101   l1    . h1 h2  cp h2-h1
    ex  (SP),HL         ; 1:19      4dup D= while 101   h2    . h1 l1  HL = l1
    push BC             ; 1:11      4dup D= while 101   h2 l2 . h1 l1
    jp   nz, break101   ; 3:10      4dup D= while 101   h2 l2 . h1 l1
                       ;[16:132]

Obdobne u _4DUP_DEQ_IF.

DNE je trosku slozitejsi protoze ma vic verzi jak se vyplati relativne vyskakovat pod posledni jp do TRUE vetve. Tam se zmenila jen small varianta.

Vlastne jsem tam pridal i tu variantu s pouzitim funkce.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Ukazalo se ze to 32 bitove porovnani, kdy prvne resim nejvyssi bajt je jeste vyhodnejsi, protoze vlastne ty spodni 3 bajty se resi uplne stejne jako u neznamenkove verze, takze se usetri 8 bajtu pokud jsou v kodu obe varianty.
Kód:
;==============================================================================
; ( d2 ret d1 -- d1 )
; carry if d2>d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_DGT:               ;[14:60,71]  fce_dgt   ( d2 ret d1 -- d2 d1 )   # default version, changes using "define({_USE_FCE_DGT},{small})"
    push AF             ; 1:11      fce_dgt   h2 l2 rt h2 h1 l1  d2>d1 --> 0>d1-d2 --> 0>DEHL-AFBC --> carry if true
    xor   D             ; 1:4       fce_dgt   h2 l2 rt h2 h1 l1  A==D?
    jr    z, FCE_UDGT_2 ; 2:7/12    fce_dgt   h2 l2 rt h2 h1 l1
    pop  BC             ; 1:10      fce_dgt   h2 l2 rt .. h1 l1
    jp    p, $+6        ; 3:10      fce_dgt   h2 l2 rt .. h1 l1
    ld    A, B          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  opposite signs
    sub   D             ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  0>B-D --> carry if true
    ret                 ; 1:10      fce_dgt   h2 l2 .. .. h1 l1
    ld    A, D          ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  identical signs
    sub   B             ; 1:4       fce_dgt   h2 l2 rt .. h1 l1  0>D-B --> carry if true
    ret                 ; 1:10      fce_dgt   h2 l2 .. .. h1 l1
;==============================================================================
; ( d2 ret d1 -- d1 )
; carry if d2 u> d1 is true
;  In: AF = h2, BC = l2, DE = h1, HL = l1
; Out:          BC = h2, DE = h1, HL = l1, set carry if true
FCE_UDGT:              ;[14:42,71]  fce_udgt   ( d2 ret d1 -- d2 d1 )
    push AF             ; 1:11      fce_udgt   h2 l2 rt h2 h1 l1  d2>d1 --> 0>d1-d2 --> 0>DEHL-AFBC --> carry if true
    xor   D             ; 1:4       fce_udgt   h2 l2 rt h2 h1 l1  A==D?
    jr    z, FCE_UDGT_2 ; 2:7/12    fce_udgt   h2 l2 rt h2 h1 l1
    pop  BC             ; 1:10      fce_udgt   h2 l2 rt .. h1 l1
    ret                 ; 1:10      fce_udgt   h2 l2 .. .. h1 l1
FCE_UDGT_2:             ;           fce_udgt   h2 l2 rt h2 h1 l1
    ld    A, L          ; 1:4       fce_udgt   h2 l2 rt h2 h1 l1
    sub   C             ; 1:4       fce_udgt   h2 l2 rt h2 h1 l1  0>L-C --> carry if true
    ld    A, H          ; 1:4       fce_udgt   h2 l2 rt h2 h1 l1
    sbc   A, B          ; 1:4       fce_udgt   h2 l2 rt h2 h1 l1  0>H-B --> carry if true
    pop  BC             ; 1:10      fce_udgt   h2 l2 rt .. h1 l1
    ld    A, E          ; 1:4       fce_udgt   h2 l2 rt .. h1 l1
    sbc   A, C          ; 1:4       fce_udgt   h2 l2 rt .. h1 l1  0>E-C --> carry if true
    ret                 ; 1:10      fce_udgt   h2 l2 .. .. h1 l1
                       ;[28:164]

Napoveda pro chybu: .fcc tadirp a bus an rox tinemz mesjl enmopaZ

small varianta u DLT se automaticky zneplatni, protoze uz neni nejkratsi. To same pro DGE. Pekne. Udelal jsem uz prvni male testy primo v ZX a zatim to dela co to ma.

Nasel jsem jen spatne hledatelnou chybu v "Du<="
Kód:
                        ;[12:80]    Du<=   ( ud2 ud1 -- flag )
    pop  BC             ; 1:10      Du<=   lo(ud2)
    scf                 ; 1:4       Du<=
    ld    A, C          ; 1:4       Du<=   BC<=HL --> BC<HL+1 --> BC-HL-1<0 --> carry if true
    sub   L             ; 1:4       Du<=   BC<=HL --> BC<HL+1 --> BC-HL-1<0 --> carry if true
    ld    A, B          ; 1:4       Du<=   BC<=HL --> BC<HL+1 --> BC-HL-1<0 --> carry if true
    sbc   A, H          ; 1:4       Du<=   BC<=HL --> BC<HL+1 --> BC-HL-1<0 --> carry if true
    pop  HL             ; 1:10      Du<=   hi(ud2)
    sbc  HL, DE         ; 2:15      Du<=   HL<=DE --> HL<DE+1 --> HL-DE-1<0 --> carry if true
    sbc  HL, HL         ; 2:15      Du<=   set flag ud2<=ud1
    pop  DE             ; 1:10      Du<=

Napoveda pro chybu: .cbs an bus tinemz mesjl enmopaZ

_________________
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: 28.06.2022, 07:09 
Offline
Óm Nejvyšší

Registrován: 22.05.2013, 21:14
Příspěvky: 3642
Bydliště: Bratislava
Has thanked: 371 times
Been thanked: 788 times
V napovedach mas drobnu chybicku :)
lemopaz evols v l oknemsip enedarirp elZ


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 30.06.2022, 17:18 
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 64 bitoveho (double) kodu primo v emulatoru jsem mel uz nejaky test pro 16 bitovy (single) kod. Tak jsem ho jen drobne upravil, prejmenoval funkce na neco ted vic logictejsiho, zkopiroval je a upravil pro 64bit. Jako

CALL(x_x_test)
CALL(d_d_test)
CALL(x_p3_test) ; tady je prvni parametr signed/unsigned 16 bit a druhy parametr implicitni +3
CALL(x_m3_test) ; tady je prvni parametr signed/unsigned 16 bit a druhy parametr implicitni -3


No a u toho 32 bitoveho kodu jsem udelal chybu kdy jsem menil

_2PUSH_nejakapodminka_IF na
_4PUSH_Dnejakapodminka_IF

A ja jen pridal D pred jmeno podminky a zapomnel zmenit _2PUSH na _4PUSH. Po kompilaci me pasmo zacalo rvat ze nejaky label je uz definovan. Dival jsem se na to o co jde a videl, ze se me nerozbalilo makro pro cislo v jake urovni jsme v IF a misto cisla to delalo label "endTHEN_STACK:".
Tak jsem resil co jsem v tech makrech udelal za chybu. Po nejake dobe jsem si vsimnnul, ale ze mam ve vyslednem asm kodu nerozbaleny _2PUSH_nejakapodminka_IF, protoze to slovo nezna. Takze je logicke ze pak THEN nema co ukoncovat, kdyz nema zadny IF.
Takze chyba byla ve FORTH programu a ne v prekladaci.

Doslo me, ze by bylo pekne, kdyby to ten prekladac napsal rovnou, protoze mam jen jedno slovo THEN a uprava neni tak slozita. Staci pridat podminku ze kdyz se makro THEN_STACK rovna primo textu THEN_STACK tak vypis chybu ".error THEN for non-existent IF".

To same jsem udelal pro BEGIN strukturu. Jen tam to bylo o dost slozitejsi, protoze u IF ELSE THEN mam jen jedno ELSE a jedno THEN, zato spoustu neco_neco_IF slov. Tak u BEGIN to vypada nejak takto:
Kód:
BEGIN
nejaka_podminka WHILE
nejaka_podminka WHILE
nejake podminka IF BREAK THEN
nejaka_podminka WHILE
ukonceni pres AGAIN,UNTIL,neco_neco_UNTIL,REPEAT

A vsechny ty varianty pro WHILE, UNTIL, slova jako AGAIN, BREAK a REPEAT atd. musi byt uvnitr BEGIN struktury, protoze BEGIN slovo vypada takto
Kód:
define({BEGIN_COUNT},100)dnl
dnl
dnl ( -- )
define({BEGIN},{define({BEGIN_COUNT}, incr(BEGIN_COUNT))pushdef({BEGIN_STACK}, BEGIN_COUNT)
dnl # begin ... flag until
dnl # begin ... flag while ... repeat
dnl # begin ... again
dnl # begin     while           repeat
dnl # do  { ... if (!) break; } while (1)
begin{}BEGIN_STACK:               ;           begin BEGIN_STACK})dnl

Ulozi si na zasobnik jmenem BEGIN_STACK ciselnou hodnotu, pocinaje 101. viz "pushdef({BEGIN_STACK}, BEGIN_COUNT)"
A tu hodnotu BEGIN_STACK pouzivaji vsechny slova, tady nejde jen o slova, ktera obsahuji popdef({BEGIN_STACK}) a snizuji hodnotu zasobniku BEGIN_STACK.

Takze jsem musel kazde slovo osetrit. Pritom jsem narazil i na nejake moje chyby, kdy jsem mel v kodu neco

Pokud je _TYP_DOUBLE rovny function tak udelej tohle. Jenze jsem mel misto

ifelse(_TYP_DOUBLE,{function},{TRUE_VETEV....

napsano

ifelse({_TYP_DOUBLE},{function},{TRUE_VETEV....

takze ta podminka byla vzdy neplatna protoze tohle dela to ze porovna retezec "_TYP_DOUBLE" a "function" jestli neni stejny. M4 vzdy vezme kazde slovo a vykona ho. Pokud je to makro tak ho rozbali a pokracuje dal. Pokud je to v {} tak ty odstrani vypise vnitrek a pokracuje dal. Pokud to nezna tak to jen vypise.

Mimochodem tohle je ten duvod proc pri definici slova by mel byt nazev naopak VZDY v {}. Vse bude pekne fungovat do okamziku kdy se pokusite definovat stejne makro, nebo se stejnym nazvem znovu. Pak se vam rozbali v define(JMENO_MAKRA,{bla bla}).

Takze hotovo, opraveno. Ted bude prekladac rvat chybu ze neni BEGIN nebo IF.

https://github.com/DW0RKiN/M4_FORTH/commit/870210c38f7326fe10b4a66a0c1e86abc6a426a1

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


Naposledy upravil _dworkin dne 30.06.2022, 17:39, celkově upraveno 1

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 ... 10, 11, 12, 13, 14, 15, 16 ... 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:  
Založeno na phpBB® Forum Software © phpBB Group
Český překlad – phpBB.cz