OldComp.cz

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


Právě je 28.03.2024, 11:21

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 ... 11, 12, 13, 14, 15, 16, 17 ... 39  Další
Autor Zpráva
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 30.06.2022, 17:37 
Offline
Site Admin
Uživatelský avatar

Registrován: 11.05.2013, 23:48
Příspěvky: 10111
Bydliště: Praha
Has thanked: 1953 times
Been thanked: 1517 times
Busy píše:
V napovedach mas drobnu chybicku :)
lemopaz evols v l oknemsip enedarirp elZ


Voba to máte blbě. Tys zase vynechal "n" :-)

_________________
Amiga/Amstrad/Atari/Commodore/Mac/Nintendo/PS/PC/Sega/Tandy/ZX


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 30.06.2022, 21:00 
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
misticjoe píše:
Tys zase vynechal "n" :-)
Jaaaaj ty si to pokaziiiil. Tuto poslednu vetu si mal zafarbit na #00FFFF a napisat obratene ! :lol:


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 02.07.2022, 04:01 
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:
misticjoe píše:
Tys zase vynechal "n" :-)
Jaaaaj ty si to pokaziiiil. Tuto poslednu vetu si mal zafarbit na #00FFFF a napisat obratene ! :lol:


¿ǝuǝɔɐɹqo sıןsʎɯ oʇ ʞɐɾ

https://smallseotools.com/reverse-text-generator/

). ...tarhop civ etsej uzum mit s is ez em olsodeN .udalkdop zilbjen isa uvrab elhut lesan a dom redaeR kraD mamen mat ,uxoferiF ev pmocdlo tirveto lesum mesj envrP .tnof ynletidiven ladelh mesj kat lesanen cin mesj zydk a yreliops isip ut es edk envrp mesj ladelH

Napoveda v obrazku:
Příloha:
Snímek obrazovky_2022-07-02_03-10-59.png
Snímek obrazovky_2022-07-02_03-10-59.png [ 168.4 KiB | Zobrazeno 2376 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: 03.07.2022, 12:45 
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 vstupu v makrech casto potrebuji zjistit zda neni vstup odkazem do pameti. Memory References. Zjednodusene se jedna o to, zda budu provadet u PUSH(x).

ld HL, x ; 3:10

nebo

ld HL,(x) ; 3:16

U prvniho typu, kdy je vstup nejaka hodnota mohu provest nejake optimalizace, u odkazu nic nevim o predavane hodnote, protoze je to vlastne promenna v pameti.

Zatim jsem to vyresil tak, ze jsem provadel:

index({$1},{(})

ktera najde otviraci zavorku a pokud index vraci hodnotu 0 tak ji nasel na prvni pozici. S tim ze pocatecni mezery maze M4 nejak sam. Pokud nic nenajde tak vrati -1, pokud je vstup "1+(500)" tak vrati 2 atd.
Koncovou zavorku jsem neresil, uz nevim proc, myslim ze M4 nemaze koncove mezery a proste se to komplikovalo.

Nove to delam pres

__IS_MEM_REF($1)

ktere vraci 0 nebo 1
Kód:
dnl (abc) --> 1
dnl (123) --> 1
dnl ()+() --> 1 fail
dnl ()    --> 0
dnl other --> 0
dnl
define({__IS_MEM_REF},{dnl
__{}eval(1+regexp({$1},{^\s*(.+)\s*$}))}){}dnl
dnl


Dela se to pomoci vestaveneho makra regexp, ktere vraci pozici hledaneho vyrazu.

Hledam: pocatek_mozne-mezery_(_aspon-jeden-znak_)_mozne-mezery_konec --> ^_\s*_(_.+_)_\s*_$ --> ^\s*(.+)\s*$

Takze bud to cele odpovida a nebo to cele selze, takze to vraci 0 jako prvni znak a nebo -1 nenasel.
Kdyz k tomu prictu 1, tak to pak vraci 1 jako pravda, nebo 0 jako nepravda. Coz je presne to, co dela vestavene makro eval, pokud mu predhodime neco jako 5==5, nebo 5==1.

Vyhoda je, ze je to v kodu snaze citelne, resi to i koncovou zavorku, tedy parametr (50+5)*2 uz nevyhodnoti jako odkaz.
Dalsi vyhoda je, ze me kwrite uz bude korektne ukazovat/zvyraznovat parove zavorky.

Takze vsude menim:
index({$1},{(}),{0}
na:
__IS_MEM_REF($1),{1}

PS: Netestuji vstup zda je cislo, protoze to muze byt slovo napr.
adr_promenne EQU 0x8000
PUSH((adr_promenne))

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Predelavam neco pro 16 bitove porovnani = a nebo <> s konstantou a podarilo se mi tam zavest pomoci parametru i to, ze se to jednou vyhodnoti pres relativni skok a jindy pres absolutni.
Kód:
dnl # Input parameters:
dnl #   $1 = 16 bit number
dnl #   $2 = +-bytes no jump
dnl #   $3 = +-clocks no jump
dnl #   $4 = +-bytes jump
dnl #   $5 = +-clocks jump


Kdyz zacina $4 parametr a-z, A-Z, nebo podrzitko _ tak se to bere ze je to jmeno navesti.

Spamuji tady, ale proto, ze tam mam porad nejake chybky, kdy se mi zbytecne jako prvni vyhodnocuje registr H, protoze obsahuje mensi cislo nez registr L. Tak premyslim nad tim, ze to nemusi byt vzdy serazeno, protoze misto:

x2 = x1 + x1

to muzu byt

x1 = x2 / 2,

protoze bude carry vynulovane.

a pak me to osviti...

Ono to klidne pri deleni (shiftu A) v pohode spolkne i ten vyhozeny nejnizsi bit.

Takze to zvladne i kdyz x2 = x1 + x1 + 1. To jsou 2 operace za cenu jedne! Kolik takovych triku jsem jeste asi prehledl a to se tomu venuji fakt dlouho.
Kód:
                     ;[12:42/21,42] dup 0x2041 = if   ( x1 -- x1 )   0x2041 == HL
    ld    A, 0x20       ; 2:7       dup 0x2041 = if
    cp    H             ; 1:4       dup 0x2041 = if   x[1] = 0x20
    jp   nz, else101    ; 3:10      dup 0x2041 = if
    ld    A, 0x41       ; 2:7       dup 0x2041 = if
    xor   L             ; 1:4       dup 0x2041 = if   x[2] = 0x41
    jp   nz, else101    ; 3:10      dup 0x2041 = if
                       ;[12:42]

Kód:
                     ;[11:39/21,39] dup 0x2041 = if   ( x1 -- x1 )   0x2041 == HL
    ld    A, 0x41       ; 2:7       dup 0x2041 = if
    cp    L             ; 1:4       dup 0x2041 = if   x[1] = 0x41
    jp   nz, else101    ; 3:10      dup 0x2041 = if
    rra                 ; 1:4       dup 0x2041 = if
    xor   H             ; 1:4       dup 0x2041 = if   x[2] = x[1]/2
    jp   nz, else101    ; 3:10      dup 0x2041 = if
                       ;[11:39]

_________________
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: 04.07.2022, 04:10 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Dodelal jsem tu 16 bitovou variantu makra pro generovani optimalniho kodu pro EQ/NE. A tim jsem presunol veskorou slozitost do tohoto pomocneho makra. Vcetne testu zda je parametr neznama, nebo memory reference.

Dve slova na ukazku puvodne vypadala takto, kde jsem se snazil pro kazdou variantu definovat kod
Kód:
dnl dup const = if
define({DUP_PUSH_EQ_IF},{dnl
__{}define({IF_COUNT}, incr(IF_COUNT)){}dnl
__{}pushdef({ELSE_STACK}, IF_COUNT){}dnl
__{}pushdef({THEN_STACK}, IF_COUNT){}dnl
__{}ifelse($1,{},{
__{}__{}.error {$0}(): Missing address parameter!},
__{}$#,{1},,{
__{}__{}.error {$0}($@): $# parameters found in macro!})
__{}ifelse(__IS_MEM_REF($1),{1},{dnl
__{}__{}                        ;[14:27/54] dup $1 = if
__{}__{}    ld    A, format({%-11s},$1); 3:13      dup $1 = if
__{}__{}    xor   L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A,format({%-12s},(1+$1)); 3:13      dup $1 = if
__{}__{}    xor   H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) & 0xFFFF),{0},{dnl
__{}__{}                        ;[5:18]     dup $1 = if   variant: zero
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    or    H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0xFFFF) - 0x00FF),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 = if   variant: 0x00FF = 255
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    inc   A             ; 1:4       dup $1 = if
__{}__{}    or    H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0xFFFF) - 0xFF00),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 = if   variant: 0xFF00 = 65280
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    inc   A             ; 1:4       dup $1 = if
__{}__{}    or    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0xFFFF) - 0xFFFF),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 = if   variant: -1
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    and   L             ; 1:4       dup $1 = if
__{}__{}    inc   A             ; 1:4       dup $1 = if   A = 0xFF --> 0x00 ?
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0x00FF) - 0x00FF),{0},{dnl
__{}__{}                        ;[11:18/39] dup $1 = if   variant: lo($1) = 255
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    inc   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 = if
__{}__{}    xor   H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0xFF00) - 0xFF00),{0},{dnl
__{}__{}                        ;[11:18/39] dup $1 = if   variant: hi($1) = 255
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    inc   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 = if
__{}__{}    xor   L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) ^ 256),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 = if   variant: 0x0100 = 256
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    or    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) & 0xFF),{0},{dnl
__{}__{}                        ;[7:25]     dup $1 = if   variant: lo($1) = zero
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 = if
__{}__{}    xor   H             ; 1:4       dup $1 = if
__{}__{}    or    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) ^ 0x0001),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 = if   variant: 0x0001
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    or    H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) & 0xFF00),{0},{dnl
__{}__{}                        ;[7:25]     dup $1 = if   variant: hi($1) = zero
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 = if
__{}__{}    xor   L             ; 1:4       dup $1 = if
__{}__{}    or    H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) ^ 0x0101),{0},{dnl
__{}__{}                        ;[9:18/32]  dup $1 = if   variant: 0x0101 = 257
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    cp    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) ^ 0x0201),{0},{dnl
__{}__{}                       ;[10:22/36]  dup $1 = if   variant: 0x0201 = 513
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    cp    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(($1) ^ 0x0102),{0},{dnl
__{}__{}                       ;[10:22/36]  dup $1 = if   variant: 0x0102 = 258
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    cp    H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(((($1) & 0xFF00)>>8)-(($1) & 0xFF)),{0},{dnl
__{}__{}                       ;[10:18/35]  dup $1 = if   variant: hi($1) = lo($1) = eval(($1) & 0xFF)
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    cp    L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    xor  low format({%-11s},$1); 2:7       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval(((($1) & 0xFF00)>>8)-1),{0},{dnl
__{}__{}                       ;[11:18/39]  dup $1 = if   variant: hi($1) = 1
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    xor  low format({%-11s},$1); 2:7       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}eval((($1) & 0xFF)-1),{0},{dnl
__{}__{}                       ;[11:18/39]  dup $1 = if   variant: lo($1) = 1
__{}__{}    ld    A, L          ; 1:4       dup $1 = if
__{}__{}    dec   A             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A, H          ; 1:4       dup $1 = if
__{}__{}    xor  high format({%-10s},$1); 2:7       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if},
__{}{dnl
__{}__{}                       ;[12:21/42]  dup $1 = if   variant: default
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 = if
__{}__{}    xor   L             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 = if
__{}__{}    xor   H             ; 1:4       dup $1 = if
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      dup $1 = if})})dnl
dnl
dnl
dnl
dnl dup const <> if
define({DUP_PUSH_NE_IF},{dnl
__{}define({IF_COUNT}, incr(IF_COUNT)){}dnl
__{}pushdef({ELSE_STACK}, IF_COUNT){}dnl
__{}pushdef({THEN_STACK}, IF_COUNT){}dnl
__{}ifelse($1,{},{
__{}__{}.error {$0}(): Missing address parameter!},
__{}$#,{1},,{
__{}__{}.error {$0}($@): $# parameters found in macro!})
__{}ifelse(__IS_MEM_REF($1),{1},{dnl
__{}__{}                        ;[13:29/51] dup $1 <> if
__{}__{}    ld    A, format({%-11s},$1); 3:13      dup $1 <> if
__{}__{}    xor   L             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+9        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A,format({%-12s},(1+$1)); 3:13      dup $1 <> if
__{}__{}    xor   H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval($1),{0},{dnl
__{}__{}                        ;[5:18]     dup $1 <> if   variant: zero
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    or    H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0xFFFF) - 0x00FF),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 <> if   variant: 0x00FF = 255
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    inc   A             ; 1:4       dup $1 <> if
__{}__{}    or    H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0xFFFF) - 0xFF00),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 <> if   variant: 0xFF00 = 65280
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    inc   A             ; 1:4       dup $1 <> if
__{}__{}    or    L             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0xFFFF) - 0xFFFF),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 <> if   variant: -1
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    and   L             ; 1:4       dup $1 <> if
__{}__{}    inc   A             ; 1:4       dup $1 <> if   A = 0xFF --> 0x00 ?
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0x00FF) - 0x00FF),{0},{dnl
__{}__{}                        ;[10:20/36] dup $1 <> if   variant: lo($1) = 255
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    inc   A             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+8        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 <> if
__{}__{}    xor   H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0xFF00) - 0xFF00),{0},{dnl
__{}__{}                        ;[10:20/36] dup $1 <> if   variant: hi($1) = 255
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    inc   A             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+8        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 <> if
__{}__{}    xor   L             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(($1) ^ 256),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 <> if   variant: 0x0100 = 256
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    dec   A             ; 1:4       dup $1 <> if
__{}__{}    or    L             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(($1) & 0xFF),{0},{dnl
__{}__{}                        ;[7:25]     dup $1 <> if   variant: lo($1) = zero
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 <> if
__{}__{}    xor   H             ; 1:4       dup $1 <> if
__{}__{}    or    L             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(($1) ^ 0x0001),{0},{dnl
__{}__{}                        ;[6:22]     dup $1 <> if   variant: 0x0001
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    dec   A             ; 1:4       dup $1 <> if
__{}__{}    or    H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(($1) & 0xFF00),{0},{dnl
__{}__{}                        ;[7:25]     dup $1 <> if   variant: hi($1) = zero
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 <> if
__{}__{}    xor   L             ; 1:4       dup $1 <> if
__{}__{}    or    H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(($1) ^ 0x0101),{0},{dnl
__{}__{}                        ;[8:20/29]  dup $1 <> if   variant: 0x0101 = 257
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    cp    L             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+6        ; 2:7/12    dup $1 <> if
__{}__{}    dec   A             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(((($1) & 0xFF00)>>8)-(($1) & 0xFF)),{0},{dnl
__{}__{}                        ;[9:20/32]  dup $1 <> if   variant: hi($1) = lo($1) = eval(($1) & 0xFF)
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    cp    L             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+7        ; 2:7/12    dup $1 <> if
__{}__{}    xor  low format({%-11s},$1); 2:7       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval(((($1) & 0xFF00)>>8)-1),{0},{dnl
__{}__{}                       ;[10:20/36]  dup $1 <> if   variant: hi($1) = 1
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    dec   A             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+8        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    xor  low format({%-11s},$1); 2:7       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}eval((($1) & 0xFF)-1),{0},{dnl
__{}__{}                       ;[10:20/36]  dup $1 <> if   variant: lo($1) = 1
__{}__{}    ld    A, L          ; 1:4       dup $1 <> if
__{}__{}    dec   A             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+8        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A, H          ; 1:4       dup $1 <> if
__{}__{}    xor  high format({%-10s},$1); 2:7       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if},
__{}{dnl
__{}__{}                        ;[11:23/39] dup $1 <> if   variant: default
__{}__{}    ld    A, low format({%-7s},$1); 2:7       dup $1 <> if
__{}__{}    xor   L             ; 1:4       dup $1 <> if
__{}__{}    jr   nz, $+8        ; 2:7/12    dup $1 <> if
__{}__{}    ld    A, high format({%-6s},$1); 2:7       dup $1 <> if
__{}__{}    xor   H             ; 1:4       dup $1 <> if
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      dup $1 <> if})})dnl
dnl

A ted to vypada:
Kód:
dnl # dup const = if
define({DUP_PUSH_EQ_IF},{dnl
__{}define({IF_COUNT}, incr(IF_COUNT))dnl
__{}pushdef({ELSE_STACK}, IF_COUNT)dnl
__{}pushdef({THEN_STACK}, IF_COUNT)dnl
__{}ifelse($1,{},{
__{}__{}.error {$0}(): Missing parameter!},
__{}eval($#>1),{1},{
__{}__{}.error {$0}($@): $# parameters found in macro!},
__{}{dnl
__{}__{}define({_TMP_INFO},{dup $1 = if})dnl
__{}__{}define({_TMP_STACK_INFO},{ _TMP_INFO   ( x1 -- x1 )   $1 == HL})dnl
__{}__{}__EQ_MAKE_BEST_CODE($1,3,10,else{}IF_COUNT,0)
__{}__{}_TMP_BEST_CODE
__{}__{}    jp   nz, else{}IF_COUNT    ; 3:10      _TMP_INFO})}){}dnl
dnl
dnl
dnl
dnl # dup const <> if
define({DUP_PUSH_NE_IF},{dnl
__{}define({IF_COUNT}, incr(IF_COUNT))dnl
__{}pushdef({ELSE_STACK}, IF_COUNT)dnl
__{}pushdef({THEN_STACK}, IF_COUNT)dnl
__{}ifelse($1,{},{
__{}__{}.error {$0}(): Missing parameter!},
__{}eval($#>1),{1},{
__{}__{}.error {$0}($@): $# parameters found in macro!},
__{}{dnl
__{}__{}define({_TMP_INFO},{dup $1 <> if})dnl
__{}__{}define({_TMP_STACK_INFO},{ _TMP_INFO   ( x1 -- x1 )   $1 <> HL})dnl
__{}__{}__EQ_MAKE_BEST_CODE($1,3,10,3,-10)
__{}__{}_TMP_BEST_CODE
__{}__{}    jp    z, else{}IF_COUNT    ; 3:10      _TMP_INFO})}){}dnl


A to se da aplikovat na DUP_PUSH_EQ_UNTIL, DUP_PUSH_EQ_WHILE atd.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Zas je toho tolik, ze nevim kde zacit, nebo zda vubec neco psat, hodne z toho je navic napul hotovo.

Na rossetacode (skvely zdroj forth programku) jsem narazil na program pro vypocet velikonoc. Co me na nem nejvic zaujalo je tahle cast:
Kód:
: bs ( -- backspace )
  8 emit ;

: eastern ( year -- )
  dup year ! . bs ." :" space ea_day . bs space ea_month monthname ;


Vystup vypada nejak takto: "2020: 12 Apr"

Je to pro me ukazka jak nekdo resi to ze slovo vypisujici cislo "." automaticky pridava mezeru ZA cislo. Pritom vetsinou chceme mezeru PRED cislem. Proste ji pokazde smaze tim ze vytiskne znak s kodem 8, ktery smaze predchozi, nebo spis asi vraci kurzor a u tisku mezery to moc nepoznate, i kdyz uz nic netisknete pokud nevyvolate scroll.

Funguje to i na ZX!

Ja jsem puvodne u slova DOT netisknul nic, pak pridal mezeru PRED. Protoze... je to "modularnejsi" kdy runtime knihovna vypada nejak takto:

mezera_a_cislo:
tiskni_mezeru
cislo:
tiskni_cislo
ret

Zatimco volitelna mezera na konci jde udelat jen


cislo_a_mezera:
call cislo
tiskni_mezeru
ret
cislo:
tiskni_cislo
ret

Tohle se komplikuje pokud mate v kodu jeste signed a zaroven unsigned.

space_s16:
tiskni_mezeru
s16:
if zaporne
tiskni_minus
negace
endif
Pokud_existuje_space_u16_skoc_na_u16
space_u16:
tiskni_mezeru
u16
tiskni_cislo
ret

Takze jsem mel mezeru pred cislem a moznost i levne volat tisk bez mezery. Ale nemel jsem na to slova. No a tady vznikl pro me nejvetsi orisek.

Pokud DOT je " -123" tak jak nazvat "-123"?

Pokud by DOT bylo "-123 " tak udelam DOT_BS jako "-123". Nestadartni, ale pochopitelne. Hral jsme si s NS_DOT jako no space...
A nakonec se vratil k DOT bez mezery "-123". A SPACE_DOT jako " -123". Funguje samozrejme i SPACE DOT, jen to vlozi (inline) 3 bajty navic pro SPACE. V dobe kdy jsem prechazel na DOT s mezerou jsem jeste nemel slovo SPACE.

Dusledek je ze jsem musel prepisovat (a jeste prepisuji) testovaci programky a pritom narazil na nejake chyby.

_________________
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.07.2022, 00:11 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Ve slovech DUP_PUSH_UEQ_WHILE() a DUP_PUSH_UNE_WHILE() jsem se jen odkazal na signed variantu, proste jen zamenil jedno slovo za druhe, takze se spistilo jine makro. Ale zapomel jsem predat parametr $1, takze to selhalo.

U nekterych optimalizacich WHILE, aby fungovali i kdyz parametr ma pro makro neznamou hodnotu, ale je znama prekladaci jsem neco kopiroval z vystupu a zanesl chybu ze jsem misto pocitadla smycky pouzil konstantu. Prvni while smycku. Neprijemna chyba protoze, nikdy nezarve prekladac a navic u prvni smycky funguje vse jak ma.

U DO LOOP smycek kdy jsou zname parametry smycky v dobe prekladu. Takze vlastne XDO(stop,index) XLOOP. Funguje to pomoci samoprepisujiciho se kodu, kdy se oba parametry nactou z datoveho zasobniku a ulozi primo do kodu.

Vypada nejak takto, vcetne vyvolani indexu nekde ve smycce:
Kód:
../check_word.sh 'XDO(5,1) SWAP XI SWAP XLOOP'

    ld   BC, 1          ; 3:10      xdo(5,1) 101
xdo101save:             ;           xdo(5,1) 101
    ld  (idx101),BC     ; 4:20      xdo(5,1) 101
xdo101:                 ;           xdo(5,1) 101
    ex   DE, HL         ; 1:4       swap ( b a -- a b )
    push DE             ; 1:11      index(101) xi
    ex   DE, HL         ; 1:4       index(101) xi
    ld   HL, (idx101)   ; 3:16      index(101) xi   idx always points to a 16-bit index
    ex   DE, HL         ; 1:4       swap ( b a -- a b )
                        ;[12:45]    xloop 101   variant +1.B: 0 <= index < stop <= 256, run 4x
idx101 EQU $+1          ;           xloop 101   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       xloop 101   1.. +1 ..(5), real_stop:0x0005
    nop                 ; 1:4       xloop 101   hi(index) = 0 = nop -> idx always points to a 16-bit index.
    inc   A             ; 1:4       xloop 101   index++
    ld  (idx101),A      ; 3:13      xloop 101
    xor  0x05           ; 2:7       xloop 101   lo(real_stop)
    jp   nz, xdo101     ; 3:10      xloop 101   index-stop
xleave101:              ;           xloop 101
xexit101:               ;           xloop 101
                       ;[26:114]

XDO musi ulozit aktualni index, protoze ho bude XI potrebovat. Je v BC, ale tam nemuze zustat protoze tohle je prekladac a musi byt defenzivni, a nevi zda BC nepouzije jine slovo, nebo ve smycce neni dalsi smycka. Bohuzel, tohle je zakladni pravidlo a proto je kod casto neoptimalni.

Hmm koukam ze jsme zvolil spatny priklad protoze se me kod XLOOP prilis optimalizuje.
Kód:
../check_word.sh 'XDO(300,1) SWAP XI SWAP XLOOP'

    ld   BC, 1          ; 3:10      xdo(300,1) 101
xdo101save:             ;           xdo(300,1) 101
    ld  (idx101),BC     ; 4:20      xdo(300,1) 101
xdo101:                 ;           xdo(300,1) 101
    ex   DE, HL         ; 1:4       swap ( b a -- a b )
    push DE             ; 1:11      index(101) xi
    ex   DE, HL         ; 1:4       index(101) xi
    ld   HL, (idx101)   ; 3:16      index(101) xi   idx always points to a 16-bit index
    ex   DE, HL         ; 1:4       swap ( b a -- a b )
                        ;[16:57/58] xloop 101   variant +1.default: step one, run 299x
idx101 EQU $+1          ;           xloop 101   idx always points to a 16-bit index
    ld   BC, 0x0000     ; 3:10      xloop 101   1.. +1 ..(300), real_stop:0x012C
    inc  BC             ; 1:6       xloop 101   index++
    ld    A, C          ; 1:4       xloop 101
    xor  0x2C           ; 2:7       xloop 101   lo(real_stop) first (44>1)
    jp   nz, xdo101save ; 3:10      xloop 101   1x false positive
    ld    A, B          ; 1:4       xloop 101
    xor  0x01           ; 2:7       xloop 101   hi(real_stop)
    jp   nz, xdo101save ; 3:10      xloop 101   44x false positive if he was first
xleave101:              ;           xloop 101
xexit101:               ;           xloop 101
                       ;[30:127]

No a XLOOP toho vyuzije ze XDO uklada index do pameti a vola xdo101save.

A ta chyba co jsem mel, ze u "?do" teda "QUESTIONXDO" jsem tohle zapomel pridat. A v kodu jsem mel neco co zjisti ze smyck nikdy neprobehne tak se QUESTIONXDO rozbali na pouhe "jp xexit101". Ale vsechen kod uvnitr smycky vcetne XLOOPu zustane. A prekladaci vadi ze mrtvy kod vola xdo101save, ktery neexistuje a selze.

Tak jsem pridal do QUESTIONXDO label a hotovo.

Slo by vymazat bajty i z XLOOP, kdybych pridal nejakou promennou, ale to by nevymazalo kod uvnitr smycky.
To by slo udelat kdybych do KAZDEHO slovo pridal nejakou podminku. Ale to je uz moc prace, abych optimalizoval kod pro pripad, kdy vime uz v dobe prekladu, ze kod nikdy neprobehne.

Ale ta myslenka s tim pridat do kazdeho makra nejake univerzalni makro, me v hlave lezi. Slo by tam napriklad sdelit co je v registrech... a podle toho optimalizovat slovo. Po push proste vim co mam v HL, nebo vim ze BC jsem nepouzil atd. Ale chce to vychytat skoky (tedy i smycky). Tuhle optimalizaci (predavani vice informaci) by slo udelat i pred makra. Slo by predat i informaci ze nikdy nepouzijeme index, proste chceme jen x-krat vykonat smycku, a to jde zapsat mnohem lepe jako sestupnou smycku k nule.

_________________
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.07.2022, 00:23 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Hodne jsem prejmenovaval include soubory.

Myslim ze se to puvodne jmenovalo output.m4 a obsahovalo to prvne funkce pro tisk cisla atd. Coz je docela pomaly kod a dlouhy kod. Takze kdyz ho volame pred call tak to neni o moc pomalejsi, ale rozhodne je to mnohem kratsi uz od dvou pouziti.

Casem tam prislo vsechno co proste neni inline, protoze to musi byt posledni include makro.

Takze tam sly operace pro nasobeni, deleni atd. a porad se to jmenovalo output...

Soubor s nazvem funkce.m4 uz existuje, protoze ten zase obsahuje makra pro definici vlastnich slov.

Nevedel jsem jak to nazvat a nakonec zvolil nazev runtime.m4. Jako zkratku pro runtime_library.m4. A kdyz uz by toho tak prejmenoval, vsechny soubory co maji byt posledni na xxx_runtime.m4. Takze je to pekne videt, pokud vite na co mate koukat.

Existuje nejaky lepsi kratky nazev?

Na netu jsem nasel ze runtime library vzniklo presne ze stejneho duvodu jaky mam ja. Nejaky casto opakujici se kod. Jen ho teda nemaji aktivovany jen v pripade pouziti pres IF.

_________________
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.07.2022, 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
Posledni vec kterou napisi je ze jsem konecne po roce? Zjistil (asi) jak funguji nejake zakladni slova ve Forthu pro pamet.

Pomohlo me k tomu slovo BUFFER:. To je proste neco co vite jak vypada a Forth to umi take. A u neho jsem nasel jak by slo implementovat pomoci jinych zakladnich slov. Takze to vypada ze...

Slovo "CREATE buf" se da implementovat jako uplne nakonec vytvor label se jmenem "buf:"

n ALLOT se da implementovat ze uplne nakonec napis "DS n". To vytvori neinicializovany prostor pro n bajtu.

A to je vse.

Drobna chybka na krase je ze, pokud to bude ve smycce tak ma prekladac smulu. Pokud ALLOT ma zaporny parametr, jako ze muze mit pro dealokaci, tak mam taky smulu... I kdyz tohle by jeste slo.
Kód:
CREATE buf 100 ALLOT
-50 ALLOT
CREATE buf2

je neco jako
Kód:
buf:
DS 100
buf2 EQU $-50


Ale to uz jsem neimplementoval. Musel jsem jeste prohodit ze jsem mel prvne sekci pro promenne a pak retezce. Takze ted jsou to retezce a pak promenne. A uz se nemusi i nejprimitivnejsi programy upravovat rucne.
Kdy jsem musel pred koncem volat LAST.M4 obsahujici vsechny _runtime soubory a v programu definovane promenne a retezce. Abych konecne mohl napsat pod to neco jako "buf:"

U tohoto bych jeste zminil ze jsem resil i slova jako VALUE a VARIABLE u kterych jsem mel hokej a implementoval jen VARIABLE.
Takze "VARIABLE name" by melo delat neco jako
Kód:
name:
dw 0
. Ja mel moznost i pridat parametr a misto nuly tam mohlo byt i neco jineho. S tim problemem, ze po prepsani, uz to nikdy nebude znovu inicializovane na puvodni hodnotu pokud zavolate program znovu.
"n VALUE name" zato udela neco takoveho
Kód:
ld HL, n            ; cast kdy vkladame do TOS n
ld (p_name), HL    ; inicializace
...zde do HL nacti dalsi hodnotu z datoveho zasobniku
...

p_name:
dw 0
A pak jeste delsi rozdil je, ze name od VARIABLE v kodu pak vraci adresu a name v kodu od VALUE pak vraci hodnotu z adresy.
VALUE ted uplne rozbiji optimalizace pro spojeni slov. Jako PUSH_NECO_NECO. Protoze misto PUSH je tam XXX NECO NECO. Takze doporucuji pouzivat VARIABLE s tim ze pouzijete PUSH a misto "name" date parametr "(name)" a tim reknete ze je to adresa. Butu to muset predelat a zmenit XXX od VALUE na PUSH((XXX)).

A zapomel jsem, ze aby VALUE nebylo jen takovy CONSTANT, tak jeste jde prepsat hodnotu pomoci "n TO name". Spatna zprava je, ze pokud je to double hodnota tak se to zase vola "d TO name". Ale inicializace je pres 2VALUE. Ech.. Mam to ted DVALUE, protoze mam jeste CVARIABLE pro bajt. A bylo by to jeste divnejsi mit CVARIABLE, VARIABLE, _2VARIABLE... A "d DTO name".

Pak existuje i slovo HERE, coz by melo byt neco jako "CREATE here here", jen bez pojmenovani. Vlozi to prvni volnou adresu.

Bohuzel na https://www.tutorialspoint.com/execute_forth_online.php to tak uplne nefunguje....

CREATE vam prida bajty... ale mam pocit ze je tam implementacni volnost.

Rozumi tomu tady nekdo? Pridal jsem odkazy pro anglicky popis co to ma delat.

_________________
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.07.2022, 19:50 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Upravoval jsem program na test pixelu.

Pozmenil jsem rutinu pro tisk pixelu tak, aby nevracela adresu pameti, kde lezi pixel, ale vracela vstup yx. Ve forthu jsem to stejne musel jen zahazovat z TOS a takhle je to mnohem jednodusi.

Upravil jsem to na zelvi grafiku a kreslil z toho ramecek. Pak si hral s atributy a pomoci FILL vyplnoval radky a nasel dve chyby. Jedna v PUSH3_FILL a druha v PUSH2_FILL. Obe chyby jsou v podstate totozne. Pri zadani, ze se bude vyplnovat 24 bajtu rutiny presly do rezimu vyplnovani 3 bajtu na jednu djnz smycku, ale mel jsem tam djnz $-4 misto djnz $-6. V te grafice to bylo hned videt, ze je neco spatne.

Pak me to jeste vyhodilo chybu u ../check_word.sh 'XDO(25700,0) PUSH_ADDXLOOP(256+1)'

Tam jsem v jednom pomocnem makru nemel vsude ozavorkovany vstupni parametr a pak to v tom hlavnim makru selhalo, protoze to skocilo do ELSE u CASE, kde je komentar ze tohle se fakt nikdy nemuze stat.

Příloha:
pixel.png
pixel.png [ 5.47 KiB | Zobrazeno 2036 krát ]


Narazil jsem na to, ze nedokazi psat do prvniho radku pomoci romky. Kdyz zadam do retezce neco jako "ZX_AT,0,0" tak to vyhodi chybu.

CONSTANT(ZX_AT,0x16)
CONSTANT(ZX_LEFT,0x08)

Nejlip co jsem zvladl bylo ZX_AT,1,1,ZX_LEFT

Tady je o tom asi zminka, kdyz najedete mysi nad left nebo right. Asi chyba v ROM?

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

PS: A prisel jsem na to jak rozdelit dlouhy retezec na vice radku, aniz bych ho rozdelil na vice radku.
Kód:
   PRINT_Z(dnl
{"Lorem ipsum dolor sit amet, cons}dnl
{ectetur adipiscing elit. Etiam p}dnl
{ellentesque, purus a tincidunt e}dnl
{uismod, turpis neque pretium ant}dnl
{e, et tempor purus metus a nisl.}dnl
{Aenean dictum tortor hendrerit n}dnl
{ibh luctus condimentum. Pellente}dnl
{sque vel urna eget risus digniss}dnl
{im volutpat. Praesent semper nis}dnl
{i quam, id egestas odio luctus u}dnl
{t. Suspendisse dignissim loborti}dnl
{s massa nec maximus. Interdum et}dnl
{malesuada fames ac ante ipsum pr}dnl
{imis in faucibus. Curabitur quis}dnl
{dui a lacus fringilla venenatis }dnl
{sed vel lacus. Duis scelerisque }dnl
{orci a risus cursus, in facilisi}dnl
{s metus condimentum. Sed ultrici}dnl
{es nibh vitae pretium placerat. }dnl
{Fusce et nibh at ante vehicula p}dnl
{haretra sed quis nisi. Aliquam t}dnl
{incidunt nulla at enim efficitur}dnl
{laoreet. Maecenas aliquam libero}dnl
{metus, nec commodo lacus vestibu"})

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


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 22.07.2022, 07:29 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Asi bych mel brzdit, kdyz vsechen volny cas programuji. Uz je zase rano a za sebou mam dalsi probdenou noc. Je to skvela vec na zabiti casu, kdyz jen cekate na konec, ale zacina me to zmahat.

Nechce se me moc rozepisovat, ale zmen je prilis mnoho. Musel jsem nekolikrat znovu prepisovat kod, protoze se ukazalo, ze je to vhodnejsi resit jinak, s jinymi parametry, jinym poradim parametru. Ze je to prilis komplikovane a musim to rozdelit na vic podfunkci atd.

Takze je hotovo vcetne automatickeho prevodu z forthu do M4 FORTHu:

CREATE(jmeno_navesti)

PUSH_ALLOT(pocet_bajtu)
Tohle slovo musi mit parametr, protoze musim vedet jaka je skutecna hodnota kolik chcete alokovat. Pokud to bude ve smycce nebo ve funkci tak to selze. V podstate to udela "DS pocet_bajtu".
Co je dulezite, uz to umi i dealokaci! Mel jsem asi v 6 rano v nedeli, ze by to mohlo jit kdyz budu pouzivat v CREATE zasobnikovy typ definice. Takze pomoci undefine se dostanu zpet na predchozi jmeno_navesti. K tomu je jeste existuje dalsi makro ktere si pamatuje kolik bajtu pod danym slovem bylo.
Pal me doslo, ze mam ale problem kdyz zacnu znovu alokovat tak jak to zapsat...
Po rade neuspechu jsem mel napad vyzkouset co dela ve zdrojaku "ORG $-40". A dela presne co chci, minimalne pokud tam zadam nove ukazatele tak budou mit spravnou adresu.

HERE
Tohle slovo hodi na zasobnik prvni volnou adresu. V podstate ulozim do HL,posledni_jmeno_navesti+kolik_tam_je_ted_bajtu

VARIABLE(jmeno_promenne)
PUSH_VARIABLE(hodnota,jmeno_promenne)
Udelal jsem zmenu v poradi parametru, takhle je to jak to ma forth, musel jsem prepsat a zkontrolovat hodne kodu

DVARIABLE(jmeno_promenne)
PUSHDOT_DVARIABLE(32bitova_hodnota,jmeno_promenne)

Obdobne s VALUE
A automaticky prevod uz sam pozna podle jmena zda je to ukazatel a nebo chceme cist z dane adresy. Takze to zmeni na PUSH((jmeno_promenne)). U VALUE() a TO() to naopak nezazavorkuje. Takze veskere optimalizace jsou funkcni.

TO(jmeno_promenne)
Samo to uz pozna zda je to 16 bitova nebo 32 bitova hodnota.
PUSH_TO(jmeno_promenne)
PUSHDOT_TO(jmeno_promenne)

COMMA
PUSH_COMMA()
PUSHS_COMMA()
Tohle forth slovo co vypada jako carka s mezerama okolo dela to ze nacte z datoveho zasobniku hodnotu a ulozi ji na prvni volne misto v pameti.
Takze program z rossetacode
Kód:
include random.fs
 
: shuffle ( deck size -- )
  2 swap do
    dup i random cells +
    over @ over @  swap
    rot  ! over !
    cell+
  -1 +loop drop ;
 
: .array   0 do dup @ . cell+ loop drop ;
 
create deck 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 ,
 
deck 10 2dup shuffle .array

Vypada nejak takto
Kód:
include(`../M4/FIRST.M4')dnl
ORG 0x8000
INIT(60000)
CREATE(_deck) PUSHS_COMMA(1,2,3,4,5,6,7,8,9,10)
PUSH2(_deck,10) _2DUP CALL(_shuffle) CALL(_dot_array)
STOP
 
COLON(_shuffle)
;#( deck size -- )
  PUSH_SWAP(2) DO
    DUP I RANDOM _2MUL ADD
    OVER FETCH OVER FETCH  SWAP
    ROT  STORE OVER STORE
    _2ADD
  PUSH_ADDLOOP(-1) DROP SEMICOLON
 
COLON(_dot_array)   PUSH(0) DO DUP_FETCH SPACE_DOT _2ADD LOOP DROP CR SEMICOLON


Uz jsem psal o tom, ze to nemuzu zapsat jen jako
Kód:
_deck: dw 1,2,3,4,5,6,7,8,9,10

Protoze pri druhem spusteni uz _deck bude obsahovat zamichane hodnoty. Takze se to musi znovu prepsat.
Po nejake dobe jsem rezignoval to udelat lepe, protoze by to nebylo podle standardu a psal neco jako
Kód:
ld HL, 1
ld (_deck),HL
ld HL, 2
ld (_deck+2),HL
...

A pak to zacalo... optimalizace... A ze jich tam je! Protoze, zname predchozi hodnotu a navic je to v HL.

To same nedelni rano, touhle ranni dobou (5:51 v Chesteru) pred usnutim me napadlo jak jsem blby. A kdysi optimalizoval slovo PUSH(5) a PUSH(10) na PUSH2(5,10) protoze me vypadne 2x ex HL, DE. A u tri hodnot to vzdal protoze to prece nejde.
Kód:
../check_word.sh 'PUSH(5) PUSH(10) PUSH2(5,10)'

    push DE             ; 1:11      push(5)
    ex   DE, HL         ; 1:4       push(5)
    ld   HL, 5          ; 3:10      push(5)
    push DE             ; 1:11      push(10)
    ex   DE, HL         ; 1:4       push(10)
    ld   HL, 10         ; 3:10      push(10)
    push DE             ; 1:11      push2(5,10)
    push HL             ; 1:11      push2(5,10)
    ld   DE, 5          ; 3:10      push2(5,10)
    ld   HL, 0x000A     ; 3:10      push2(5,10)
                       ;[18:92]

Ale proc by to neslo, kdyz vlastne prvne ulozim DE a HL na zasobnik, protoze budou oba prepsany a pak bud do HL nebo DE dam prvni hodnotu a taky ji hodim na zasobnik a pak druhou dam do DE a posledni do HL. Hotovo.
No... vlastne ne. Tohle je jeste vetsi slozitost nez v PUSHS_COMMA.
Mam nejake 3 hodnoty ktere znam, a dve budou lezet ve stejnem registru. Tech kombinaci je fakt hodne. Psal jsem to asi 3 dny. Vytvarel funkce, ty nadale delil atd.
Az dospel k zakladnim 2 pomocnym funkcim.

Prvni vypada takto:
__LD_REG16_16BIT({HL},co_tam_chci,{DE},0x1234,{HL},0x5678)
Prvni parametr je jmeno registru pro ktery chci generovat kod.
Druhy parametr je co tam chci mit za hodnotu
Pak nasleduji nepovinne dvojice parametru s jmenem registru a co tam lezi. Je to delane az pro 8 parametru. Pocita se jen s HL,DE,BC.

Pak me doslo, ze to nebude stacit. Protoze kdyz napriklad mam
Kód:
../check_word.sh "PUSH3(0x55FF,0x56FF,0x5600)"

    push DE             ; 1:11      0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)
    push HL             ; 1:11      0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)
    ld   HL, 0x55FF     ; 3:10      0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)
    push HL             ; 1:11      0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)
    ld    E, L          ; 1:4       0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)   E = L = 0xFF
    inc  HL             ; 1:6       0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)
    ld    D, H          ; 1:4       0x55FF 0x56FF 0x5600  push3(0x55FF,0x56FF,0x5600)   D = H = 0x56
                       ;[ 9:57]

Tak prvni hodnotu zde je nejlepsi vlozit do HL a pak pres inc HL ziskame treti hodnotu. Ale jak do DE vlozime 0x56FF, kdyz nizsi bajt ma L pred zmenou a vyssi bajt ma H po zmene? To potrebuji rozdelit...

__LD_REG16_16BIT_BEFORE_AFTER({DE},co_tam_chci,{HL},0x1234,{HL},0x5678)
Napevno 6 parametru. Kdy se do DE snazi vecpat hodnoty z 4 parametru nebo 6 parametru a vystup je rozdelen na 2 promenne.

Pak me doslo, ze ani to nebude stacit. Ale to uz jsem ignoroval. Muze se stat, ze chceme misto

ld HL, 0x20FE
...
ld HL, 0x2100

a o bajt kratsi je to pres

ld HL, 0x20FE
...
inc L
inc HL

Takze mame hned 0x20,0x21,0xFF,0x00. Ale ten 0xFF ztratim. Pokud bych chtel mit napriklad v DE, 0xFFFF mam smulu.

Je toho mnohem, mnohem vic. Pokud napriklad nacitame do HL 0x5353 a mame HL 0x2052 tak muzeme tady vyuzit toho ze jeden z registru H nebo L udelame prvni a uz je to tak vstup pro druhy registr.

Takze ve vysledku, musim udelat vsechny kombinace pro 8 nebo 16 bit a najit tu nejlepsi.
Kód:
    push DE             ; 1:11      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)
    push HL             ; 1:11      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)
    ld   HL, 0x2222     ; 3:10      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)
    push HL             ; 1:11      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)
    ld   DE, 0x3333     ; 3:10      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)
    add  HL, DE         ; 1:11      0x2222 0x3333 0x5555  push3(0x2222,0x3333,0x5555)   0x5555 = 0x2222+0x3333
                       ;[10:64]


Zpetne jsem pak upravil PUSH2 s vyuzitom novych maker a i PUSHS_COMMA.

PUSHS_COMMA me vadilo, ze kdyz zadate 1,2,3,4,5,6,7,8,9,10 tak to jde napsat lepe. Tak jsem udelal analyzu vstupu a u +1,-1,+256,-256,+0 rad jsem provedl smycku.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh "CREATE(_deck) PUSHS_COMMA(1,2,3,4,5,6,7,8,9,10)"
 
    push HL             ; 1:11      1 , 2 , ... 10 ,   +1
    ld   HL, _deck      ; 3:10      1 , 2 , ... 10 ,
    ld   BC, 0x0A01     ; 3:10      1 , 2 , ... 10 ,
    ld  (HL),C          ; 1:7       1 , 2 , ... 10 ,
    inc  HL             ; 1:6       1 , 2 , ... 10 ,
    ld  (HL),0x00       ; 2:10      1 , 2 , ... 10 ,
    inc  HL             ; 1:6       1 , 2 , ... 10 ,
    inc   C             ; 1:4       1 , 2 , ... 10 ,
    djnz $-6            ; 2:8/13    1 , 2 , ... 10 ,
    pop  HL             ; 1:10      1 , 2 , ... 10 ,
                        ;[16:496]   1 , 2 , ... 10 ,
VARIABLE_SECTION:

_deck:
    dw 1
    dw 2
    dw 3
    dw 4
    dw 5
    dw 6
    dw 7
    dw 8
    dw 9
    dw 10
                       ;[16:82]

Stale to jeste neni ono, protoze kdyz to nenajde radu a spoleha se to na pouhe optimalizace z predchoziho cisla, tak by bylo vhodne to prvne vzestupne seradit, protoze s ld (adresa+x),HL mame volnost co dame za x. To ale vyzaduje seradit n parametru v makru!
Myslim ze to jde... zkousel jsem predtim neco hackovat a nejde to, ale jde udelat z parametru retezec oddeleny treba mezerama. A kazde sude cislo bude index puvodniho parametru. A takovy retezec jde pak seradit. I bez podpory smycek. Pres zasobniky.

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


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 22.07.2022, 08:30 
Offline
Óm Nejvyšší
Uživatelský avatar

Registrován: 28.01.2016, 23:57
Příspěvky: 3756
Has thanked: 213 times
Been thanked: 388 times
Kdyz jsi u tech optimalizaci, nektere implementace drzi vrchni polozky / polozku zasobniku v registrech, takze se setri pristup do pameti...

_________________
Nikdy nediskutujte s blbcem. Stáhne vás na svoji úroveň a vyhraje zkušeností.


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 22.07.2022, 17:29 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Kubik píše:
Kdyz jsi u tech optimalizaci, nektere implementace drzi vrchni polozky / polozku zasobniku v registrech, takze se setri pristup do pameti...


HL = TOS
DE = NOS
(SP+...) = dalsi

Je to videt skoro v kazdem kodu co jsem kopiroval, ze si hraji neustale s ex DE,HL. Protoze kazdy lichy "push", nebo "pop" potrebuje prohodit tyto registry. Bud potrebuji dat byvaly TOS/HL do NOS/DE, protoze do TOS/HL jde nova hodnota pri "pop", nebo pri "pop" byvaly NOS/DE do TOS/HL.
Jestli to je globalne vyhodnejsi nebo ne, je uz na delsi diskuzi, neni to az tak jednoduche. Dalo by se rici, ze staci mit jen TOS v HL. Protoze treba pri +, stejne ztratis jednu hodnotu. Ale zase jsou pripady, kdy vhodnou manipulaci slov, ziskas takove kombinace, ze s tim zasobnikem nehybes, a pokud ta kombinace existuje jako optimalizovane slovo tak je to fakt efektivni. Tohle reseni ma zase drasticky ubytek rychlosti pri praci se zasobnikem navratovych adres, ktery mam v HL'. A je tezke tam dostat DE a HL.
Spravne reseni je to asi zanorovat, nebo vynorovat do (SP) podle aktualnich slov co jsou v kodu. To by, ale vyzadovalo pro uplne KAZDE slovo nekolik variant kodu.
Kód:
../check_word.sh 'PUSH(5) PUSH(10) PUSH2(5,10)'

    push DE             ; 1:11      push(5)
    ex   DE, HL         ; 1:4       push(5)
    ld   HL, 5          ; 3:10      push(5)
    push DE             ; 1:11      push(10)
    ex   DE, HL         ; 1:4       push(10)
    ld   HL, 10         ; 3:10      push(10)
    push DE             ; 1:11      push2(5,10)
    push HL             ; 1:11      push2(5,10)
    ld   DE, 5          ; 3:10      push2(5,10)
    ld   HL, 0x000A     ; 3:10      push2(5,10)
                       ;[18:92]

_________________
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.07.2022, 06:12 
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 do generovani kodu v PUSHS_COMMA i moznost to dat do nevyhodnejsiho BC, pokud je to aspon pres PRICE (takty+4*bajty) aspon stejne jako pro HL pro nasledujici 2 hodnoty. Preferuji to, protoze to vytvari o 2 registry vice pro optimalizace a je sance, ze to bude jeste uzitecnejsi pro dalsi hodnoty.
Vypada to celkem pekne. U 0x0405 se nenechal nachytat na ld H,L a dec H jako ja pri prvnim pohledu a usetril takt.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh --silent "CREATE(_a) PUSHS_COMMA(1,2,-1,3,4,-2,0xFE05,0x0405) "
 
    push HL             ; 1:11      1 , 2 , ... 0x0405 ,   default version
    ld   HL, 1          ; 3:10      1 ,
    ld  (_a),HL         ; 3:16      1 ,
    inc   L             ; 1:4       2 ,
    ld  (_a+2),HL       ; 3:16      2 ,
    ld   BC, 0xFFFF     ; 3:10      -1 ,
    ld  (_a+4),BC       ; 4:20      -1 ,
    inc   L             ; 1:4       3 ,
    ld  (_a+6),HL       ; 3:16      3 ,
    inc   L             ; 1:4       4 ,
    ld  (_a+8),HL       ; 3:16      4 ,
    dec   C             ; 1:4       -2 ,
    ld  (_a+10),BC      ; 4:20      -2 ,
    inc   L             ; 1:4       0xFE05 ,
    ld    H, C          ; 1:4       0xFE05 ,   H = C = 0xFE
    ld  (_a+12),HL      ; 3:16      0xFE05 ,
    ld    H, 0x04       ; 2:7       0x0405 ,
    ld  (_a+14),HL      ; 3:16      0x0405 ,
    pop  HL             ; 1:10      1 , 2 , ... 0x0405 ,
                        ;[42:208]   1 , 2 , ... 0x0405 ,
VARIABLE_SECTION:

_a:
    dw 1
    dw 2
    dw -1
    dw 3
    dw 4
    dw -2
    dw 0xFE05
    dw 0x0405
                       ;[42:208]

_________________
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 ... 11, 12, 13, 14, 15, 16, 17 ... 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