OldComp.cz

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


Právě je 28.03.2024, 20:52

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 ... 25, 26, 27, 28, 29, 30, 31 ... 39  Další
Autor Zpráva
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 28.02.2023, 18:08 
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
l00k píše:
no já bych byl s tím přerušením hodně opatrnej, pokud by přišlo ke konci plnění, tak nějaká rutina přerušení co zatěžuje víc zásobník by mohla přetéct do oblasti kde se nemá co zapisovat (jiná proměnná)
Pozri moj prispevok tesne nad tvojim ;)


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Busy jses na me moc rychlej. :D Ja se jeste trapil s tou podrutinou a ty uz me navrhujes dalsi reseni.

Problem s tim zasobnikem je ten, ze tohle je prekladac a od prekladace neocekavas nejake podrazy a nebo neocekavane/nedokumentovane chovani. Ja (teda M4 Forth) ted normalne funguji na ZX Spectru se standartni ROMkou (tady jsem to trosku podelal s jednou malou optimalizaci hned ve slove INIT, takze nevim zda to pobezi i na jinych romkach) a v podstate spolecne s basicem.
Neudelal jsem nic (teda nevim o nicem) co by bylo s necim v kolizi.
Ok, pokud zacnes pouzivat rozsireni pro prace s poli, tak tam se pouziva register IX. (To nevim co pokazi).

Takze pokud prekladac zacne pouzivat push kreativnim zpusobem, bez toho ze ho k tomu primo vyzve uzivatel nejakou direktivou tak je to spatne.
Ten navrh interupt je pekny, ale ja fakt netusim kdo bude (ok vim ze nikdo) na druhe strane chtit ten prekladac pouzit a s jakou znalosti. Takze bych to videl tak, ze to mohu pouzit, ale muselo by to bezet i bez zakazu preruseni a opravdu se me nechce nastudovat ROMka kolik ze v nejhorsim pripade potrebuje ukladat na zasobnik a jsem si jisty ze se to bude lisit v zavislosti i co by tam mohlo byt pripojene atd., takze to muze byt i celkem dost a jakmile to bude vic jak 8 bajtu tak se dostanu do situace, kdy se to uz nemusi vyplacet zase kvuli velikosti.

Ja to musim psat defenzivne, pro ten nejhorsi scenar.

To je jeden z mnoha duvodu proc jsou prekladace C atd. na Z80 tak spatne. Ty mu doslova rikas tady mas funkci a ta funkce musi bezet i REKURZIVNE a bude delat tohle. A pritom si myslis ze mu rikas, mas funkci a ta udela tuhle malou smycku idealne s pocitadlem v registu B a protoze vis ze dalsi veci okolo te nemusi zajimat. Prekladac to netusi, ma mit smycku s 16 BITOVYM pocitadlem a jeste to musi prezit rekurzi a dalsi strasne veci, takze misto modelky na plazi ti z toho vyleze vojak s plnou polni a snorchlem.

Takze bych mohl napsat nejaky kod, ale musel by se aktivovat pres direktivu a jeste by se musel zadat parametr, a to kolik bajtu pred koncem to uz neni bezpecne. A tohle jeste vysvetlit uzivateli. Uf.

Ale asi to udelam... jen pro tu srandu. .)

Chtel jsem ale psat co jsem nedopsal predevcirem, ale nakonec reknu ze jsem se pral s tim jak udelat to volani te nove fce. A to jeste tak, aby se to nevolalo na djnz ale na zacatek, co je vyhodnejsi protoze prodlouzi rozsah o jeden bajt.
Pokud to nedeli segment je to jasne:

__TMP_MOD=rozsah mod 16
__TMP_B=(rozsah+15)/16

a skacu na START+2*(16-__TMP_MOD)

Pak uz jsem bojoval.
Zacal jsem se sudou adresou a sudym rozsahem, takze zadny zbytek. To je to same co predchozi pripad.
Kdyz pridam lichy rozsah na sude adrese pocatku... Umazal jsem 1 z rozsahu a pak proste pridal LD (DE),A
Tak jeste lichy zacatek a tady me to prestala hlava chapat a ani testy moc nepomohly. (Protoze se navzajem ovlivnuje lichy/sudy rozsah se sudym/lichym pocatkem)

Az dnes cestou do prace a v praci jsem to videl naprosto jasne. Je to snadne, divam se na to ze spatneho konce. Proste a jasne kdyz ta podrutina skonci tak za DJNZ je uz nepouzita SUDA adresa. Pokud by byla licha tak je to spatne a i ten skok dovnitr podrutiny bude na spatnem miste, liche na sudem a sude na lichem.
Takze jedine co musim osetrit je ze POCATEK+ROZSAH je suda hodnota.

((POCATEK+ROZSAH)&1)==0

Kdyz neni tak predtim snizim ROZSAH o jedna. A na konci pridam pro tu posledni lichou adresu to LD (DE),A.
Pak je vsechno na spravnych mistech a mohu pouzit ten prvni vzorec, kdy nedelim segmenty.

Tri ukazky pro liche zacatky (lichy rozsah, sudy rozsah, lichy konec ale bez deleni segmentu)
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(0x50FF,16+5,0x33) PUSH3_FILL(0x50FF,16+4,0x33) PUSH3_FILL(0x508F,16+4,0x33)'
                       ;[12:333]    0x50FF 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FF 16+5 0x33 fill
    ld   DE, 0x50FF     ; 3:10      0x50FF 16+5 0x33 fill   addr 0x50FF..0x5113
    ld    A, 0x33       ; 2:7       0x50FF 16+5 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x50FF 16+5 0x33 fill   u=B*16-11=2*16-11
    call Fill+22        ; 3:301     0x50FF 16+5 0x33 fill
    exx                 ; 1:4       0x50FF 16+5 0x33 fill
                       ;[13:316]    0x50FF 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FF 16+4 0x33 fill
    ld   DE, 0x50FF     ; 3:10      0x50FF 16+4 0x33 fill   addr 0x50FF..0x5112
    ld    A, 0x33       ; 2:7       0x50FF 16+4 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x50FF 16+4 0x33 fill   u=B*16-13=2*16-13
    call Fill+26        ; 3:277     0x50FF 16+4 0x33 fill
    ld  (DE),A          ; 1:7       0x50FF 16+4 0x33 fill
    exx                 ; 1:4       0x50FF 16+4 0x33 fill
                       ;[12:320]    0x508F 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x508F 16+4 0x33 fill
    ld   DE, 0x508F     ; 3:10      0x508F 16+4 0x33 fill   addr 0x508F..0x50A2
    ld    A, 0x33       ; 2:7       0x508F 16+4 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x508F 16+4 0x33 fill   u=B*16-12=2*16-12
    call Fill+24        ; 3:288     0x508F 16+4 0x33 fill
    exx                 ; 1:4       0x508F 16+4 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*16 - (start_address-Fill)/2
; Out: B = 0
;      DE += (B-1)*16+0..16
Fill:                  ;[37:B*205+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +16
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +18
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +20
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +22
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +24
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +26
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +28
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +30
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    ret                 ; 3:10      Fill
; seconds: 0           ;[74:1179]

A tri ukazky pro sude zacatky (lichy rozsah, sudy rozsah, lichy konec ale bez deleni segmentu)
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(0x50FE,16+5,0x33) PUSH3_FILL(0x50FE,16+4,0x33) PUSH3_FILL(0x508E,16+5,0x33)'
                       ;[13:327]    0x50FE 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FE 16+5 0x33 fill
    ld   DE, 0x50FE     ; 3:10      0x50FE 16+5 0x33 fill   addr 0x50FE..0x5112
    ld    A, 0x33       ; 2:7       0x50FE 16+5 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x50FE 16+5 0x33 fill   u=B*16-12=2*16-12
    call Fill+24        ; 3:288     0x50FE 16+5 0x33 fill
    ld  (DE),A          ; 1:7       0x50FE 16+5 0x33 fill
    exx                 ; 1:4       0x50FE 16+5 0x33 fill
                       ;[12:320]    0x50FE 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FE 16+4 0x33 fill
    ld   DE, 0x50FE     ; 3:10      0x50FE 16+4 0x33 fill   addr 0x50FE..0x5111
    ld    A, 0x33       ; 2:7       0x50FE 16+4 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x50FE 16+4 0x33 fill   u=B*16-12=2*16-12
    call Fill+24        ; 3:288     0x50FE 16+4 0x33 fill
    exx                 ; 1:4       0x50FE 16+4 0x33 fill
                       ;[12:333]    0x508E 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x508E 16+5 0x33 fill
    ld   DE, 0x508E     ; 3:10      0x508E 16+5 0x33 fill   addr 0x508E..0x50A2
    ld    A, 0x33       ; 2:7       0x508E 16+5 0x33 fill   char
    ld    B, 0x02       ; 2:7       0x508E 16+5 0x33 fill   u=B*16-11=2*16-11
    call Fill+22        ; 3:301     0x508E 16+5 0x33 fill
    exx                 ; 1:4       0x508E 16+5 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*16 - (start_address-Fill)/2
; Out: B = 0
;      DE += (B-1)*16+0..16
Fill:                  ;[37:B*205+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +16
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +18
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +20
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +22
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +24
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +26
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +28
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +30
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    ret                 ; 3:10      Fill
; seconds: 0           ;[74:1190]

V praci jsem byl z toho nadsenej, protoze se to muze pouzit i pro pripad, kdy misto PUSH3_FILL volam PUSH2_FILL a adresa je v HL a dal a dal...
A dal je to vlastne k nicemu, protoze ve chvili kdy neznam od pocatku ROZSAH tak to muze byt vic jak 4096 a pak by to selhalo, takze bych to musel osetrovat a volat dalsi proceduru a nebo resit nejhorsi scenar s opakovanim a to uz je lepsi pouzit neco jineho, klidne LDIR.

PS: Ale jinak ta funkce celkem pekna a jak to hezky pocita ty takty u kazdeho call. .)))
PPS: Jen by to chtelo nejak vic propagovat tuhle moznost, protoze pokud nevis ze mas pouzit _TYP_SINGLE=function....
Tak vyleze pro zajimavost tohle:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH3_FILL(0x50FF,16+5,0x33) PUSH3_FILL(0x50FF,16+4,0x33) PUSH3_FILL(0x508F,16+4,0x33)'
                       ;[17:376]    0x50FF 16+5 0x33 fill   fill(addr,u,char)   variant: fill(num,3*7 (max 767),no ptr)
    push HL             ; 1:11      0x50FF 16+5 0x33 fill
    ld   HL, 0x50FF     ; 3:10      0x50FF 16+5 0x33 fill   addr
    ld    B, 0x07       ; 2:7       0x50FF 16+5 0x33 fill   (16+5)/3
    ld    A, 0x33       ; 2:7       0x50FF 16+5 0x33 fill   char
    ld  (HL),C          ; 1:7       0x50FF 16+5 0x33 fill
    inc  HL             ; 1:6       0x50FF 16+5 0x33 fill   0x50FF=0x50FF+0+3*0
    ld  (HL),C          ; 1:7       0x50FF 16+5 0x33 fill
    inc   L             ; 1:4       0x50FF 16+5 0x33 fill
    ld  (HL),C          ; 1:7       0x50FF 16+5 0x33 fill
    inc   L             ; 1:4       0x50FF 16+5 0x33 fill
    djnz $-6            ; 2:13/8    0x50FF 16+5 0x33 fill
    pop  HL             ; 1:10      0x50FF 16+5 0x33 fill
                       ;[14:406]    0x50FF 16+4 0x33 fill   fill(addr,u,char)   variant: fill(?,max 513,no ptr)
    push HL             ; 1:11      0x50FF 16+4 0x33 fill
    ld   HL, 0x50FF     ; 3:10      0x50FF 16+4 0x33 fill   addr
    ld   BC, 0x0A33     ; 3:10      0x50FF 16+4 0x33 fill   B = 10x, C = 0x33
    ld  (HL),C          ; 1:7       0x50FF 16+4 0x33 fill
    inc  HL             ; 1:6       0x50FF 16+4 0x33 fill   0x50FF=0x50FF+0+2*0
    ld  (HL),C          ; 1:7       0x50FF 16+4 0x33 fill
    inc   L             ; 1:4       0x50FF 16+4 0x33 fill   only even numbers
    djnz $-4            ; 2:13/8    0x50FF 16+4 0x33 fill
    pop  HL             ; 1:10      0x50FF 16+4 0x33 fill
                       ;[14:386]    0x508F 16+4 0x33 fill   fill(addr,u,char)   variant: fill(?,max 513,no ptr)
    push HL             ; 1:11      0x508F 16+4 0x33 fill
    ld   HL, 0x508F     ; 3:10      0x508F 16+4 0x33 fill   addr
    ld   BC, 0x0A33     ; 3:10      0x508F 16+4 0x33 fill   B = 10x, C = 0x33
    ld  (HL),C          ; 1:7       0x508F 16+4 0x33 fill
    inc   L             ; 1:4       0x508F 16+4 0x33 fill
    ld  (HL),C          ; 1:7       0x508F 16+4 0x33 fill
    inc   L             ; 1:4       0x508F 16+4 0x33 fill   only even numbers
    djnz $-4            ; 2:13/8    0x508F 16+4 0x33 fill
    pop  HL             ; 1:10      0x508F 16+4 0x33 fill
; seconds: 1           ;[45:247]

Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH3_FILL(0x50FE,16+5,0x33) PUSH3_FILL(0x50FE,16+4,0x33) PUSH3_FILL(0x508E,16+5,0x33)'
                       ;[17:376]    0x50FE 16+5 0x33 fill   fill(addr,u,char)   variant: fill(num,3*7 (max 767),no ptr)
    push HL             ; 1:11      0x50FE 16+5 0x33 fill
    ld   HL, 0x50FE     ; 3:10      0x50FE 16+5 0x33 fill   addr
    ld    B, 0x07       ; 2:7       0x50FE 16+5 0x33 fill   (16+5)/3
    ld    A, 0x33       ; 2:7       0x50FE 16+5 0x33 fill   char
    ld  (HL),C          ; 1:7       0x50FE 16+5 0x33 fill
    inc   L             ; 1:4       0x50FE 16+5 0x33 fill
    ld  (HL),C          ; 1:7       0x50FE 16+5 0x33 fill
    inc  HL             ; 1:6       0x50FE 16+5 0x33 fill   0x50FF=0x50FE+1+3*0
    ld  (HL),C          ; 1:7       0x50FE 16+5 0x33 fill
    inc   L             ; 1:4       0x50FE 16+5 0x33 fill
    djnz $-6            ; 2:13/8    0x50FE 16+5 0x33 fill
    pop  HL             ; 1:10      0x50FE 16+5 0x33 fill
                       ;[14:406]    0x50FE 16+4 0x33 fill   fill(addr,u,char)   variant: fill(?,max 513,no ptr)
    push HL             ; 1:11      0x50FE 16+4 0x33 fill
    ld   HL, 0x50FE     ; 3:10      0x50FE 16+4 0x33 fill   addr
    ld   BC, 0x0A33     ; 3:10      0x50FE 16+4 0x33 fill   B = 10x, C = 0x33
    ld  (HL),C          ; 1:7       0x50FE 16+4 0x33 fill
    inc   L             ; 1:4       0x50FE 16+4 0x33 fill   only even numbers
    ld  (HL),C          ; 1:7       0x50FE 16+4 0x33 fill
    inc  HL             ; 1:6       0x50FE 16+4 0x33 fill   0x50FF=0x50FE+1+2*0
    djnz $-4            ; 2:13/8    0x50FE 16+4 0x33 fill
    pop  HL             ; 1:10      0x50FE 16+4 0x33 fill
                       ;[17:362]    0x508E 16+5 0x33 fill   fill(addr,u,char)   variant: fill(num,3*7 (max 767),no ptr)
    push HL             ; 1:11      0x508E 16+5 0x33 fill
    ld   HL, 0x508E     ; 3:10      0x508E 16+5 0x33 fill   addr
    ld    B, 0x07       ; 2:7       0x508E 16+5 0x33 fill   (16+5)/3
    ld    A, 0x33       ; 2:7       0x508E 16+5 0x33 fill   char
    ld  (HL),C          ; 1:7       0x508E 16+5 0x33 fill
    inc   L             ; 1:4       0x508E 16+5 0x33 fill
    ld  (HL),C          ; 1:7       0x508E 16+5 0x33 fill
    inc   L             ; 1:4       0x508E 16+5 0x33 fill
    ld  (HL),C          ; 1:7       0x508E 16+5 0x33 fill
    inc   L             ; 1:4       0x508E 16+5 0x33 fill
    djnz $-6            ; 2:13/8    0x508E 16+5 0x33 fill
    pop  HL             ; 1:10      0x508E 16+5 0x33 fill
; seconds: 0           ;[48:262]

Stale jeste kratsi kod.

PPPS: A i kdybych ty priklady spojil do jednoho tak je to 2*74-37=111 ku 48+45=93. Lol. Takze i kdybych to volal 6x v programu na ruznych mistech tak, verze s podrutinou bude stale delsi. .)))

x*12.3+37 = x*15.5
37=x(15.5-12.3)
x=37/3.1667
x=11.68

Hmm.. od 12 pouziti by to uz bylo kratsi. Ale pri jinem rozsahu by to bylo rychleji.

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Asi bude lepsi to jeste trochu upravit, aby to zvadlo premazat celych 64kb.
Registr C je snadny nastavit, stoji to jen jeden bajt a 3 takty zmenou z LD B,xx na LD BC,xxxx.
Ta rutina je napsana tak dobre, ze muze zacinat na libovolne adrese a konci vzdy na sude. Takze pokud rozsah je vetsi nez maximalni hodnota tak to jde rozseknout tak, ze druhy prubeh probehne na maximalnim rozsahu a prvni co zbyva.
ld B,xx
call Fill+2*n
; to nastavilo B na nulu takze staci
call Fill+0
dtta pokud je to potreba

Tahle cast by sla napriklad delat i pomoci

call $+3
call $+3
call Fill+0

co by volalo plny rozsah 4x.

ale smycka me prijde lepsi

ld BC,xxxx
call Fill+n
call Fill
dec C
jr nz, $-4

Pritom ta cast:

call Fill
dec C
jr nz, $-4

Jde primo dat do te podrutiny.

Zmensil jsem "buffer" na polovinu, protoze jsem pridaval tu smycku za cenu 6 bajtu a vsechny volani +1 bajt.
To zpomalilo provadeni z cca 12.8125 taktu na bajt na 13 taktu na bajt.

Tim mam vyresene ze ta podrutina nemuze selhat kvuli rozsahu, coz je dulezite.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(0x50FF,16+5,0x33) PUSH3_FILL(0x50FF,16+4,0x33) PUSH3_FILL(0x508F,16+4,0x33)'
                       ;[13:349]    0x50FF 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FF 16+5 0x33 fill
    ld   DE, 0x50FF     ; 3:10      0x50FF 16+5 0x33 fill   addr 0x50FF..0x5113
    ld    A, 0x33       ; 2:7       0x50FF 16+5 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x50FF 16+5 0x33 fill   u=B*16-3=0x03*16-3
    call Fill+6         ; 3:314     0x50FF 16+5 0x33 fill
    exx                 ; 1:4       0x50FF 16+5 0x33 fill
                       ;[14:332]    0x50FF 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FF 16+4 0x33 fill
    ld   DE, 0x50FF     ; 3:10      0x50FF 16+4 0x33 fill   addr 0x50FF..0x5112
    ld    A, 0x33       ; 2:7       0x50FF 16+4 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x50FF 16+4 0x33 fill   u=B*16-5=0x03*16-5
    call Fill+10        ; 3:290     0x50FF 16+4 0x33 fill
    ld  (DE),A          ; 1:7       0x50FF 16+4 0x33 fill
    exx                 ; 1:4       0x50FF 16+4 0x33 fill
                       ;[13:336]    0x508F 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x508F 16+4 0x33 fill
    ld   DE, 0x508F     ; 3:10      0x508F 16+4 0x33 fill   addr 0x508F..0x50A2
    ld    A, 0x33       ; 2:7       0x508F 16+4 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x508F 16+4 0x33 fill   u=B*16-4=0x03*16-4
    call Fill+8         ; 3:301     0x508F 16+4 0x33 fill
    exx                 ; 1:4       0x508F 16+4 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*8 - (start_address-Fill)/2
; Out: B = 0
;      DE += (B-1)*8+0..8
Fill:                  ;[24:B*109+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    dec   C             ; 1:4       Fill
    jr   nz, Fill       ; 2:7/12    Fill
    ret                 ; 3:10      Fill
; seconds: 0           ;[64:1142]
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(0x50FE,16+5,0x33) PUSH3_FILL(0x50FE,16+4,0x33) PUSH3_FILL(0x508E,16+5,0x33)'
                       ;[14:343]    0x50FE 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FE 16+5 0x33 fill
    ld   DE, 0x50FE     ; 3:10      0x50FE 16+5 0x33 fill   addr 0x50FE..0x5112
    ld    A, 0x33       ; 2:7       0x50FE 16+5 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x50FE 16+5 0x33 fill   u=B*16-4=0x03*16-4
    call Fill+8         ; 3:301     0x50FE 16+5 0x33 fill
    ld  (DE),A          ; 1:7       0x50FE 16+5 0x33 fill
    exx                 ; 1:4       0x50FE 16+5 0x33 fill
                       ;[13:336]    0x50FE 16+4 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x50FE 16+4 0x33 fill
    ld   DE, 0x50FE     ; 3:10      0x50FE 16+4 0x33 fill   addr 0x50FE..0x5111
    ld    A, 0x33       ; 2:7       0x50FE 16+4 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x50FE 16+4 0x33 fill   u=B*16-4=0x03*16-4
    call Fill+8         ; 3:301     0x50FE 16+4 0x33 fill
    exx                 ; 1:4       0x50FE 16+4 0x33 fill
                       ;[13:349]    0x508E 16+5 0x33 fill   fill(addr,u,char)   variant function: fill(num,max 4096,?)
    exx                 ; 1:4       0x508E 16+5 0x33 fill
    ld   DE, 0x508E     ; 3:10      0x508E 16+5 0x33 fill   addr 0x508E..0x50A2
    ld    A, 0x33       ; 2:7       0x508E 16+5 0x33 fill   char
    ld   BC, 0x0301     ; 3:10      0x508E 16+5 0x33 fill   u=B*16-3=0x03*16-3
    call Fill+6         ; 3:314     0x508E 16+5 0x33 fill
    exx                 ; 1:4       0x508E 16+5 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*8 - (start_address-Fill)/2
; Out: B = 0
;      DE += (B-1)*8+0..8
Fill:                  ;[24:B*109+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    dec   C             ; 1:4       Fill
    jr   nz, Fill       ; 2:7/12    Fill
    ret                 ; 3:10      Fill
; seconds: 0           ;[64:1153]


PS: Posledni vypocet v nove variante je 2*64-24=104 ku 48+45=93.

x*13.33+11 = x*15.5
11=x(15.5-13.333)
x=11/2.1667
x=5.07

Tedy priblizne u 5 pouziti uz to vyjde na delku lepe (u vetsich rozsahu mnohem lepe).

Takty u tech prikladu:
Old: 333+316+320+327+320+333=1949
New: 349+332+336+343+336+349=2045
Inline: 376+406+386+376+406+362=2312

Ale zrovna ty priklady jsem bral pro cca 20 bajtu tak to neni moc relevantni.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Kdyz jsem se pokousel pouzit tu podrutinu pro PUSH2_FILL tak jsem tvrde narazil...

Zkousel jsem to napsat a dival se na ten problem ze vsech stran, ale proste to nejde napsat efektivne.
Hodne magie je proste skryto uz v tech vstupnich parametrech a na jakou adresu to skoci na zacatku, a tohle osetrit az za behu v kodu se me nevyplaci.
A fakt jsem se snazil, ruzne triky, ale nic nepomohlo.

Takze jsem se podival jak by ta subrutina mela vypadat pro PUSH2_FILL a vyslo me, ze by vysledek nemel byt zavisly na soubehu pocatecni adresy a poctu prepisovanych bajtu.

Kdyz odstranim tu variantu, kdy se nekdy pridava pro posledni lichou adresu "LD (DE),A" a ve smycce tim bude jen 16 bitovy INC DE, protoze uz neplati ze za djnz je suda adresa a prechod tak muze nastat kdekoliv, tak volani uz zase jednoduche bude.

Takze mam nakonec 4 varianty subrutiny.

- Jednou se to vetvi, kdyz se program snazi aspon jednou prepsat vic jak 2kb. Definuje se USE_Fill_Over.

- Dale se to vetvi, kdyz aspon jednou je ta pocatecni adresa neznama, jako u PUSH2_FILL a nebo kdyz je to u PUSH3_FILL ukazatel. Definuje se USE_Fill_Unknown_Addr.

Podle toho se pak generuje "pro nejhorsi scenar" podrutina a podle ni se meni i vsechna volani.

To si vyzadalo jeste dalsi upravu, protoze je tam jedna neprijemnost...
Pokud by to bylo vsechno PUSH3_FILL tak by to slo resit...
ach... mozna to slo resit i tak jak to ted pisi tak mam napad... no nic.

Ok, takze myslel jsem si, ze mam problem ze me z tokenu vznika spojenim PUSH PUSH FILL --> PUSH2_FILL a kdyz se prida dalsi PUSH tak vznika PUSH3_FILL a ja pak netusim zda PUSH2_FILL je jen prechodovy stav nebo konecny.

Pricemz pokud to skonci na PUSH2_FILL tak se musi aktivovat USE_Fill_Unknown_Addr (jeste je tam podminka ze "u" by melo byt vetsi jak 5, protoze se jinak generuje jiny kod).
Pokud skonci na PUSH3_FILL tak se USE_Fill_Unknown Addr aktivuje jen pokud adresa je ukazatel.

Hmm.. Ale v soucastnosti asi ty tokenove pravidla neumoznuji zmenu z PUSH2_FILL na PUSH3_FILL.

No ja to vyresil jednoduse tak, ze jsem pridal jeste jeden pruchod nad tokeny uplne na konci, kde sleduji jen zda tam neni PUSH2_FILL nebo PUSH3_FILL a podle toho nastavim v runtime spravnou podrutinu a vsechny volani jsou spravne.

znamy pocatek a <=2kb
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(addr,420,0x33) PUSH3_FILL(0x4800,201,0x33) PUSH3_FILL(0x48F0,201,0x33) PUSH2_FILL(5,0x33)'
                 ;[13/12:5779/5783] addr 420 0x33 fill   fill(addr,u,char)   variant function: fill(variable, max 4096,?)
    exx                 ; 1:4       addr 420 0x33 fill
    ld   DE, addr       ; 3:10      addr 420 0x33 fill   addr addr..addr+420-1
    ld    A, 0x33       ; 2:7       addr 420 0x33 fill   char
  if (1&(addr+420))&&(0xFF00&((addr)xor(addr+420-1)))
    ld    B, 0x35       ; 2:7       addr 420 0x33 fill   u=B*16-5=53*16-5
    call Fill+10        ; 3:5740    addr 420 0x33 fill
    ld  (DE),A          ; 1:7       addr 420 0x33 fill
  else
    ld    B, 0x35       ; 2:7       addr 420 0x33 fill   u=B*16-4=53*16-4
    call Fill+8         ; 3:5751    addr 420 0x33 fill
  endif
    exx                 ; 1:4       addr 420 0x33 fill
                       ;[12:2805]   0x4800 201 0x33 fill   fill(addr,u,char)   variant function: fill(ptr/num, max 4096,?)
    exx                 ; 1:4       0x4800 201 0x33 fill
    ld   DE, 0x4800     ; 3:10      0x4800 201 0x33 fill   addr 0x4800..0x48C8
    ld    A, 0x33       ; 2:7       0x4800 201 0x33 fill   char
    ld    B, 0x1A       ; 2:7       0x4800 201 0x33 fill   u=B*16-7=26*16-7
    call Fill+14        ; 3:2773    0x4800 201 0x33 fill
    exx                 ; 1:4       0x4800 201 0x33 fill
                       ;[13:2786]   0x48F0 201 0x33 fill   fill(addr,u,char)   variant function: fill(ptr/num, max 4096,?)
    exx                 ; 1:4       0x48F0 201 0x33 fill
    ld   DE, 0x48F0     ; 3:10      0x48F0 201 0x33 fill   addr 0x48F0..0x49B8
    ld    A, 0x33       ; 2:7       0x48F0 201 0x33 fill   char
    ld    B, 0x19       ; 2:7       0x48F0 201 0x33 fill   u=B*16-0=25*16-0
    call Fill+0         ; 3:2747    0x48F0 201 0x33 fill
    ld  (DE),A          ; 1:7       0x48F0 201 0x33 fill
    exx                 ; 1:4       0x48F0 201 0x33 fill
                        ;[13:80]    5 0x33 fill  ( addr -- ) u=5, char=0x33
    ld    A, 0x33       ; 2:7       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    ex   DE, HL         ; 1:4       5 0x33 fill
    pop  DE             ; 1:10      5 0x33 fill   ( a -- )
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*8 - (start_address-Fill)/2
; Out:  B = 0
;      DE+= B*8 + (Fill-start_address)/2
Fill:                  ;[19:B*109+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill   DE = even address
    ret                 ; 1:10      Fill
; seconds: 1           ;[75:17322]

znamy pocatek a aspon jednou >2kb
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(addr,4200,0x33) PUSH3_FILL(0x4800,201,0x33) PUSH2_FILL(5,0x33)'
               ;[14/13:57311/57315] addr 4200 0x33 fill   fill(addr,u,char)   variant function: fill(variable, no limit,?)
    exx                 ; 1:4       addr 4200 0x33 fill
    ld   DE, addr       ; 3:10      addr 4200 0x33 fill   addr addr..addr+4200-1
    ld    A, 0x33       ; 2:7       addr 4200 0x33 fill   char
  if (1&(addr+4200))&&(0xFF00&((addr)xor(addr+4200-1)))
    ld   BC, 0x0D03     ; 3:10      addr 4200 0x33 fill   u=B*16-1=13*16-1
    call Fill+2         ; 3:57269   addr 4200 0x33 fill
    ld  (DE),A          ; 1:7       addr 4200 0x33 fill
  else
    ld   BC, 0x0D03     ; 3:10      addr 4200 0x33 fill   u=B*16-0=13*16-0
    call Fill+0         ; 3:57280   addr 4200 0x33 fill
  endif
    exx                 ; 1:4       addr 4200 0x33 fill
                       ;[13:2819]   0x4800 201 0x33 fill   fill(addr,u,char)   variant function: fill(ptr/num, no limit,?)
    exx                 ; 1:4       0x4800 201 0x33 fill
    ld   DE, 0x4800     ; 3:10      0x4800 201 0x33 fill   addr 0x4800..0x48C8
    ld    A, 0x33       ; 2:7       0x4800 201 0x33 fill   char
    ld   BC, 0x1A01     ; 3:10      0x4800 201 0x33 fill   u=B*16-7=26*16-7
    call Fill+14        ; 3:2784    0x4800 201 0x33 fill
    exx                 ; 1:4       0x4800 201 0x33 fill
                        ;[13:80]    5 0x33 fill  ( addr -- ) u=5, char=0x33
    ld    A, 0x33       ; 2:7       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    inc  HL             ; 1:6       5 0x33 fill
    ld  (HL),A          ; 1:7       5 0x33 fill
    ex   DE, HL         ; 1:4       5 0x33 fill
    pop  DE             ; 1:10      5 0x33 fill   ( a -- )
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = (C-1)*2048 + B*8 - (start_address-Fill)/2
; Out: BC = 0
;      DE+= (C-1)*2048+(B-1)*8+(Fill+16-start_address)/2
Fill:    ;[22:B*109+(C-1)*27915+16] Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc   E             ; 1:4       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill   DE = even address
    dec   C             ; 1:4       Fill
    jr   nz, Fill       ; 2:7/12    Fill
    ret                 ; 1:10      Fill
; seconds: 0           ;[68:117625]

neznama pocatecni adresa (takze uz se nerozlisuji sude a liche konce) a <= 2kb
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(addr,1200,0x33) PUSH3_FILL(0x4800,201,0x33) PUSH2_FILL(6,0x33)'
                       ;[12:17604]  addr 1200 0x33 fill   fill(addr,u,char)   variant function: fill(variable, max 4096,?)
    exx                 ; 1:4       addr 1200 0x33 fill
    ld   DE, addr       ; 3:10      addr 1200 0x33 fill   addr addr..addr+1200-1
    ld    A, 0x33       ; 2:7       addr 1200 0x33 fill   char
    ld    B, 0x96       ; 2:7       addr 1200 0x33 fill   u=B*16-0=150*16-0
    call Fill+0         ; 3:17572   addr 1200 0x33 fill
    exx                 ; 1:4       addr 1200 0x33 fill
                       ;[12:3005]   0x4800 201 0x33 fill   fill(addr,u,char)   variant function: fill(ptr/num, max 4096,?)
    exx                 ; 1:4       0x4800 201 0x33 fill
    ld   DE, 0x4800     ; 3:10      0x4800 201 0x33 fill   addr 0x4800..0x48C8
    ld    A, 0x33       ; 2:7       0x4800 201 0x33 fill   char
    ld    B, 0x1A       ; 2:7       0x4800 201 0x33 fill   u=B*16-7=26*16-7
    call Fill+14        ; 3:2973    0x4800 201 0x33 fill
    exx                 ; 1:4       0x4800 201 0x33 fill
                        ;[9:141]    6 0x33 fill   ( addr -- ) fill(u,char)   variant function: fill(num,?)
    ex   DE, HL         ; 1:4       6 0x33 fill   addr
    ld    A, 0x33       ; 2:7       6 0x33 fill   char
    ld    B, 0x01       ; 2:7       6 0x33 fill   u=B*16-2=1*16-2
    call Fill+4         ; 3:113     6 0x33 fill
    pop  DE             ; 1:10      6 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = B*8 - (start_address-Fill)/2
; Out:  B = 0
;      DE+= B*8 + (Fill-start_address)/2
Fill:                  ;[19:B*117+5]Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    ret                 ; 1:10      Fill
; seconds: 0           ;[52:20872]

neznama pocatecni adresa (takze uz se nerozlisuji sude a liche konce) a aspon jednou >2kb
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) PUSH3_FILL(addr,4200,0x33) PUSH3_FILL(0x4800,201,0x33) PUSH2_FILL(6,0x33)'
                       ;[13:61515]  addr 4200 0x33 fill   fill(addr,u,char)   variant function: fill(variable, no limit,?)
    exx                 ; 1:4       addr 4200 0x33 fill
    ld   DE, addr       ; 3:10      addr 4200 0x33 fill   addr addr..addr+4200-1
    ld    A, 0x33       ; 2:7       addr 4200 0x33 fill   char
    ld   BC, 0x0D03     ; 3:10      addr 4200 0x33 fill   u=B*16-0=13*16-0
    call Fill+0         ; 3:61480   addr 4200 0x33 fill
    exx                 ; 1:4       addr 4200 0x33 fill
                       ;[13:3019]   0x4800 201 0x33 fill   fill(addr,u,char)   variant function: fill(ptr/num, no limit,?)
    exx                 ; 1:4       0x4800 201 0x33 fill
    ld   DE, 0x4800     ; 3:10      0x4800 201 0x33 fill   addr 0x4800..0x48C8
    ld    A, 0x33       ; 2:7       0x4800 201 0x33 fill   char
    ld   BC, 0x1A01     ; 3:10      0x4800 201 0x33 fill   u=B*16-7=26*16-7
    call Fill+14        ; 3:2984    0x4800 201 0x33 fill
    exx                 ; 1:4       0x4800 201 0x33 fill
                       ;[10:155]    6 0x33 fill   ( addr -- ) fill(u,char)   variant function: fill(num,?)
    ex   DE, HL         ; 1:4       6 0x33 fill   addr
    ld    A, 0x33       ; 2:7       6 0x33 fill   char
    ld   BC, 0x0101     ; 3:10      6 0x33 fill   u=B*16-2=1*16-2
    call Fill+4         ; 3:124     6 0x33 fill
    pop  DE             ; 1:10      6 0x33 fill
;==============================================================================
; ( --  ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = (C-1)*2048 + B*8 - (start_address-Fill)/2
; Out: BC = 0
;      DE+= (C-1)*2048+(B-1)*8+(Fill+16-start_address)/2
Fill:    ;[22:B*117+(C-1)*29963+16] Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    dec   C             ; 1:4       Fill
    jr   nz, Fill       ; 2:7/12    Fill
    ret                 ; 1:10      Fill
; seconds: 0           ;[58:64822]

PS: Vsechno teda bezi jen pokud se definuje _TYP_SINGLE na "function", jinak se generuje "inline" kod.

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


Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 07.03.2023, 21:05 
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 kdy pri vysledku ze se ma smycka opakova 0x??00 krat to priradilo do B 0x00 a do C = 0x?? + 1.
To ale jak jsem zjistil neplati pro B = 0x00. Protoze v B je pak ve skutecnosti 256 a ne nula takze by mel byt C o 1 mensi.

Dopsal jsem pouziti podrutiny i pro "PUSH(char) FILL" a jenom FILL.
Je to "trosku" nabobtnalejsi kod..
Oboje ponechavaji mimo fci uklizeni zasobniku, je to pokazde o 2 bajty navic kod pri kazdem volani, ale doufam ze to nekdy pujde pouzit na rozseknuti toho slova na 2 podtokeny s tim ze by pak nasledujici slovo jako napriklad PUSH2 nezacalo:
Kód:
    pop  HL             ; 1:10      0x33 fill   ( b a -- )
    pop  DE             ; 1:10      0x33 fill
                        ;[8:42]     0xDEAD 0xC0DE   ( -- 0xDEAD 0xC0DE )
    push DE             ; 1:11      0xDEAD 0xC0DE
    push HL             ; 1:11      0xDEAD 0xC0DE
    ld   DE, 0xDEAD     ; 3:10      0xDEAD 0xC0DE
    ld   HL, 0xC0DE     ; 3:10      0xDEAD 0xC0DE
ale tyhle prvni 4 instrukce rovnou odmazalo. Ted si to musi udelat programator rucne pokud mu to vadi...
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},function) FILL PUSH(0x33) FILL'
                        ;[5:37]     fill   ( addr u char -- ) variant function
    call Fill3          ; 3:17      fill   ( address u char -- address+u x )
    pop  HL             ; 1:10      fill   ( b a -- )
    pop  DE             ; 1:10      fill
                        ;[7:44]     0x33 fill  ( addr u -- ) fill(char)   variant function: fill(?)
    ld    A, 0x33       ; 2:7       0x33 fill  A = char
    call Fill2          ; 3:17      0x33 fill
    pop  HL             ; 1:10      0x33 fill   ( b a -- )
    pop  DE             ; 1:10      0x33 fill
;==============================================================================
; ( address u char ret -- ret address+u x ) (address..address+u-1) = char
;  In: (SP+2) = address, DE = u, L = char
; Out:  A = char
;      BC = 0
;      DE = address+u
Fill3:                  ;[4:37]     Fill3
    ld    A, L          ; 1:4       Fill3
    pop  HL             ; 1:10      Fill3   ret
    ex  (SP),HL         ; 1:19      Fill3   address
    ex   DE, HL         ; 1:4       Fill3
;   ...fall down to Fill2
;==============================================================================
; ( -- ) (DE..DE+HL-1) = A
;  In: DE = address, HL = u, A=char
; Out: BC = 0
;      DE+= HL, HL>>=3
Fill2:                 ;[26:108]    Fill2
    ex   AF, AF'        ; 1:4       Fill2
    xor   A             ; 1:4       Fill2
    sub   L             ; 1:4       Fill2  -0,-1,-2,-3,-4,-5,-6,-7
    and  0x07           ; 2:7       Fill2   0, 7, 6, 5, 4, 3, 2, 1
    add   A, A          ; 1:4       Fill2   0,14,12,10, 8, 6, 4, 2
    ld  (Fill2_self+1),A; 3:13      Fill2
    dec  HL             ; 1:6       Fill2   if B=0=256 --> C--
    ld    A, L          ; 1:4       Fill2
    srl   H             ; 2:8       Fill2
    rra                 ; 1:4       Fill2   HA >> 1
    srl   H             ; 2:8       Fill2
    rra                 ; 1:4       Fill2   HA >> 2
    srl   H             ; 2:8       Fill2
    rra                 ; 1:4       Fill2   HA >> 3
    ld    C, H          ; 1:4       Fill2
    ld    B, A          ; 1:4       Fill2
    inc   C             ; 1:4       Fill2
    inc   B             ; 1:4       Fill2   B=255->256=0 ok
    ex   AF, AF'        ; 1:4       Fill2
Fill2_self:             ;           Fill2
    jr  $+0             ; 2:12      Fill2
;   ...fall down to Fill
;==============================================================================
; ( -- ) (DE_in..DE_out-1) = A
;  In: DE = address, A=char, u = (C-1)*2048 + B*8 - (start_address-Fill)/2
; Out: BC = 0
;      DE+= (C-1)*2048+(B-1)*8+(Fill+16-start_address)/2
Fill:    ;[22:B*117+(C-1)*29963+16] Fill
    ld  (DE),A          ; 1:7       Fill  +0
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +2
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +4
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +6
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill  +8
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +10
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +12
    inc  DE             ; 1:6       Fill
    ld  (DE),A          ; 1:7       Fill +14
    inc  DE             ; 1:6       Fill
    djnz Fill           ; 2:8/13    Fill
    dec   C             ; 1:4       Fill
    jr   nz, Fill       ; 2:7/12    Fill
    ret                 ; 1:10      Fill
; seconds: 0           ;[65:365]


PS: Pokud nekoho zajima proc rovnou neudelam "FILL = _2DUP + FILL + _2DROP" Tak je to proto ze "_2DUP_FILL <> _2DUP + FILL_bez2DROP". Po Fill slove mam v TOS a NOS v podstate smeti. Takze to chce asi vymyslet slovo co jakoby spini TOS a NOS, aby se odlisilo skutecne _2DUP_FILL. Neco jako FILL = _2DUP_FILL_2DIRTY + _2DROP... Hmm..

PPS: FILL_2DIRTY! :lol: a u PUSH2_FILL by to bylo DUP_PUSH2_FILL_DIRTY + DROP

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Predelal jsem varianty FILL na ty 2 podtokeny, ale u variant s PUSH2_FILL, kdy v TOS je adresa, je to ted horsi nez to bylo... .)))

Zapomnel jsem, ze zrovna tahle varianta je zavisla az na konkretnich vstupnich parametrech... kdy nekdy si vystacim s BC a A a nekdy holt musim pouzit LDIR a teda musim na zasobnik schovat DE.

Takze v jednom pripade to konci pres DROP a podruhe pres _2DROP.

Napsal jsem to teda tak, ze druhy token je DROP (DUP_PUSH2_FILL_DIRTY + DROP) a kdyz je potreba _2DROP tak to prvni slovo ma na konci kod shodnym s dalsim DROP.

Takze to pak vypada blbe, protoze DROP + DROP za sebou pokud neoptimalizuji vypada takto
Kód:
    ex   DE, HL         ; 1:4       drop
    pop  DE             ; 1:10      drop   ( a -- )
    ex   DE, HL         ; 1:4       drop
    pop  DE             ; 1:10      drop   ( a -- )

Jsou tam 2x zbytecne ex DE,HL. A pokud by nasledovalo PUSH2 tak to neni taky zadna hitparada, protoze se odstrani jen jedno DROP a ze je tam jeste jeden inline DROP ani netusi...

A to jeste neni vsechno... protoze kdyz to ma byt fce tak, by to nemelo koncit DROP ale NIP (odstrani NOS). Takze abych to bylo spravne tak musim dodat na konci kodu jeden SWAP, jen pro tu nadeji ze se to DROP odstrani.

Takze ten kod pak vypada pokud se druhy token s DROP nijak nezrusi jako
Kód:
                      ;[10:259990] 0x4567 0x33   ( addr -- ) fill(u,char)   variant function: fill(num,?)
    ex   DE, HL         ; 1:4       0x4567 0x33   addr
    ld    A, 0x33       ; 2:7       0x4567 0x33   char
    ld   BC, 0xAD09     ; 3:10      0x4567 0x33   u=B*16-1=173*16-1
    call Fill+2         ; 3:259965  0x4567 0x33
    ex   DE, HL         ; 1:4       0x4567 0x33
    ex   DE, HL         ; 1:4       0x4567 0x33
    pop  DE             ; 1:10      0x4567 0x33   ( a -- )


Chtelo by to bud nejak umet jeste generovat tokeny v dobe kdy uz generuji kod a nebo mit nejaky buffer kde ke konci se prohrne kod nejakym filtrem a odstrani se tyhle blbosti. Slo by to mit v tom bashi compile pres awk, ale prijde mi to takovy... nepraktickty.

Zatim to necham nejak vyhnit a uvidim... Nakonec o nic nejde...

Zlepsil jsem to teda v jednom smeru za cenu ustupku v jinem a hlavne je to navic slozitejsi, snaz se udela chyba. Radost.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Pouzil jsem maly trik jak zjistit zda je v 16 bitovem registru nula a zaroven ten registr musite snizit o 1.

Nazorneji, mam hodnotu U ktera ma byt rozsah kolik bajtu potrebuji od nejake adresy premazat na jine.

A kdyz pouzivam LDIR registr tak prvne musim zjistit zda neni nahodou U nulove a nedelat nic.
Pokud neni nulove tak do (HL) nacist hodnotu kterou to mam premazat.
A jeste zkontrolovat zda U nebyla jednicka, protoze uz jsme jednu adresu premazali, takze se U snizi o 1 a pokud by byla nula tak LDIR probehne... hodnekrat (nez se premaze kod).

Takze v kodu probehne neco jako

ld a,c
or b ; add a,b
jr z, exit
dec bc
...
ld a,c
or b ; add a,b
jr z, exit
...
ldir

Vlastne muzu ukazat cely kod u PUSH_FILL:
Kód:
                      ;[20:83+u*21] 0x33 fill  ( addr u -- )  char = 0x33  # default version, change: "define({_TYP_SINGLE},{small})"
    ld    A, H          ; 1:4       0x33 fill
    or    L             ; 1:4       0x33 fill
    jr    z, $+16       ; 2:7/12    0x33 fill  u  = 0?
    ld    C, L          ; 1:4       0x33 fill
    ld    B, H          ; 1:4       0x33 fill
    ld    L, E          ; 1:4       0x33 fill
    ld    H, D          ; 1:4       0x33 fill  HL = from
    ld  (HL),0x33       ; 2:10      0x33 fill
    dec  BC             ; 1:6       0x33 fill
    ld    A, B          ; 1:4       0x33 fill
    or    C             ; 1:4       0x33 fill
    jr    z, $+5        ; 2:7/12    0x33 fill  u  = 1?
    inc  DE             ; 1:6       0x33 fill  DE = to
    ldir                ; 2:u*21/16 0x33 fill
$+16:
$+5:
    pop  HL             ; 1:10      0x33 fill   ( b a -- )
    pop  DE             ; 1:10      0x33 fill
; seconds: 1           ;[18:88]


No a na tohle se da pouzit trik na zjistovani nuly a zaroven snizeni hodnoty o 1

dec BC
inc C
nastavi zero flag kdyz bude puvodni BC nulove.
No a nastavi to teda jeste (kdyz to domyslite) i kdyz bylo puvodni BC v rozsahu 0xFF01..0xFFFF, ale to vubec nevadi ze me vypadne jeden segment, protoze mame stejne pristup jen k 48 kb a zbytek je ROMka a i kdyby nebyla tak jeste nekam musim strcit ten kod.
Funguje to teda jeste proto, ze ten vstup mam jinde a teprve ho musim dat do BC.

Nove PUSH_FILL:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'PUSH(0x33) FILL'
                      ;[19:79+u*21] 0x33 fill  ( addr u -- )  char = 0x33  # default version, change: "define({_TYP_SINGLE},{small})"
    dec  HL             ; 1:6       0x33 fill
    ld    B, H          ; 1:4       0x33 fill
    inc   H             ; 1:4       0x33 fill
    jr    z, $+14       ; 2:7/12    0x33 fill  u  = 0xFF01..0x0000?
    ld    C, L          ; 1:4       0x33 fill
    ld    L, E          ; 1:4       0x33 fill
    ld    H, D          ; 1:4       0x33 fill  HL = from
    ld  (HL),0x33       ; 2:10      0x33 fill
    ld    A, B          ; 1:4       0x33 fill
    or    C             ; 1:4       0x33 fill
    jr    z, $+5        ; 2:7/12    0x33 fill  u  = 1?
    inc  DE             ; 1:6       0x33 fill  DE = to
    ldir                ; 2:u*21/16 0x33 fill
$+14:
$+5:
    pop  HL             ; 1:10      0x33 fill   ( b a -- )
    pop  DE             ; 1:10      0x33 fill
; seconds: 0           ;[17:84]


To same pro FILL:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'FILL'
                      ;[21:94+u*21] fill  ( addr u char -- )  # default version can be changed with "define({_TYP_SINGLE},{small})"
    ld    A, D          ; 1:4       fill
    or    E             ; 1:4       fill
    ld    A, L          ; 1:4       fill
    pop  HL             ; 1:10      fill  HL = from
    jr    z, $+15       ; 2:7/12    fill  u = 0?
    ld  (HL),A          ; 1:7       fill
    dec  DE             ; 1:6       fill
    ld    A, D          ; 1:4       fill
    or    E             ; 1:4       fill
    jr    z, $+9        ; 2:7/12    fill  u = 1?
    ld    C, E          ; 1:4       fill
    ld    B, D          ; 1:4       fill
    ld    E, L          ; 1:4       fill
    ld    D, H          ; 1:4       fill
    inc  DE             ; 1:6       fill  DE = to
    ldir                ; 2:u*21/16 fill
$+15:
$+9:
    pop  HL             ; 1:10      fill   ( b a -- )
    pop  DE             ; 1:10      fill
; seconds: 0           ;[19:99]

Novy FILL:
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'FILL'
                      ;[20:90+u*21] fill  ( addr u char -- )  # default version can be changed with "define({_TYP_SINGLE},{small})"
    ld    A, L          ; 1:4       fill
    pop  HL             ; 1:10      fill  HL = from
    dec  DE             ; 1:6       fill  0xFF01..0x0000 -> zero flag
    ld    B, D          ; 1:4       fill
    inc   D             ; 1:4       fill
    jr    z, $+13       ; 2:7/12    fill  u = 0xFF01..0x0000?
    ld  (HL),A          ; 1:7       fill
    ld    A, B          ; 1:4       fill
    or    E             ; 1:4       fill
    jr    z, $+8        ; 2:7/12    fill  u = 1?
    ld    C, E          ; 1:4       fill
    ld    E, L          ; 1:4       fill
    ld    D, H          ; 1:4       fill
    inc  DE             ; 1:6       fill  DE = to
    ldir                ; 2:u*21/16 fill
$+13:
$+8:
    pop  HL             ; 1:10      fill   ( b a -- )
    pop  DE             ; 1:10      fill
; seconds: 0           ;[18:95]


Puvodne jsem to provedl pro "small" inline verzi, kde jsem tim vyresil problem s nulovym offsetem na vstupu.

dec BC
inc C
inc B

By zvednul hodnotu B o 1 pokud neni C nulove. A zaroven je to test na nulu.

Puvodni kod neukazi, uz ho nemam, ale kdyz jsem zjistil ze je pocatecni B nulove tak jsem tam mel skok za djnz.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},small) FILL'
            ;[16:50+u*26+(u>>8)*11] fill  ( addr u char -- )  # small version, change: "define({_TYP_SINGLE},{default})"
    ld    A, L          ; 1:4       fill  A  = char
    pop  HL             ; 1:10      fill  HL = addr
    ld    B, E          ; 1:4       fill
    dec  DE             ; 1:6       fill
    inc   D             ; 1:4       fill
    jr    z, $+9        ; 2:7/12    fill  u = 0xFF01..0x0000 --> exit
    ld  (HL),A          ; 1:7       fill
    inc  HL             ; 1:6       fill
    djnz $-2            ; 2:8/13    fill
    dec   D             ; 1:4       fill
    jr   nz, $-5        ; 2:7/12    fill
$+9:
    pop  HL             ; 1:10      fill   ( b a -- )
    pop  DE             ; 1:10      fill
; seconds: 0           ;[16:87]


PS: Jeste mozna stoji za ukazku pokus o inline ne LDIR verzi co bude rychlejsi
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/M4$ ../check_word.sh 'define({_TYP_SINGLE},fast) FILL'
          ;[25:90+u*19.5+(u>>9)*11] fill  ( addr u char -- )  # small version, change: "define({_TYP_SINGLE},{default})"
    ld    A, L          ; 1:4       fill  A  = char
    pop  HL             ; 1:10      fill  HL = addr
    inc  DE             ; 1:6       fill  -1->0 0->1 1->2
    srl   D             ; 2:8       fill
    rr    E             ; 2:8       fill   0->0 1->0 2->1
    ld    B, E          ; 1:4       fill
    dec  DE             ; 1:6       fill
    inc   D             ; 1:4       fill
    jr    z, $+13       ; 2:7/12    fill  u = 0x0000 --> exit
    jr   nc, $+4        ; 2:7/12    fill  odd u
$-7:
$-4:
    ld  (HL),A          ; 1:7       fill
    inc  HL             ; 1:6       fill
$+4:
    ld  (HL),A          ; 1:7       fill
    inc  HL             ; 1:6       fill
    djnz $-4            ; 2:8/13    fill
    dec   D             ; 1:4       fill
    jr   nz, $-7        ; 2:7/12    fill
$+13:
    pop  HL             ; 1:10      fill   ( b a -- )
    pop  DE             ; 1:10      fill
; seconds: 1           ;[25:129]

Ale tohle je boj to napsat rychle a zaroven kratce. Stale se me ten kod jeste nelibi...
Funguje to tak ze udela
U >>=1
takze muze mit ve smycce 2x ld (HL),A
a podle toho zda vypadl nebo nevypadl jendickovy bit (carry) to na zacatku skoci doprostred nebo ne.

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


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Příloha:
levenshtein_5x8.png
levenshtein_5x8.png [ 3.37 KiB | Zobrazeno 1114 krát ]


Udelal jsem si na spectru font 5x8.
4x8 je sice mnohem praktictejsi, ale chtel jsem neco citelnejsiho.
Myslel jsem si ze 6x8 jsem uz psal pro https://www.youtube.com/watch?v=B1pY6BajmS0, ale to jen starnu a koukam ze je to taky 5x8, jen jsou to jen kapitalky, ale snizene o pixel.
6x8 si muzete najit teda ve hre The Hobbit.

Ten font jsem psal rucne primo do kodu... .)
Nekolik verzi, na obrazku je pokus o to aby mala pismena drzela horni linku co to jde. Takze J a I jsou vysoke a P B D jsou jakoby "tehotne".
Da se tam udelat hodne chyb. Napriklad jak resit znaky s lichym poctem pixelu na sirku. Vsechny by meli byt asi zarovnane stejne, jinak to zacne byt videt jako by se tulila obcas vlevo a bocas vpravo..
Mno... nakonec mam stejne pocit, kdyz tam dam cisla ze je to stale prehustene. Mozna je 6x8 lepsi volba.

Co jsem chtel rici?

Aha problemy.

Protoze to chci udelat jako rychlou nahradu za rst 0x10, tak vznikaji takove nepekne pozadavky...

Pokud by to byla jen nejaka fce co tiskne retezec a nacita dalsi znak jako

ld A,(HL)
inc HL

tak je to mnohem snazsi, protoze jakmile zacneme podporovat specialni znaky jako je AT, TAB, INK, PAPER atd tak staci mit hned po nacteni znaku nejake vetveni a kdyz je to specialni znak tak si to pekne vyresit a pokud ma parametr tak ho nacteme pres ty dve instrukce a pokracujeme...

Ale "rst 0x10" je STREAM. Proste do nej cpeme znaky a neco vypadne nebo nevypadne.

Takze musim vyresit ze kdyz me prijde specialni znak tak zjistim co to je pres nejake vetveni a ted.... ted co? Potrebuji parametr. Dalsi znak ale prece nemam, ten bude az v pristim volani.
Takze musim ulkladat nekde stav, a podle toho se chovat k dalsimu vstupu. A to neco stoji. Vyresil jsem to prvnim zpusobem co me napadl. Samoprepisujicim se kodem. Nepisi to pro ROMku takze je to kratsi nez to mit v nejake promenne nekde v RAMce. Jen mam problem s tim, ze v kazde vetvi musim pak zase nastavit stav na pocatek. Takze duplicitni kod. Ve skutecnosti tam mam vsude odskok.

Vsechno nejak mam, ve FORTHu jsem vsude udelal zmenu kde pouzivam "rst 0x10" aby se to zmenilo na CALL pokud definuji USE_FONT_5x8 a zacnu testovat.

Hmm... potrebuji udelat navazovani na to kde skoncil text vypisovany BASICEM a zase kdyz skonci program udelat pro BASIC novy zacatek.
To jsem resil cele 2 dny. Nekecam, zjistit kam si to ROMka uklada byl pro me fakt orisek a to jsem zkousel i AI (ta se me snazila namluvit uplne nesmysly).

Nakonec jsem vzdal nejake hledani a snazil se to najit rucne. To taky nebylo nejlepsi reseni.
Krome adresy potrebujete totiz vedet i to ze si ROMka XY hodnoty uklada sestupne a konci v jednicce. Logika je, ze kdyz dalsi hodnota je nula tak hned vi ze ma jit na dalsi radek a takze kolik znaku mu zbyva kdyz chce psat nejake slovo, u ktereho zna delku a nechce ho pulit.
Tohle ma 48k na adrese 0x5C88.
Pak jeste uklada na adresu 0x5C84 adresu prvniho bajtu dalsiho znaku na obrazovce. Ale ne vzdy... pokud zrovna preleza tretiny tak je horni bajt spatne. Jakoby (nebo to asi dela) delal INC HL.

A kdyz jsem zkousel pokkovanim 0x5C88 nastavit novy kurzor tak to selze, dokud nezmenite i 0x5C84.

Ja pouzival YX jako cisla vzestupna od nuly a ten kod je fakt kratsi, nez kdyz se to snazim prepsat na sestupny. Je to i kratsi nez kdyz budu misto X mit X v pixelech. Nalezeni adresy je u X v pixelexh kratsi, ale celkove delsi je zase reseni AT, TAB.

Jeste jsem musel dodelat i kod 0x08 coz je pohyb vlevo, protoze ho pouzivam pri nacitani vstupu pro mazani.

Navaznost jsem vyresil, ale bohuzel jsem to testoval ve vadnem obrazu spectra, kde jsem si prestim neco premazal a ROMka si myslela ze BASIC je mnohem delsi nez mi ukazovala. (Ve skutecnosti me mohlo trknout ze vypis konci "10 > RUN" a to jeste pod radkem 30, vlastne je to mozna zajimave jak toho vubec dosahnout) Takze kdyz jsem pridal nejaky radek pred volani rutiny, kde jsem jen tisknul neco v PRINTu abych se kouknul, zda to bude navazovat, tak jsem skoncil bud v chybe nebo restartem. Jedine ze jsem po zmene basicu znovu nacetl binarku to fungovalo. Kdyz jsem to debugoval tak jsem si vsiml ze je ten kod jen posunuty o par bajtu.
Prvni co me napadlo je ze mam zdrojak ve spatne casti pameti tak goolglil jak je to s RAMTOP a pak hledal klavesu RAMTOP :D protoze jsem spatne pochopil "CLEAR new RAMTOP". Nakonec napsal "CLEAR ramtop" a to me napsalo RAMTOP error. WTF? Coz bylo fakt divny a az pak jsem zkousel prikaz "listbasic" co me vyleze a uvidel nejake nesmysly, tak me doslo, ze mam zdrojak ulozeny primo v basicu a udelal si novy obraz spectra a uz to fungovalo jak to ma.

Ale co SCROLL? Ted mam ze to pretece zase na zacatek. Napsat si ho sam? To neni az tak snadne. Protoze musis restit jeste klavesnici, pak nejakou logiku. Nekdo psal ze by se scroll mel aktivovat az kdyz se snazis tisknout mimo obrazovku. Dobry napad ale... kdyz budes tisknout text delsi jak 24 radku tak si pocatek neprectes a ZX nema prikaz MORE. Takze vlastne potrebujes tu pauzu a nejake pocitadlo ze dasli scroll uz ti odskroluje radek, ktery sis nemel cas precist.
Jeste se to bije s tim zda chces psat na spodni radky nebo ne... Ukazovat "SCROLL" nebo ne.
Prvni napad byl ze prvni znak na novem radku prvne vytisknu mezeru pres rst 0x10. No ale to pak musim nejak osetrit i AT a TAB.
Nevim co je lepsi.

ZX ma koncept STREAMu tak mozna vytvorit nejaky novy a ten by mohl mit vlastni nahradu za RST 0x10 (tisk znaku) a zbytek pouzivat ROM? Jde to? A je to jednodussi nez to cele napsat bez ROM?
Videt vypis basicu v 5x8 by mohla byt sranda. Jen nevim, zda by to neblo jen namackano na jednu stranu obrazovku a ukazovalo stale 32 znaku na radek. Ale kdyz pisete ovldac tiskarny tak snad nema litmit 32 znaku na radek.
A jeste by to mohlo kolidovat s tim ze krome cisla noveho kanalu jsou jeste definovany nejake znaky. Muslim S jako screen, atd.
Debugovani ROMky je fakt opruz a ztracim se v tom.

Ukazka co jak jsem nasel ty adresy a ze nastaveni horni obrazovky podruhe "nenuluje" kurzor.
Kód:
    ld    L, 0x1A       ; 2:7       init   Upper screen
    call 0x1605         ; 3:17      init   Open channel
   
;                     cc          xx yy
; 0x5C80: 00 5B 21 17 00 40 E0 50 21 18 21 17 01 38 00 38
    ld    A, '0'
    rst 0x10   

    ld    A, 0x08
    rst 0x10   

    ld    A, '+'
    rst 0x10   

   
; 0x5C80: 00 5B 21 17 01 40 E0 50 20 18 21 17 01 38 00 38
    ld    A, '1'
    rst 0x10   

; 0x5C80: 00 5B 21 17 02 40 E0 50 1F 18 21 17 01 38 00 38
    ld    A, ZX_AT
    rst 0x10   
   
; 0x5C80: 00 5B 21 17 02 40 E0 50 1F 18 21 17 01 38 00 38
    ld    A, 0x00
    rst 0x10   
   
; 0x5C80: 00 5B 21 17 02 40 E0 50 1F 18 21 17 01 38 00 38
    ld    A, 0x1F
    rst 0x10   

; 0x5C80: 00 5B 21 17 1F 40 E0 50 02 18 21 17 01 38 00 38
    ld    A, 'z'
    rst 0x10   
     
;                     cc          xx yy
; 0x5C80: 00 5B 21 17 20 40 E0 50 01 18 21 17 01 38 00 38
    ld    A, '0'
    rst 0x10   

; 0x5C80: 00 5B 21 17 21 40 E0 50 20 17 21 17 01 38 00 38


    ld    A, ZX_AT
    rst 0x10   
   
    ld    A, 0x07
    rst 0x10   
   
    ld    A, 0x1F
    rst 0x10   

    ld    A, 'i'
    rst 0x10   

;                     cc          xx yy
; 0x5C80: 00 5B 21 17 00 41 E0 50 01 11 21 17 01 38 00 38
; 41!!!! ne 48!!!

    ld    A, 'n'
    rst 0x10   
; 0x5C80: 00 5B 21 17 01 48 E0 50 20 10 21 17 01 38 00 38


    ld    A, ZX_AT
    rst 0x10   
   
    ld    A, 0x08
    rst 0x10   
   
    ld    A, 0x1F
    rst 0x10   

    ld    A, 'w'
    rst 0x10   
   
;                     cc          xx yy
; 0x5C80: 00 5B 21 17 20 48 E0 50 01 10 21 17 01 38 00 38


    ld    L, 0x1A       ; 2:7       init   Upper screen
    call 0x1605         ; 3:17      init   Open channel
   
; 0x5C80: 00 5B 21 17 20 48 E0 50 01 10 21 17 01 38 00 38

    ld    A, '3'
    rst 0x10   

; 0x5C80:00 5B 21 17 21 48 E0 50 20 0F 21 17 01 38 00 38


PS: ROMka pouziva vlastni buffer pokud se nacte specialni znak jako AT, takze se provede, az kdyz ma vsechny parametry a nedela to jako ja, ze se to rozsekne na AT_Y a priste se vola AT_X. Ale to by nemelo nicemu vadit.

PPS: Zapomnel jsem otazku. Resil to uz nekdo? Ze se prida adresa pro novy kanal a pokud ho aktivujete tak muzete pouzivat "rst 0x10" a ne nejaky CALL a tisknete na obrazovku klidne fontem 5x8? A nemusite resit ani scroll?

PPPS: Ukazuje se ze mam problem u retezcu ukoncene nulou, protoze se me ukonci na prvnim nulovem parametru specialniho/ridiciho znaku. Toho jsem si predtim nejak nevsimnul... .))) A i kdybych to nejak osetril tak jeste je tam problem kdy posledni znak retezce bude ridici znak co me zase sezere ukoncujici nulu.
Tohle plati nejen pro 5x8 font, takze tam ta chyba uz byla, jen jsem ji "neaktivoval", protoze jsem pouzival jen konec radku. (Ale mam takovy pocit, ze jsem mozna resil ze me AT neskace na prvni radek, tak to bylo asi ono)
Lepsi je teda pouzivat tu inverzni variantu, kde je to ukoncene 7. bitem.


Přílohy:
font_5x8.png
font_5x8.png [ 8 KiB | Zobrazeno 1114 krát ]

_________________
Z80 Forth compiler (ZX Spectrum 48kb): https://codeberg.org/DW0RKiN/M4_FORTH
Nahoru
 Profil  
 
 Předmět příspěvku: Re: Macro FORTH
PříspěvekNapsal: 17.03.2023, 09:30 
Offline
Óm Nejvyšší

Registrován: 22.05.2013, 21:14
Příspěvky: 3642
Bydliště: Bratislava
Has thanked: 371 times
Been thanked: 788 times
_dworkin píše:
To jsem resil cele 2 dny
Si sa mohol spytat, romku mame mnohi "zmaknutu" a na vsetky (technicke) otazky okolo romky vieme odpovedat alebo aspon v rozumnom case odpoved najst. A ty si si mohol usetrit kopec namahy ;)

K tvojej otazke, ci sa da namiesto CALL pouzit RST #10. Ano, da sa, stream posielany do RST #10 si mozes v systemovych premennych presmerovat kam len chces, staci ked sa pozries do zdrojaku akehokolvek tlacoveho drivera co podporuje LPRINT / LLIST.

K tomu "Scroll" - funguje to tak, ze ak zaplnis celu obrazovku, este sa nic nedeje, ale ak pridu dalsie znaky na vypis, a tieto znaky by mali obrazovku posunut tak, ze by si uz nemusel vidiet horny riadok, az potom sa pyta "Scroll?". Takze ti nic neujde a podla otazky "Scroll?" poznas, ze "za rohom" je uz pripravene nieco dalsie na vypis.

V suvislosti s tym ako by vyzeral listing basicu by mohlo byt pre teba zaujimave si vyskusat moje upravene romky co vedia 64zn/riadok. Hladaj "Rozsirenie romky pre 64 znakov na riadok". Mam tam takto upravenu originalnu ZX ROM ale aj moje BS rom 118 a 140.

Btw. na tom poslednom obrazku mas dole ukazku BRIGHT ktory pekne vidno, ale FLASH ti tam nejak nefungnuje :poke: :lol:

Inak ked uz o tom pisem, ja som znaky 5x8 nikdy nepouzival, pretoze aj 4x8 boli pre mna vzdy velmi dobre citatelne (dokonca aj na staruckom Tesla Color 110ST pripojenom cez VF antenu) a ked uz som chcel nieco medzi 8x8 a 4x8 tak som bud pouzil klasicky ROM font ale v rastri 7x7 (ukazka ako to vyzera je napriklad tu) alebo som si nadefinoval vlastny 6x8 font ktory som pouzil napriklad na uvodnych informacnych screenoch starych slovenskych hier ktore sme minuly rok prekladali do anglictiny:
Příloha:
InfoChrobakTruhlik.png
InfoChrobakTruhlik.png [ 6.49 KiB | Zobrazeno 1100 krát ]


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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Busy píše:
_dworkin píše:
To jsem resil cele 2 dny
Si sa mohol spytat, romku mame mnohi "zmaknutu" a na vsetky (technicke) otazky okolo romky vieme odpovedat alebo aspon v rozumnom case odpoved najst. A ty si si mohol usetrit kopec namahy ;)

To by bylo skvele mit pomocnou ruku. :) :god2: Ale, obavam se, ze spoustu veci si musim osahat sam, abych je pochopil. Ale nasmerovani, ze tohle nejde... urcite pomuze.
Busy píše:

K tvojej otazke, ci sa da namiesto CALL pouzit RST #10. Ano, da sa, stream posielany do RST #10 si mozes v systemovych premennych presmerovat kam len chces, staci ked sa pozries do zdrojaku akehokolvek tlacoveho drivera co podporuje LPRINT / LLIST.

Vyrvoril jsem teda ted 2 verze, ktere se aktivuji kdyz se definuje makro
USE_FONT_5x8_CALL a nebo USE_FONT_5x8

Prvni ma vsude misto "rst 16" "call" a ta druha si na zacatku nastavi tohle
Kód:
    ld    L, 0x1A       ; 2:7       init   Upper screen
    call 0x1605         ; 3:17      init   Open channel

CURCHL          equ 0x5C51
PRINT_OUT       equ 0x5CBB

    ld  HL, PRINT_OUT   ; 3:10      init
    ld (CURCHL),HL      ; 3:16      init
    ld  HL,draw_char    ; 3:10      init
    ld (PRINT_OUT),HL   ; 3:10      init

Pro ty co nestudovali romku 48k, tak na adrese PRINT_OUT, lezi pointer ukazujici jaka rutina bude vykreslovat horni obrazovku. https://skoolkid.github.io/rom/asm/5CB6.html Tu jsem zmenil na svoji.
A CURCHL je pointer na pointer cim se to bude provadet, ktery se nacita pro prave aktivni stream. Radek 15F4.
Kód:
15EF:                           ; THE 'MAIN PRINTING' SUBROUTINE
; Used by the routines at MAIN_EXEC, OUT_SP_2, OUT_NUM_1 and PRINT_FP.
; Input:
;   A Value from +00 to +09 (for digits) or +11 to +22 (for the letters A-R)
OUT_CODE  15EF  LD E,$30        ; Increase the value in the A register by +30.
          15F1  ADD A,E
; This entry point is used by the routine at PRINT_A_1 with A holding the code of the character to be printed.
PRINT_A_2 15F2  EXX             ; Save the registers.
          15F3  PUSH HL
          15F4  LD HL,($5C51)   ; Fetch the base address for the current channel (CURCHL). This will point to an output address.
; This entry point is used by the routine at INPUT_AD with A holding the code of the character to be printed.
; Now call the actual subroutine. HL points to the output or the input address as directed.
CALL_SUB  15F7  LD E,(HL)       ; Fetch the low byte.
          15F8  INC HL          ; Fetch the high byte.
          15F9  LD D,(HL)
          15FA  EX DE,HL        ; Move the address to the HL register pair.
          15FB  CALL CALL_JUMP  ; Call the actual subroutine.
          15FE  POP HL          ; Restore the registers.
          15FF  EXX
          1600  RET             ; Return will be from here unless an error occurred.

https://skoolkid.github.io/rom/asm/15EF.html#15F2
to skoci na
Kód:
CALL_JUMP   162C   JP (HL)   Jump to the routine.
https://skoolkid.github.io/rom/asm/1615.html#162C
Je okolo toho jeste dost rezije, takze nakonec me vychazi ta CALL verze kratsi a urcite rychlejsi. Zakladni rutina je skoro stejna, jen si musim hlidat kde dam EXX, protoze pri RST je to prohozene a jeste jsem zjistil ze ROMka kdyz pouzijes puvodni rutinu co je volana pres RST, teda
Kód:
call 0x09F4         ; 3:17      putchar   rst 0x10 --> call 0x09F4

Tak ti prepise PRINT_OUT hodnotu na puvodni. Takze se to musi pokazde obnovit.
Pouzivam tu puvodni rutinu abych provedl posun kurzoru o radek dolu. Nastavim hodnotu X v pameti na 1. Coz pro 48k ROM znamena ze uz jsme za koncem radku (ale Y stale drzi puvodni) a vyvolam OVER 1 a psani mezery. To provede scroll a necha Y kde bylo a nebo posune Y dolu. Takze Y ziskam pres 0x18-[0x5C89] .
Provadi se to jen kdyz je zapsan ENTER, TAB ktery se nevleze, COMMA co se nevleze a posledni pripad je kdyz proste dalsi znak je uz na dalsim radku.

K studovani jinych zdrojaku jsme se nedostal, ale objevil jsem spoustu chyb u sebe (jak to nikdo netestuje a ja to neustale menim tak to co fungovalo uz nemusi...), ze jsem se k tomu jeste nedostal.
Busy píše:
K tomu "Scroll" - funguje to tak, ze ak zaplnis celu obrazovku, este sa nic nedeje, ale ak pridu dalsie znaky na vypis, a tieto znaky by mali obrazovku posunut tak, ze by si uz nemusel vidiet horny riadok, az potom sa pyta "Scroll?". Takze ti nic neujde a podla otazky "Scroll?" poznas, ze "za rohom" je uz pripravene nieco dalsie na vypis.

Ja mel na mysli to, ze je to slozitejsi nez jsem si myslel. Protoze ten scroll si zaroven pamatuje kolik radku uz odskroloval. Pro uzivatele to vypada ze proste to posune o obrazovku dal, ale on nezna budoucnost, takze to posouva radek za radkem, jak mu to chodi na vstup (na konci to ani nemusi byt cela obrazovka) a az uz ma to pocitadlo prazdne, tak znovu zapise SCROLL? a ceka. Proto jsem se v tom nechtel vrtat. I kdyz stale musim prozkoumat, zda neni lehci cesta misto zapisovani prazdneho znaku zjistovat sirku horni obrazovky a volat primo scroll rutinu.
Busy píše:
V suvislosti s tym ako by vyzeral listing basicu by mohlo byt pre teba zaujimave si vyskusat moje upravene romky co vedia 64zn/riadok. Hladaj "Rozsirenie romky pre 64 znakov na riadok". Mam tam takto upravenu originalnu ZX ROM ale aj moje BS rom 118 a 140.

Pokud to chapu dobre (podle cteni na https://hood.speccy.cz/dwnld/rom64_info.htm). Tak jak tam cte z nizke adresy co lezi v romce jake rozsireni se jedna, tak to je primo zmena ROM a ne nejake tanecky okolo standartni ROM aby to vypisovalo jine fonty nez 8x8.
V te verzi "zmeny RST" to kupodivu vypise i v Basicu LIST v 51 znacich na radek, a sezere to i AT pro 51 znaku u standartni romky.

Mam tam ted nejakou zmenu ze COMMA nedela 0 nebo 16 ale 0,17,34. Takze to deli na tretiny. A jeste to mam asi cele blbe protoze jsem netestoval presne chovani u TAB a COMMA, mam pocit ze to maze znaky predtim a ja to mam jako AT. Je toho fakt hodne najendou... i kdyz to nevypada.

PS: Jeste me napada, ze pri vypsani tokenu to provadi dalsi silenosti s flagama, kde tisknout mezeru pred a za token. Cely ten system flagu, lokalnich buferu, streamu atd. je asi nad moje sily se v tom do bitu orientovat a byt si jisty ze jsem neco nepodelal.

Busy píše:
Btw. na tom poslednom obrazku mas dole ukazku BRIGHT ktory pekne vidno, ale FLASH ti tam nejak nefungnuje :poke: :lol:

To jsem jen blbe "tipnul", protoze me na tom nezalezelo v jake poloze to bude.
Busy píše:
Inak ked uz o tom pisem, ja som znaky 5x8 nikdy nepouzival, pretoze aj 4x8 boli pre mna vzdy velmi dobre citatelne (dokonca aj na staruckom Tesla Color 110ST pripojenom cez VF antenu) a ked uz som chcel nieco medzi 8x8 a 4x8 tak som bud pouzil klasicky ROM font ale v rastri 7x7 (ukazka ako to vyzera je napriklad tu) alebo som si nadefinoval vlastny 6x8 font ktory som pouzil napriklad na uvodnych informacnych screenoch starych slovenskych hier ktore sme minuly rok prekladali do anglictiny:
Příloha:
InfoChrobakTruhlik.png


7x7 font kopirovany z 8x8 fontu je uplne genialni napad! wow... To me fakt spadla celist, protoze na prvni pohled jsem to ani nepoznal, ze je to namackane na sebe (misto 2 px mezery jen 1 px). Asi bych preferoval 7x8 kvuli atributum, ale zrovna sirka 7 je takova neprijemna, u sirky 4,5,6 je to celkem v pohode. Proste se zapise atribut na prvni levy pixel znaku, a ze tim mozna prepises trochu znaku vlevo (a nebo dokoncis obarveni vlevo) a nebo zbytek znaku vpravo bude neobarveny nemusis resit. To si uz muze osefovat programator, kdyz se mu chce menit atributy, aby mu to sedelo (spolecny delitel 8 a x), a nebo natvrdo tisknout mezeru vpred a po. Takze kdyz uz neresis atributy vubec tak to muzes zmackat i na vysku.

PS: Jeste jsem nedodelal UDG znaky....
PPS: A narazil jsem na neprijemnou chybu, kdy se me v retezci vytiskne slovo RAS, ale jakmile ho pouziju i v kodu, tak uz se me nevytiskne, ale aktivuje. Tim se to cele zacykli a skonci s vypisem M4 overflow, co je spatne si najdi nejak sam...
Vubec nechapu, kde je chyba jsem musel zjistit postupnym pridavanim a odmazavanim kodu.
Zatim jsem to vyresil tim ze tisknu v retezci R.A.S.
Puvodne jsem mel slovo __RAS, ale navrat zpet nic nevyresi, pokud se me tohle deje i u napriklad tisku SWAP.
Ah.. koukam ze
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Pasmo_test$ ../check_word.sh 'PRINT_I({"SWAP"})'
    ld   BC, string101  ; 3:10      print_i   Address of string101 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(reg A) with ZX 48K ROM
PRINT_STRING_I:         ;           print_string_i
    ld    A,(BC)        ; 1:7       print_string_i
    inc  BC             ; 1:6       print_string_i
    or    A             ; 1:4       print_string_i
    jp    p, $-4        ; 3:10      print_string_i
    and  0x7f           ; 2:7       print_string_i
    rst   0x10          ; 1:11      print_string_i   putchar(reg A) with ZX 48K ROM
    ret                 ; 1:10      print_string_i

STRING_SECTION:
string101:
    db "SWA","P" + 0x80
size101              EQU $ - string101
; seconds: 0           ;[17:93]
dworkin@dw-A15:~/Programovani/ZX/Forth/Pasmo_test$ ../check_word.sh 'PRINT_I({"SWAP"}) SWAP'
^C
dworkin@dw-A15:~/Programovani/ZX/Forth/Pasmo_test$ ../check_word.sh 'PRINT_I({"SWAP"}) SWAP'
m4: stack overflow
; seconds: 11          ;[ 0:0]
dworkin@dw-A15:~/Programovani/ZX/Forth/Pasmo_test$
deje...

PPPS: U toho jsem nasel starou chybu kdyz jsem se snazil zkompilovat program pro test_if, ze jsem tam 2x volal v kodu tokenu jiny token misto kod toho jineho tokenu. Kolikrat jsem to jeste prehledl... .) Tokenizace neco stoji... A to jsem mel jeste napad jak vyrestit snadno to duplicitni "ex de,hl" nebo navazujici "push hl" pred "pop hl" tim ze bych stokenizoval i ten kod slova. Pro kazdou instrukci token. Takze, bych nad tim mel kontrolu a az uplne nakonec by vylezl asembler. To by pak uz mohlo rovnou lezt i binarni kod, a mohl bych si osetrit i relativni skoky a nahrazovat za absolutni kde jsou mimo rozsah...
...ale ne, uz ted je toho na me moc. I kdyz by to slo...

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

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Jo jeste jsem si vzpomnel ze mam stale INVERZE udelany bez parametru (proste ho ignoruje a prohodi atributy). Protoze to bylo snazsi a nemusel jsem se snazit pochopit tu kombinaci promennych a flagu v ROMce. Takze i ty barvy si ukladam u sebe a nesnazim se prijit pro jakou cast obrazovky existuje spravna promenna. Protoze tam je i nejake TEMP a jeste na to testuje flag promennou... A nemam podporu pro OVER. Vlastne me to jeste tiskne jen 4 pixely (znak ma jen 4 bajty) a paty pixel je mezera a tu ignoruji, spravne bych ji mel nulovat.
Kód:
;vvvv
include(`../M4/FIRST.M4')dnl
;^^^^

    define({USE_FONT_5x8})
    ZX_CONSTANT

    org 0x8000
         
    INIT(6000)
   
    PUSH(0xF5) ;# token {PRINT}
    EMIT
   
   
    PUSH(100) PUSH(0) DO
        I UDOT CR
    LOOP
    PRINT_I("Konec...", 0x0D)
    PRINT_I({ZX_AT,12,5,"Hello,",ZX_INVERSE,1," Speccy!", ZX_INVERSE, 0,ZX_EOL,}dnl
    {"dalsi radek na ",ZX_PAPER, ZX_YELLOW, "zlute...",}dnl
    {ZX_AT,0,0,"pocatek", ZX_INK, ZX_BLUE," modrou!", ZX_EOL,}dnl
    {" !",0x22,0x23,"$%&'()*+,-./0123456789:;<=>?", ZX_EOL,}dnl
    {"@ABCDEFGHIJKLMNOPQRSTUVWXYZ[",0x5C,"]^_", ZX_EOL,}dnl
    {"`abcdefghijklmnopqrstuvwxyz{|}~",0x7F, ZX_EOL,}dnl
    {"abc",ZX_TAB,5,"x",ZX_TAB,6,"y",ZX_TAB,MAX_X+6,"Nuclear war...",ZX_TAB,10,"sin(PI*2.7849)*23+(536+123)*2^7", ZX_EOL,}dnl
    {ZX_TAB,30,"Test zalomeni pres tretiny...",}dnl
    {ZX_AT,20,12,"AT(20,12) ",ZX_BRIGHT,1,"BRIGHT ",ZX_BRIGHT,0,}dnl
    {ZX_AT,21,12,"AT(21,12) ",ZX_FLASH, 1,"FLASH ", ZX_FLASH, 0,"end"})
    STOP

Kód:
;vvvv
;^^^^

   
   
ZX_EOL               EQU 0x0D     ; zx_constant   end of line

ZX_INK               EQU 0x10     ; zx_constant   colour
ZX_PAPER             EQU 0x11     ; zx_constant   colour
ZX_FLASH             EQU 0x12     ; zx_constant   0 or 1
ZX_BRIGHT            EQU 0x13     ; zx_constant   0 or 1
ZX_INVERSE           EQU 0x14     ; zx_constant   0 or 1
ZX_OVER              EQU 0x15     ; zx_constant   0 or 1
ZX_AT                EQU 0x16     ; zx_constant   Y,X
ZX_TAB               EQU 0x17     ; zx_constant   # spaces

ZX_BLACK             EQU %000     ; zx_constant
ZX_BLUE              EQU %001     ; zx_constant
ZX_RED               EQU %010     ; zx_constant
ZX_MAGENTA           EQU %011     ; zx_constant
ZX_GREEN             EQU %100     ; zx_constant
ZX_CYAN              EQU %101     ; zx_constant
ZX_YELLOW            EQU %110     ; zx_constant
ZX_WHITE             EQU %111     ; zx_constant


    org 0x8000
         
   
   
     ;# token {PRINT}
   
   
   
       
         
   
   
   
   

;   ===  b e g i n  ===
    ld  (Stop+1), SP    ; 4:20      init   storing the original SP value when the "bye" word is used
    ld    L, 0x1A       ; 2:7       init   Upper screen
    call 0x1605         ; 3:17      init   Open channel
    ld  HL, PRINT_OUT   ; 3:10      init
    ld (CURCHL),HL      ; 3:16      init
    ld  HL,draw_char    ; 3:10      init
    ld (PRINT_OUT),HL   ; 3:10      init
  if 0
    ld   HL, 0x0000     ; 3:10      init
    ld  (cursor),HL     ; 3:16      init
  else
    ld   HL, 0x1821     ; 3:10      init
    ld   DE,(0x5C88)    ; 4:20      init
    or    A             ; 1:4       init
    sbc  HL, DE         ; 2:15      init
    ld    A, L          ; 1:4       init   x
    add   A, A          ; 1:4       init   2*x
    inc   A             ; 1:4       init   2*2+1
    add   A, A          ; 1:4       init   4*x+2
    add   A, A          ; 1:4       init   8*x+4
     ld   L, 0xFF       ; 2:7       init
    inc   L             ; 1:4       init
    sub 0x05            ; 2:7       init
    jr   nc, $-3        ; 2:7/12    init
    ld  (cursor),HL     ; 3:16      init
  endif
    ld   HL, 0x1770     ; 3:10      init   Return address stack = 6000
    exx                 ; 1:4       init
    ld    A, 0xF5       ; 2:7       0xF5 emit   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      0xF5 emit   putchar(reg A) with ZX 48K ROM
    ld   BC, 0          ; 3:10      100 0 do_101(xm)
do101save:              ;           100 0 do_101(xm)
    ld  (idx101),BC     ; 4:20      100 0 do_101(xm)
do101:                  ;           100 0 do_101(xm)
    push DE             ; 1:11      i_101(m)   ( -- i )
    ex   DE, HL         ; 1:4       i_101(m)
    ld   HL, (idx101)   ; 3:16      i_101(m)   idx always points to a 16-bit index
    call PRT_U16        ; 3:17      u.   ( u -- )
    ld    A, 0x0D       ; 2:7       cr   Pollutes: AF, AF', DE', BC'
    rst   0x10          ; 1:11      cr   putchar(reg A) with ZX 48K ROM
                        ;[12:45]    loop_101   variant +1.B: 0 <= index < stop <= 256, run 100x
idx101 EQU $+1          ;           loop_101   idx always points to a 16-bit index
    ld    A, 0          ; 2:7       loop_101   0.. +1 ..(100), real_stop:0x0064
    nop                 ; 1:4       loop_101   hi(index) = 0 = nop -> idx always points to a 16-bit index.
    inc   A             ; 1:4       loop_101   index++
    ld  (idx101),A      ; 3:13      loop_101
    xor  0x64           ; 2:7       loop_101   lo(real_stop)
    jp   nz, do101      ; 3:10      loop_101   index-stop
leave101:               ;           loop_101
exit101:                ;           loop_101
    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
Stop:                   ;           stop
    ld   SP, 0x0000     ; 3:10      stop   restoring the original SP value when the "bye" word is used
    ld   HL, 0x2758     ; 3:10      stop
    exx                 ; 1:4       stop
    ret                 ; 1:10      stop
;   =====  e n d  =====
;------------------------------------------------------------------------------
; Input: HL
; Output: Print unsigned decimal number in HL
; Pollutes: AF, BC, HL <- DE, DE <- (SP)
PRT_U16:                ;           prt_u16
    xor   A             ; 1:4       prt_u16   HL=103 & A=0 => 103, HL = 103 & A='0' => 00103
    ld   BC, -10000     ; 3:10      prt_u16
    call BIN16_DEC      ; 3:17      prt_u16
    ld   BC, -1000      ; 3:10      prt_u16
    call BIN16_DEC      ; 3:17      prt_u16
    ld   BC, -100       ; 3:10      prt_u16
    call BIN16_DEC      ; 3:17      prt_u16
    ld    C, -10        ; 2:7       prt_u16
    call BIN16_DEC      ; 3:17      prt_u16
    ld    A, L          ; 1:4       prt_u16
    pop  HL             ; 1:10      prt_u16   load ret
    ex  (SP),HL         ; 1:19      prt_u16
    ex   DE, HL         ; 1:4       prt_u16
    jr   BIN16_DEC_CHAR ; 2:12      prt_u16
;------------------------------------------------------------------------------
; Input: A = 0 or A = '0' = 0x30 = 48, HL, IX, BC, DE
; Output: if ((HL/(-BC) > 0) || (A >= '0')) print number -HL/BC
; Pollutes: AF, HL
    inc   A             ; 1:4       bin16_dec
BIN16_DEC:              ;           bin16_dec
    add  HL, BC         ; 1:11      bin16_dec
    jr    c, $-2        ; 2:7/12    bin16_dec
    sbc  HL, BC         ; 2:15      bin16_dec
    or    A             ; 1:4       bin16_dec
    ret   z             ; 1:5/11    bin16_dec   does not print leading zeros
BIN16_DEC_CHAR:         ;           bin16_dec
    or   '0'            ; 2:7       bin16_dec   1..9 --> '1'..'9', unchanged '0'..'9'
    rst   0x10          ; 1:11      bin16_dec   putchar(reg A) with ZX 48K ROM
    ld    A, '0'        ; 2:7       bin16_dec   reset A to '0'
    ret                 ; 1:10      bin16_dec
;------------------------------------------------------------------------------
; Print string ending with inverted most significant bit
; In: BC = addr string_imsb
; Out: BC = addr last_char + 1
    rst   0x10          ; 1:11      print_string_i   putchar(reg A) with ZX 48K ROM
PRINT_STRING_I:         ;           print_string_i
    ld    A,(BC)        ; 1:7       print_string_i
    inc  BC             ; 1:6       print_string_i
    or    A             ; 1:4       print_string_i
    jp    p, $-4        ; 3:10      print_string_i
    and  0x7f           ; 2:7       print_string_i
    rst   0x10          ; 1:11      print_string_i   putchar(reg A) with ZX 48K ROM
    ret                 ; 1:10      print_string_i
;==============================================================================
; Print text with 5x8 font
; entry point is draw_char

MAX_X           equ 51       ; x = 0..50
MAX_Y           equ 24       ; y = 0..23
CURCHL          equ 0x5C51
PRINT_OUT       equ 0x5CBB
   
set_ink:                ;           putchar   0x10
    ld   HL, self_attr  ; 3:10      putchar
    xor (HL)            ; 1:7       putchar
    and 0x07            ; 2:7       putchar
    xor (HL)            ; 1:7       putchar
    jr  set_attr        ; 2:12      putchar
   
set_paper:              ;           putchar   0x11         
    ld   HL, self_attr  ; 3:10      putchar
    add   A, A          ; 1:4       putchar   2x
    add   A, A          ; 1:4       putchar   4x
    add   A, A          ; 1:4       putchar   8x
    xor (HL)            ; 1:7       putchar
    and 0x38            ; 2:7       putchar
    xor (HL)            ; 1:7       putchar
    jr  set_attr        ; 2:12      putchar
   
set_flash:              ;           putchar   0x12
    rra                 ; 1:4       putchar   carry = flash
    ld   HL, self_attr  ; 3:10      putchar
    ld    A,(HL)        ; 1:7       putchar
    adc   A, A          ; 1:4       putchar
    rrca                ; 1:4       putchar
    jr  set_attr        ; 2:12      putchar
   
set_bright:             ;           putchar   0x13
    ld   HL, self_attr  ; 3:10      putchar
    rrca                ; 1:4       putchar
    rrca                ; 1:4       putchar
    xor (HL)            ; 1:7       putchar
    and 0x40            ; 2:7       putchar
    xor (HL)            ; 1:7       putchar
    jr   set_attr       ; 2:12      putchar
   
set_inverse:            ;           putchar   0x14
    ld   HL, self_attr  ; 3:10      putchar
    ld    A,(HL)        ; 1:7       putchar
    and  0x38           ; 2:7       putchar   A = 00pp p000
    add   A, A          ; 1:4       putchar
    add   A, A          ; 1:4       putchar   A = ppp0 0000
    xor (HL)            ; 1:7       putchar
    and  0xF8           ; 2:7       putchar
    xor (HL)            ; 1:7       putchar   A = ppp0 0iii
    rlca                ; 1:4       putchar
    rlca                ; 1:4       putchar
    rlca                ; 1:4       putchar   A = 00ii ippp
    xor (HL)            ; 1:7       putchar
    and  0x3F           ; 2:7       putchar
    xor (HL)            ; 1:7       putchar   A = fbii ippp

set_attr:               ;           putchar
    ld  (HL),A          ; 1:7       putchar   save new attr   
clean_set_0:            ;           putchar
    xor   A             ; 1:4       putchar
clean_set_A:            ;           putchar
    ld  (self_jmp),A    ; 3:13      putchar
    pop  HL             ; 1:10      putchar
    ret                 ; 1:10      putchar
   
set_over:               ;           putchar   0x15
    jr   clean_set_0    ; 2:12      putchar

set_at:                 ;           putchar   0x16
    ld  (cursor+1),A    ; 3:13      putchar   save new Y
    neg                 ; 2:8       putchar
    add   A, 0x18       ; 2:7       putchar
    ld  (0x5C89),A      ; 3:13      putchar
    ld   A,$+4-jump_from; 2:7       putchar
    jr   clean_set_A    ; 2:12      putchar

set_at_x:               ;           putchar
    ld  (cursor),A      ; 3:13      putchar   save new X
    jr   clean_set_0    ; 2:12      putchar

  if 0
    jr   print_comma    ; 2:12      putchar   0x06
    jr   print_edit     ; 2:12      putchar   0x07
    jr   cursor_left    ; 2:12      putchar   0x08
    jr   cursor_right   ; 2:12      putchar   0x09
    jr   cursor_down    ; 2:12      putchar   0x0A
    jr   cursor_up      ; 2:12      putchar   0x0B
    jr   delete         ; 2:12      putchar   0x0C
    jr   enter          ; 2:12      putchar   0x0D
    jr   not_used       ; 2:12      putchar   0x0E
    jr   not_used       ; 2:12      putchar   0x0F   
  endif
 
tab_spec:               ;           putchar
    jr   set_ink        ; 2:12      putchar   0x10
    jr   set_paper      ; 2:12      putchar   0x11
    jr   set_flash      ; 2:12      putchar   0x12
    jr   set_bright     ; 2:12      putchar   0x13
    jr   set_inverse    ; 2:12      putchar   0x14
    jr   set_over       ; 2:12      putchar   0x15
    jr   set_at         ; 2:12      putchar   0x16
;   jr   set_tab        ; 2:12      putchar   0x17

set_tab:                ;           putchar
    ld   HL,(cursor)    ; 3:16      putchar   load origin cursor
    sub  MAX_X          ; 2:7       putchar
    jr   nc,$-2         ; 2:7/12    putchar
    add   A, MAX_X      ; 2:7       putchar   (new x) mod MAX_X
    cp    L             ; 1:4       putchar
    call  c, next_line  ; 3:10/17   putchar   new x < (old x+1)
set_tab_A               ;           putchar
    ld    L, A          ; 1:4       putchar
    ld  (cursor),HL     ; 3:16      putchar   save new cursor
    jr   clean_set_0    ; 2:12      putchar

cursor_left:            ;           putchar   0x08
    ld   HL,(cursor)    ; 3:16      putchar
    inc   L             ; 1:4       putchar
    dec   L             ; 1:4       putchar
    dec  HL             ; 1:6       putchar
    jr   nz, $+4        ; 2:7/12    putchar
    ld    L, MAX_X-1    ; 2:7       putchar
    jr   enter_exit     ; 2:12      putchar

print_comma:            ;           putchar   0x06
    ld   HL,(cursor)    ; 3:16      putchar
    ld    A, 17         ; 2:7       putchar
    cp    L             ; 1:4       putchar
    jr   nc, set_tab_A  ; 2:12      putchar
    add   A, A          ; 1:4       putchar
    cp    L             ; 1:4       putchar
    jr   nc, set_tab_A  ; 2:12      putchar
    xor   A             ; 1:4       putchar
   
enter:                  ;           putchar   0x0D
    call  z, next_line  ; 3:10/17   putchar
enter_exit:             ;           putchar
    ld  (cursor),HL     ; 3:16      putchar   save new cursor
    pop  HL             ; 1:10      putchar   load HL
    ret                 ; 3:10

   
print_edit:             ;           putchar   0x07
cursor_right:           ;           putchar   0x09
cursor_down:            ;           putchar   0x0A
cursor_up:              ;           putchar   0x0B
delete:                 ;           putchar   0x0C
not_used:               ;           putchar   0x0E, 0x0F

print_question          ;           putchar   0x00..0x05 + 0x0E..0x0F + 0x18..0x1F
    ld    A, '?'        ; 2:7       putchar
    jr   print_char_HL  ; 2:7/12    putchar

;------------------------------------------------------------------------------
;  Input: A = char
; Poluttes: AF, AF', DE', BC'
draw_char:
    push HL                 ; 1:11
self_jmp    equ $+1
    jr   jump_from          ; 2:7/12    self-modifying
jump_from:
    cp   0xA5               ; 2:7       token
    jr   nc, print_token    ; 2:7/12

    cp   0x20               ; 2:7
    jr   nc, print_char_HL  ; 2:7/12

    cp   0x06               ; 2:7       comma
    jr    z, print_comma    ; 2:7/12
    cp   0x08               ; 2:7       cursor_left
    jr    z, cursor_left    ; 2:7/12
    cp   0x0D               ; 2:7       enter
    jr    z, enter          ; 2:7/12

    sub  0x10               ; 2:7       set_ink
    jr    c, print_question ; 2:7/12

    cp   0x08               ; 2:7       >print_tab
    jr   nc, print_question ; 2:7/12

draw_spec:   
    add   A,A               ; 1:4       2x
    sub  jump_from-tab_spec ; 2:7
    ld  (self_jmp),A        ; 3:13
draw_spec_exit:             ;
    pop  HL                 ; 1:10
    ret                     ; 1:10
   
print_token:
    ex   DE, HL             ; 1:4
    ld   DE, 0x0095           ; 3:10      The base address of the token table
    sub  0xA5               ; 2:7
    push AF                 ; 1:11      Save the code on the stack. (Range +00 to +5A,  to COPY).
   
; Input
;   A   Message table entry number
;   DE  Message table start address
; Output
;   DE  Address of the first character of message number A
;   F   Carry flag: suppress (set) or allow (reset) a leading space
    call 0x0C41             ; 3:17      THE 'TABLE SEARCH' SUBROUTINE
    ex   DE, HL             ; 1:4

    ld    A,' '             ; 2:7       A 'space' will be printed before the message/token if required (bit 0 of FLAGS reset).
    bit   0,(IY+0x01)       ;
    call  z, print_char     ; 3:17

; The characters of the message/token are printed in turn.

token_loop:
    ld    A,(HL)            ; 1:7       Collect a code.
    and  0x7F               ; 2:7       Cancel any 'inverted bit'.
    call print_char         ; 3:17      Print the character.
    ld    A,(HL)            ; 1:7       Collect the code again.
    inc  HL                 ; 1:6       Advance the pointer.
    add   A, A              ; 1:4       The 'inverted bit' goes to the carry flag and signals the end of the message/token; otherwise jump back.
    jr   nc, token_loop     ; 2:7/12
   
; Now consider whether a 'trailing space' is required.

    pop  HL                 ; 1:10      For messages, H holds +00; for tokens, H holds +00 to +5A.
    cp   0x48               ; 2:7       Jump forward if the last character was a '$'
    jr    z, $+6            ; 2:7/12
    cp   0x82               ; 2:7       Return if the last character was any other before 'A'.
    jr    c, draw_spec_exit ; 2:7/12
    ld    A, H              ; 1:4       Examine the value in H and return if it indicates a message, , INKEY$ or PI.
    cp   0x03               ; 2:7
    ld    A, ' '            ; 2:7       All other cases will require a 'trailing space'.   
    ret   c                 ; 1:5/11
    pop  HL                 ; 1:10
print_char:
    push HL                 ; 1:11    uschovat HL na zásobník
print_char_HL:

    exx                     ; 1:4
    push DE                 ; 1:11    uschovat DE na zásobník
    push BC                 ; 1:11    uschovat BC na zásobník   

    push HL                 ; 1:11    uschovat HL na zásobník

    ld    BC, FONT_ADR      ; 3:10    adresa, od níž začínají masky znaků

    add   A, A              ; 1:4
    ld    L, A              ; 1:4     2x
    ld    H, 0x00           ; 1:4     C je nenulové
    add  HL, HL             ; 1:11    4x
    add  HL, BC             ; 1:11    přičíst bázovou adresu masek znaků   
    exx                     ; 1:4

;# YX -> ATTR

cursor     equ     $+1
    ld   DE, 0x0000         ; 3:10
    ld    A, E              ; 1:4     X
    add   A, A              ; 1:4     2*X
    add   A, A              ; 1:4     4*X
    add   A, E              ; 1:4     5*X
    ld    B, A              ; 1:4     save 5*X
   
    xor   D                 ; 1:4
    and 0xF8                ; 2:7
    xor   D                 ; 1:4
    rrca                    ; 1:4
    rrca                    ; 1:4
    rrca                    ; 1:4
    ld    L, A              ; 1:4

    ld    A, D              ; 1:4   
    or  0xC7                ; 2:7     110y y111, reset carry
    rra                     ; 1:4     0110 yy11, set carry
    rrca                    ; 1:4     1011 0yy1, set carry
    ccf                     ; 1:4     reset carry
    rra                     ; 1:4     0101 10yy
    ld    H, A              ; 1:4

self_attr       equ $+1
    ld  (HL),0x38           ; 2:10    uložení atributu znaku

    ld    A, D              ; 1:4
    and 0x18                ; 2:7
    or  0x40                ; 2:7
    ld    H, A              ; 1:4
   
    ld    A, B              ; 1:4     load 5*X
    and 0x07                ; 2:7
    cpl                     ; 1:4
    add   A, 0x09           ; 2:7         
    ld    B, A              ; 2:7     pocitadlo pro pocatecni posun vlevo masky znaku
    exx                     ; 1:4
    ld    C, A              ; 1:4
    exx                     ; 1:4
    ex   DE, HL             ; 1:4
    ld   HL, 0x00F0         ; 3:10
    add  HL, HL             ; 1:11    pocatecni posun masky
    djnz  $-1               ; 2:8/13       
    ex   DE, HL             ; 1:4

    ld    C, 4              ; 2:7       
loop_c:
    exx                     ; 1:4
    ld    A,(HL)            ; 1:7
    inc  HL                 ; 1:6
    ld    B, C              ; 1:4
    rlca                    ; 1:4
    djnz  $-1               ; 2:8/13
    ld    B, A              ; 1:4
    exx                     ; 1:4
    ld    B, 2              ; 2:7       
loop_b:
    xor (HL)                ; 1:7
    and   D                 ; 1:4
    xor (HL)                ; 1:7
    ld  (HL),A              ; 1:4     ulozeni jednoho bajtu z masky

    exx                     ; 1:4
    ld    A, B              ; 1:4     načtení druhe poloviny "bajtu" z masky
    exx                     ; 1:4

    inc   L                 ; 1:4
    xor (HL)                ; 1:7
    and   E                 ; 1:4
    xor (HL)                ; 1:7
    ld  (HL),A              ; 1:4     ulozeni jednoho bajtu z masky
    dec   L                 ; 1:4
    inc   H                 ; 1:4

    exx                     ; 1:4
    ld    A, B              ; 1:4     načtení jednoho bajtu z masky
    rlca                    ; 1:4
    rlca                    ; 1:4
    rlca                    ; 1:4
    rlca                    ; 1:4
    ld    B, A              ; 1:4
    exx                     ; 1:4

;     halt
   
    djnz loop_b             ; 2:8/13
   
    dec   C                 ; 2:7       
    jr   nz, loop_c         ; 2/7/12


    pop  HL                 ; 1:10    obnovit obsah HL ze zásobníku

    pop  BC                 ; 1:10    obnovit obsah BC ze zásobníku
    pop  DE                 ; 1:10    obnovit obsah DE ze zásobníku   

    exx                     ; 1:4
;   fall to next cursor   


    ld   HL,(cursor)   ; 3:16
; Input: HL = YX
; Output: HL = cursor = next cursor
next_cursor:
    inc   L                 ; 1:4     0..50
    ld    A, L              ; 1:4
    sub  MAX_X              ; 2:7     -51
    call nc, next_line      ; 3:10/17
next_exit:
    ld  (cursor),HL         ; 3:16
exit_hl:                    ;
    pop  HL                 ; 1:10    obnovit obsah HL ze zásobníku
    ret                     ; 1:10

; Input:
; Output: H = Y+1/Y+0+scroll, L=0
next_line:
    push AF             ; 1:11      putchar
    ld   HL, 0x5C88     ; 3:10      putchar
    ld  (HL), 0x01      ; 2:10      putchar
    ld    A, 0x15       ; 2:7       putchar   over
    push HL             ; 1:11      putchar
    call 0x09F4         ; 3:17      putchar   rst 0x10 --> call 0x09F4
    exx                 ; 1:4       putchar
    ld    A, 0x01       ; 2:7       putchar   over 1
    rst  0x10           ; 1:11      putchar       
    ld    A, ' '        ; 2:7       putchar   space and check bios scroll
    rst  0x10           ; 1:11      putchar
    exx                 ; 1:4       putchar
    ld  HL,draw_char    ; 3:10      putchar
    ld (PRINT_OUT),HL   ; 3:10      putchar
    pop  HL             ; 1:10      putchar
    ld    A, 0x18       ; 2:7       putchar
    inc   L             ; 1:4       putchar
    sub (HL)            ; 1:7       putchar
    ld    H, A          ; 1:7       putchar
    ld    L, 0x00       ; 2:7       putchar
    pop  AF             ; 1:10      putchar
    ret                 ; 1:10      putchar

FONT_ADR    equ     FONT_5x8-32*4
FONT_5x8:
    db %00000000,%00000000,%00000000,%00000000 ; 0x20 space
    db %00000010,%00100010,%00100000,%00100000 ; 0x21 !
    db %00000101,%01010000,%00000000,%00000000 ; 0x22 "
    db %00000000,%01011111,%01011111,%01010000 ; 0x23 #
    db %00000010,%01110110,%00110111,%00100000 ; 0x24 $
    db %00001100,%11010010,%01001011,%00110000 ; 0x25 %
    db %00000000,%11101010,%01011010,%11010000 ; 0x26 &
    db %00000011,%00010010,%00000000,%00000000 ; 0x27 '   
    db %00000010,%01000100,%01000100,%00100000 ; 0x28 (
    db %00000100,%00100010,%00100010,%01000000 ; 0x29 )
    db %00000000,%00001010,%01001010,%00000000 ; 0x2A *
    db %00000000,%00000100,%11100100,%00000000 ; 0x2B +
    db %00000000,%00000000,%00000010,%00100100 ; 0x2C ,
    db %00000000,%00000000,%11100000,%00000000 ; 0x2D -
    db %00000000,%00000000,%00000000,%01000000 ; 0x2E .
    db %00000000,%00010010,%01001000,%00000000 ; 0x2F /
   
    db %00000110,%10011011,%11011001,%01100000 ; 0x30 0
    db %00000010,%01100010,%00100010,%01110000 ; 0x31 1
    db %00000110,%10010001,%01101000,%11110000 ; 0x32 2
    db %00000110,%10010010,%00011001,%01100000 ; 0x33 3
    db %00000010,%01101010,%11110010,%00100000 ; 0x34 4
    db %00001111,%10001110,%00011001,%01100000 ; 0x35 5
    db %00000110,%10001110,%10011001,%01100000 ; 0x36 6
    db %00001111,%00010010,%01000100,%01000000 ; 0x37 7
    db %00000110,%10010110,%10011001,%01100000 ; 0x38 8
    db %00000110,%10011001,%01110001,%01100000 ; 0x39 9
    db %00000000,%00000010,%00000010,%00000000 ; 0x3A :
    db %00000000,%00000010,%00000010,%01000000 ; 0x3B ;
    db %00000000,%00010010,%01000010,%00010000 ; 0x3C <
    db %00000000,%00000111,%00000111,%00000000 ; 0x3D =
    db %00000000,%01000010,%00010010,%01000000 ; 0x3E >
    db %00001110,%00010010,%01000000,%01000000 ; 0x3F ?
   
    db %00000000,%01101111,%10111000,%01100000 ; 0x40 @
    db %00000110,%10011001,%11111001,%10010000 ; 0x41 A
    db %00001110,%10011110,%10011001,%11100000 ; 0x42 B
    db %00000110,%10011000,%10001001,%01100000 ; 0x43 C
    db %00001110,%10011001,%10011001,%11100000 ; 0x44 D
    db %00001111,%10001110,%10001000,%11110000 ; 0x45 E
    db %00001111,%10001110,%10001000,%10000000 ; 0x46 F
    db %00000110,%10011000,%10111001,%01110000 ; 0x47 G
    db %00001001,%10011111,%10011001,%10010000 ; 0x48 H
    db %00000111,%00100010,%00100010,%01110000 ; 0x49 I
    db %00000111,%00010001,%00011001,%01100000 ; 0x4A J
    db %00001001,%10101100,%10101001,%10010000 ; 0x4B K
    db %00001000,%10001000,%10001000,%11110000 ; 0x4C L
    db %00001001,%11111001,%10011001,%10010000 ; 0x4D M
    db %00001001,%11011011,%10011001,%10010000 ; 0x4E N
    db %00000110,%10011001,%10011001,%01100000 ; 0x4F O
   
    db %00001110,%10011001,%11101000,%10000000 ; 0x50 P
    db %00000110,%10011001,%10011010,%01010000 ; 0x51 Q
    db %00001110,%10011001,%11101001,%10010000 ; 0x52 R
    db %00000111,%10000110,%00010001,%11100000 ; 0x53 S
    db %00001111,%00100010,%00100010,%00100000 ; 0x54 T
    db %00001001,%10011001,%10011001,%01100000 ; 0x55 U
    db %00001001,%10011001,%10010101,%00100000 ; 0x56 V
    db %00001001,%10011001,%10011111,%10010000 ; 0x57 W
    db %00001001,%10010110,%10011001,%10010000 ; 0x58 X
    db %00001001,%10010101,%00100010,%00100000 ; 0x59 Y
    db %00001111,%00010010,%01001000,%11110000 ; 0x5A Z
    db %00000111,%01000100,%01000100,%01110000 ; 0x5B [
    db %00000000,%10000100,%00100001,%00000000 ; 0x5C \
    db %00001110,%00100010,%00100010,%11100000 ; 0x5D ]
    db %00000010,%01010000,%00000000,%00000000 ; 0x5E ^
    db %00000000,%00000000,%00000000,%11110000 ; 0x5F _
   
    db %00000011,%01001110,%01000100,%11110000 ; 0x60 ` GBP
    db %00000000,%01100001,%01111001,%01110000 ; 0x61 a
    db %00001000,%11101001,%10011001,%11100000 ; 0x62 b
    db %00000000,%01101001,%10001001,%01100000 ; 0x63 c
    db %00000001,%01111001,%10011001,%01110000 ; 0x64 d
    db %00000000,%01101001,%11111000,%01110000 ; 0x65 e
    db %00110100,%11100100,%01000100,%01000000 ; 0x66 f
    db %00000000,%01111001,%10010111,%00010110 ; 0x67 g
    db %00001000,%11101001,%10011001,%10010000 ; 0x68 h
    db %00100000,%01100010,%00100010,%01110000 ; 0x69 i
    db %00010000,%00110001,%00010001,%10010110 ; 0x6A j
    db %00001000,%10011010,%11001010,%10010000 ; 0x6B k
    db %00001100,%01000100,%01000100,%11100000 ; 0x6C l
    db %00000000,%11001011,%10111011,%10010000 ; 0x6D m
    db %00000000,%10101101,%10011001,%10010000 ; 0x6E n
    db %00000000,%01101001,%10011001,%01100000 ; 0x6F o
   
    db %00000000,%11101001,%10011001,%11101000 ; 0x70 p
    db %00000000,%01111001,%10011001,%01110001 ; 0x71 q
    db %00000000,%10101101,%10001000,%10000000 ; 0x72 r
    db %00000000,%01111000,%01100001,%11100000 ; 0x73 s
    db %00000100,%11100100,%01000100,%00110000 ; 0x74 t
    db %00000000,%10011001,%10011001,%01100000 ; 0x75 u
    db %00000000,%10011001,%10010101,%00100000 ; 0x76 v
    db %00000000,%10011001,%10011111,%10010000 ; 0x77 w
    db %00000000,%10011001,%01101001,%10010000 ; 0x78 x
    db %00000000,%10011001,%10010111,%00010110 ; 0x79 y
    db %00000000,%11110010,%01001000,%11110000 ; 0x7A z
    db %00010010,%00100100,%00100010,%00010000 ; 0x7B
    db %01000100,%01000100,%01000100,%01000000 ; 0x7C |
    db %10000100,%01000010,%01000100,%10000000 ; 0x7D
    db %00000101,%10100000,%00000000,%00000000 ; 0x7E ~
    db %00000110,%10011011,%10111001,%01100000 ; 0x7F (c)

STRING_SECTION:
string102:
    db ZX_AT,12,5,"Hello,",ZX_INVERSE,1," Speccy!", ZX_INVERSE, 0,ZX_EOL,    "dalsi radek na ",ZX_PAPER, ZX_YELLOW, "zlute...",    ZX_AT,0,0,"pocatek", ZX_INK, ZX_BLUE," modrou!", ZX_EOL,    " !",0x22,0x23,"$%&'()*+,-./0123456789:;<=>?", ZX_EOL,    "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[",0x5C,"]^_", ZX_EOL,    "`abcdefghijklmnopqrstuvwxyz{|}~",0x7F, ZX_EOL,    "abc",ZX_TAB,5,"x",ZX_TAB,6,"y",ZX_TAB,MAX_X+6,"Nuclear war...",ZX_TAB,10,"sin(PI*2.7849)*23+(536+123)*2^7", ZX_EOL,    ZX_TAB,30,"Test zalomeni pres tretiny...",    ZX_AT,20,12,"AT(20,12) ",ZX_BRIGHT,1,"BRIGHT ",ZX_BRIGHT,0,    ZX_AT,21,12,"AT(21,12) ",ZX_FLASH, 1,"FLASH ", ZX_FLASH, 0,"en","d" + 0x80
size102              EQU $ - string102
string101:
    db "Konec...",0x0D + 0x80
size101              EQU $ - string101

PS: Asi si dam trochu pauzu, nez budu zjistovat jestli dokazi vytisknout realne cislo pomoci ROMky v tom fontu. Je toho fakt nejak moc najednou. Prilis vysoke schody na me. Tak na zebrik...


Přílohy:
scroll_4.png
scroll_4.png [ 3.26 KiB | Zobrazeno 975 krát ]
scroll_0.png
scroll_0.png [ 1.35 KiB | Zobrazeno 975 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: 21.03.2023, 21:36 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Zajimalo by me jestli nekdo odmazal treti obrazek, nebo jsem udelal chybu ja, kdyz jsem je menil, protoze je tu limit jen na 3.
Vypadal podobne...

vlastne ho mohu nahrat znovu, lol.

Jen ze ma asi 3.3kb takze i me prispevky maji kolikrat vice, takze setreni mistem neni moc silny argument.

Je to konecny screen jak to vypada co probehnou i vsechny basic prikazy.

PS: Pisi hlavne proto ze se me podarilo vylepsit zpusob jakym nutim ROMku detekovat zda prechod na dalsi radek vyvola SCROLL nebo ne. Staci uz me jen jedno volani. Zadne nastaveni OVER na 1 a pak mezera. Staci jediny znak. CURSOR_RIGHT!!! 0x09.
Kvuli tomu ze je to v ROMce funkcni jako CURSOR_LEFT to musim upravit i u sebe, aby me to netisklo otaznik ale pohlo kurzorem.


Přílohy:
scroll_5.png
scroll_5.png [ 3.31 KiB | Zobrazeno 912 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: 22.03.2023, 03:29 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
V clanku na rootu jsem si prochazel odkazy a jeden odkazoval na Boriel Basic. Uz jsem na to narazil, ale netusil jsem, ze je to PREKLADAC a ne nejaka nahradni ROMka.

Hned jsem to vyzkousel jak si to stoji s M4 Forthem a Ceckem ZCC a je to fakt dost dobry.

1. Zadny problem s instalaci, zadnych milion souboru a chyba pri kompilaci jako cecko (vyreseno ze je to ted ve flat..v necem zabalene, ani nevim). Je to python, takze jen skopirujete adresar.

2. Zadny problem pri kompilaci meho souboru, na prvni pokus vse fungovalo. Hned co jsem zjistil ze potrebuji napsat nejaky parametr. .)

../zxbc.py -A xxx.bas
vytvori xxx.asm
../zxbc.py -taB xxx.bas
vytvori xxx.tap

3. Je to 3x rychlejsi jak cecko! Aspon v tom jedinem testu co jsem delal. .)))

Kód:
System                          Forth / C                 Benchmark     Time (sec/round)
ZX Spectrum Fuse 1.5.1 Ubuntu   M4_FORTH                  Fib2          0m6.39s   
ZX Spectrum Fuse 1.5.1 Ubuntu   M4_FORTH use data stack   Fib2s         0m5.23s   
ZX Spectrum Fuse 1.5.1 Ubuntu   M4_FORTH use assembler    Fib2a         0m2.55s   
ZX Spectrum Fuse 1.6.0 Ubuntu   Boriel Basic zxbc 1.16.4  Fib2 a = a+c  0m14.38s   
ZX Spectrum Fuse 1.5.1 Ubuntu   zcc z88dk v16209          Fib2 a = a+c  0m49.19s   
ZX Spectrum Fuse 1.5.1 Ubuntu   zcc z88dk v16209          Fib2 a+= c    0m43.97s


Kód:
DIM m as Uinteger
DIM n as Uinteger
DIM i as Uinteger
DIM a as Uinteger
DIM b as Uinteger
DIM c as Uinteger


GOSUB fib2_bench
END
   
fib2:
    LET a=0
    LET b=1
    FOR i = 1 TO n
        LET c = b
        LET b = a
        LET a = a + c
    NEXT i
RETURN

fib2_bench:
FOR m = 0 to 999
    FOR n = 0 to 19
        GOSUB fib2
    NEXT n
NEXT m
RETURN


V kodu udelal v podstate co jsem mu presne rekl, jen to hodil vsechno do pameti.
Kód:
   org 32768
.core.__START_PROGRAM:
   di
   push ix
   push iy
   exx
   push hl
   exx
   ld hl, 0
   add hl, sp
   ld (.core.__CALL_BACK__), hl
   ei
   jp .core.__MAIN_PROGRAM__
.core.__CALL_BACK__:
   DEFW 0
.core.ZXBASIC_USER_DATA:
   ; Defines USER DATA Length in bytes
.core.ZXBASIC_USER_DATA_LEN EQU .core.ZXBASIC_USER_DATA_END - .core.ZXBASIC_USER_DATA
   .core.__LABEL__.ZXBASIC_USER_DATA_LEN EQU .core.ZXBASIC_USER_DATA_LEN
   .core.__LABEL__.ZXBASIC_USER_DATA EQU .core.ZXBASIC_USER_DATA
_m:
   DEFB 00, 00
_n:
   DEFB 00, 00
_i:
   DEFB 00, 00
_a:
   DEFB 00, 00
_b:
   DEFB 00, 00
_c:
   DEFB 00, 00
.core.ZXBASIC_USER_DATA_END:
.core.__MAIN_PROGRAM__:
   call .LABEL._fib2_bench
   ld hl, 0
   ld b, h
   ld c, l
.core.__END_PROGRAM:
   di
   ld hl, (.core.__CALL_BACK__)
   ld sp, hl
   exx
   pop hl
   pop iy
   pop ix
   exx
   ei
   ret
.LABEL._fib2:
   ld hl, 0
   ld (_a), hl
   ld hl, 1
   ld (_b), hl
   ld hl, 1
   ld (_i), hl
   jp .LABEL.__LABEL0
.LABEL.__LABEL3:
   ld hl, (_b)
   ld (_c), hl
   ld hl, (_a)
   ld (_b), hl
   ld de, (_a)
   ld hl, (_c)
   add hl, de
   ld (_a), hl
   ld hl, (_i)
   inc hl
   ld (_i), hl
.LABEL.__LABEL0:
   ld hl, (_n)
   ld de, (_i)
   or a
   sbc hl, de
   jp nc, .LABEL.__LABEL3
   ret
.LABEL._fib2_bench:
   ld hl, 0
   ld (_m), hl
   jp .LABEL.__LABEL5
.LABEL.__LABEL8:
   ld hl, 0
   ld (_n), hl
   jp .LABEL.__LABEL10
.LABEL.__LABEL13:
   call .LABEL._fib2
   ld hl, (_n)
   inc hl
   ld (_n), hl
.LABEL.__LABEL10:
   ld hl, 19
   ld de, (_n)
   or a
   sbc hl, de
   jp nc, .LABEL.__LABEL13
   ld hl, (_m)
   inc hl
   ld (_m), hl
.LABEL.__LABEL5:
   ld hl, 999
   ld de, (_m)
   or a
   sbc hl, de
   jp nc, .LABEL.__LABEL8
   ret
   ;; --- end of user code ---

   END

_________________
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.03.2023, 21:58 
Offline
Pan Štábní

Registrován: 23.06.2013, 23:49
Příspěvky: 1100
Has thanked: 100 times
Been thanked: 157 times
Tak jsem to s tou chvalou trosku prehnal, uz u druheho testu jsem musel zkoumat kod...
tapku to vytvori bez problemu, ale ten zdrojak nejde zkompilovat protoze to vytvari radky typu

#line 123 ....

ktere staci jen odmazat

Pak to u nekterych pomocnych fci jako je binarni or vlozilo subrutinu, ale odkazovalo se na ni jako na

.core.__BOR16

ale label se jmenoval jen

__BOR16:

jeste to obalilo radky s push a pop, ktere ale staci jen smazat. Jen to trosku boli to zjistit, musel jsem to debugovat z binarky. Ta ma totiz nejaky sum pred adresou 0x8000, ale je to fakt jen nejake smeti.
Kód:
    push namespace core
__BOR16:
   ...
    pop namespace



Kód:
|       Name        |                  System                   |          Forth / C        | Benchmark | Time (sec/round) | Scale |
| :---------------: | :---------------------------------------: | :-----------------------: | :-------: | :--------------- | :---: |
| Dw0rkin           | ZX Spectrum Fuse 1.5.1 Ubuntu             | M4_FORTH                  |   GCD2    | 4.53s
| Dw0rkin           | ZX Spectrum Fuse 1.5.1 Ubuntu             | M4_FORTH                  |   GCD2 ui | 4.08s
| Dw0rkin           | ZX Spectrum Fuse 1.6.0 Ubuntu             | Boriel Basic zxbc 1.16.4  |   GCD2    | 12.52s
| Dw0rkin           | ZX Spectrum Fuse 1.6.0 Ubuntu             | Boriel Basic zxbc 1.16.4  |   GCD2 ui | 10.36s
| Dw0rkin           | ZX Spectrum Fuse 1.5.1 Ubuntu             | zcc z88dk v16209          |   GCD2    | 35.31s
| Ben               | IBM PS/2 L40SX                            | DX-Forth                  |   GCD2    | 42s              | 10x
| Stefan Niestegge  | Atari Falcon 68060                        | f68kans                   |   GCD2    | 0,067s           |
| Johan Kotlinski   | C64                                       | DurexForth 1.6.1 (STC)    |   GCD2    | 70s              | 1x
| Carsten Strotmann | A-ONE (Apple 1 Clone) mit 65C02           | TaliForth 2 (STC)         |   GCD2    | 1m25s            | 1x
| Thomas Woinke     | Steckschwein 8MHz 65c02                   | TaliForth 2 (STC)         |   GCD2    | 11.75s           | 1x
| Enrico/Dirk       | Robotron A 7150 i8086/8087 Multibus ~5Mhz | VolksForth MS-DOS (ITC)   |   GCD2    | 30               |
| Andreas Boehm     | Commodore C64 6510                        | Audiogenic Forth-64       |   GCD2    | 84.84            |


Kód:
DIM m as integer
DIM n as integer
DIM a as integer
DIM b as integer

GOSUB gcd2_bench
END
   
gcd2:
    LET a=m
    LET b=n
   
    IF (a bOR b )=0 THEN
        LET a=1
        RETURN
    END IF
    IF a=0 THEN
        LET a=b
        RETURN
    END IF
    IF b=0 THEN
        RETURN
    END IF
   
    WHILE a <> b
        IF (a>b) THEN
            LET a = a - b
        ELSE
            LET b = b - a
        END IF
    END WHILE
RETURN

gcd2_bench:
FOR m = 0 to 99
    FOR n = 0 to 99
        GOSUB gcd2
    NEXT n
NEXT m
RETURN


Kód:
   org 32768
.core.__START_PROGRAM:
   di
   push ix
   push iy
   exx
   push hl
   exx
   ld hl, 0
   add hl, sp
   ld (.core.__CALL_BACK__), hl
   ei
   jp .core.__MAIN_PROGRAM__
.core.__CALL_BACK__:
   DEFW 0
.core.ZXBASIC_USER_DATA:
   ; Defines USER DATA Length in bytes
.core.ZXBASIC_USER_DATA_LEN EQU .core.ZXBASIC_USER_DATA_END - .core.ZXBASIC_USER_DATA
   .core.__LABEL__.ZXBASIC_USER_DATA_LEN EQU .core.ZXBASIC_USER_DATA_LEN
   .core.__LABEL__.ZXBASIC_USER_DATA EQU .core.ZXBASIC_USER_DATA
_m:
   DEFB 00, 00
_n:
   DEFB 00, 00
_a:
   DEFB 00, 00
_b:
   DEFB 00, 00
.core.ZXBASIC_USER_DATA_END:
.core.__MAIN_PROGRAM__:
   call .LABEL._gcd2_bench
   ld hl, 0
   ld b, h
   ld c, l
.core.__END_PROGRAM:
   di
   ld hl, (.core.__CALL_BACK__)
   ld sp, hl
   exx
   pop hl
   pop iy
   pop ix
   exx
   ei
   ret
.LABEL._gcd2:
   ld hl, (_m)
   ld (_a), hl
   ld hl, (_n)
   ld (_b), hl
   ld de, (_b)
   ld hl, (_a)
   call .core.__BOR16
   ld de, 0
   call .core.__EQ16
   or a
   jp z, .LABEL.__LABEL1
   ld hl, 1
   ld (_a), hl
   ret
.LABEL.__LABEL1:
   ld de, 0
   ld hl, (_a)
   call .core.__EQ16
   or a
   jp z, .LABEL.__LABEL3
   ld hl, (_b)
   ld (_a), hl
   ret
.LABEL.__LABEL3:
   ld de, 0
   ld hl, (_b)
   call .core.__EQ16
   or a
   jp z, .LABEL.__LABEL6
   ret
.LABEL.__LABEL6:
   ld de, (_b)
   ld hl, (_a)
   or a
   sbc hl, de
   ld a, h
   or l
   jp z, .LABEL.__LABEL7
   ld hl, (_b)
   ld de, (_a)
   call .core.__LTI16
   or a
   jp z, .LABEL.__LABEL8
   ld hl, (_a)
   ld de, (_b)
   or a
   sbc hl, de
   ld (_a), hl
   jp .LABEL.__LABEL9
.LABEL.__LABEL8:
   ld hl, (_b)
   ld de, (_a)
   or a
   sbc hl, de
   ld (_b), hl
.LABEL.__LABEL9:
   jp .LABEL.__LABEL6
.LABEL.__LABEL7:
   ret
.LABEL._gcd2_bench:
   ld hl, 0
   ld (_m), hl
   jp .LABEL.__LABEL10
.LABEL.__LABEL13:
   ld hl, 0
   ld (_n), hl
   jp .LABEL.__LABEL15
.LABEL.__LABEL18:
   call .LABEL._gcd2
   ld hl, (_n)
   inc hl
   ld (_n), hl
.LABEL.__LABEL15:
   ld hl, 99
   ld de, (_n)
   call .core.__LTI16
   or a
   jp z, .LABEL.__LABEL18
   ld hl, (_m)
   inc hl
   ld (_m), hl
.LABEL.__LABEL10:
   ld hl, 99
   ld de, (_m)
   call .core.__LTI16
   or a
   jp z, .LABEL.__LABEL13
   ret
   ;; --- end of user code ---
; vim:ts=4:et:
   ; FASTCALL bitwise or 16 version.
   ; result in HL
; __FASTCALL__ version (operands: A, H)
   ; Performs 16bit or 16bit and returns the boolean
; Input: HL, DE
; Output: HL <- HL OR DE

.core.__BOR16:
       ld a, h
       or d
       ld h, a

       ld a, l
       or e
       ld l, a

       ret

.core.__EQ16:   ; Test if 16bit values HL == DE
    ; Returns result in A: 0 = False, FF = True
       xor a   ; Reset carry flag
       sbc hl, de
       ret nz
       inc a
       ret

  if 0
__LEI8: ; Signed <= comparison for 8bit int
       ; A <= H (registers)
       PROC
       LOCAL checkParity
       sub h
       jr nz, __LTI
       inc a
       ret

__LTI8:  ; Test 8 bit values A < H
       sub h

__LTI:   ; Generic signed comparison
       jp po, checkParity
       xor 0x80
checkParity:
       ld a, 0     ; False
       ret p
       inc a       ; True
       ret
       ENDP
  endif

.core.__LTI16: ; Test 8 bit values HL < DE
    ; Returns result in A: 0 = False, !0 = True
       PROC
       LOCAL checkParity
       or a
       sbc hl, de
       jp po, checkParity
       ld a, h
       xor 0x80
checkParity:
       ld a, 0     ; False
       ret p
       inc a       ; True
       ret
       ENDP


   END

PS: Jeste jsem teda zakomentoval pres if 0 nejakou cast kodu co nepouziva, ale pridal si ji tam.
PPS: Vytvoril jsem 2 verze, jedna jak vyzaduje test a druha s u16, tam je snazsi <.
PPPS: Nebyl to tak uplne ztraceny cas, protoze jsem u toho rozsekal slepene slova z puvodniho gdc.m4 a opravil chybejici pravidla v tokenech, aby si to spojil sam,

_________________
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.03.2023, 02:14 
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 tokenova pravidla pro specialni varianty pri DUP ADD PUSH(x) ADD/SUB
Kód:
    add  HL, HL         ; 1:11      dup +
    ld   BC, 0x0007     ; 3:10      7 +   ( x -- x+0x0007 )
    add  HL, BC         ; 1:11      7 +
; seconds: 1           ;[ 5:32]

Pokud se pricita jen 1 tak staci pouhe "inc HL ; 1:6" a to funguje efektivneji az do hodnoty 3. Obdobne pro odcitani.

Tady ale funguje trik s tim ze se to prvne zdvoji. Takze pokud pricitam 2 tak misto dvojiho "inc HL" staci jedno pred zdvojenim.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(1) ADD'
    add  HL, HL         ; 1:11      dup +
    inc  HL             ; 1:6       1 +   ( x -- x+0x0001 )
; seconds: 1           ;[ 2:17]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(2) ADD'
    inc  HL             ; 1:6       dup + 2 +
    add  HL, HL         ; 1:11      dup + 2 +
; seconds: 0           ;[ 2:17]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(3) ADD'
    inc  HL             ; 1:6       dup + 3 +
    add  HL, HL         ; 1:11      dup + 3 +
    inc  HL             ; 1:6       dup + 3 +
; seconds: 0           ;[ 3:23]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(4) ADD'
    inc  HL             ; 1:6       dup + 4 +   ( x -- x+0x0002 )
    inc  HL             ; 1:6       dup + 4 +
    add  HL, HL         ; 1:11      dup + 4 +
; seconds: 0           ;[ 3:23]

Pro tu trojku jsem musel vytvorit nove spojene slovo, protoze na vstupu mam 2 tokeny

__DUP_ADD
__PUSH_ADD(3)

a vystup ma byt

__PUSH_ADD(2)
__DUP_ADD
__1ADD

A ja to uz resim v tom poslednim kroku, protoze v prvnim se resi i ruzne kombinace "-1 +2 -1 +2 -1" ze je pouze "+1" .

A musim mit stejny pocet tokenu jak na vstupu tak na vystupu. Takze mam novy token/slovo __DUP_ADD_2ADD (coz jsou ty prvni 2 nove tokeny vlastne)

PS: Obdobne pro odcitani.
PPS: Tak jsem ten novy token zmenil na __DUP_ADD_1ADD, protoze se da pouzit i pro pricitani 5. Tenhle trik funguje az do +6, od 7 uz je efektivnejsi to co jsem ukazal na zacatku.
Kód:
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(5) ADD'
    inc  HL             ; 1:6       dup + 5 +   ( x -- x+0x0002 )
    inc  HL             ; 1:6       dup + 5 +
    add  HL, HL         ; 1:11      dup + 5 +
    inc  HL             ; 1:6       dup + 5 +
; seconds: 0           ;[ 4:29]
dworkin@dw-A15:~/Programovani/ZX/Forth/Benchmark$ ../check_word.sh 'DUP ADD PUSH(6) ADD'
    inc  HL             ; 1:6       dup + 6 +   ( x -- x+0x0003 )
    inc  HL             ; 1:6       dup + 6 +
    inc  HL             ; 1:6       dup + 6 +
    add  HL, HL         ; 1:11      dup + 6 +
; seconds: 1           ;[ 4:29]

_________________
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 ... 25, 26, 27, 28, 29, 30, 31 ... 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