OldComp.cz

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


Právě je 28.03.2024, 21:50

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Zato tohle si vyzadalo o hodne vic zmeny a kontroly kodu, aby rozlisoval jak ukazatele do pameti (a nenechal se nachytat ze (2)==2) a pak i nezname hodnoty. A umel s nema pracovat pokud maji aspon shodu ((2)==(2)).
Kód:
../check_word.sh --silent "CREATE(_a) PUSHS_COMMA(1,2,(2),3,4,(2),5) "
 
    push HL             ; 1:11      1 , 2 , ... 5 ,   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, (2)        ; 4:20      (2) ,
    ld  (_a+4),BC       ; 4:20      (2) ,
    inc   L             ; 1:4       3 ,
    ld  (_a+6),HL       ; 3:16      3 ,
    inc   L             ; 1:4       4 ,
    ld  (_a+8),HL       ; 3:16      4 ,
    ld  (_a+10),BC      ; 4:20      (2) ,
    inc   L             ; 1:4       5 ,
    ld  (_a+12),HL      ; 3:16      5 ,
    pop  HL             ; 1:10      1 , 2 , ... 5 ,
                        ;[36:187]   1 , 2 , ... 5 ,
VARIABLE_SECTION:

_a:
    dw 1
    dw 2
    dw (2)
    dw 3
    dw 4
    dw (2)
    dw 5

Tady je videt ukazka u ukazatelu, jak pozna shodu.
Kód:
    push DE             ; 1:11      push2((0x8000),(0x8000))
    push HL             ; 1:11      push2((0x8000),(0x8000))
    ld   HL, (0x8000)   ; 3:16      push2((0x8000),(0x8000))
    ld    E, L          ; 1:4       push2((0x8000),(0x8000))
    ld    D, H          ; 1:4       push2((0x8000),(0x8000))
                       ;[ 7:46]

A z kodu jsem mohl uplne vyhodit rozlisovani zda je tam ukazatel nebo neznama hodnota, a prenechat praci na subrutinu.
Kód:
dnl # ( -- b a)
dnl # push2(b,a) ulozi na zasobnik nasledujici polozky
define({PUSH2},{ifelse(eval($#<2),{1},{
__{}  .error {$0}($@): Missing parameter!},
eval($#!=2),{1},{
__{}  .error {$0}($@): The wrong number of parameters in macro!},
{
__{}    push DE             ; 1:11      push2($1,$2)
__{}    push HL             ; 1:11      push2($1,$2){}dnl
__{}define({_TMP_INFO},{push2($1,$2)}){}dnl
__{}__LD_REG16_16BIT({DE},$1,{HL},$2){}dnl
__{}define({PUSH2_HL},__CLOCKS_16BIT){}dnl
__{}__LD_REG16_16BIT({HL},$2){}dnl
__{}define({PUSH2_HL},eval(PUSH2_HL+__CLOCKS_16BIT)){}dnl
__{}__LD_REG16_16BIT({HL},$2,{DE},$1){}dnl
__{}define({PUSH2_DE},__CLOCKS_16BIT){}dnl
__{}__LD_REG16_16BIT({DE},$1){}dnl
__{}define({PUSH2_DE},eval(PUSH2_DE+__CLOCKS_16BIT)){}dnl
__{}ifelse(eval(PUSH2_DE<=PUSH2_HL),{1},{__CODE_16BIT{}__{}__LD_REG16_16BIT({HL},$2,{DE},$1){}__CODE_16BIT},
__{}{dnl
__{}__LD_REG16_16BIT({HL},$2){}__CODE_16BIT{}__LD_REG16_16BIT({DE},$1,{HL},$2){}__CODE_16BIT}){}dnl
})}){}dnl

Jenom to jeste budu muset trosku poladit zda nepujde udelat jeden trik, abych to nemusel volat vse 2x. Vlastne jsou na to 2 triky. Protoze problem je s carkama v zdrojaku, ze se po case zacnou vyhodnocovat.
Jeden je ze misto carek se napise __COMMA, ktere se predtim musi pomoci undefine "znefunkcnit". A pak pred vypsanim nahradit za define({__COMMA},{,}).
Druhy trik je ze ty makra se zmeni z procedur menici globalni promenne na funkce. Nebo spis na fce co stale meni globalni promenne.
Protoze ted to vraci
Kód:
dnl # Use: __LD_REG16_16BIT({HL},0x2200,{DE},1,{BC},0x3322,{HL},-1)
dnl # Input:
dnl # _TMP_INFO
dnl #  $1 Name of target register pair
dnl #  $2 Searched 16-bit value that is needed
dnl
dnl #  $3 Source registry name
dnl #  $4 Source registry 16-bit value
dnl #  $5 Source registry name
dnl #  $6 Source registry 16-bit value
dnl #  $7 Source registry name
dnl #  $8 Source registry 16-bit value
dnl
dnl # Output:
dnl # __CLOCKS_16BIT
dnl # __BYTES_16BIT
dnl # __CODE_16BIT
dnl # __PRICE_16BIT = __CLOCKS_16BIT+4*__BYTES_16BIT

A problematicky __CODE_16BIT se da odstranit tak ze misto ukladani do __CODE_16BIT to makro bude vypisovat. A ten vypis si pak muze odchytnout PUSH2.
define({VARIANTA_HL_NAPRED},__LD_REG16_16BIT({HL},$2))
Ale pochybuji ze je to dost srozumitelne co pisi, bez vetsich znalosti psani M4 maker.

PS: ten kod vypada trosku lepe se zvyraznenou syntaxi, viz obrazek, ale vlastne je to stale peklo, kdy na kazde mezere zalezi. .)


Přílohy:
push2.png
push2.png [ 322.21 KiB | Zobrazeno 1691 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: 24.07.2022, 04:47 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Chtel jsem vyzkouset zda me to spravne generuje kod, kdy pro dvojnasobek hodnoty se pouzije add HL,HL a zadal PUSHS_COMMA(1,2,4,8,16,32) s tim, ze uvidim pekne pokazde add HL,HL. A ono nic. Tak si rikam, ok, tak kdyz to bude vic jak jeden bajt tak to uz vygeneruje a pridam radu az do 1024 a ... zase nic. Sakra, kouknu se poradne a vidim aspon jednu add HL,HL! Tazke generuje.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh --silent "CONSTANT({abc},-1) CREATE(_a) PUSHS_COMMA(1,2,4,8,16,32,64,128,256,512,1024) "

abc                  EQU -1 
    push HL             ; 1:11      1 , 2 , ... 1024 ,   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    L, 0x04       ; 2:7       4 ,
    ld  (_a+4),HL       ; 3:16      4 ,
    ld    L, 0x08       ; 2:7       8 ,
    ld  (_a+6),HL       ; 3:16      8 ,
    ld    L, 0x10       ; 2:7       16 ,
    ld  (_a+8),HL       ; 3:16      16 ,
    ld    L, 0x20       ; 2:7       32 ,
    ld  (_a+10),HL      ; 3:16      32 ,
    ld    L, 0x40       ; 2:7       64 ,
    ld  (_a+12),HL      ; 3:16      64 ,
    ld    L, 0x80       ; 2:7       128 ,
    ld  (_a+14),HL      ; 3:16      128 ,
    add  HL, HL         ; 1:11      256 ,   256 = 128+128
    ld  (_a+16),HL      ; 3:16      256 ,
    inc   H             ; 1:4       512 ,
    ld  (_a+18),HL      ; 3:16      512 ,
    ld    H, 0x04       ; 2:7       1024 ,
    ld  (_a+20),HL      ; 3:16      1024 ,
    pop  HL             ; 1:10      1 , 2 , ... 1024 ,
                        ;[55:275]   1 , 2 , ... 1024 ,
VARIABLE_SECTION:

_a:
    dw 1
    dw 2
    dw 4
    dw 8
    dw 16
    dw 32
    dw 64
    dw 128
    dw 256
    dw 512
    dw 1024
                       ;[55:275]

Pak se podivam jeste vic poradne a vidim 2 bajty a 7 taktu je lepsi nez 1 bajt a 11 taktu?

7+4*2 =15
11+4*1=15
A reseni po 8-bitovych hodnotach se generuje prvni.
Ale... chci to? Vlastne nevim, PRICE je uplne shodne, ale jedno reseni je na rychlost a druhe na velikost (malost? :) ).
Co preferujete?
Pridat zase volitelnou "direktivu"?

PS: Zacina to byt chytrejsi nez ja. Nedoslo me hned, ze ty hodnoty jsou jen o posunu jednoho bitu. INC pro 2 = 2*1 a 512=2*256. Dalsi ukazka jak je lepsi pouzivat hex format nez dekadicky.
Mam se zlobit jak jsem hloupy? Mam byt hrdy, ze jsem autor? Mam jit spat? .)

Vlastne je ta hloupost soucasti testovani. .) Nemuset se vsim zabyvat, proto se pisi prekladace. Od neho se ocekava, ze to prevede do asembleru co nejlepe. Stejne to zmrvi, protoze mu nikdy nerekneme poradne co chceme. Jasne mu rikam nasob dvema, jak mu to mam lepe rici nez udelat tuhle ciselnou radu? .) A on ze jsem mu rekl neco jineho.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Moc jsem s tim za dnesek nepohnul. Zabredl jsem dost v tom jak ve funkci __IS_NUM() zrusit chybovou hlasku co hlasi M4, protoze jeden ze zakladnich testu zda je parametr cislo je vyuziti toho ze eval pro neciselnou hodnotu vrati prazdny retezec a zarve k tomu ale chybu.

Vstup muze byt cislo, hexadecimalni cislo, nejaky matematicky vyraz, konstanta kterou M4 zna (tu resit nemusim protoze se automaticky rozbali na cislo), odkaz do pameti a neznamy nazev promenne.

V podstate vse krome odkazu do pameti a nazvu promenne vraci 1.
Zbytek 0.

Prvne jsem to vzdaval, pak dokonce otravoval emailem nekoho kdo napal na rootu clanek o M4. https://www.root.cz/clanky/generovani-kodu-v-m4-uvod/

No a pak si rekl, ze aspon muzu odstranit pres regexp nejednodusi pripad kdy vstup je neco jako "alfa" nebo "value_a".

No a pritom me docvaklo, ze nemusim vubec resit matematicky vyraz. Staci zjistit zda v nem je "alfa" nebo "value_a", pak musi selhat.

To dost zjednodusuje regexp.

Prvne jsem vypracoval neco jako [^_a-zA-Z0-9][_a-zA-Z][_a-zA-Z0-9]*
Co by melo najit vsechno co vypada jako nazev.

Pak me doslo, ze vse krome a,b,c,d,e,f,x je automaticky spatne.

Trocha debugovani, proc mi to nefunguje kdyz zadam tohle a tohle... Myslim ze jsem napsal vsechny chyby co tam jdou vecpat. Vcetne toho ze regexp nevraci 0 a 1 jak to pouzivam v __IS_MEM_REF, ale -1 nenalezen a 0+ kde to nasel.

a nakonec smazani prvniho regexpu co jsem napsal, protoze uz neni potreba.
Kód:
define({__IS_MEM_REF},{dnl
dnl # (abc) --> 1
dnl # (123) --> 1
dnl # ()+() --> 1 fail
dnl # ()    --> 0
dnl # other --> 0
__{}eval( 1 + regexp({$1},{^\s*(.+)\s*$}) )}){}dnl
dnl
dnl
dnl
define({__IS_NUM},{dnl
dnl # (abc)   --> 0
dnl # (123)   --> 0
dnl # (1)+(2) --> 0 fail
dnl # ()      --> 0
dnl #         --> 0
dnl # abc     --> 0
dnl # 0a      --> 0
dnl # 0g      --> 0
dnl # 0xa     --> 1
dnl # 5       --> 1
dnl # 25*3    --> 1
__{}ifelse(dnl
__{}$1,{},{0},
__{}$1,(),{0},
__{}eval( regexp({$1},{[yzYZ_g-wG-W]}) != -1 ),{1},{0},dnl # Any letter and underscore _ except a,b,c,d,e,f,x
__{}eval( regexp({$1},{\(^\|[^0]\)[xX]}) != -1 ),{1},{0},dnl # x without leading zero
__{}eval( regexp({$1},{[a-fA-F0-9]0[xX]}) != -1 ),{1},{0},dnl # 0x inside hex characters or numbers, like 3210x or abc0x
__{}eval( regexp({$1},{\(^\|[^xX0-9a-fA-F]+\)[0-9a-fA-F]*[a-fA-F]}) != -1 ),{1},{0},dnl # hex characters without leading 0x
__{}{dnl
__{}__{}eval( __IS_MEM_REF($1)==0 && ifelse(eval($1),{},{0},{1}) ){}dnl
})}){}dnl


Pak hledal vsude kde mam "),{}" protoze to najde eval($1),{} a zamenoval za __IS_NUM($1),{0} a u toho se ztratil ve slovech jako
PUSH_STORE
PUSH2_STORE
PUSH_2STORE
PUSH2_2STORE
PUSHDOT_PUSH_2STORE
ktere potrebovali trosku upravit pro ukazatele na vstupu.

A vubec se nedostal na to trideni v M4.
Nez jsem to vzdal tak jsem objevil na rossetacode ze ma kategorii M4 a tam... tam ma Quicksort, Bubblesort atd. Hura! Nemusim to vse vymyset sam. .)
Treba odkoukam i nejake uzitecne triky.
Dnes to balim, boli me hlava.

https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#M4

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Pochopit ten kod na trideni bylo slozitejsi nez jsem cekal. Da se rici, ze jsem ho dosud nepochopil, ale nakonec se mi ho podarilo ohnout tak, ze krome trideni si i zachova puvodni index.

Celkem me prekvapilo ze obycejna zavorka uplne zmeni vstupni pole.

NECO(1,2,3,4,5)
$1 = 1
$2 = 2
atd.

NECO((1,2,3,4,5))
$1 = 1,2,3,4,5
$2 = prazdny retezec

Myslel jsem ze to delaji jen tyhle znaky `', respektive {} u me.

Ohnul jsem kod tak, ze misto SORT((3,2,4,0)) tridi SORT(((3,0),(2,1),(4,3),(0,3)))

Vubec se nedaji uz pouzit $1 atd.

Protoze $1 je ((3,0),(2,1),(4,3),(0,3))

Proto pouziva na to makro __ARG1
dnl # return the first element of a list when called in the funny way seen below
define({__ARG1}, {$1})dnl
define({__ARG2}, {$2})dnl
define({__ARG1_1}, {__ARG1$1})dnl
define({__ARG1_2}, {__ARG2$1})dnl
define({__ARG2_1}, {__ARG1$2})dnl
define({__ARG2_2}, {__ARG2$2})dnl
define({__ARG3_1}, {__ARG1$3})dnl
define({__ARG3_2}, {__ARG2$3})dnl

Ja jsem potreboval i dalsi.

__ARG1 vraci z (4,5,...) hodnotu 4
__ARG2 vraci z (4,5,...) hodnotu 5
__ARG1_1 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 4
__ARG1_2 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 5
__ARG2_1 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 8
__ARG2_2 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 9
...

Vola se to bez uvozovek, nevim proc a jakto ze to vubec funguje... ale klasicky s uvozovkama to nefunguje vubec.

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/ntest$ ../check_word.sh 'CREATE(_a) PUSHS_COMMA(1,3,5,2,6,0,4)'
 
    push HL             ; 1:11      1 , 3 , ... 4 ,   default version
    ld   HL, 0          ; 3:10      0 ,
    ld  (_a+10),HL      ; 3:16      0 ,
    inc   L             ; 1:4       1 ,
    ld  (_a),HL         ; 3:16      1 ,
    inc   L             ; 1:4       2 ,
    ld  (_a+6),HL       ; 3:16      2 ,
    inc   L             ; 1:4       3 ,
    ld  (_a+2),HL       ; 3:16      3 ,
    inc   L             ; 1:4       4 ,
    ld  (_a+12),HL      ; 3:16      4 ,
    inc   L             ; 1:4       5 ,
    ld  (_a+4),HL       ; 3:16      5 ,
    inc   L             ; 1:4       6 ,
    ld  (_a+8),HL       ; 3:16      6 ,
    pop  HL             ; 1:10      1 , 3 , ... 4 ,
                        ;[32:167]   1 , 3 , ... 4 ,
VARIABLE_SECTION:

_a:
    dw 1
    dw 3
    dw 5
    dw 2
    dw 6
    dw 0
    dw 4
                       ;[32:167]


Musel jsem si jeste pohrat z ukazatelama a neznamyma hodnotama. Ted se mi vubec nedari generovat BC v rade.
Zajimalo by me do kolika bajtu je to efektivnejsi, nez nejaka komperese s pribalenou dekompresni rutinou, ktera se nemaze. Tohle se nedostane pod 3 bajty na 2 bajty dat. .))

Slovo na presun bloku dat, kdyz zname odkud i kam a kolik slov
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/ntest$ ../check_word.sh 'PUSH3_MOVE(0x8000,0x8500,7)'


                        ;[15:361]   0x8000 0x8500 7 move   ( -- ) from = 0x8000, to = 0x8500, u = 7 words
    ld   BC, 0x000E     ; 3:10      0x8000 0x8500 7 move   BC = 14 chars
    push DE             ; 1:11      0x8000 0x8500 7 move
    push HL             ; 1:11      0x8000 0x8500 7 move
    mov  HL, 0x8000     ; 3:10      0x8000 0x8500 7 move   from_addr
    mov  DE, 0x8500     ; 3:10      0x8000 0x8500 7 move   to_addr
    ldir                ; 2:u*42-5  0x8000 0x8500 7 move   addr++
    pop  HL             ; 1:10      0x8000 0x8500 7 move
    pop  DE             ; 1:10      0x8000 0x8500 7 move
                       ;[13:72]

Ma 13 bajtu. Takze tech 7 slov by mel zvladnout za 2*7+13=27 bajtu.
Ale pokud jde o rychlost tak je to 361 taktu ku 167.

PS: Pokud dobre pocitam tak ZX ma cca 70920 taktu na frame. Tohle by mohlo mit cca 10 taktu na bajt.
192*256/8=6144
32*24=768
To je 6912 bajtu na obrazovku, krat 10 mi to vychazi 69120 taktu. Jen to bude zapisovat na ten screen nahodne... Podle toho jak je to serazeno. Muselo by se to jeste rozdelit do mensich bloku.

PPS: Tak je to spis 2.03 bajtu kodu na jeden bajt dat a 68176 taktu na 6912 bajtu scr. Musel jsem to rozdelit presne na polovinu, protoze me system killnul proces... :D
A navic kdyz jsem to spustil tak to nekde ma chybu a nevykreslilo se to. .)

Příloha:
title2.png
title2.png [ 17.3 KiB | Zobrazeno 1605 krát ]

Příloha:
title2_fail.png
title2_fail.png [ 5.4 KiB | Zobrazeno 1605 krát ]


No.. na testovani dobry... .)

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Chyba rychle odhalena, $# vraci pocet prvku a kdyz to vynasobite dvema tak ziskam hodnotu kterou musim pricist k LAST_HERE_ADD.
Jenze $# ted vracelo jedna, protoze vsechny prvky byly obaleny v te zavorce. Takze se pricetla jen dvojka.

Ale blika me tam jeden atribut, tak nevim... je tam jeste neco? Ale je 8 rano a ja jeste nespal a dnes mam jit do prace... a to jsem rikal, ze uz na to kaslu.

Příloha:
title2b.png
title2b.png [ 10.55 KiB | Zobrazeno 1605 krát ]


PS: Vypada to ze pouzil jen HL. Takze by analyzou kodu, kterou hodnotu nacita nejvic a pridanim natvrdo do A,D,E,B,C by to melo jit zrychlit.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
_dworkin píše:
__ARG1 vraci z (4,5,...) hodnotu 4
__ARG2 vraci z (4,5,...) hodnotu 5
__ARG1_1 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 4
__ARG1_2 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 5
__ARG2_1 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 8
__ARG2_2 vraci z ((4,5,6,7),(8,9,10,11)) hodnotu 9
...

Vola se to bez uvozovek, nevim proc a jakto ze to vubec funguje... ale klasicky s uvozovkama to nefunguje vubec.


Vola se to bez uvozovek, protoze parametr je VZDY obaleny v uvozovkach, takze se tim jedny uvozovky pokazde odstrani.

$1 = "(1,2,3,4,5)"

__ARG1$1 --> __ARG1(1,2,3,4,5) --> 1

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
_dworkin píše:
PPS: Tak je to spis 2.03 bajtu kodu na jeden bajt dat a 68176 taktu na 6912 bajtu scr. Musel jsem to rozdelit presne na polovinu, protoze me system killnul proces... :D
A navic kdyz jsem to spustil tak to nekde ma chybu a nevykreslilo se to. .)


Zrusil jsem QuickSort algoritmus pro trideni a zavedl BubbleSort, protoze QuickSort me pri trideni cele obrazovky vyzral celou pamet. Vic jak 8Gb... nez byl killnut systemem. A vypadalo to, ze je to tim algoritmem, ze to nespravim.

BubbleSort je evidentne reseny jinak, ukazuje mi to stabilne okolo 130 Mb pro trideni tech 3456 words co zabira obrazovka.

Trvalo to nekolik dnu, nez se mi to podarilo prepsat tak, aby to delalo co chci.
Vstup jako pole hodnot a vystup jako pole poli s hodnotou a offsetem. Pouzil jsem ten trik z QuickSortu kdy kazda polozka vypada jako "(value,index)".
BubbleSort si vytvari vnitrne pole s nazvem. Se kterym pak pracuje. Takze jsem krome osetreni porovnani hodnot musel prepsat kompletne vstup a i funkci __SORT_SHOW, ktera zase vypisuje ty hodnoty pole. Ta je uplne nezavisla, muzu vypisovat tridene nebo netridene.
Osetril porovnani, aby nacetl value. Cely BubbleSort je vlastne reseny jinak. Neni to ani pole, takze i vstup z pole do jeho formatu a vystup zase do pole jsem musel predelat. Vlastne presne nevim ani jak to funguje, vypada to ze si definuje slovo pro kazdou polozku toho pole. Takze prohazuje jen hodnoty tech slov.

Jmeno pole {a} polozky 1,2,3
Vytvori slova a[1] a[2] a[3] a k tem se dostava pres defn(a[1]), protoze asi a[1] nebude platny nazev slova. Ale mozna kecam.
Kód:
define({__SORT_SET},{define({$1[$2]},{$3})}){}dnl
define({__SORT_GET},{defn({$1[$2]})}){}dnl
dnl
dnl # for the heap calculations, it's easier if origin is 0, so set value first
define({__SORT_NEW},{__SORT_SET($1,size,0)}){}dnl
dnl
dnl
define({__SORT_APPEND},{__SORT_SET($1,size,incr(__SORT_GET($1,size))){}__SORT_SET($1,__SORT_GET($1,size),$2)}){}dnl
dnl
dnl
dnl # __SORT_SWAP(<name>,<j>,<name>[<j>],<k>)  using arg stack for the temporary
define({__SORT_SWAP},{__SORT_SET($1,$2,__SORT_GET($1,$4)){}__SORT_SET($1,$4,$3)}){}dnl
dnl
dnl
define({__SORT_VAL},$1){}dnl
define({__SORT_OFFSET},$2){}dnl
define({__SORT_ARG1_1},{__SORT_VAL$1}){}dnl
dnl
dnl
define({__SORT_INIT},{ifelse($#,3,
    {__SORT_APPEND({$1},($3,$2))},
    eval($#>3),{1},{__SORT_APPEND({$1},($3,{eval($2)})){}$0($1,eval($2+2),shift(shift(shift($@))))})}){}dnl
dnl
dnl
dnl # Input
dnl #   $1 counter_name
dnl #   $2 from
dnl #   $3 to
dnl #   $4 what
define({__FOR},{ifelse($#,0,
{{$0}},
{ifelse(eval($2<=$3),1,
    {pushdef({$1},$2)$4{}popdef({$1})$0({$1},incr($2),$3,{$4})})})}){}dnl
dnl
dnl
define({__SORT_ONCE},{__FOR({x},1,$2,
    {ifelse(eval(__SORT_ARG1_1(__SORT_GET($1,x))>__SORT_ARG1_1(__SORT_GET($1,incr(x)))),1,
        {__SORT_SWAP($1,x,__SORT_GET($1,x),incr(x)){}1})})0}){}dnl
dnl
dnl
define({__SORT_UP_TO},
    {ifelse(__SORT_ONCE($1,$2),0,
        {},
        {__SORT_UP_TO($1,decr($2))})}){}dnl
dnl
dnl
dnl # Input:
dnl #   $1 = array name
dnl #   $2 = offset first value
dnl #   $3,$4,$5,... = values
define({__SORT},
    {__SORT_NEW({$1}){}__SORT_INIT($@){}__SORT_UP_TO($1,decr(__SORT_GET($1,size)))}){}dnl
dnl
dnl
define({__SORT_SHOW},
   {__SORT_GET($1,1){}__FOR({x},2,__SORT_GET($1,size),{,__SORT_GET($1,x)})}){}dnl


Musel jsem prepsat znovu PUSHS_COMMA, protoze uz to neni jedna polozka, ale zase zpet pole. Tazke takovy navrat na puvodni stav.

Obrazkovym testem prosel.

Asm me ukazuje ;[13504:66400]. Prvni cislo jsou bajty a druhe cislo takty.
Takze spojeny obrazek je o 1776 taktu rychlejsi. A je to 9.6 taktu na zkopirovany bajt. A 1.95 bajtu na jeden bajt dat.

Zase si to hraje jen s HL. Ale kdyz se divam na ten kod, tak me moc BC,DE,A nepomuze.
Protoze pokud nepouzije nejcastejsi INC L tak tam ma LD L,0x18 napriklad. A tech opakovani neni tolik. Tady mate ukazku, kdyz pomoci grepu najdu jen to ld L, 0xnn, pak ostranim komentar, protoze tam je odlisny HIGH bajt, setridim, spocitam duplicity a nakonec setridim ciselne
Kód:
...
      9     ld    L, 0x5F
      9     ld    L, 0x7C
     10     ld    L, 0xBF
     10     ld    L, 0x0C
     10     ld    L, 0x0F
     10     ld    L, 0x1C
     10     ld    L, 0x2A
     10     ld    L, 0x7F
     11     ld    L, 0xFC
     11     ld    L, 0xF0
     11     ld    L, 0x0B
     11     ld    L, 0x04
     12     ld    L, 0xF8
     12     ld    L, 0x18
     12     ld    L, 0x28
     13     ld    L, 0x0A
     13     ld    L, 0x02
     13     ld    L, 0x10
     14     ld    L, 0xE0
     14     ld    L, 0x17
     15     ld    L, 0xA0
     15     ld    L, 0xFE
     15     ld    L, 0x05
     15     ld    L, 0x07
     16     ld    L, 0x08
     16     ld    L, 0x30
     16     ld    L, 0x50
     17     ld    L, 0x55
     18     ld    L, 0xAA
     18     ld    L, 0x38
     18     ld    L, 0x78
     19     ld    L, 0x70
     21     ld    L, 0x20
     22     ld    L, 0xC0
     22     ld    L, 0x60
     30     ld    L, 0x80
     31     ld    L, 0xFF
     33     ld    L, 0x40
dworkin@dw-A15:~/Programovani/ZX/Forth/RossetaCode$ grep "ld    L, 0x[0-9A-F][0-9A-F] " white_jaguar.asm | sed -e "s#\(ld    L, 0x[0-9A-F][0-9A-F]\).*#\1#" | sort | uniq -c | sort -n

Pokud do BC dam 0x40FF tak usetrim par taktu.
31*(7-4)+33*(7-4)-10=182
Takze to ani nema cenu resit.


Přílohy:
WhiteJaguar.zip [66.66 KiB]
41 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: 28.07.2022, 05:41 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Opravil jsem krizove reference. Tam kde me doslo, ze mohu pouzivat prvni cilovy registr jako vstup pro druhy cilovy registr me nenapadlo, ze naopak musim mazat puvodni hodnotu pro prvni cilovy registr, protoze uz ma novou hodnotu.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/RossetaCode$ ../check_word.sh 'PUSHDOT_2SWAP(0x01333301)'


    ld   BC, 0x0133     ; 3:10      pushdot_2swap(0x01333301)   hi word
    push BC             ; 1:11      pushdot_2swap(0x01333301)
    ld    C, B          ; 1:4       pushdot_2swap(0x01333301)   lo word   C = B = 0x01
    ld    B, C          ; 1:4       pushdot_2swap(0x01333301)   lo word   B = C = 0x33
    push BC             ; 1:11      pushdot_2swap(0x01333301)
                       ;[ 7:40]
dworkin@dw-A15:~/Programovani/ZX/Forth/RossetaCode$ ../check_word.sh 'PUSHDOT_2SWAP(0x01333301)'


    ld   BC, 0x0133     ; 3:10      pushdot_2swap(0x01333301)   hi word
    push BC             ; 1:11      pushdot_2swap(0x01333301)
    ld   BC, 0x3301     ; 3:10      pushdot_2swap(0x01333301)   lo word
    push BC             ; 1:11      pushdot_2swap(0x01333301)
                       ;[ 8:42]

Jo a udelal jsem optimalizovane spojeni slov pushdot_2swap(), dale varianty slov AND OR XOR INVERT pro double.

Pak pri konverzi udelal prevod z "[char] text" na "push('t')". Tohle ma ulozit na zasobnik prvni pismeno(ascii hodnotu) slova co je za [char]. Ja se k tomu mohu chovat jako k cislu, forth ne protoze ten kdyz pozna ze je to cislo tak to da na zasobnik, ale pismeno nebo slovo? Kdyz ho nenajde ve slovniku tak ma napsat chybu. Nevi ze to chcete na zasobnik. Ja mam na davani neceho na zasobnik to slovo PUSH a uz je jedno co tam je. Zda cislo nebo 'a'.

Asi jeste lepsi reseni je zmenit to na ascii hodnotu toho pismena a pak si to optimalizace najdou. Jen by to bylo mene citelne.

Puvodni impuls byl prevest kod na zjisteni zda je veta pangram (obsahuje vsechny znaky) z rossettacode.
Kód:
: pangram? ( addr len -- ? )
  0 -rot bounds do
    i c@ 32 or [char] a -
    dup 0 26 within if
      1 swap lshift or
    else drop then
  loop
  1 26 lshift 1- = ;
 
s" The five boxing wizards jump quickly." pangram? .   \ -1

Ale ten kod je neuveritelne spatny.
Po odstraneni problemy s "[char] a" jsem resil co ma delat "bounds" ale nenasel to na netu. Neni to standartni slovo. Takze analyzou kodu. V te smycce je "i c@", takze "i" ma vracet postupne adresy toho retezce. Bounds jsem nahradil za "OVER ADD SWAP" co by melo udelat z "addr len" v zasobniku "addr+len addr", coz jsou vstupni hodnoty pro DO LOOP smycku. Teda SKORO_AZ=addr+len a PRVNI_HODNOTA=addr.

Po kompilaci me kod selhal, postupnym debugovanim jsem zjistil ze se me retezec meni na STRING_Z retezec, takze nevraci ( adr len ) ale jen adr. Opravil jsem to a hazelo to stale kraviny.
Tak jsem se musel kouknout co to dela a ten kod je psany pro 32 bitove slova... eee... Takze prepsat na double slova a tady jsem narazel na svizele. Neexistuje lshift pro double slova ve standardu. hmm.. to jsem vyresil smyckou pro opakovane nasobeni dvema.
U te smycky jsem zapomel ze 0 0 DO ... LOOP se provede 65536x. A ze potrebuji 0 0 ?DO ... LOOP. Pak tam tropil dalsi chyby a snazil se prijit na to jak kombinovat double a single slova na zasobniku. Kdy potrebuji swap kdy mam na jedne strane slovo a na druhe dvouslovo.. "1 swap lshift..." Pak zapomel ze ta mam OR a potrebuji double OR. To taky neni ve standartu.
Nakonec se povedlo, ale pocit z toho nic moc. Ze bych vzal kod forthu a bez problemu zkompiloval... Ale jak jsem psal, ten kod je fakt spatny.
Kód:
include(`../M4/FIRST.M4')dnl
ORG 0x8000
INIT(60000)
STRING({"The five boxing wizards jump quickly."})
CALL(_pangram_) SPACE_DOT CR  ;# -1
STOP
COLON(_pangram_,( addr len -- ? ))
  PUSHDOT(0) _2SWAP OVER ADD SWAP DO
    I CFETCH PUSH_OR(32) PUSH('a') SUB
    DUP PUSH2_WITHIN(0,26) IF
      PUSHDOT(1) ROT PUSH(0) QUESTIONDO D2MUL LOOP DOR
    ELSE DROP THEN
  LOOP
  PUSHDOT(0x3FFFFFF) DEQ SEMICOLON


PS: PUSH_OR(32) prevadi mala pismena na velka.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
WITHIN je komplikovana funkce i kdyz to tak nevypada, protoze pracuje s cisly se znamenkem.
Vraci TRUE pokud plati b<=c<a, kde a=TOS, b=NOS a c je dalsi v poradi.
Mel jsem udelanou optimalizovanou fci PUSH2_WITHIN, tedy $1<=TOS<$2, ale byla fakt dlouha... je tam hodne kombinaci podle vstupu. Takze jsem uz nedelal dalsi optimalizovane fce jako WITHIN_IF, i kdyz je logicka, protoze WITHIN vraci boolean a IF ma na vstupu boolean.

Dnes jsem udelal pomocne makra __WITHIN a __SAVE_HL_WITHIN (To zachova zasobnik, ale uz nezvladne pokud je vstup pointer).
A do nich presunul generovany kod. Takze nove PUSH2_WITHIN vypada
Kód:
dnl # ( a $1 $2 -- ((a-$1) ($2-$1) U<) )
dnl # $1 <= a < $2
define({PUSH2_WITHIN},{ifelse($1,{},{
__{}__{}.error {$0}(): Missing parameters!},
__{}$#,{1},{
__{}__{}.error {$0}($@): The second parameter is missing!},
__{}eval($#>2),{1},{
__{}__{}.error {$0}($@): $# parameters found in macro!},
{define({_TMP_INFO},{$1 $2 within}){}define({PUSH2_WITHIN_CODE},__WITHIN($1,$2))
__{}                        ;format({%-11s},[eval(2+__WITHIN_B):eval(15+__WITHIN_C)])_TMP_INFO   ( {TOS} -- flag )  flag=($1<={TOS}<$2){}dnl
__{}PUSH2_WITHIN_CODE
__{}    sbc  HL, HL         ; 2:15      _TMP_INFO   HL = 0x0000 or 0xffff}){}dnl
}){}dnl

Doporucovane reseni pro within je (x-spodni_vcetne) - (horni_vyjma-spodni_vcetne). Pokud to vrati priznak preteceni tak je to TRUE. Zavorky se musi dodrzet, pak to zvladne i opacne znamenka.

Nove optimalizovane slova jsou:
PUSH2_WITHIN_IF ( x -- )
PUSH2_WITHIN_UNTIL ( x -- )
PUSH2_WITHIN_WHILE ( x -- )
DUP_PUSH2_WITHIN_IF ( x -- x )
DUP_PUSH2_WITHIN_UNTIL ( x -- x )
DUP_PUSH2_WITHIN_WHILE ( x -- x )

Mala ukazka pro nejsnazsi reseni, kdy spodni_vcetne je nulove, takze se to prevadi na x-horni_vyjma.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth$ ./check_word.sh 'DUP PUSH2_WITHIN(0,26) IF'

    push DE             ; 1:11      dup
    ld    D, H          ; 1:4       dup
    ld    E, L          ; 1:4       dup ( a -- a a )
                        ;[8:37]     0 26 within   ( TOS -- flag )  flag=(0<=TOS<26)
    ld    A, L          ; 1:4       0 26 within
    sub  0x1A           ; 2:7       0 26 within
    ld    A, H          ; 1:4       0 26 within
    sbc   A, 0x00       ; 2:7       0 26 within   carry: HL-(26-(0))
    sbc  HL, HL         ; 2:15      0 26 within   HL = 0x0000 or 0xffff
    ld    A, H          ; 1:4       if
    or    L             ; 1:4       if
    ex   DE, HL         ; 1:4       if
    pop  DE             ; 1:10      if
    jp    z, else101    ; 3:10      if
                       ;[18:88]
dworkin@dw-A15:~/Programovani/ZX/Forth$ ./check_word.sh 'DUP PUSH2_WITHIN_IF(0,26)'

    push DE             ; 1:11      dup
    ld    D, H          ; 1:4       dup
    ld    E, L          ; 1:4       dup ( a -- a a )
                        ;[11:46]    0 26 within if   ( TOS -- )  true=(0<=TOS<26)
    ld    A, L          ; 1:4       0 26 within if
    sub  0x1A           ; 2:7       0 26 within if
    ld    A, H          ; 1:4       0 26 within if
    sbc   A, 0x00       ; 2:7       0 26 within if   carry: HL-(26-(0))
    ex   DE, HL         ; 1:4       0 26 within if
    pop  DE             ; 1:10      0 26 within if
    jp   nc, else101    ; 3:10      0 26 within if
                       ;[14:65]
dworkin@dw-A15:~/Programovani/ZX/Forth$ ./check_word.sh 'DUP_PUSH2_WITHIN_IF(0,26)'

                        ;[9:32]     dup 0 26 within if   ( x -- x )  true=(0<=x<26)
    ld    A, L          ; 1:4       dup 0 26 within if
    sub  low 26         ; 2:7       dup 0 26 within if
    ld    A, H          ; 1:4       dup 0 26 within if
    sbc   A, high 26    ; 2:7       dup 0 26 within if   carry: HL - (26 - (0))
    jp   nc, else101    ; 3:10      dup 0 26 within if
                       ;[ 9:32]

Je to vynatek z toho kodu Pangram.

_________________
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.08.2022, 13:37 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Opravil jsem chybu v STRING_I a STRING_Z, ktera mela vracet do TOS adresu retezce ukonceneho nulovym bajtem.
Misto toho to davala to regitru BC s tim, ze se pak zavola runtime fce PRINT_STRING_I, nebo PRINT_STRING_Z.
Vzhledem k tomu, ze to nikdo nepouziva tak me to nikdo nehlasil. .)

Ted uz to korektne vraci do TOS. Ale udelal jsem i slova STRING_I_DROP a STRING_Z_DROP. Ta pouze alokuji retezec a nic nevraci. Ten se pak da vypsat pres PUSH_TYPE_I, nebo PUSH_TYPE_Z a pak ten kod vypada jako predtim, kdy to slo do BC.

Nekolikrat jsem prepsal ten kod s retezci a menil nazvy maker na neco lepsiho. Ted uz to dokaze poznat, ze mu davate spatny retezec typu "Hello",,,,"","",,,,"",,, a ulozi jen "Hello". Duvod byl ten, ze jsem potreboval u konverze na ukonceni retezce pres znamenkovy bit najit skutecny posledni znak. Bonus je, ze kdyz mu ted vlozite dva stejne retezce jen s jinou falesnou kombinaci ukonceni tak pozna shodu.

Puvodne jsem shodne retezce vubec neukladal do STRING_SECTION, ale doslo me, ze pokud pouziji STRING_I_DROP nebo STRING_Z_DROP funkce a on nic neulozi, jen vypise ze retezec string105 == string101 a ja pak udelam PUSH_TYPE_I(string105) tak to selze.

Tak jsem premyslel jak z toho ven a predelal zasobnik retezcu tak ze u noveho retezce pridam " db ", to pak nemusim pridavat u tisku toho zasobniku retezcu a podle toho poznam ze je to retezec. A pokud mam ukladat shodny retezec tak misto neho tam dam "string105 EQU string101
size105 EQU size101". Nikdy me to nemuze nalezt falesnou shodu, protoze kdybych chtel pridat tento text tak tam bude na zacatku to " db ".

Nakonec jsem narazil na to, ze bych mel ty retezce misto do STRING_SECTION ukladat do VARIABLE_SECTION. Duvod je ten, ze pak muzu definovat jmeno navesti pred ten retezec a nemusim zjistovat kolikaty to retezec bude, abych zjistil jmeno kde je ulozen. Dalo by se to pak i dealokovat.

Jenze to bych musel znat delku retezce uz v makrech a to neni takova sranda. A na tom jsem skoncil, protoze se mi to fakt nechce delat.
Navic bych musel premyslet zda nevadi, ze nebudu ty retezce inicializovat. Pokud se neprepisi nemusim, pokud se napriklad dealokuji, tak bych musel. A kdyz to neudelam tak to postrada smysl davat do VARIABLE_SECTION.

Testovaci kod vypada takto (o tom jsem jeste nepsal ze mam i nejake automaticke testy, kdy si otevru vystupni retezec v kwrite a on umi sestavit rozdili a tak se jde prehledne divat co se zmenilo/rozbilo)
Kód:
#!/bin/bash
echo '; ------- PRINT --------' > string.txt
../check_word.sh 'PRINT({"Hello",,,}) PRINT({"Bussy",0x0D}) PRINT({"Hello","",}) PRINT({"Bye",,""}) PRINT({"Bussy",0x0D,,"",,,}) PRINT({"Last"})' >> string.txt

echo '; ------- PRINT_Z --------' >> string.txt
../check_word.sh 'PRINT_Z({"Hello",,,}) PRINT_Z({"Bussy",0x0D}) PRINT_Z({"Hello","",}) PRINT_Z({"Bye",,""}) PRINT_Z({"Bussy",0x0D,,"",,,}) PRINT_Z({"Last"})' >> string.txt

echo '; ------- PRINT_I --------' >> string.txt
../check_word.sh 'PRINT_I({"Hello",,,}) PRINT_I({"Bussy",0x0D}) PRINT_I({"Hello","",}) PRINT_I({"Bye",,""}) PRINT_I({"Bussy",0x0D,,"",,,}) PRINT_I({"Last"})' >> string.txt

echo '; ------- STRING --------' >> string.txt
../check_word.sh 'STRING({"Hello",,,}) STRING({"Bussy",0x0D}) STRING({"Hello","",}) STRING({"Bye",,""}) STRING({"Bussy",0x0D,,"",,,}) STRING({"Last"})' >> string.txt

echo '; ------- STRING_Z --------' >> string.txt
../check_word.sh 'STRING_Z({"Hello",,,}) STRING_Z({"Bussy",0x0D}) STRING_Z({"Hello","",}) STRING_Z({"Bye",,""}) STRING_Z({"Bussy",0x0D,,"",,,}) STRING_Z({"Last"})' >> string.txt

echo '; ------- STRING_I --------' >> string.txt
../check_word.sh 'STRING_I({"Hello",,,}) STRING_I({"Bussy",0x0D}) STRING_I({"Hello","",}) STRING_I({"Bye",,""}) STRING_I({"Bussy",0x0D,,"",,,}) STRING_I({"Last"})' >> string.txt

echo '; ------- STRING_Z_DROP --------' >> string.txt
../check_word.sh 'STRING_Z_DROP({"Hello",,,}) STRING_Z_DROP({"Bussy",0x0D}) STRING_Z_DROP({"Hello","",}) STRING_Z_DROP({"Bye",,""}) STRING_Z_DROP({"Bussy",0x0D,,"",,,}) STRING_Z_DROP({"Last"})' >> string.txt

echo '; ------- STRING_I_DROP --------' >> string.txt
../check_word.sh 'STRING_I_DROP({"Hello",,,}) STRING_I_DROP({"Bussy",0x0D}) STRING_I_DROP({"Hello","",}) STRING_I_DROP({"Bye",,""}) STRING_I_DROP({"Bussy",0x0D,,"",,,}) STRING_I_DROP({"Last"})' >> string.txt

_________________
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.08.2022, 13:37 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
A vystup ted vypada takto:
Kód:
; ------- PRINT --------

    push DE             ; 1:11      print     "Hello",,,
    ld   BC, size101    ; 3:10      print     Length of string101
    ld   DE, string101  ; 3:10      print     Address of string101
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
    push DE             ; 1:11      print     "Bussy",0x0D
    ld   BC, size102    ; 3:10      print     Length of string102
    ld   DE, string102  ; 3:10      print     Address of string102
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
    push DE             ; 1:11      print     "Hello","",
    ld   BC, size101    ; 3:10      print     Length of string103 == string101
    ld   DE, string101  ; 3:10      print     Address of string103 == string101
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
    push DE             ; 1:11      print     "Bye",,""
    ld   BC, size104    ; 3:10      print     Length of string104
    ld   DE, string104  ; 3:10      print     Address of string104
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
    push DE             ; 1:11      print     "Bussy",0x0D,,"",,,
    ld   BC, size102    ; 3:10      print     Length of string105 == string102
    ld   DE, string102  ; 3:10      print     Address of string105 == string102
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print
    push DE             ; 1:11      print     "Last"
    ld   BC, size106    ; 3:10      print     Length of string106
    ld   DE, string106  ; 3:10      print     Address of string106
    call 0x203C         ; 3:17      print     Print our string with ZX 48K ROM
    pop  DE             ; 1:10      print

STRING_SECTION:
string106:
    db "Last"
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "Bye"
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D
  size102   EQU  $ - string102
string101:
    db "Hello"
  size101   EQU  $ - string101
                       ;[66:348]
; ------- PRINT_Z --------

    ld   BC, string101  ; 3:10      print_z   Address of null-terminated string101
    call PRINT_STRING_Z ; 3:17      print_z
    ld   BC, string102  ; 3:10      print_z   Address of null-terminated string102
    call PRINT_STRING_Z ; 3:17      print_z
    ld   BC, string101  ; 3:10      print_z   Address of null-terminated string103 == string101
    call PRINT_STRING_Z ; 3:17      print_z
    ld   BC, string104  ; 3:10      print_z   Address of null-terminated string104
    call PRINT_STRING_Z ; 3:17      print_z
    ld   BC, string102  ; 3:10      print_z   Address of null-terminated string105 == string102
    call PRINT_STRING_Z ; 3:17      print_z
    ld   BC, string106  ; 3:10      print_z   Address of null-terminated string106
    call PRINT_STRING_Z ; 3:17      print_z
;------------------------------------------------------------------------------
; Print C-style stringZ
; In: BC = addr
; Out: BC = addr zero + 1
    rst  0x10           ; 1:11      print_string_z putchar with ZX 48K ROM in, this will print char in A
PRINT_STRING_Z:         ;           print_string_z
    ld    A,(BC)        ; 1:7       print_string_z
    inc  BC             ; 1:6       print_string_z
    or    A             ; 1:4       print_string_z
    jp   nz, $-4        ; 3:10      print_string_z
    ret                 ; 1:10      print_string_z

STRING_SECTION:
string106:
    db "Last", 0x00
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "Bye", 0x00
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D, 0x00
  size102   EQU  $ - string102
string101:
    db "Hello", 0x00
  size101   EQU  $ - string101
                       ;[44:210]
; ------- PRINT_I --------

    ld   BC, string101  ; 3:10      print_i   Address of string101 ending with inverted most significant bit
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string102  ; 3:10      print_i   Address of string102 ending with inverted most significant bit
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string101  ; 3:10      print_i   Address of string103 ending with inverted most significant bit == string101
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string104  ; 3:10      print_i   Address of string104 ending with inverted most significant bit
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string102  ; 3:10      print_i   Address of string105 ending with inverted most significant bit == string102
    call PRINT_STRING_I ; 3:17      print_i
    ld   BC, string106  ; 3:10      print_i   Address of string106 ending with inverted most significant bit
    call PRINT_STRING_I ; 3:17      print_i
;------------------------------------------------------------------------------
; Print string ending with inverted most significant bit
; In: BC = addr string_imsb
; Out: BC = addr last_char + 1
    rst  0x10           ; 1:11      print_string_i putchar with ZX 48K ROM in, this will print char in A
PRINT_STRING_I:         ;           print_string_i
    ld    A,(BC)        ; 1:7       print_string_i
    inc  BC             ; 1:6       print_string_i
    or    A             ; 1:4       print_string_i
    jp    p, $-4        ; 3:10      print_string_i
    and  0x7f           ; 2:7       print_string_i
    rst  0x10           ; 1:11      print_string_i putchar with ZX 48K ROM in, this will print char in A
    ret                 ; 1:10      print_string_i

STRING_SECTION:
string106:
    db "Las","t" + 0x80
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "By","e" + 0x80
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D + 0x80
  size102   EQU  $ - string102
string101:
    db "Hell","o" + 0x80
  size101   EQU  $ - string101
                       ;[47:228]
; ------- STRING --------

    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Hello",,,
    ld   DE, string101  ; 3:10      string    Address of string101
    ld   HL, size101    ; 3:10      string    Length of string101
    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Bussy",0x0D
    ld   DE, string102  ; 3:10      string    Address of string102
    ld   HL, size102    ; 3:10      string    Length of string102
    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Hello","",
    ld   DE, string101  ; 3:10      string    Address of string103 == string101
    ld   HL, size101    ; 3:10      string    Length of string103 == string101
    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Bye",,""
    ld   DE, string104  ; 3:10      string    Address of string104
    ld   HL, size104    ; 3:10      string    Length of string104
    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Bussy",0x0D,,"",,,
    ld   DE, string102  ; 3:10      string    Address of string105 == string102
    ld   HL, size102    ; 3:10      string    Length of string105 == string102
    push DE             ; 1:11      string    ( -- addr size )
    push HL             ; 1:11      string    "Last"
    ld   DE, string106  ; 3:10      string    Address of string106
    ld   HL, size106    ; 3:10      string    Length of string106

STRING_SECTION:
string106:
    db "Last"
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "Bye"
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D
  size102   EQU  $ - string102
string101:
    db "Hello"
  size101   EQU  $ - string101
                       ;[48:252]
; ------- STRING_Z --------

    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Hello",,,
    ld   HL, string101  ; 3:10      string_z   Address of null-terminated string101
    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Bussy",0x0D
    ld   HL, string102  ; 3:10      string_z   Address of null-terminated string102
    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Hello","",
    ld   HL, string101  ; 3:10      string_z   Address of null-terminated string103 == string101
    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Bye",,""
    ld   HL, string104  ; 3:10      string_z   Address of null-terminated string104
    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Bussy",0x0D,,"",,,
    ld   HL, string102  ; 3:10      string_z   Address of null-terminated string105 == string102
    push DE             ; 1:11      string_z   ( -- addr )
    ex   DE, HL         ; 1:4       string_z   "Last"
    ld   HL, string106  ; 3:10      string_z   Address of null-terminated string106

STRING_SECTION:
string106:
    db "Last", 0x00
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "Bye", 0x00
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D, 0x00
  size102   EQU  $ - string102
string101:
    db "Hello", 0x00
  size101   EQU  $ - string101
                       ;[30:150]
; ------- STRING_I --------

    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Hello",,,
    ld   HL, string101  ; 3:10      string_i   Address of string101 ending with inverted most significant bit
    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Bussy",0x0D
    ld   HL, string102  ; 3:10      string_i   Address of string102 ending with inverted most significant bit
    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Hello","",
    ld   HL, string101  ; 3:10      string_i   Address of string103 ending with inverted most significant bit == string101
    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Bye",,""
    ld   HL, string104  ; 3:10      string_i   Address of string104 ending with inverted most significant bit
    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Bussy",0x0D,,"",,,
    ld   HL, string102  ; 3:10      string_i   Address of string105 ending with inverted most significant bit == string102
    push DE             ; 1:11      string_i   ( -- addr )
    ex   DE, HL         ; 1:4       string_i   "Last"
    ld   HL, string106  ; 3:10      string_i   Address of string106 ending with inverted most significant bit

STRING_SECTION:
string106:
    db "Las","t" + 0x80
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "By","e" + 0x80
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D + 0x80
  size102   EQU  $ - string102
string101:
    db "Hell","o" + 0x80
  size101   EQU  $ - string101
                       ;[30:150]
; ------- STRING_Z_DROP --------

                        ;           string_z drop   ( -- )   Allocate null-terminated string101
                        ;           string_z drop   ( -- )   Allocate null-terminated string102
                        ;           string_z drop   ( -- )            null-terminated string103 == string101
                        ;           string_z drop   ( -- )   Allocate null-terminated string104
                        ;           string_z drop   ( -- )            null-terminated string105 == string102
                        ;           string_z drop   ( -- )   Allocate null-terminated string106

STRING_SECTION:
string106:
    db "Last", 0x00
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "Bye", 0x00
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D, 0x00
  size102   EQU  $ - string102
string101:
    db "Hello", 0x00
  size101   EQU  $ - string101
                       ;[ 0:0]
; ------- STRING_I_DROP --------

                        ;           string_i drop   ( -- )   Allocate string101 ending with inverted most significant bit
                        ;           string_i drop   ( -- )   Allocate string102 ending with inverted most significant bit
                        ;           string_i drop   ( -- )            string103 ending with inverted most significant bit == string101
                        ;           string_i drop   ( -- )   Allocate string104 ending with inverted most significant bit
                        ;           string_i drop   ( -- )            string105 ending with inverted most significant bit == string102
                        ;           string_i drop   ( -- )   Allocate string106 ending with inverted most significant bit

STRING_SECTION:
string106:
    db "Las","t" + 0x80
  size106   EQU  $ - string106
string105   EQU  string102
  size105   EQU    size102
string104:
    db "By","e" + 0x80
  size104   EQU  $ - string104
string103   EQU  string101
  size103   EQU    size101
string102:
    db "Bussy",0x0D + 0x80
  size102   EQU  $ - string102
string101:
    db "Hell","o" + 0x80
  size101   EQU  $ - string101
                       ;[ 0:0]

Zkousel jsem to zkompilovat pres pasmo, jak tak mam napr. "size105 EQU size102" a v te chvili size102 jeste neznam a on to nejak zvladne.

PS: Mel jsem tam jeste chybu ze jsem u STRING_I a STRING_Z automaticky aktivoval vypsani funkce na tisk toho typu retezcu i kdyz jsem nic netisknul.
PPS: A u prevodu na zakonceni pres znamenkovy bit jsem neresil pripad "H","e","l","l","o", kdy to udelalo chybu. Cely ten regexp jsem prekopal, takze i pozna ze selhal a kvuli opakovani udelal jako samostatne makro/fci.
Kód:
dnl # conversion to string_i
dnl # "T","e","x","t",,"",,       --> "T","e","x","t" + 0x80
dnl # "Text",,"",,                --> "Tex","t" + 0x80
dnl # "Text",0x0D,"",,            --> "Text",0x0D + 0x80
define({__CONVERSION_TO_STRING_I},{ifelse(dnl
__{}__{}regexp({$*},     {^\(.*\)\("[^"]"\)\s*\(,\(""\|\)\s*\)*\s*$},{{"x","x"}}),{"x","x"},
__{}__{}__{}{regexp({$*},{^\(.*\)\("[^"]"\)\s*\(,\(""\|\)\s*\)*\s*$},{{\1\2 + 0x80}})},dnl           # "H","e","l","l","o"      --> "H","e","l","l","o" + 0x80
__{}__{}regexp({$*},     {^\(.*".*[^"]\)\([^"]\)"\s*\(,\(""\|\)\s*\)*\s*$},{{"...xx"}}),{"...xx"},
__{}__{}__{}{regexp({$*},{^\(.*".*[^"]\)\([^"]\)"\s*\(,\(""\|\)\s*\)*\s*$},{{\1","\2" + 0x80}})},dnl # "Hello"                  --> "Hell","o"+0x80
__{}__{}regexp({$*},     {^\(.*\)\s*\([^",]*[^", ]+\)\s*\(,\(""\|\)\s*\)*\s*$},{{x,x}}),{x,x},
__{}__{}__{}{regexp({$*},{^\(.*\)\s*\([^",]*[^", ]+\)\s*\(,\(""\|\)\s*\)*\s*$},{{\1\2 + 0x80}})},dnl # 0x48,0x65,0x6c,0x6c,0x6f --> 0x48,0x65,0x6c,0x6c,0x6f+0x80
__{}__{}{dnl
__{}__{}__{}regexp({$*},{^\(.+[^ ]\)\s*$},{{\1 + 0x80}}){}errprint({
  .warning $0:($*) Last character not found. Check if you have an even number of characters "})}){}dnl           # ???                      --> ??? + 0x80
}){}dnl


PPPS: Orezal jsem jeste vypis tech textu v poznamkach na 60 znaku retezce, viz
Kód:
    ex   DE, HL         ; 1:4       string_i   "Hello",,,

Predtim jsem to tam dal, protoze je to prehlednejsi co tisknete, ale zapomnel, ze kdyz me tam nekdo hodi cely odstavec tak to bude naopak mene prehledne.

_________________
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.08.2022, 22:53 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Protoze Pangram pouziva pri stavu zasobniku "d1 u" kombinaci slov
Kód:
1. rot dlshift dor


1. vlozi na zasobnik jednicku 32 bitove. Zasobnik je pak "d1 u 1."

ROT prohodi posledni 32 bitove cislo s nasledujicim 16-bit unsigned. Zasobnik je pak "d1 1. u"

dLSHIFT je nestandartni slovo pro logicky posun vlevo o "u" bitu. Nestadartne je tam "d" pro double. Zasobnik je pak "d1 d2", kde d2 = 1. << u

dOR je dalsi nestadartni slovo pro binarni OR mezi dvema double cislama. Zasobnik je "d3", kde d3 = d1 | d2, jinak napsano d3 = d1 | 2**u.

Takze ta kombinace slov nastavi u-ty bit double cisla d1.

Hmm... zrovna u tohohle prikladu se bitovy pole hodi.

Takze jsem pro to napsal optimalizovane slova SETBIT, PUSH_SETBIT a DSETBIT, PUSH_DSETBIT.

Hledal jsem na netu reseni kde Busy delal pseudoinstrukci SET x,REG, ale vubec jsem to nenasel, i kdyz vim ze to nekde mel.

Tak jsem to musel vypotit sam.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'PUSHDOT(1) ROT_DLSHIFT DOR'

    push DE             ; 1:11      pushdot(1)   ( -- hi lo )
    push HL             ; 1:11      pushdot(1)
    ld   HL, 0x0001     ; 3:10      pushdot(1)
    ld    E, H          ; 1:4       pushdot(1)   E = H = 0x00
    ld    D, E          ; 1:4       pushdot(1)   D = E = 0x00
    pop  BC             ; 1:10      rot D<<   ( d1 -- d )  d = d1 << BC
    call BC_LSHIFT32    ; 3:17      rot D<<
    pop  BC             ; 1:10      dor   ( d2 d1 -- d )  d = d2 | d1
    ld    A, C          ; 1:4       dor
    or    L             ; 1:4       dor
    ld    L, A          ; 1:4       dor
    ld    A, B          ; 1:4       dor
    or    H             ; 1:4       dor
    ld    H, A          ; 1:4       dor
    pop  BC             ; 1:10      dor
    ld    A, C          ; 1:4       dor
    or    E             ; 1:4       dor
    ld    E, A          ; 1:4       dor
    ld    A, B          ; 1:4       dor
    or    D             ; 1:4       dor
    ld    D, A          ; 1:4       dor
;-------------------------------------------------------------------------------
; ( d1 -- d )  d = d1<<BC
; shifts d1 left BC places
;  Input: BC=u, DEHL=d1, (SP)=ret
; Output: DEHL <<=  BC
; Pollutes: AF, BC, DE, HL
BC_LSHIFT32:            ;[34:]      lshift32
    ld    A, 0xE0       ; 2:7       lshift32
    and   C             ; 1:4       lshift32
    or    B             ; 1:4       lshift32
    jr   nz, LSHIFT32_Z ; 2:7/12    lshift32   overflow
    ld    A, C          ; 1:4       lshift32
    and  0x07           ; 1:4       lshift32   A = u & 0x07
    jr    z, $+10       ; 2:7/12    lshift32
    ld    B, A          ; 1:4       lshift32
    add  HL, HL         ; 1:11      lshift32
    rl    E             ; 2:8       lshift32
    rl    D             ; 2:8       lshift32   DEHL = DEHL << 1
    djnz $-5            ; 2:8/13    lshift32
    xor   C             ; 1:4       lshift32   A = u & 0xF8
    ret   z             ; 1:5/11    lshift32
    sub  0x08           ; 2:7       lshift32
    ld    D, E          ; 1:4       lshift32
    ld    E, H          ; 1:4       lshift32
    ld    H, L          ; 1:4       lshift32
    ld    L, B          ; 1:4       lshift32   DEHL = DEHL << 8
    jr   $-7            ; 2:12      lshift32
LSHIFT32_Z:             ;           lshift32
    ld   DE, 0x0000     ; 3:10      lshift32
    ld    H, D          ; 1:4       lshift32
    ld    L, E          ; 1:4       lshift32   DEHL = 0
    ret                 ; 1:10      lshift32
                       ;[59:283]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'DBITSET'

    call BITSET32       ; 3:17      dbitset   ( d1 u -- d )  d == d1 | 2**u   default version
;==============================================================================
; ( d1 u -- d )  d = d1 | 2**u
; set u bit
;  Input: HL=u, DE=lo, (SP)=ret, (SP+2)=hi
; Output: DEHL = d1 | (1 << u)
; Pollutes: AF, BC, DE, HL
BITSET32:              ;[29:143/67] bitset32   ( d1 u -- d )  d = d1 | 2**u
    ld    C, L          ; 1:4       bitset32
    ld    B, H          ; 1:4       bitset32   BC = u
    pop  HL             ; 1:10      bitset32   ret
    ex  (SP),HL         ; 1:19      bitset32
    ex   DE, HL         ; 1:4       bitset32   DEHL = d1
    ; fall to BC_BITSET32
BC_BITSET32:           ;[24:102/26] bc_bitset32   ( d1 -- d )  d = d1 | 2**BC
    ld    A, 0xE0       ; 2:7       bc_bitset32
    and   C             ; 1:4       bc_bitset32
    or    B             ; 1:4       bc_bitset32
    ret  nz             ; 1:5/11    bc_bitset32   out of range 0..31
    ld    A, C          ; 1:4       bc_bitset32   A = 000r rnnn
    rlca                ; 1:4       bc_bitset32   2x
    rlca                ; 1:4       bc_bitset32   4x
    rlca                ; 1:4       bc_bitset32   8x
    ld    C, A          ; 1:4       bc_bitset32   C = rrnn n000, nnn = 0..7, rr=(L:0,H:1,E:2,D:3) --> 5-rr=(L:5,H:4,E:3,D:2)
    rlca                ; 1:4       bc_bitset32
    rlca                ; 1:4       bc_bitset32
    and  0x03           ; 1:4       bc_bitset32
    ld    B, A          ; 1:4       bc_bitset32   B = 0000 00rr
    ld    A, C          ; 1:4       bc_bitset32   A = rrnn n000
    or   0xC5           ; 2:7       bc_bitset32   A = 11nn n101     = set n, L
    sub   B             ; 1:4       bc_bitset32   A = 11nn n101 - B = set n, DEHL
    ld  ($+4), A        ; 3:13      bc_bitset32
    set   0, L          ; 2:8       bc_bitset32
    ret                 ; 1:10      bc_bitset32
                       ;[32:160]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'define({_TYP_DOUBLE},{fast}) DBITSET'
 
                       ;[26:108/45] dbitset   ( d1 u -- d )  d == d1 | 2**u   fast version
    ld    A, 0xE0       ; 2:7       dbitset
    and   L             ; 1:4       dbitset
    or    H             ; 1:4       dbitset
    ld    A, L          ; 1:4       dbitset   A = 000r rnnn
    pop  HL             ; 1:10      dbitset
    ex   DE, HL         ; 1:4       dbitset
    jr   nz, $+19       ; 2:7/12    dbitset   out of range 0..31
    rlca                ; 1:4       dbitset   2x
    rlca                ; 1:4       dbitset   4x
    rlca                ; 1:4       dbitset   8x
    ld    C, A          ; 1:4       dbitset   C = rrnn n000, nnn = 0..7, rr=(L:0,H:1,E:2,D:3) --> 5-rr=(L:5,H:4,E:3,D:2)
    rlca                ; 1:4       dbitset
    rlca                ; 1:4       dbitset
    and  0x03           ; 1:4       dbitset
    ld    B, A          ; 1:4       dbitset   B = 0000 00rr
    ld    A, C          ; 1:4       dbitset   A = rrnn n000
    or   0xC5           ; 2:7       dbitset   A = 11nn n101     = set n, L
    sub   B             ; 1:4       dbitset   A = 11nn n101 - B = set n, DEHL
    ld  ($+4), A        ; 3:13      dbitset
    set   0, L          ; 2:8       dbitset
                       ;[26:108]

32 bit jsem testoval na tom pangramu a funguje to.

_________________
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.08.2022, 22:59 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
16 bitove varianty jsem netestoval. Ale vypada to ze to bude fungovat... .)
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'PUSH_SWAP(1) LSHIFT OR'

    push DE             ; 1:11      1 swap
    ld   DE, 1          ; 3:10      1 swap ( a -- 1 a )
    call DE_LSHIFT      ; 3:17      <<   ( x1 u -- x1<<u )
    pop  DE             ; 1:10      <<
    ld    A, E          ; 1:4       or   ( x2 x1 -- x )  x = x2 | x1
    or    L             ; 1:4       or
    ld    L, A          ; 1:4       or
    ld    A, D          ; 1:4       or
    or    H             ; 1:4       or
    ld    H, A          ; 1:4       or
    pop  DE             ; 1:10      or
;==============================================================================
; ( x u -- ? x<<u )
; shifts x left u places
;  Input: HL, DE
; Output: HL = DE << HL
; Pollutes: AF, B, DE, HL
DE_LSHIFT:              ;[27:]      de_lshift
    ld    A, 0xF0       ; 2:7       de_lshift
    and   L             ; 1:4       de_lshift
    or    H             ; 1:4       de_lshift
    jr   nz, DE_LSHIFTZ ; 2:7/12    de_lshift   overflow
    or    L             ; 1:4       de_lshift
    ex   DE, HL         ; 1:4       de_lshift   HL = x
    ret   z             ; 1:5/11    de_lshift    A = E = u
    ld    B, A          ; 1:4       de_lshift
    sub   0x08          ; 2:7       de_lshift
    jr    c, $+7        ; 2:7/12    de_lshift
    ld    H, L          ; 1:4       de_lshift
    ld    L, 0x00       ; 2:7       de_lshift   HL = HL << 8
    ret   z             ; 1:5/11    de_lshift
    ld    B, A          ; 1:4       de_lshift
    add  HL, HL         ; 1:11      de_lshift   HL = HL << 1
    djnz $-1            ; 2:8/13    de_lshift
    ret                 ; 1:10      de_lshift
DE_LSHIFTZ:             ;           de_lshift
    ld   HL, 0x0000     ; 3:10      de_lshift   HL = 0
    ret                 ; 1:10      de_lshift
                       ;[42:204]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'BITSET'

    call BITSET16       ; 3:17      bitset   ( x1 u -- x )  x == x1 | 2**u   default version
    pop  DE             ; 1:10      bitset
;==============================================================================
; ( x1 u -- ? x )  x = x1 | 2**u
; set u bit
;  Input: HL, DE
; Output: HL = DE | ( 1<<HL )
; Pollutes: AF, B, DE, HL
BITSET16:               ;[21:89/30] bitset16   ( x1 u -- ? x )  x = x1 | 2**u
    ld    A, 0xF0       ; 2:7       bitset16
    and   L             ; 1:4       bitset16
    or    H             ; 1:4       bitset16
    ex   DE, HL         ; 1:4       bitset16
    ret  nz             ; 1:5/11    bitset16   out of range 0..15
    ld    A, E          ; 1:4       bitset16   A = 0000 rnnn
    rlca                ; 1:4       bitset16   A = 000r nnn0
    rlca                ; 1:4       bitset16   A = 00rn nn00
    add   A, 0xE0       ; 2:7       bitset16   A = ...n nn00 carry = r
    ccf                 ; 1:4       bitset16   A = ...n nn00 carry = i = 1-r
    adc   A, A          ; 1:4       bitset16   A = ..nn n00i
    or   0xC4           ; 2:7       bitset16   A = 11nn n101 = set n,L   or   A = 11nn n100 = set n,H
    ld  ($+4), A        ; 3:13      bitset16
    set   0, L          ; 2:8       bitset16
    ret                 ; 1:10      bitset16
                       ;[25:116]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Automatic$ ../check_word.sh 'define({_TYP_SINGLE},{fast}) BITSET'
 
                       ;[22:91/45]  bitset   ( x1 u -- x )  x == x1 | 2**u   fast version
    ld    A, 0xF0       ; 2:7       bitset
    and   L             ; 1:4       bitset
    or    H             ; 1:4       bitset
    ld    A, L          ; 1:4       bitset   A = 0000 rnnn
    pop  HL             ; 1:10      bitset
    ex   DE, HL         ; 1:4       bitset
    jr   nz, $+15       ; 2:7/12    bitset   out of range 0..15
    rlca                ; 1:4       bitset   A = 000r nnn0
    rlca                ; 1:4       bitset   A = 00rn nn00
    add   A, 0xE0       ; 2:7       bitset   A = ...n nn00 carry = r
    ccf                 ; 1:4       bitset   A = ...n nn00 carry = i = 1-r
    adc   A, A          ; 1:4       bitset   A = ..nn n00i
    or   0xC4           ; 2:7       bitset   A = 11nn n101 = set n,L   or   A = 11nn n100 = set n,H
    ld  ($+4), A        ; 3:13      bitset
    set   0, L          ; 2:8       bitset
                       ;[22:91]

Mate nekdo lepsi rutinu? Trochu jsem premyslel nad smyckou nad A a pak zvolenim spravneho registru z DEHL nebo HL, ale pri vypoctu pro 4x posun o bit me to vychazelo vzdy horsi.

PS: PUSH_ varianty neukazuji, ty proste jen neudelaji nic nebo neco jako "set 4,E".

Docela silena verze je pak s tim, kdyz vlozite jako parametr nejake nezname cislo. To byste fakt nemeli delat, ale i tak to bude fungovat. Vygeneruje to makro pro prekladac na 2 stranky. A vzhledem k tomu ze pasmo neumi ELSEIF a na jednom radku nesmi byt nic jineho nez JEDEN if nebo else nebo endif tak to vypada nejak jako

if (($1) = 1)
set 0,L
else
if (($1) = 2)
set 1,L
else
...
if (($1) = 0xFF)
ld L=0xFF ; tohle je tam protoze pouzivam standartni rutinu pro 8-bit OR
else
if (($1) > 0)
ld A, $1 ; tohle je tam protoze pouzivam standartni rutinu pro 8-bit OR
or L
ld L, A
endif
endif
endif
endif
...
A to cele jeste obalene dalsima ifama pro vyber registru. .)

PPS: Argh! PASMO je fakt neuveritelny. Retezec "(aa)>>8" me vyhodi jako odkaz do pameti s chybou ze ceka konec radku a pritom nasel >>8.

Je to tezke osetrovat, protoze ty zavorky kolikrat musite mit, kdyz nevite co je na vstupu...
I kdyz to asi vypada ze "aa" nemuze byt neznamy retezec, jako "5*3-1" ale asi jen cislo. Protoze aa EQU 5*3-1 prevede na 14. Hmmm... ted si vzpominam, ze jsem neco takoveho uz rikal a pak jsem nasel ze neco nefunguje...

No proste kdyz mam radu do sebe vnorenych maker, tak potrebuji, aby to nebylo nikdy cele v zavorce a pritom to bylo ozavorkovane a ted to musim upravit...

($2) & 0xFF --> 0xFF & ($2)
($2) >> 8 --> +($2) >> 8

Plusko je kratsi jak 1*($2) >> 8. Hmmm.... Mozna bych mel v M4 rovnou zarvat, ze to nejde. Protoze kolikrat to jde, kdyz definujeme konstantu ve Fortu. Ale jsou pripady, kdy je to zavisle na adrese...

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Vcera jsem nemohl spat a tak zase programoval. Tentokrat zkousel co vyplodi nejaky C prekladac pro pangram. Zase se pral s tim, aby me to vubec neco zkompilovalo. Nakonec jsem uspel a podival se na kod.
Chapal jsem vse, ale fakt se divil co jsem videl.
Kód:
int pangram(const char * str)
{
   str--;
   unsigned char c;
   unsigned long int alphabet = 0;
   
   while (c = *++str) {
      c |= 32; // uppercase
      c -= 'a';
      if ( c<26 ) alphabet |= (long unsigned int) 1 << c;     
   }
   
   return alphabet==0x3FFFFFF;
}

Tuhle cast vam popisi.

Kód:
   0000                      49 _pangram::
   0000 DD E5         [15]   50    push   ix
   0002 DD 21 00 00   [14]   51    ld   ix,#0
   0006 DD 39         [15]   52    add   ix,sp

Cecko bude vytvaret na zasobniku prostor pro lokalni promenne a protoze toho bude hodne,
tak si ulozi puvodni hodnotu zasobniku do IX, ktery si prvne ulozi, aby je pak oba rychleji vratil na puvodni hodnotu.

Kód:
   0008 21 F4 FF      [10]   53    ld   hl, #-12
   000B 39            [11]   54    add   hl, sp
   000C F9            [ 6]   55    ld   sp, hl

Tady posune zasobnik o 6 mist dolu = si udela prostor proo sest 16bitovych cisel.

Kód:
                             56 ;Pangram.c:5: str--;
   000D DD 6E 04      [19]   57    ld   l, 4 (ix)
   0010 DD 66 05      [19]   58    ld   h, 5 (ix)
   0013 2B            [ 6]   59    dec   hl
   0014 DD 75 04      [19]   60    ld   4 (ix), l
   0017 DD 74 05      [19]   61    ld   5 (ix), h

IX ma hodnotu puvodniho zasobniku. Takze:
IX+0..IX+1 - puvodni hodnota IX
IX+2..IX+3 - ret funkce
IX+4..IX+5 - predavany parametr str
Vubec ho nezajima ze bude str znovu brzo potrebovat. Nevidi to... nenecha to v HL.

Kód:
                             62 ;Pangram.c:7: unsigned long int alphabet = 0;
   001A AF            [ 4]   63    xor   a, a
   001B DD 77 FC      [19]   64    ld   -4 (ix), a
   001E DD 77 FD      [19]   65    ld   -3 (ix), a
   0021 DD 77 FE      [19]   66    ld   -2 (ix), a
   0024 DD 77 FF      [19]   67    ld   -1 (ix), a

Do vytvoreneho prostoru pro lokalni promenne na zasobniku da 32bitove cislo alphabet nastavene na nulu;

Kód:
                             68 ;Pangram.c:9: while (c = *++str) {
   0027 DD 7E 04      [19]   69    ld   a, 4 (ix)
   002A DD 77 F9      [19]   70    ld   -7 (ix), a
   002D DD 7E 05      [19]   71    ld   a, 5 (ix)
   0030 DD 77 FA      [19]   72    ld   -6 (ix), a

Udela si uplne zbytecne kopii str a zase ji nedrzi v registru... Vypada to, ze jen pro jistotu. Uplne postradam smysl.
I bez analyzy kodu je jasne, ze puvodni str uz nebude potrebovat. Nejde to udelat v programu tak, ze najednou ziskam nejak puvodni hodnotu.
Zadnym IF ELSE, ani rekurzi, nijak.
A udela si diru/misto v lokalnich promenych na pocitadlo smycky.
Nasleduje hlavni smycka while, label 00103$.

Kód:
   0033                      73 00103$:
   0033 DD 34 F9      [23]   74    inc   -7 (ix)
   0036 20 03         [12]   75    jr   NZ,00124$
   0038 DD 34 FA      [23]   76    inc   -6 (ix)
   003B                      77 00124$:

++str, ale slozite v pameti s pomoci pomocneho navesti a jeste nad kopii... Podivejte se na ty takty. 23 jen za prvni instrukci. Drzet to v HL tak to mohl mit za jeden bajt misto 8 a za 6 taktu!

Kód:
   003B DD 6E F9      [19]   78    ld   l, -7 (ix)
   003E DD 66 FA      [19]   79    ld   h, -6 (ix)
   0041 7E            [ 7]   80    ld   a, (hl)
   0042 DD 77 FB      [19]   81    ld   -5 (ix), a
   0045 DD 77 F8      [19]   82    ld   -8 (ix), a
   0048 DD 7E FB      [19]   83    ld   a, -5 (ix)
   004B B7            [ 4]   84    or   a, a
   004C 28 5D         [12]   85    jr   Z,00105$

Tady to s te inkrementovane kopie v pameti musi do HL dat, aby mohl nacist z toho ukazatele znak.
A ted pozor, ten znak si ulozi rovnou 2x. Jednou do te mezery co ma v lokalnich datech a podruhe jeste na -8.
Vypada to, ze tu -5 pouzije jen proto, aby mohl obnovit akumulator, pote co ho pouzije na ulozeni do -8, takze ho nezmeni. Nikde jinde se nepouziva. Uzasne.
A to dokonce predtim nez zjisti zda ho bude jeste potrebovat, protoze je to pred skokem a mimo smycku se s tim nic nedela.
On za skok nevidi.
Vsechno instrukce s ix jsou tady nadbytecne. Jen 3 bajty kodu jsou potreba.

Kód:
                             86 ;Pangram.c:10: c |= 32; // uppercase
   004E DD 4E F8      [19]   87    ld   c, -8 (ix)
   0051 CB E9         [ 8]   88    set   5, c
   0053 79            [ 4]   89    ld   a, c

On to ma stale v akumulatoru a presto to bude tahat z te -8 a jeste do registru c, aby to musel nastavovat pres set! A pak to strci do akumulatoru.
Naprosto neuveritelne. Jako slepec. Tam musi chybet uplne predavani dat z predchoziho kodu.
Tohle slo napsat na 2 bajty a 7 taktu prostym "or 32".

Kód:
                             90 ;Pangram.c:11: c -= 'a';
   0054 C6 9F         [ 7]   91    add   a, #0x9f

Nevim proc voli pricteni zaporne hodnoty, nez odecet te hodnoty, ale nema to zadnou rezii navic.

Kód:
                             92 ;Pangram.c:12: if ( c<26 ) alphabet |= (long unsigned int) 1 << c;     
   0056 DD 77 F8      [19]   93    ld   -8 (ix), a
   0059 D6 1A         [ 7]   94    sub   a, #0x1a
   005B 30 D6         [12]   95    jr   NC,00103$

Tohle je ale strasne chytre. To bych chtel mit taky.
On tady konecne vidi dopredu a vi, ze tohle je posledni radek smycky a skoci rovno zpet a ne prvne za konec radku a pak teprve zpet.
Vsimnete si jak prvne ulozi akumulator do pameti -8, aby ho za chvili mohl z pameti nacist do registru b.
Rikate si proc? Tak na tohle neznam odpoved. Proste nema data. Mohl pouzit i CP misto SUB.
Vic ix, vic bajtu a taktu.

Kód:
   005D DD 46 F8      [19]   96    ld   b, -8 (ix)
   0060 DD 36 F4 01   [19]   97    ld   -12 (ix), #0x01
   0064 DD 36 F5 00   [19]   98    ld   -11 (ix), #0x00
   0068 DD 36 F6 00   [19]   99    ld   -10 (ix), #0x00
   006C DD 36 F7 00   [19]  100    ld   -9 (ix), #0x00
   0070 04            [ 4]  101    inc   b
   0071 18 10         [12]  102    jr   00126$

Inicializace smycky pro opakovany bitovy posun vlevo.
On to bude ted dost intenzivne pouzivat a nic jineho, ale do registru to neda ani nahodou.
Pritom takove add HL,HL pro nizsich 8 bajtu...

Kód:
   
   0073                     103 00125$:
   0073 DD CB F4 26   [23]  104    sla   -12 (ix)
   0077 DD CB F5 16   [23]  105    rl   -11 (ix)
   007B DD CB F6 16   [23]  106    rl   -10 (ix)
   007F DD CB F7 16   [23]  107    rl   -9 (ix)
   0083                     108 00126$:
   0083 10 EE         [13]  109    djnz   00125$

...by mu usetrilo 6 bajtu a bylo vic jak 4x rychleji.
Je to takova zajimava ukazka, ze nam staci pro programovani jen jeden ix registr a dostatek pameti, i pro ten nabobtnaly kod.
Tohle uplne krici o to ze mam volne idealni pro rotaci HL,A, a jeden z registru D,E,C. Nezajem, nebo spis slepota.

Kód:
   0085 DD 7E FC      [19]  110    ld   a, -4 (ix)
   0088 DD B6 F4      [19]  111    or   a, -12 (ix)
   008B DD 77 FC      [19]  112    ld   -4 (ix), a
   008E DD 7E FD      [19]  113    ld   a, -3 (ix)
   0091 DD B6 F5      [19]  114    or   a, -11 (ix)
   0094 DD 77 FD      [19]  115    ld   -3 (ix), a
   0097 DD 7E FE      [19]  116    ld   a, -2 (ix)
   009A DD B6 F6      [19]  117    or   a, -10 (ix)
   009D DD 77 FE      [19]  118    ld   -2 (ix), a
   00A0 DD 7E FF      [19]  119    ld   a, -1 (ix)
   00A3 DD B6 F7      [19]  120    or   a, -9 (ix)
   00A6 DD 77 FF      [19]  121    ld   -1 (ix), a
   00A9 18 88         [12]  122    jr   00103$

32 bitovy OR dvou cisel v pameti. :)
Proc nema to jedno cislo v registech nepochopime. Fakt bych chtel umet videt jak to delaji. Ja mam izolovana slova nebo spojeni slov.
To je v podstate taky jedno slovo a uvnitr mohu delat optimalizaci, ne z dat v okoli, protoze pouzivam pouha makra.
Teoreticky bych mohl mit nejake udaje z prechozich slov, ale to by bylo celkem slozite bezpecne implementovat.
Mohu si udelat makra __HL, __DE, __BC a drzet v nich co obsahuji. Zda je to znama hodnota, protoze jsem tam predtim vlozil konstantu, nebo uz ne.
Ale to by si vyzadalo osetreni vsech skoku. Na nic nezapomenout.

A mam automaticky prvnich 32 bitu vzdy v registrech, takze se mi nemuze stat z principu delat operaci nad dvema operandy v pameti.
To bych musel mit slovo jako PUSH2_OR() a programator to tak chtel mit a hodit me 2 pointery.

Kód:
   00AB                     123 00105$:
                            124 ;Pangram.c:15: return alphabet==0x3FFFFFF;
   00AB DD 7E FC      [19]  125    ld   a, -4 (ix)
   00AE 3C            [ 4]  126    inc   a
   00AF 20 16         [12]  127    jr   NZ,00127$
   00B1 DD 7E FD      [19]  128    ld   a, -3 (ix)
   00B4 3C            [ 4]  129    inc   a
   00B5 20 10         [12]  130    jr   NZ,00127$
   00B7 DD 7E FE      [19]  131    ld   a, -2 (ix)
   00BA 3C            [ 4]  132    inc   a
   00BB 20 0A         [12]  133    jr   NZ,00127$
   00BD DD 7E FF      [19]  134    ld   a, -1 (ix)
   00C0 D6 03         [ 7]  135    sub   a, #0x03

Zvolil metodu, ktera muze byt u smycky idealni, kdy prvne resi nejnizsi bity.
Bohuzel tady se to nevyplati, protoze to neni podminka smycky.
Tomu se ale neda nic vytknout, to uz chce vic informaci a vetsi nadhled, ze tahle cast kodu probehne jen jednou.

Kód:
   00C2 20 03         [12]  136    jr   NZ, 00127$
   00C4 3E 01         [ 7]  137    ld   a, #0x01
   00C6 20                  138    .db   #0x20
   00C7                     139 00127$:
   00C7 AF            [ 4]  140    xor   a, a
   00C8                     141 00128$:
   00C8 6F            [ 4]  142    ld   l, a
   00C9 26 00         [ 7]  143    ld   h, #0x00

V tehle casti je jedna genialni vec.
Ten bajt 0x20 je zacatek instrukce jr NZ. On vi ze protoze to selhalo predtim a nic se nezmenil tak to selze znovu a odmaze to xor a,a.
Tady musim podotknout, ze on vyzaduje oba registry v xor! Pasmo naopak tohle oznaci jako chybu a selze...
Proc? Co je snandart? Ze by byl problem v tom, ze tohle neni jen cilene na Z80? Ale i jine procesory?
Zrovna u "xor a,a", me nejaky novejsi klon Z80 asi novou instrukci nezmate. "sub c" by mohlo, kdyby mu pridali instrukce pro odcitani nejen u akulutaru.

Zpet k tomu jr NZ. Ja bych automaticky pouzil variantu s ld b,* nebo ld bc,** a zabil tak hodnotu v jednom nebo vice registru. Tohle je chytrejsi a pritom tak proste.
Dokonce by to bylo o bajt mensi a obe varianty pokazde o jeden takt rychlejsi.
Kód:
   jr   NZ,00127$
   db 0x12 0x01              ; 12 01 .. = ld hl, 0x2e01    ld hl + nop + ld h = 10+4+7 = 21
00127$:
   ld   l, 0x00              ; 2e 00                       ld l + ld h = 7+7 = 14
   ld   h, 0x00              ; 26 00


Cele je to ale uplne zbytecne, protoze za chvili je konec a nepouzivat zbytecne ix mohl to napsat
Kód:
00127$:
   ld   hl, 0x0000           ; 3:10      Replace str with a return value of 0 or 1
   ret  NZ                   ; 1:5/11
   inc  l                    ; 1:4


Kód:
                            144 ;Pangram.c:16: }
   00CB DD F9         [10]  145    ld   sp, ix
   00CD DD E1         [14]  146    pop   ix
   00CF C9            [10]  147    ret

Vrati zasobnik zpet a hodnotu ix.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Prepsat ten kod do asembleru beze zmeny algoritmu by vypadalo nejak takto
Kód:
;   ---------------------------------
; Function pangram
; ---------------------------------
; hl = *str
_pangram::
;Pangram.c:5: str--;
   dec  hl
;Pangram.c:7: long unsigned int alphabet = 0;
   ld   de, 0x0000           ; A little trick is to use DE as the lower 16 bit part and then in the shift number one have DE as the higher 16 bit part.
   ld   b, d
   ld   c, d                 ; alphabet = bcde = 0x0000
;Pangram.c:9: while (c = *++str) {
00103$:
   inc  hl
   ld   a, (hl)
   or   a, a
   jr   Z,00105$
;Pangram.c:10: c |= 32; // uppercase
   or   0x20
;Pangram.c:11: c -= 'a';
; 'a' = 97 = 0x61, 256-97 = 0x9F
   sub  'a'
;Pangram.c:12: if ( c<26 ) alphabet |= (long unsigned int) 1 << c;
   cp   0x1a                 ; =26
   jr   NC,00103$            ;  Very clever
   push hl                   ;  need free reg, save str
   push de                   ;  need free reg, save hi16(bcde)
   ld   hl, 0x0001
   ld   e, h
   ld   d, h                 ; dehl = 0x0001  It's possible to have a loop start with zero and set carry, but that's not universal, so I'm showing this.
   inc  a                    ; Another option with BC register is a byte longer and faster up to repetitions (4+10+11) times
   jr   00126$
00125$:
   add  hl,hl
   rl   e
   rl   d
00126$:
   dec  a
   jp   NZ,00125$
   ld   a, c
   or   e
   l    c, a
   ld   a, b
   or   d
   ld   b, a
   pop  de                   ; load de
   ld   a, e
   or   l
   l    e, a
   ld   a, d
   or   h
   ld   d, a
   pop  hl                   ; load hl
   jr   00103$
00105$:
;Pangram.c:17: return alphabet==0x3FFFFFF;
; alphabet = bcde
   inc  e
   jr   NZ,00127$            ; Not now, but if it were a loop, it is more efficient to solve the lowest byte in particular.
   ld   a, 0xC0              ; 0xC0 ^ 0x3F = 0xFF
   xor  b
   and  c
   and  d
   inc  a
if 0
   jr   NZ,00127$
   db 0x12 0x01              ; 12 01 .. = ld hl, 0x2e01    ld hl + nop + ld h = 10+4+7 = 21
00127$:
   ld   l, 0x00              ; 2e 00                       ld l + ld h = 7+7 = 14
   ld   h, 0x00              ; 26 00
else
00127$:
   ld   hl, 0x0000           ; 3:10      Replace str with a return value of 0 or 1
   ret  NZ                   ; 1:5/11
   inc  l                    ; 1:4
endif
;Pangram.c:18: }
   ret

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