; kalibrace 60 znaků ; 2345678901234567890123456789012345678901234567890123456789 ; ******************************* ; *** *** ; *** PMD-85 BASIC G/V2.A *** ; *** *** ; ******************************* ; 1) Tato verze velmi často modifikuje svůj kód, proto se ; nehodí k implemetaci do ROM. ; 2) Značení funkcí BIOSu a proměnných ve standardním ; zápisníku ve videoram respektuje symbolická jména ; zavedená Libovickým & Olmerem v jejich komentovaném ; výpisu Monitoru PMD-85-2 (s výjimkou procedury "byte" ; na adrese 8b6ch, která s ohledem na klíčová slova ; překladače byla přejmenována na "ldbyte"). ; 3) Po prvním spuštění BASICu se přesměruje bufer pro ulo- ; žení textu z dialogového řádku po stisku EOL z adresy ; 7F82h na adresu BE07h, kde zůstane i po přechodu ; do Monitoru. Některé procedury ovšem využívají ; i původní adresu buferu o hodnotě 7F82h. ; 4) U příkazu ROM je (zřejmě chybně) nastavena délka přeno- ; su bloku o 256 bajtů delší než je ve skutečnosti, ; protože u verze 1 se to takto dělalo. BIOS verze 2/2A ; si sám tuto hodnotu zvětší o těch potřebných 256 bajtů, ; takže je to uděláno 2x a namísto 1kB se z ROMPACKu ; přenáší 1,25kB dat. ; 5) Tato verze vykazuje silnou podobnost s verzí Nascom ; BASIC 4.7 s délkou 8k. ; 6) Grafické příkazy využívají proměnné @0..@7, @X a @Y. ; Bližší informace v sekci grafických příkazů. ; 7) Při načítání řetězcových polí příkazem DLOAD se chybně ; testuje překročení dostupné paměti. Je použita konstan- ; ta 5Fh, která u verze 2.0 určovala podkročení adresy ; 6000h, vymezené pro řetězcová pole, Pro verzi 2A by ; tato konstanta měla mít hodnotu 90h (adresa procedury ; 1F74h) ; 8) Chybný průběh funkce RND se záporným argumentem. ; (Přepíše koeficienty mocninné řady pro výpočet ; funkce EXP.) ; ********************************************* ; konstanty a proměnné v dolních 32k paměti RAM ; mimo vlastní kód BASIC interpreteru ; ********************************************* romarea .equ 7000h ; oblast programů pro příkaz ROM usrexec .equ 7f00h ; oblast uživatelských programů edibuff .equ 7f82h ; ukazatel na text, vytvořený ; v řádkovém editoru BIOSu ; (podprogramem ENTER) ; ************************ ; vazba na procedury BIOSu ; ************************ hex .equ 80e0h ; konverze ASCII > 4 bity pairin .equ 80f7h ; konverze 2xASCII > bajt clr .equ 8113h ; inicializace editačního buferu prevo2 .equ 813bh ; převod čísla na hexadecimální inklav .equ 84a1h ; vstup ASCII znaku z klávesnice adras .equ 84ceh ; výpočet adresy znaku dle čísla prtout .equ 8500h ; tisk znaku na obrazovku inb .equ 85f6h ; načtení bajtu ze sériové linky edit .equ 8800h ; výkonná rutina kláves wrbuf .equ 8855h ; vypíše obsah editačního řádku beep .equ 88a3h ; generování tónu mgfhead .equ 8a7ah ; MGF modifikační procedura i82531 .equ 8b41h ; nastavení 8251 a 8253 ldbyte .equ 8b6ch ; načtení bajtu z MGF enter2 .equ 8bf4h ; nestandardní volání ENTER transfer .equ 8c00h ; program pro přenos z ROMPACKu point .equ 8c7dh ; vykreslení pixelu pospoint .equ 8c94h ; výpočet adresy a bitové masky inpol .equ 8cd0h ; interpolátor BIOSu usartout .equ 8d7eh ; výstup znaku po sériové lince shead .equ 8de2h ; vyhledání a načtení souboru prbtxt .equ 8e43h ; zobrazí edit. bufer v dial. řádku save .equ 8ea1h ; načte a uloží jméno souboru na MGF save2 .equ 8eadh ; výkonná část BIOSovské funkce SAVE ; ************************************** ; proměnné v rozšířené paměti 64kB verze ; ************************************** colpos .equ 0be01h ; 1b aktuální sloupec na obrazovce ctrlflg .equ 0be03h ; 1b pozůstatek z jiné verze crntln .equ 0be04h ; 2b číslo aktuálního řádku c_odloz .equ 0be07h ; 80b textový bufer pro editaci ; (přepisuje následující ; proměnné, což ovšem v daném ; režimu asi nevadí) dimreq .equ 0be52h ; 1b NONZERO => požadavek na vytvo- ; ření (neexistující) proměnné vartype .equ 0be53h ; 1b 00h=číslo/01h=řetězec quote .equ 0be54h ; 1b příznak uvozovkového režimu Xbe55 .equ 0be55h ; 2b spolu s be57 jedna proměnná laststg .equ 0be57h ; 2b ukazatel na hlavičku řetězcové ; proměnné v bloku proměnných ; !!! tmpstrg .equ 0be59h ; 4b pomocná řetězcová proměnná failln .equ 0be5dh ; 2b číslo chybového řádku onerrln .equ 0be61h ; 2b číslo řádku ON ERR GOTO tmpvar .equ 0be65h ; 4b pomocná řetězcová proměnná strlast .equ 0be69h ; 2b ukazatel na volné místo pod ; posledním textem řetězců fncadr .equ 0be6bh ; 2b adresa nadřazeného operátoru ; v zápisu zdrojového kódu dataln .equ 0be6dh ; 2b číslo aktuálního řádku DATA indxen .equ 0be6fh ; 1b 01h..80h => nelze použít inde- ; xovanou proměnnou ovrbuf .equ 0be70h ; 1b příznak porušení dialog. řádku inptype .equ 0be71h ; 1b 00h=INPUT/NONZERO=READ crntadr .equ 0be72h ; 2b ukazatel do zdrojového kódu ; programu v BASICu eofxpr .equ 0be74h ; 2b ukazatel na konec výrazu stopln .equ 0be76h ; 2b číslo přerušeného řádku ; (tlačítkem STOP, nebo příkazy) stopadr .equ 0be78h ; 2b adresa místa přerušení ; (tlačítkem STOP, nebo příkazy) ; 0000h => nelze zadat CONT varbase .equ 0be7ah ; 2b začátek oblasti proměnných arrbase .equ 0be7ch ; 2b začátek oblasti polí arrend .equ 0be7eh ; 2b konec oblasti polí dataadr .equ 0be80h ; 2b adresa aktuální položky DATA fpaccum .equ 0be82h ; 5b FP akumulátor (4b) + rozšíření fpprtbf .equ 0be87h ; 12b textový bufer FP čísla ; 1b nevyužito nebo rezerva na NULL nulstrg .equ 0be94h ; bufer pro nulový řetězec? ; ******************************************************* ; proměnné ve standardním zápisníku "napravo" od videoram ; ******************************************************* buf .equ 0c030h ; 2b začátek editačního buferu color .equ 0c03ah ; 1b atribut barvy cursor .equ 0c03eh ; 2b adresa pro tisk znaků curch .equ 0c072h ; 2b ukaz. do edit. buferu při čtení mess .equ 0c074h ; 2b adresa systémového hlášení odloz .equ 0c078h ; 2b adresa textu po editaci řádku ram .equ 0c0f0h ; 4b návratový vektor u MGF operací kdir .equ 0c132h ; 2b tabulka vektorů řídicích kláves ascii .equ 0c134h ; 1b znak načtení z klávesnice lstr .equ 0c13ch ; 2b délka textu v zadaném řádku x1 .equ 0c170h ; 2b X-souřadnice počátečního bodu y1 .equ 0c172h ; 1b Y-souřadnice počátečního bodu x2 .equ 0c173h ; 1b X-souřadnice koncového bodu y2 .equ 0c174h ; 1b Y-souřadnice koncového bodu bcur .equ 0c17ah ; 2b ukaz. pro BMOVE/BPLOT findnr .equ 0c1b0h ; 1b číslo požadovaného MGF souboru findtp .equ 0c1b1h ; 1b typ požadovaného MGF souboru numfil .equ 0c1b2h ; 1b číslo souboru u MGF operací typfil .equ 0c1b3h ; 1b typ souboru u MGF operací adrfil .equ 0c1b4h ; 2b začátek souboru u MGF operací lenfil .equ 0c1b6h ; 2b délka MGF souboru, zmenšená o 1 namfil .equ 0c1b8h ; 8b jméno MGF souboru ochr .equ 0c1f1h ; 1b příznak chráněného souboru 2Ah vystup .equ 0c1f4h ; 10b rutina pixelových operací arrlen .equ 0c330h ; 2b délka pole proměnných imsptr .equ 0c334h ; 2b ukazatel do imsbuf imsbuf .equ 0c33ah ; 6b bufer hlavičky protokolu IMS-2 Xc370 .equ 0c370h ; arradr .equ 0c374h ; 2b adresa začátku pole proměnných Xc377 .equ 0c377h ; autonr .equ 0c37ch ; 2b počáteční hodnota řádku AUTO autosp .equ 0c37eh ; 1b hodnota kroku u příkazu AUTO autofl .equ 0c37fh ; 1b 0 = aktivní režim AUTO ; ****************************** ; Zde začíná PMD-85 BASIC G/V2.A ; ****************************** .org 0 ; ******************************* ; RST0 - inicializace interpretru ; ******************************* ; (0000h) init: lxi h,edibuff ; Výstup znaků půjde mvi a,0fh ; do editačního buferu. jmp init2 ; ******************************************************* ; RST 1 - test znaku na adrese (HL) na hodnotu za RST 1 ; - není-li shoda, přejde na chybu 09h - Syntax err ; ******************************************************* ; (0008h) X0008: mov a,m ; Načíst znak, který je v pořadí xthl ; a porovnat se znakem, který cmp m ; následuje za volací instrukcí ; RST 1 inx h ; posun na další znak xthl jnz err_09 ; v případě neshody vyvolat ; chybu 09h - Syntax err ; **************************************** ; RST 2 - test na cifru 0-9 na adrese (HL) ; - přeskakuje mezery ; - je-li platná cifra, nastaví CY=1 ; **************************************** ; (0010h) X0010: inx h ; nejprve posun na další znak mov a,m ; a jeho test cpi 3ah ; na horní rozsah cifer rnc ; je-li větší => konec jmp X04d6 ; další testy ; **************************************************** ; RST 3 - porovná HL vůči DE ; - příznaky Z a CY nastavuje jako instrukce CMP ; **************************************************** ; (0018h) X0018: mov a,h ; Nejprve porovnat vyšší bajty sub d ; (tedy H versus D) rnz mov a,l ; a v případě shody i nižší bajty sub e ; (tedy L versus E) ret ; ******************************* ; vektor na porovnání dvou hodnot ; ******************************* X001e: .dw 0a36h ; ************************************************ ; RST 4 - zkratka pro načtení 8-bitového argumentu ; ************************************************ ; (0020h) X0020: jmp X1627 ; jen odskok na vlastní rutinu ; ************************** ; universální textový výstup ; ************************** ; (0023h) cout: jmp prtout ; modifikací adresy se volí ovladače ; pro výstup znaku ; ******** ; proměnné ; ******** X0026: .db 0 ; kód chyby pro ON ERR GOTO X0027: .db 1 ; parametr příkazu NULL +1 ; ********************************************** ; RST 5 - dle hodnoty v reg. E zobrazí kód chyby ; ********************************************** ; (0028h) X0028: pop psw ; zrušit návratovou adresu jmp 0108h ; a skok na vlastní chybové hlášení ; ******** ; proměnné ; ******** X002c: .dw edibuff ; ukazatel (kurzor) pro "tisk" ; do buferu ; (002eh) maxcol: .db 30h ; počet znaků na řádek při tisku ; (příkaz LLIST si tuto proměnnou ; modifikuje na 80 ale pak vrací ; původní hodnotu) tuto proměnnou ; lze modifikovat pouze příkazem ; POKE, není na to příkaz X002fh: .db 00h ; nevyužitý bajt ; ********************************************** ; RST6 - Test stavu FP akumulátoru ; v reg. A vrací hodnou -1/0/+1 dle konvence SGN ; ********************************************** ; (0030h) X0030: lda fpaccum+3 ; Test exponentu FP akumulátoru ana a ; a při nenulové hodnotě provést jnz X10d0 ; další testy ret ; jinak nastavit A = CY = Z = 0 ; *********************** ; RST7 - obluha přerušení ; *********************** X0038: nop ; pokud bude pod BASICem používáno nop ; přerušení, hrozí porušení dat ret ; v zásobníku, neboť procedury BIOSu ; používají registr SP jako pracovní ; ********************************* ; konstanty, určující meze v paměti ; ********************************* strlim: .dw 9000h ; (003bh) "konec" textů řetězců spbase: .dw 6fffh ; (003dh) hodnota registru SP pgbase: .dw 2401h ; (003fh) začátek programu stbase: .dw 9f00h ; (0041h) "začátek" textů řetězců ; *************************** ; pomocná procedura pro BPLOT ; *************************** ; (0043h) X0043: ldax d ; jen načtení předlohy, xra m ; sloučení s pozadím funkcí XOR mov m,a ; a zápis do videoram ret ; ******************************* ; pokračování inicializace BASICu ; ******************************* ; (0047h) init2: di shld X002c ; init tiskového buferu (7f82h) shld mess ; a jeho deklarace pro BIOS lxi h,Xc370 ; vyplnit 15 bajtů od adresy C370h X0051: mvi m,0 ; vhodnými údaji dcr a inx h jnz X0051 mvi m,0ffh mvi a,10h sta Xc377 lhld spbase ; inicializace SP pro BASIC sphl lxi h,t_init ; tisk textu BASIC-G /V2.A X0066: mov a,m inx h push psw call cout pop psw ana a jnz X0066 xra a ; test na výskyt BASICovského programu lhld pgbase ; pokud je na adrese 2402h hodnota 24h dcx h ; (tedy odkaz na další řádek) pak je mov m,a ; platný program v paměti a nic se neděje ei inx h ; ale co když bude první BASICovský řádek inx h ; uměle zadán s délkou větší než 256 bajtů? mov a,m ; no, přirozenou cestou to nikdy nenastane cmp h cnz X01f4 ; v opačném případě se provede příkaz NEW call X01ff ; ale v každém případě se při restartu ; BASICu provede ekvivalent příkazu CLEAR .db 3eh ; mvi a,0c1h X0083: pop b ; ******************************************************** ; zde se program vrací po stisku klávesy STOP, po vykonání ; příkazů STOP nebo END nebo pokud dojdou řádky programu ; ******************************************************** ; (0084h) X0084: call X071e ; podmíněný CR+LF X0087: lxi h,X0324 ; do editačního buferu dialogového řádku shld cout+1 ; přesměrovat tisk lxi h,t_ok ; string „OK“ call tx2edi ; vytisknout do editačního buferu jmp X013f ; a skok do dialogové smyčky BASICu ; *********************************************** ; tabulka aritmetických operátorů, jejich priorit ; a skokových vektorů obslužných rutin ; *********************************************** ; (0096h) X0096: .db 079h ; priorita operátoru + .dw X1252 ; a jeho obslužný vektor .db 079h ; priorita operátoru - .dw X0e97 ; a jeho obslužný vektor .db 07ch ; priorita operátoru * .dw X0fc1 ; a jeho obslužný vektor .db 07ch ; priorita operátoru / .dw X101f ; a jeho obslužný vektor .db 07fh ; priorita operátoru ^ .dw X1359 ; a jeho obslužný vektor .db 050h ; priorita operátoru AND .dw f_and ; a jeho obslužný vektor .db 046h ; priorita operátoru OR .dw f_or ; a jeho obslužný vektor ; ******************** ; systémové hlášení OK ; ******************** ; (00abh) t_ok: .db "OK",0dh,0 ; ******************************************* ; test obsahu zásobníku zda obsahuje položku ; cyklu FOR/NEXT a pokud ano, test na shodu ; pracovní proměnné (dodané v DE) ; Z=1 znamená pozitivní nález ; ******************************************* ; (00afh) X00af: lxi h,4 ; ofset v rámci datové položky dad sp X00b3: mov a,m ; kód položky inx h cpi 81h ; je to struktura FOR? rnz ; není => konec testu mov c,m inx h mov b,m ; BC = adresa pracovní proměnné inx h push h mov l,c mov h,b mov a,d ora e xchg jz X00c7 ; pokud se pracovní proměnná xchg ; shoduje s tou dodanou v DE, rst 3 ; pak konec, jinak X00c7: lxi b,13 ; se zavrtat 13(+3) bajtů hlouběji pop h ; do zásobníku na potenciálně rz ; další (nadřazený) cyklus dad b ; FOR/NEXT (předčasné ukončení jmp X00b3 ; vnořeného cyklu). ; ************** ; alokace paměti ; ************** ; (00d0h) X00d0: call X00e8 ; nejprve test dostatečné paměti ; ******************************************************* ; Vytvoří místo v paměti na požadované adrese odsunutím ; horní části směrem k vyšším adresám. Kopírování provádí ; v opačném pořadí adres. ; ******************************************************* ; (00d3h) X00d3: push b ; prohodí obsahy BC a HL xthl pop b X00d6: rst 3 ; dokud nedosáhne HL hodnoty DE, mov a,m ; kopírování bloku z adresy dané HL stax b ; na adresu danou BC rz dcx b ; od vyšších adres dolů dcx h jmp X00d6 ; ***************************************** ; Test na dostatek paměti pro novou datovou ; položku v množství (2 x C) bajtů. ; ***************************************** ; (00dfh) X00df: push h ; k poslední využité adrese lhld arrend ; (využito pro indexované mvi b,0 ; proměnné) se připočte hodnota 2xC dad b ; a tento požadavek na nový dad b ; horní limit využité RAM se otestuje .db 3eh ; ***************************************** ; Test na volnou paměť v množství HL bajtů. ; ***************************************** ; (00e8h) X00e8: push h ; vypočte se, kolik místa zbude mvi a,0d4h ; mezi novým horním limitem využité sub l ; RAM a spodní položkou zásobníku mov l,a ; (včetně rezervy 44 bajtů pro jeho mvi a,0ffh ; kolísání) sbb h mov h,a dad sp pop h rc X00f4: mvi e,7 ; pokud místo nezbyde, vyvolá se rst 5 ; chyba 07h - Pg too big ; *************************************************** ; vyvolání chyby při nesmyslné položce v příkazu DATA ; *************************************************** X00f7: lhld dataln ; řádek s aktuální položkou DATA shld crntln ; se podstrčí jako aktuální ; a vyvolá se chyba 09 - Syntax err ; **************************** ; Chybové hlášení „Syntax err“ ; **************************** err_09: mvi e,09h ; (00fdh) .db 01h ; lxi b,.. ; **************************** ; Chybové hlášení „Dv by zero“ ; **************************** err_0c: mvi e,0ch ; (0100h) .db 01h ; lxi b,.. ; **************************** ; Chybové hlášení „No for stm“ ; **************************** err_05: mvi e,05h ; (0103h) .db 01h ; lxi b,.. ; **************************** ; Chybové hlášení „Arr.alloc.“ ; **************************** err_02: mvi e,02h ; (0106h) ; **************************** ; Tisk (chybového) hlášení ; Vstup: číslo hlášení v reg.E ; **************************** ; (0108h) X0108: call X0220 ; vynulovat STACK sta ctrlflg ; v této verzi nevyužitá proměnná mov a,e sta X0026 ; uložit kód chyby lhld crntln ; a číslo chybového řádku shld failln mov a,h ; v dialogovém režimu ignorovat ana l ; konstrukci ON ERR GOTO inr a jz X0136 lhld oneradr ; je definována uživatelská obsluha mov a,h ; chyb ? ora l jz X0136 ; ne => přeskočit ON ERR GOTO ; ********************************************************* ; uživatelské ošetření chyby ON ERR GOTO ; ********************************************************* ; jako číslo řádku se dosadí číslo řádku, na kterém je ; samotná konstrukce ON ERR GOTO a jako adresa pro čtení ; zdrojového textu BASICu se nastaví adresa klíčového slova ; GOTO v zápisu ON ERR GOTO ; ********************************************************* shld crntadr ; nastavit řádek s ošetřením chyby xchg lxi h,0 ; deaktivovat funkci ON ERROR GOTO shld oneradr lhld onerrln ; načíst ještě číslo řádku a od něj jmp X04a8 ; pokračovat v běhu programu ; ********************************* ; Standardní ošetření chyby výpisem ; ********************************* ; (0136h) X0136: call X071e ; podmíněný CR + LF (dokončení řádku) call X169c ; tisk chyby do dialogového řádku call X071e ; podmíněný CR + LF ; *********************************************** ; Zobrazit systémové hlášení do dialogového řádku ; *********************************************** ; (013fh) X013f: call X1e33 ; nastavit výstup textu na obrazovku ; a nadefinovat editační bufer call clr ; vymazat dialogový řádek call prbtxt ; editační bufer zobrazí v dialogového řádku .db 26h ; mvi h,0e1h ; ************************************************************** ; zde se vstupuje z příkazu LLIST, když vyberu řádek pro editaci ; a do editačního buferu dialogového řádku nakopíruji jeho obsah ; ************************************************************** ; (0149h) X0149: pop h X014a: lxi h,0ffffh ; jsem v dialogovém režimu shld crntln call X1ec0 ; pokud je aktivní AUTO, předtisknout č. řádku call i82531 ; nadefinovat režimy 8251/8253 call X0307 ; volat BIOS/ENTER (editace dialogového řádku) ; HL = začátek textového buferu po editaci sta ovrbuf ; (=0) po provedení instrukce RETURN, která ; vrátí aktivitu do dialogového režimu se bude ; pokračovat v následujících zadaných instrukcích rst 2 ; test na úvodní cifru na vloženém řádku push psw call getnum ; do reg. DE extrahovat číslo BASIC řádku push d call X023d ; provést tokenizaci klíčových slov mov b,a pop d pop psw jnc X20eb ; přímé provedení řádku bez čísla ; (deaktivovat režim AUTO) ; ***************************** ; Uložení BASIC řádku do paměti ; ***************************** ; (016bh) push d ; Řádek začíná číslem, proto push b ; bude uložen do paměti. rst 2 ana a ; přeskočit mezery a test znaku push psw call fndlin ; existuje už tento řádek? jc X017c ; ano => běž dál ; nyní víme, že řádek s tímto číslem ještě ; neexistuje pop psw ; teď obnovíme informaci, která říká, zda bylo push psw ; zadáno pouze číslo řádku (neexistujícího) jz err_0b ; ano? => chyba 0bh - Numb.nonex ana a X017c: push b ; při zadávání nového, zatím neexistujícího jnc X0191 ; řádku skočíme na jeho vložení, při mazání ; existujícího řádku pokračujeme ; ********************************************* ; vymazat vybraný BASICovský řádek (paměť ; s programem posunout směrem k nižším adresám) ; ********************************************* xchg lhld varbase ; v HL držím konec programu X0184: ldax d ; vlastní přesun bajtů stax b ; směrem k nižším adresám inx b inx d rst 3 ; dosáhl jsem konce programu? jnz X0184 ; ne => další bajt mov h,b ; v BC mám nyní nový konec programu, mov l,c ; tak jej uložím do patřičné proměnné shld varbase ; (ta určuje i začátek proměnných) ; *********************** ; zde se vloží nový řádek ; *********************** X0191: pop d ; DE = adresa, kam budu vkládat řádek pop psw ; PSW ještě pořád nese informaci o tom, ; zda jsem zadal pouze číslo řádku jz X01b8 ; a pokud ano, pak už jen přepočet ukazatelů lhld varbase xthl pop b ; alokace potřebné paměti od adresy dad b ; DE v délce BC (bylo vypočteno dříve) push h ; blok dat se kopíruje v opačném pořadí, call X00d0 ; aby se nepřepisoval sám sebou pop h shld varbase ; po vytvoření místa v paměti pro nový řádek xchg mov m,h ; do struktury nového řádku se zapíše něco, ; co sepozději stejně přepíše. zřejmě chyba pop d ; vyzvednout číslo řádku inx h inx h mov m,e ; a uložit je do 3. a 4. bajtu inx h mov m,d inx h lxi d,c_odloz ; zde se obsah nového řádku z editačního X01b0: ldax d ; buferu (po tokenizaci) nakopíruje mov m,a ; do vytvořeného prostoru v bloku programu inx h inx d ana a jnz X01b0 ; ***************************************************** ; inicializace ukazatelů proměnných ; ***************************************************** ; protože jsme zvětšili/zmenšili kód programu a hned ; za programem jsou naskládány proměnné, je dobré kvůli ; integritě dat prohlásit všechny proměnné a ukazatele ; za neexistující ; ***************************************************** ; (01b8h) X01b8: call X01ff ; CLEAR + přepočet ukazatelů inx h xchg ; ********************************************************** ; provede se zřetězení všech! řádků programu (včetně nového) ; ********************************************************** ; (01bdh) X01bd: mov h,d ; základní zřetězovací smyčka mov l,e mov a,m ; načíst první dva bajty řádku inx h ; (potenc. ukazatel na další řádek) ora m jz X014a ; byl poslední řádek => konec inx h inx h ; přeskočit zbytek hlavičky řádku inx h ; ve zdrojovém zápisu BASICu xra a X01c9: cmp m ; najedeme za poslední (tj. nulový) inx h ; bajt programového řádku jnz X01c9 xchg ; a tuto adresu uložíme do hlavičky mov m,e ; předchozího řádku inx h mov m,d jmp X01bd ; ************************************* ; hledání řádku podle jeho čísla ; vstup: DE = číslo řádku ; výstup: CY = 0 (řádek nenalezen) ; CY = 1 (adresa řádku je v BC) ; ************************************* ; (01d5h) fndlin: lhld pgbase ; začneme od začátku (programu) fndlfr: mov b,h mov c,l mov a,m ; pokud je v záhlaví řádku odkaz na inx h ; nulovou adresu (první dva bajty) ora m dcx h rz ; pak konec programu => nenalezeno inx h inx h mov a,m ; načíst číslo prohledávaného řádku inx h mov h,m mov l,a rst 3 ; shoduje se? mov h,b mov l,c mov a,m inx h mov h,m mov l,a cmc rz ; ano => konec a CY = 1 cmc rnc ; ne, navíc čísla řádků už jsou větší jmp fndlfr ; ne, pak test dalšího řádku ; ********** ; příkaz NEW ; ********** ; (01f3h) c_new: rnz ; nesmí následovat žádný parametr X01f4: lhld pgbase xra a mov m,a ; na začátek programu uložit vektor inx h ; 0000h, indikující neplatný program mov m,a inx h shld varbase ; a ukazatel na oblast proměnných ; nadeklarovat hned za neexistující ; program ; ************************************************ ; varianta příkazu CLEAR, volaná při editaci řádků ; a s tím spojeným vymazáním všech proměnných ; ************************************************ X01ff: lhld pgbase dcx h xra a ; ************ ; příkaz CLEAR ; ************ ; (0204h) c_clea: rnz ; nesmí následovat žádný parametr X0205: shld crntadr lhld stbase ; vymazat texty řetězcových shld strlast ; proměnných call datrst ; RESTORE na začátek programu lhld varbase shld arrbase ; vymazat proměnné shld arrend ; a pole lxi h,0 shld oneradr ; deaktivovat funkci ON ERR GOTO ; ******************************************* ; vynulování interních proměnných a zásobníku ; se zachováním programu a proměnných BASICu ; ******************************************* ; (0220h) X0220: pop b ; uschovat návratovou adresu do BC lhld spbase ; inicializovat ukazatel zásobníku sphl lxi h,tmpstrg ; ??? shld laststg ; ??? xra a mov l,a mov h,a shld stopadr ; znemožnit pokrač. příkazem CONT sta indxen sta v_dgrd ; obloukové míry v radiánech push h push b ; vrátit do zásobníku návratovou lhld crntadr ; adresu a obnovit ukazatel do zdro- ret ; jového kódu BASIC programu ; ***************************************** ; převod sekvence ASCII znaků na kód BASICu ; (tuto proceduru využivá i funkce VAL) ; ***************************************** ; (023dh) X023d: xra a ; na začátek vypnu uvozovkový režim a mohu sta quote ; tím pádem nahrazovat příkazy jejich kódem mvi c,5 lxi d,c_odloz ; převedený text uložím do buferu X0246: mov a,m cpi 20h ; test na mezeru jz X02d1 mov b,a cpi 22h ; test na uvozovky jz X02f1 ana a ; test na nulový bajt jz X02f8 cpi 27h ; test na apostrof jnz X026b X025b: mov a,b ; narazil jsem na apostrof, proto budu stax d ; doslova převádět znak po znaku, dokud inr c ; se bude jednat o znaky hexadecimální inx d ; abecedy inx h mov a,m mov b,a call hex ; test na hexadecimální znak jnc X025b ; pokud to je, pokračuj ve smyčce, jmp X0246 ; pokud není, běž na hlavní převaděč ; ********************************************************* ; zpracování ostatních zn. mimo SPACE, uvozovek a apostrofu ; ********************************************************* X026b: lda quote ; test uvozovkového (doslovného) režimu ana a mov a,m ; pokud je, jdu ven z této sekce a převádím jnz X02d1 ; přesně znak po znaku bez TOKENS ; v opačném případě dělám náhrady cpi 3fh ; znaku ? (otazník) mvi a,0ceh ; znakem _ (podtržítko) jz X02d1 ; a v tom případě jdu ven z této sekce mov a,m ; ještě otestuju znak, je-li to desítková cpi 30h ; cifra, dvojtečka nebo středník jc X0285 ; => v tom případě taky převádím cpi 3ch ; znak po znaku bez TOKENS jc X02d1 X0285: push d lxi d,tb_tok-1 ; rozpoznání klíčového slova push b lxi b,X02cd ; adresa pro návrat (STACK) push b mvi b,7fh ; připravit počitadlo TOKEN CODE mov a,m ana a jp X0298 ani 7fh mov m,a X0298: mov c,m ; do acc (=reg.c) se uloží bajt z (hl) xchg X029a: inx h ora m jp X029a ; najít první znak dalšího příkazu inr b ; a zvednout počitadlo TOKEN CODE mov a,m ani 7fh rz ; test na konec tabulky příkazů cmp c ; porovnat se znakem rozpoznávaného slova jnz X029a ; při první neshodě zkusit další příkaz xchg push h X02aa: inx d ldax d ; test dalších znaků nalezeného příkazu ana a jm X02c9 ; až do příchodu nového příkazu mov c,a mov a,b cpi 88h ; pokud zrovna porovnáváme shodu na jnz X02b9 ; příkaz GOTO, pak při porovnávání rst 2 ; přeskakujeme mezery v BASIC zápisu dcx h ; možné jsou proto varianty: X02b9: inx h ; GOTO mov a,m ; GO TO ana a ; G O T O jp X02c1 ; G OT O ani 7fh X02c1: cmp c jz X02aa ; shoda dalšího znaku rozpoznávaného příkazu pop h jmp X0298 ; jinak test na další příkaz X02c9: mov c,b ; v reg. c vrátí TOKEN CODE pop psw xchg ret X02cd: xchg ; pokud jsem identifikoval klíčové slovo mov a,c ; BASICu, uložím je následující procedurou pop b ; do výstupního buferu pop d ; (02d1h) X02d1: inx h ; doslovný převod znaku stax d ; inkriminovaný znak uložit inx d ; další adresa na výstupu inr c ; počitadlo převedených symbolů sui 3ah jz X02df ; dvojtečka? pak vypnout uvozovkový mód cpi 49h jnz X02e2 ; příkaz DATA? pak zapnout uvozovkový režim X02df: sta quote X02e2: sui 54h ; příkaz REM? pak nezapínat uvozovkový režim jnz X0246 ; ale přesto kopírovat doslova až do příchodu mov b,a ; nulového bajtu, který uložím do registru B X02e8: mov a,m ; doslovná kopírovací smyčka, čekající ana a ; na příchod ukončovacího znaku, který jz X02f8 ; je držen v registru B (buď to budou cmp b ; uvozovky nebo nulový bajt konce řádku) jz X02d1 X02f1: inx h stax d inr c inx d jmp X02e8 X02f8: lxi h,c_odloz-1 ; zakončení převodu - připraví stax d ; ukazatel před bufer a na konec inx d ; buferu přidá tři nuly stax d inx d stax d ret ; ***************************************************** ; pípnout, vymazat editační bufer a editovat dialogový ; řádek voláním nestandardního vstupu podprogramu ENTER ; ***************************************************** ; (0301h) X0301: call c_beep call clr ; ******************************************************* ; editace dialogového řádku bez jeho předchozího vymazání ; ******************************************************* ; (0307h) X0307: lxi h,c_odloz ; od této adresy se nakopíruje text, mvi m,0 ; zadaný v dialogovém řádku při editaci shld odloz call enter2 ; volat podprogram ENTER (editace řádku) lhld lstr xchg lxi h,c_odloz ; sečtením adres začátku textového buferu dad d ; a počtu znaků v něm inx h ; a ještě posunutím za poslední znak xra a ; dostaneme adresu, na kterou umístíme mov m,a ; editační zarážku 00 sta colpos ; vynulovat počitadlo tisk. sloupce lxi h,c_odloz-1 ; a inicializovat HL na začátek textového ret ; buferu ; ******************************************************************* ; "driver" tisku standardní tiskovou procedurou do editačního buferu, ; což se následně projeví jako předtisk dat v dialogovém řádku ; ******************************************************************* ; (0324h) X0324: push h lhld X002c ; načíst aktuální ukazatel (kurzor) mov m,a ; uložit znak do buferu inx h ; posunout kurzor shld X002c ; a jeho hodnotu uložit pop h ret ; ************ ; příkaz LLIST ; ************ ; (032fh) c_llst: call rdlnnr ; načíst parametr (číslo řádku) rnz ; konec s chybou, pokud nenásleduje dvojtečka pop b ; zrušit návratovou adresu (ukončit program) call fndlin ; nalézt požadovaný řádek push b X0338: pop h ; v HL mám počáteční adresu aktuálního řádku mov c,m inx h mov b,m ; do BC načtu délku řádku, inx h mov a,b ora c ; je-li nulová, jsem na konci programu jz X0087 ; a tak se vrátím do dialogové smyčky push b push h lxi h,maxcol ; uschovat původní hodnotu proměnné maxcol mov a,m sta X0366+1 mvi m,79 ; a nastavit hodnotu 79 (to jako 80 sloupců) lhld buf ; adresu buferu dialogového řádku použijeme shld X002c ; jako adresu tiskového buferu pro lxi h,X0324 ; tiskový driver universálního výstupu shld cout+1 ; do paměťového buferu pop h mov e,m ; nyní načteme BASICovské číslo řádku inx h mov d,m inx h push h xchg call X126b ; a vytiskneme je zatím do buferu call X0383 ; a stejně tak i zbylý obsah řádku X0366: mvi a,0 ; zde se nezapisuje nula, jak by se mohlo sta maxcol ; zdát ale původní hodnota proměnné maxcol call X1e33 ; universální výstup přesměrovat zpět ; do pracovní oblasti obrazovky call wrbuf ; do dialogového řádku zobrazíme náhled ; vybraného řádku call inklav ; a přečteme, jakou klávesou uživatel reagoval cpi 0dh jnz X0149 ; pokud je to EOL, jdeme editovat call clr ; jinak ten bufer vyčistíme xra a sta colpos ; ještě inicializace počitadla znaků jmp X0338 ; a jdeme zobrazit další řádek ; ************************************************************** ; vytiskne zakódovaný obsah BASICovského řádku do čisté sekvence ; ASCII znaků (rozvine zástupné jednobajtové kódy příkazů) ; ************************************************************** ; (0383h) X0383: pop h ; defacto do HL uložíme předposlední položku xthl ; ze zásobníku, která je adresou v programu ; na pátem bajtu vybraného řádku, tedy ; za délkou řádku a jeho číslem lxi b,32 ; C = ASCII kód mezery (úvodní mezera za číslem ; tisknutého řádku) X0388: mvi d,0 ; D = 00/22h - atribut uvozovkového režimu X038a: mov a,c ana a cnz X03dd ; jakýkoliv nenulový znak vytisknout mov a,m ana a inx h rz ; konec řádku mov c,a cpi 22h ; test na uvozovky jnz X039b sub d ; pokud přijdou uvozovky, překlopí se hodnota mov d,a ; registru D na tu druhou z hodnot 00/22h X039b: mov a,d ana a ; při uvozovkovém (doslovném) režimu se nic jnz X038a ; nedekóduje a tiskne se každý bajt natvrdo mov a,b ; ošetření znaků za příkazy DATA a REM ana a ; v případě těchto příkazů se vše co je za jz X03ad ; nimi interpretuje jako jednoduché ASCII sub c ; znaky (u příkazu DATA až do následujícího jnz X03aa ; znaku dvojtečka, u příkazu REM mov b,a ; až do následujícího znaku LF - ASCII kód 0Fh) X03aa: jmp X03da ; jde na další znak (vypíná uvozovkový mód) ; **************************************************************** ; dle kódu v registru C vytiskne ASCII znak nebo zakódovaný příkaz ; (u příkazů DATA a REM aktivuje jejich atributy) ; **************************************************************** X03ad: mov a,c ; je-li načtený bajt v rozsahu 00..7Fh, ana a ; pak se jedná o prostý ASCII znak jp X03da ; a ten bude vytištěn sui 7fh ; kódy nad 7Fh vyhledáme v tabulce TOKENS mov c,a lxi d,tb_tok cpi 4 ; v případě kódu příkazu DATA jnz X03bf mvi b,3ah ; nastavíme atribut 3Ah (ASCII kód dvojtečky) X03bf: cpi 0fh ; v případě kódu příkazu REM jnz X03c5 mov b,a ; atribut 0Fh (ASCII kód LF, součást CR+LF) X03c5: ldax d ; dojet v tabulce TOKENS na začátek dalšího inx d ; klíčového slova ana a jp X03c5 dcr c ; čekání na to správné klíčové slovo jnz X03c5 ani 7fh ; odmaskovat MSB prvního znaku příkazu X03d1: call X03dd ; vytisknout tento znak ldax d ; načíst další znak nalezeného příkazu inx d ; ukazatel posunout za něj, ana a ; a dokud není začátek dalšího příkazu (což jp X03d1 ; je konec toho aktuálního), tisknout.. X03da: jmp X0388 ; jde na další znak (vypíná uvozovkový mód) ; ************************************************* ; universální výstup znaku do čehokoliv s ošetřením ; maximálního počtu znaků na řádek při tisku ; ************************************************* X03dd: push b ; (03ddh) push psw cpi 20h ; jedná se o řídicí znak ASCII? jc X03f7 ; pokud ano, běž přímo na tiskový driver lda maxcol ; je-li omezovač počtu sloupců nulový ana a ; pak nic neřešit a přímo tisknout jz X03f7 mov b,a ; ale jinak porovnat s aktuálním číslem lda colpos ; tiskového sloupce a pokud tisk cmp b ; překročil maximální sloupec, cnc X0723 ; zařádkovat (CR+LF+NULL bajtů) inr a sta colpos ; formálně upravit ukazatel tiskového sloupce X03f7: pop psw ; a zde již přechod na samotný tisk push psw mov c,a call cout ; volání univerzálního tiskového driveru pop psw pop b ret ; *********** ; příkaz LIST ; *********** ; (0400h) c_list: call X23b3 ; záplata pro kanálový výstup X0403: call rdlnnr ; načíst číslo řádku rnz ; za příkazem kromě čísla nesmí být nic pop b ; po příkazu LIST se (případný) program ukončí call fndlin ; číslo řádku převést na adresu řádku v paměti push b X040c: pop h ; v HL mám počáteční adresu aktuálního řádku mov c,m inx h mov b,m ; do BC načtu délku řádku, inx h xra a sta X0740+1 mov a,b ora c ; je-li nulová, jsem na konci programu jz X0084 ; a tak se vrátím do dialogové smyčky call X04eb ; test SHIFT/STOP call X0723 ; vyšle kombinaci CR+LF+NULL bajtů push b mov e,m ; nyní načteme BASICovské číslo řádku inx h mov d,m inx h push h xchg call X126b ; které vytiskneme lda colpos ; zde počet mezer na úvod zalomeného řádku, inr a ; aby se nám čísla řádků neztrácela v textu sta X0740+1 ; (čísla řádků jsou předsazená o svou délku+1) call X0383 ; vytisknout kódovaný zbytek BASIC řádku jmp X040c ; další řádek.. ; *************************************************** ; datová struktura v zásobníku pro jeden cyklus FOR ; má tento tvar (adresa směrem dolů klesá) ; *************************************************** ; 2 bajty - adresa zdrojového kódu, kde začíná smyčka ; (za posledním znakem celého zápisu FOR..) ; 2 bajty - číslo řádku, kde začíná smyčka ; (za posledním znakem celého zápisu FOR..) ; 4 bajty - FP číslo, určující koncovou hodnotu cyklu ; 4 bajty - FP číslo, určující velikost kroku ; (včetně znaménka!) ; 1 bajt - ještě jednou znaménko kroku -1/0/+1 ; 2 bajty - adresa proměnné cyklu (ukazuje na 3. bajt ; ze šesti, tedy na vlastní hodnotu) ; 1 bajt - signatura 81h označující cyklus FOR ; *************************************************** ; ********** ; příkaz FOR ; ********** ; (0437h) c_for: mvi a,64h ; jako proměnnou cyklu nelze sta indxen ; použít indexovanou proměnnou call c_let ; volání příkazu LET (načte pracovní xthl ; proměnnou a výchozí hodnotu cyklu) call X00af ; pokud proměnná cyklu není ještě pop d ; v žádném cyklu použita, snížím jnz X0449 ; stack a tam bude založena nová dad b ; struktura FOR, jinak přepíšu! sphl ; nalezenou strukturu FOR, která ; tuto proměnnou již použila a tím ; při následném NEXT vyvolám chybu ; křížení smyček 05h - No for stm X0449: xchg mvi c,8 ; test na volných 8*2 bajty paměti call X00df push h ; výpočet adresy za zápisem FOR.. call c_data ; tuto adresu začátku smyčky xthl ; uložit do zásobníku push h lhld crntln ; uložit do zásobníku číslo xthl ; aktuálního řádku call X08cb rst 1 ; vynutit si klíčové slovo .db 9eh ; "TO" před koncovou hodnotou cyklu call numpar ; načíst koncovou hodnotu cyklu push h ; do FP akumulátoru call X1113 ; a následně do B:C:D:E pop h push b ; uložit do zásobníku tuto koncovou push d ; hodnotu (FP konstanta) lxi b,8100h ; default hodnota STEP (+1) mov d,c ; pokud není výslovně uvedena mov e,d ; (FP číslo 00h 00h 00h 81h) mov a,m cpi 0a3h ; následuje příkaz STEP? mvi a,1 ; ještě dodefinovat znaménko kroku jnz X047f rst 2 ; STEP uveden => přeskočit mezery a call numpar ; načíst hodnotu kroku push h ; do FP akumulátoru call X1113 ; a následně do B:C:D:E rst 6 ; do ACC dosadit znaménko kroku pop h X047f: push b ; koncová hodnota ve formátu FP push d ; velikost kroku ve formátu FP push psw ; znaménko kroku -1/0+1 inx sp ; (uloží se jen ACC, ne příznaky) push h lhld crntadr ; adresa proměnné cyklu xthl X0488: mvi b,81h ; a jeden bajt signatury FOR (81h) push b inx sp ; (uloží se jen reg. B, ale ne C) ; ********************************* ; vykonání další instrukce v pořadí ; ********************************* ; 048ch – ExecNext X048c: call X04eb ; otestovat klávesy SHIFT a STOP shld crntadr mov a,m cpi ':' ; pokud najdu oddělovací znak jz X04ac ; dvojtečka, přeskočím jej ana a ; každý jiný znak kromě nuly jnz err_09 ; vyvolá chybu 09h - Syntax err. inx h ; našel jsem konec řádku, načtu tedy mov a,m ; první dva bajty následujícího inx h ; řádku ora m jz X04fd ; jsou-li nulové, pak konec programu inx h ; jinak načtu číslo nového řádku mov e,m inx h mov d,m xchg X04a8: shld crntln ; a uložím je jako číslo aktuálního xchg ; řádku programu ; ************************* ; Interpretace kódu příkazu ; ************************* ; (04ach) X04ac: rst 2 lxi d,X048c ; přímé vykonání příkazu push d X04b1: rz X04b2: sui 80h ; vstup v ACC jc c_let ; znaky pod 80h => interpretovat jako LET cpi 1dh ; kódy příkazů (ne funkcí a pomocných slov) jc X04c3 sui 46h ; pro kódy funkcí a pomocných slov se volá jm err_09 ; chybové hlášení 9h – Syntax err adi 1dh ; u 2. části příkazů (od c6h) se přemapuje X04c3: rlc ; ukazatel do tabulky adres výkonných rutin mov c,a ; v reg. páru BC se sestaví ofset do této mvi b,0 ; tabulky adres výkonných rutin xchg lxi h,tb_cmd ; tabulka klíčových slov dad b mov c,m inx h mov b,m push b ; uložit adresu, kam se nakonec půjde xchg X04d1: inx h mov a,m cpi 3ah ; ukazatel výběru BASIC kódu nastavit rnc ; na event. parametr za příkazem ; **************************** ; dokončení RST2 - testu znaku ; **************************** X04d6: cpi 20h ; přeskakování mezer jz X04d1 cpi 30h ; test na dolní rozsah cifer cmc ; je-li znakem cifra, vrací CY=1 inr a dcr a ret ; ********************************* ; RESTORE na začátek BASIC programu ; ********************************* ; (04e1h) datrst: xchg lhld pgbase ; adresa začátku BASIC programu dcx h X04e6: shld dataadr ; je použita jako výchozí adresa xchg ; řádku s DATA pro příkaz READ ret ; *********************** ; SHIFT/STOP LISTING TEST ; *********************** ; (04ebh) X04eb: in 0f5h ; test klávesy SHIFT ani 20h jz X04eb ; čekání při SHIFT X04f2: in 0f5h ani 40h rnz ; test klávesy STOP ; *********** ; příkaz STOP ; *********** ; (04f7h) c_stop: .db 0f6h ; ori 0c0h - kvůli zjednodušení se ; u příkazu STOP nehlídá následující ; znak, tak jako u příkazu END ; ********** ; příkaz END ; ********** ; (04f8h) c_end: rnz ; chyba při jiném znaku než ':' shld crntadr ; uložit ukazatel na aktuální znak programu pop b ; likvidace návratové adresy ; ********************************** ; ukončení programu, dojdou-li řádky ; ********************************** ; (04fdh) X04fd: lhld crntln ; otestovat číslo řádku, pokud je platné push psw ; (tj. není FFFFh) pak jsme v programu a ne mov a,l ; v dialogovém režimu a tudíž si uložíme ana h inr a jz X0510 shld stopln ; řádek, na kterém jsme přerušili program lhld crntadr shld stopadr ; a ukazatel na následující znak v programu X0510: call X071e pop psw mvi e,16h ; chyba 16h - „Stop“ se vyvolá cnz X169c ; jen u příkazu STOP a stisku klávesy STOP jmp X0084 ; *********** ; příkaz CONT ; *********** ; (051ch) c_cont: lhld stopadr ; pokud není kde pokračovat, mov a,h ora l ; (ukazatel stopadr má hodnotu 0000h) mvi e,0dh jz X0108 ; vyvolá se chyba 0dh - „Can’t cont“ xchg lhld stopln ; jinak se obnoví číslo řádku shld crntln xchg ; a do HL adresa aktuálního znaku ret ; (ta se později uloží do crntadr) ; *********** ; příkaz NULL ; *********** ; (052fh) c_null: rst 4 ; Načíst parametr v rozsahu rnz ; 0..255 inr a cpi 50h ; a pokud je větší než 78, hlásit jnc X0569 ; chybu 03h - Fnc.param. sta X0027 ; jinak parametr uložit ret ; **************************************************************** ; je-li znak na adrese (HL) písmeno A..Z nebo a..z, pak vrací CY=0 ; **************************************************************** ; (053bh) isabcd: mov a,m ; testuje bajt cpi 40h ; zda je větší než kód písmene @ rc mov a,m cpi 5bh ; a zároveň menší než kód písmene Z cmc rnc mov a,m cpi 61h ; a další test na skupinu kódů rc cpi 7bh ; písmen a..z cmc ret ; ********************************************************* ; přeskočí mezery a vyhodnotí číselný výraz s rozsahem ; 0..32767 (v opačném případě hlásí chybu 03h - Fnc.param.) ; ********************************************************* ; (054ch) X054c: rst 2 ; přeskočit mezery ; ****************************************************** ; vyhodnotí číselný výraz a pokud je záporný nebo >32767 ; pak zahlásí chybu Fnc.param. ; ****************************************************** ; (054dh) getpin: call numpar ; vyhodnotit číselný výraz ; ************************************** ; test čísla ve FP akumulátoru na rozsah ; 0..+32767 ; ************************************** ; (0550h) tstpin: rst 6 ; test FP čísla na znaménko jm X0569 ; záporné číslo => chyba Fnc.param. ; ************************************** ; test čísla ve FP akumulátoru na rozsah ; -32768..+32767 ; ************************************** ; (0554h) tstint: lda fpaccum+3 ; je-li absolutní hodnota čísla cpi 90h ; ve FP akumulátoru <32768, pak jc X116d ; převést na Integer 16 bit lxi b,9080h ; a ještě povolit průchod lxi d,0000h ; okrajové hodnoty -32768 push h call X1142 ; zde je vlastní porovnání.. pop h mov d,c rz X0569: mvi e,3 ; chyba 03h - Fnc.param. rst 5 ; *********************** ; zkompletuje číslo řádku ; *********************** ; (056ch) rdlnnr: dcx h ; test znaku na cifru rst 2 jz getnum ; po dvojtečce načíst číslo jc getnum ; při cifře také načíst číslo push b call getpin ; jinak vyčíslit výraz pop b ; s povoleným rozsahem dcx h ; 0..32767 rst 2 ret ; ******************************************* ; Ze stringu extrahuje BASICovské číslo řádku ; výstup: reg. DE ; ******************************************* ; (057ch) getnum: dcx h lxi d,0 X0580: rst 2 rnc ; konec při jiném znaku než je cifra push h push psw lxi h,0ccch ; 3276 rst 3 jc err_09 ; test na Syntax Err při >3276x mov h,d mov l,e dad d dad h dad d dad h ; HL = 10 * DE mov a,h ani 80h jnz err_09 ; Syntax Err při čísle řádku >32767 pop psw sui 30h ; obnovit načtený ciferný znak mov e,a ; a převést na cifru mvi d,0 dad d ; HL = 10 * DE + cifra xchg ; a výsledek uložit do reg. DE pop h jmp X0580 ; ********** ; příkaz RUN ; ********** ; (05a3h) c_run: jz X01ff ; call X0205 lxi b,X048c jmp X05bf ; ************ ; příkaz GOSUB ; ************ ; (05afh) c_gosb: mvi c,3 ; Alokace 3 x 2 bajty v zásobníku (i když se call X00df ; využije jen 5 bajtů) pop b ; dočasně vyzvednout návratovou adresu push h ; uložit ukazatel na aktuální znak v programu push h lhld crntln xthl ; dokončit uložení aktuálního čísla řádku mvi a,8ch ; uložit kód „GOSUB“ push psw inx sp ; zde se ušetří onen šestý bajt X05bf: push b ; a zpět uložit návratovou adresu ; pak už se to chová jako GOTO ; *********** ; příkaz GOTO ; *********** ; (05c0h) c_goto: call rdlnnr ; do DE připravit požadované číslo řádku call c_rem ; defacto „dojet“ na konec BASIC řádku push h lhld crntln ; aktuální číslo BASIC řádku rst 3 ; porovnat s požadovaným pop h inx h cc fndlfr ; a buď od daného místa cnc fndlin ; nebo od začátku programu mov h,b ; vyhledat požadovaný BASIC řádek mov l,c dcx h rc ; řádek nalezen => ukončení příkazu ; ********************************** ; chybové hlášení "Řádek neexistuje" ; ********************************** err_0b: mvi e,0bh ; chyba „Numb.nonex“ (05d7h) rst 5 ; ************* ; příkaz RETURN ; ************* ; (05dah) c_retr: rnz ; příkaz musí být bez parametrů mvi d,0ffh call X00af ; test zásobníku sphl ; a odebrání 4 nevýznamných bajtů cpi 8ch ; test na kód GOSUB mvi e,0ah jnz X0108 ; chyba 0ah - „Return err“ pop h ; vyzvednout číslo řádku shld crntln ; a uložit jako aktuální inx h mov a,h ; je-li číslo řádku platné, pak byl ora l ; podprogram volán v programovém režimu jnz X05f9 ; a proto regulérní návrat do programu lda ovrbuf ; podprogram byl volán v dialogovém ana a ; režimu (číslo řádku je FFFFh) jnz X0083 ; pokud došlo během chodu programu ; k porušení editačního buferu (například ; příkazem INPUT), pak nevykonávat další ; příkazy v editačním režimu za voláním ; GOSUB XXX ; bohužel kód v tomto odstavci nefunguje, ; protože BE70h je stále nulové! X05f9: lxi h,X048c ; návratová adresa do interpretační xthl ; rutiny + ignorovat zbytek řádku ; *********** ; příkaz DATA ; *********** ; (05fdh) c_data: .db 01h ; lxi b,X0e3a .db 3ah ; zde se jen nadefinuje jedna z platných ; zarážek, určujících konec sekvence, které ; si nyní program nevšímá (až při READ) ; zde defacto jen dvojtečka - ASCII kód 3Ah, ; celá sekvence pak vypadá takto: ; lxi b,0e3ah/nop a pokrač. na adrese 0601h, ; kde se definuje hodnota pouze registru B ; ********** ; COMAND REM ; ********** ; (05ffh) c_rem: mvi c,0 ; B = C = 0 (u REM je ignorován text mvi b,0 ; až do konce řádku - nehlídá se dvojtečka) X0603: mov a,c ; v registru B se drží zarážka (dvojtečka), mov c,b ; která se v případě potřeby vypne a schová mov b,a ; do registru C X0606: mov a,m ; procházení znaků za REM/DATA/... ana a rz ; test na konec řádku cmp b rz ; test na zarážku (např. dvojtečka) inx h cpi 22h ; test na uvozovky (vypínají a opět jz X0603 ; zapínají test zarážky) jmp X0606 ; ostatní znaky přeskočit ; ********** ; příkaz LET ; ********** ; (0614h) c_let: call varadr ; do DE načíst adresu proměnné ; (pokud neexistuje => vytvořit) rst 1 ; vynucení .db 0ach ; token kódu '=' X0619: push d lda vartype ; načíst požadovaný datový typ push psw call X08d6 ; vyčíslit výraz pop psw xthl shld crntadr rar ; do CY umístit typ (0 = číslo) call X08cd ; provést typovou kontrolu jz X065f ; skok při číselné proměnné X062d: push h lhld fpaccum ; v FP akumulátoru přeskočíme údaj push h ; o délce řetězcové proměnné a další inx h ; (prázdný) bajt a z dalších dvou inx h ; bajtů načteme ukazatel na text mov e,m inx h mov d,m ; do DE ukazatel na text proměnné lhld pgbase rst 3 ; pokud ještě cílová proměnná jnc X064e ; nebyla použita (má neplatný uka- ; zatel na text), pak založit ; prázdnou proměnnou lhld spbase ; pokud už někdy použita byla, rst 3 ; otestuji, zda je to textová pop d ; konstanta ve zdrojovém kódu jnc X0656 ; (adresa textu je "nad" zdrojovým ; kódem BASIC programu ale "pod" ; zásobníkem) ; odkaz na textovou konstantu ; jen přiřadím do proměnné lhld varbase ; stejně tak i v případě, že se rst 3 ; jedná o řetězec, který leží jnc X0656 ; v přechodné oblasti "pod" ; adresou začátku proměnných X064d: .db 3eh ; mvi a,0d1h - přeskočí "pop d" X064e: pop d ; obnovím adresu cílové proměnné call X153f ; BC = adresa zdrojového řetězce ; HL = adresa BE59 ??? xchg call X0cd2 ; vytvoří pracovní kopii proměnné X0656: call X153f ; BC = BE59 ??? ; HL = BE55 ??? pop h call X1122 ; přenos 4byte z (DE) na (HL) pop h ret X065f: push h ; obsah FP akumulátoru uloží call X111f ; do proměnné na levé straně pop d ; přiřazovacího příkazu pop h ; obnovit ukazatel do zdrojového ret ; kódu a konec příkazu ; ********* ; příkaz ON ; ********* ; (0666h) c_on: cpi 97h ; test na klíčové slovo ERR jnz X067f xchg ; konstrukce ON ERR lhld crntln ; analýza čísla řádku shld onerrln mov a,h ana l inr a jz X0cb0 ; chyba „Only in pg“ xchg ; jsem-li v programu, uložím adresu shld oneradr ; za konstrukcí ON ERR na adresu 23feh jmp c_rem ; a zbytek řádku ignoruji X067f: call numpar ; konstrukce ON var GOTO/GOSUB call tstint mov a,d ana a jz X068d ; max. hodnota proměnné je 255 lxi d,0 X068d: mov a,m mov b,a cpi 8ch ; test na klíčové slovo GOSUB jz X0697 rst 1 ; jinak vynucený test na slovo GOTO .db 88h dcx h X0697: mov c,e ; v reg. e je pořadí skokové adresy X0698: dcr c ; v seznamu za ON var GOTO/GOSUB mov a,b ; do acc se připraví kód GOTO/GOSUB pro .. jz X04b2 ; případ úspěšného provedení skoku inx h call rdlnnr ; přeskočit proměnnou cpi 2ch ; pak musí být čárka rnz ; jinak konec (chybí argumenty) jmp X0698 ; přesun na další adresu v seznamu ; ********* ; příkaz IF ; ********* ; (06a7h) c_if: call X08d6 ; vyčíslení výrazu mov a,m cpi 88h ; test na kód GOTO jz X06b2 rst 1 ; pokud není GOTO, .db 0a1h ; pak vynutit THEN X06b2: dcx h call X08cb ; vynutit si číselnou proměnnou rst 6 ; zde je odpověď na otázku, jak se kóduje jz c_rem ; v BASICu TRUE a FALSE: ; TRUE = nenulový výsledek (v FP akumulátoru) ; FALSE = nulový výsledek rst 2 ; přeskočit mezery a testovat další znak jc c_goto ; pokud je, vyčíslit číslo řádku a GO jmp X04b1 ; jinak bez jakékoliv akce pokračovat ; v interpretaci kódu ; ************ ; příkaz PRINT ; ************ ; (06c1h) c_prnt: call X1e33 ; textový výstup nastavit na obrazovku cpi 23h ; je-li prvním znakem za příkazem PRINT znak jz X2071 ; kanálového výstupu (#), pak se přímo skočí ; na příkaz OUTPUT, což je v dané situaci ; ekvivalent (sdílí i stejný formát výstupních ; dat, která lze posílat na I/O zařízení) X06c9: dcx h rst 2 ; přeskočit mezery a test PRINT bez parametrů X06cb: jz X0723 ; => odřádkovat X06ce: rz ; po poslední položce konec příkazu cpi 9dh ; test na token klíčového slova TAB( jz X0763 cpi 0a0h ; test na SPC( jz X0763 cpi 0e7h ; test na AT jz X0788 cpi 0e4h ; test na INK( jz X07c0 push h cpi ',' ; test na oddělovač čárka jz X074f cpi 3bh ; test na oddělovač středník jz X0783 pop b call X08d6 ; když nic z toho nepřišlo, očekává se výraz push h lda vartype ; je vyhodnocený výraz číselný nebo řetězcový? ana a jnz X0715 ; => řetězcový výraz ; => číselný výraz call X1276 ; FP číslo "vytiskne" do buferu call X0cf6 ; lhld fpaccum ; a délku tohoto řetězce lda colpos ; spolu s aktuálním sloupcovým ukazatelem add m ; sečte - pokud je ovšem sloupec cpi 48 ; větší než 47, cnc X0723 ; odřádkuje se CR+LF+NULL bajtů call X0d37 mvi a,' ' ; to je ta prokletá mezera, kterou BASIC bez call X03dd ; našeho vědomí vkládá za každé číslo xra a ; (0715h) X0715: cnz X0d37 ; vytisknout řetězcový výraz, uvedený pop h ; v příkazu PRINT, dcx h rst 2 ; přeskočit mezery jmp X06cb ; a test další položky příkazu PRINT ; *************** ; podmíněný CR+LF ; *************** ; (071eh) X071e: lda colpos ; odřádkování CR+LF se provede jen tehdy, ana a ; pokud to má význam (sloupcový ukazatel rz ; není na začátku řádku) ; ********************************************************* ; odřádkování, vyšle se sekvence znaků CR + LF + NULL bajtů ; ********************************************************* ; (0723h) X0723: mvi a,0dh call X03dd ; poslat CR na universální výstup mvi a,0ah call X03dd ; poslat LF na universální výstup ; ***************************************************** ; dle počtu NULL bajtů vyšle tyto na universální výstup ; ***************************************************** ; (072dh) X072d: lda X0027 ; načíst počet NULL bajtů+1 X0730: dcr a sta colpos ; zde se fakticky nic neukládá, neboť na konci jz X0740 ; procedury je vždy colpos nulové! push psw xra a ; nulový bajt call X03dd ; vyslat na universální výstup pop psw jmp X0730 ; a opakovat do splnění limitu ; ************************************************************* ; defacto jen zakončení předchozí procedury s nastavením CY = 0 ; ************************************************************* ; (0740h) X0740: mvi a,0 ; vhodná hodnota pro další běh ; ********************************************************** ; podle hodnoty v registru A vytiskne požadovaný počet mezer ; (je využíváno příkazem LIST) ; ********************************************************** ; (0742h) X0742: ana a rz ; toto asi komentář nepotřebuje.. dcr a push psw mvi a,' ' call X03dd ; snad jen, že zde je universální pop psw ; výstup znaku jmp X0742 ; *************** ; oddělovač čárka ; *************** ; (074fh) X074f: lda colpos cpi 2ah ; pokud je aktuální hodnota tiskového sloupce cnc X0723 ; větší než 42, zařádkovat CR+LF+NULL bajtů jnc X0783 ; a už nic jiného nedělat X075a: sui 14 ; v daném řádku tak dlouho odečítám tiskovou jnc X075a ; rozteč 14, až se dostanu "před" začátek cma ; řádku a výsledek po otočení znaménka mi dá jmp X0778 ; počet mezer, které musím vytisknout.. ; ********************* ; klíčová slova TAB/SPC ; ********************* ; (0763h) X0763: push psw rst 2 ; přeskočit mezery rst 4 ; načíst parametr příkazu rst 1 ; vynutit pravou závorku .db ')' dcx h pop psw sui 0a0h ; nyní rozlišit TAB( a SPC( push h jz X0773 ; TAB se počítá od začátku řádku lda colpos ; SPC se "odpíchne" od aktuálního sloupce X0773: cma add e ; nyní připočteme parametr funkce TAB/SPC jnc X0783 ; a pokud se u TAB nelze "vrátit" doleva ; ignorujeme takový TAB(N) ; **************************************************** ; dle hodnoty v reg. A vytiskne požadovaný počet mezer ; **************************************************** X0778: inr a mov b,a ; výsledný počet požadovaných mvi a,' ' ; mezer X077c: call X03dd ; pustíme do universálního výstupu dcr b jnz X077c ; *************************************************************** ; bezprostřední přechod na další položku PRINT bez vkládání mezer ; *************************************************************** ; (0783h) X0783: pop h ; obnovit ukazatel na další znaky rst 2 ; přeskočit případné mezery jmp X06ce ; a zpět do smyčky příkazu PRINT ; **************** ; klíčové slovo AT ; **************** ; (0788h) X0788: rst 2 rst 4 ; načíst číslo Y tiskového řádku (nahoře=0) cpi 1ah ; a pokud je větší než 25, upravit jc X0791 mvi a,19h ; je právě na hodnotu 25 X0791: push h inr a mov b,a ; nyní se vypočte dílčí část fyzické adresy add a ; ve videoram, která odpovídá zvolenému řádku add a ; dle vzorce add a ; adresa = C000h + 64 x (9Y+11) add b inr a ; tedy jeden textový řádek má 9 mikrořádků inr a ; a protože znaky se kreslí "odspodu", mov b,a ; je tam i ta aditivní konstanta pro první rrc ; (respektive nultý) řádek rrc ; konstanta C000h je začátek videoram ani 3fh ori 0c0h mov h,a mov a,b rrc rrc ani 0c0h mov l,a xthl rst 1 ; vynutit oddělovací čárku .db ',' rst 4 ; načíst číslo tiskového sloupce dcx h cpi 48 ; a pokud je větší než 47, upravit jc X07b4 mvi a,47 ; je právě na hodnotu 47 X07b4: sta colpos ; (a uložit i do ukazatele tisk. sloupce) xthl ; obnovit předvypočtenou fyzickou adresu add l ; a přičíst příspěvek řádku mov l,a ; a sestavenou adresu ve videoram pro ukazatel shld cursor ; tisku uložit do proměnné BIOSu jmp X0783 ; a běž na další položku v příkazu PRINT ; ***************** ; klíčové slovo INK ; ***************** ; (07c0h) X07c0: rst 2 ; přeskočit mezery call X2161 ; zavolat rutinu PEN/INK pro nastavení masky rst 1 ; vynutit pravou závorku .db ')' jmp X06ce ; a zpracovat další položku v příkazu PRINT ; ************************************************ ; zpracování chyby při vstupu dat INPUT/ENTER/READ ; ************************************************ ; (07c9h) X07c9: lda inptype ; pokud byl vstup dat realizován ana a ; příkazem READ jnz X00f7 ; vyvolat chybu 09h - "Syntax err" mvi e,13h ; pro INPUT chyba 13h - "Input err" rst 5 ; ****************** ; příkaz INPUT/ENTER ; ****************** ; (07d3h) c_inpt: cpi 23h ; test na znak # (kanálový vstup) jz X2123 ; a případný odskok push h lxi h,X0301 ; nadefinovat obslužný vektor pro shld X080b+1 ; vstup dat z klávesnice (INPUT) call prgtst ; test na programový režim pop h X07e3: push h ; uschovat ukazatel na zdrojový text pop b push b ; BC = HL jmp X07ee ; a skok na společnou rutinu ; *********** ; příkaz READ ; *********** ; (07e9h) c_read: push h lhld dataadr X07ed: .db 0f6h ; + xra a => ori 0afh X07ee: xra a ; ****************************** ; společná část INPUT/ENTER/READ ; ****************************** X07ef: sta inptype xthl X07f3: lxi b,2ccfh ; skryté instrukce CF 2C call varadr ; DE = adresa proměnné xthl push d mov a,m ; test na čárku cpi ',' jz X0812 lda inptype ; zde se procedura dělí na dvě ana a ; specifické části READ / INPUT jnz X085d ; skok při READ lxi h,7f01h X080b: call 0 ; INPUT/ENTER vektor pop d pop b push b push d X0812: lda vartype ; rozlišení číselné a řetězcové ana a ; proměnné jz X0832 rst 2 ; načtení řetězcové proměnné mov d,a ; pokud řetězec začíná uvozovkami, mov b,a ; pak může končit opět jen uvozovkami cpi 22h ; nebo koncem řádku jz X0826 mvi d,':' ; jinak může "končit" dvojtečkou (konec mvi b,',' ; seznamu DATA) nebo čárkou (oddělovač dcx h ; hodnot) nebo koncem řádku X0826: call X0cfa ; ..vlastní "vyčíslení" řetězce.. xchg ; vsunout návratovou adresu na proceduru, lxi h,X083b ; která na rozdíl od LET ještě otestuje xthl ; čárku za hodnotou a event. provede push d ; nové přiřazení.. jmp X062d ; skok do výkonné části příkazu LET ; načtení číselné proměnné X0832: rst 2 ; ze zdrojového textu sestavit call X11cc ; FP konstantu do FP akumulátoru xthl ; HL = adresa proměnné, a tam call X111f ; uložit sestavenou FP konstantu pop h ; obnovit ukazatel na zdroj. text X083b: dcx h ; přeskočit mezery v zápisu BASICu rst 2 ; a pokud není konec řádku nebo jz X0845 ; dvojtečka, pak testovat.. cpi ',' ; oddělovač položek? jnz X07c9 ; pokud není, hlásit chybu X0845: xthl ; ze zápisu dat se přepnout dcx h ; za příkaz READ/INPUT rst 2 ; pokud nekončí seznam proměnných, jnz X07f3+1 ; návrat ke čtení dalšího prvku pop d lda inptype ; pokud už nejsou další proměnné ana a ; následující za příkazem READ, xchg ; aktualizovat ukazatel pro READ jnz X04e6 ; na aktuální prvek DATA push d ; pokud nechce číst příkaz INPUT ora m ; další hodnoty a ony tam jsou, pak mvi e,14h ; chyba 14h - Field lost jnz X0108 pop h ; obnovit ukazatel do zdrojového ret ; textu programu v BASICu a konec ; ******************************* ; specifická část pro příkaz READ ; ******************************* ; (085dh) X085d: call c_data ana a jnz X0876 inx h ; po detekci konce řádku otestuji mov a,m ; přítomnost dalšího řádku inx h ora m ; pokud již další neexistuje, pak mvi e,6 ; vyvolat chybu 06h - Data exhau jz X0108 inx h ; v opačném případě uložím číslo mov e,m ; nového řádku jako číslo inx h mov d,m xchg shld dataln ; řádku s aktuální položkou DATA xchg X0876: rst 2 ; je další znak kódem příkazu DATA? cpi 83h ; pokud ne, jnz X085d ; čti další proměnnou (nebo znak) jmp X0812 ; *********** ; příkaz NEXT ; *********** ; (087fh) c_next: lxi d,0 ; následuje-li text, zkusit jej X0882: cnz varadr ; interpretovat jako proměnnou cyklu shld crntadr ; jinak si NEXT vybere poslední FOR call X00af ; zkusit v zásobníku najít strukturu jnz err_05 ; FOR s adresou proměnné cyklu v DE ; (pokud není nebo nesedí proměnná ; cyklu, vyvolá se chyba křížení ; smyček FOR 05h - No for stm) sphl push d mov a,m inx h push psw push d call X1105 ; FP číslo zkopírovat z adresy (HL) xthl ; do FP akumulátoru (proměnná cyklu) push h call X0e8d ; přičte krok cyklu k FP akumulátoru pop h call X111f ; obsah FP akumulátoru vrátí do paměti pop h call X1116 ; do B:C:D:E načte cílovou hodnotu cyklu push h call X1142 ; a porovná s obsahem FP akumulátoru pop h pop b sub b call X1116 jz X08ba ; dosaženo cílové hodnoty proměnné cyklu xchg ; nebylo dosaženo cílové hodnoty, shld crntln ; další průchod cyklem.. mov l,c mov h,b jmp X0488 X08ba: sphl ; parametry v příkazu NEXT je možné lhld crntadr ; sdružovat oddělením čárkou, např. mov a,m ; NEXT C,B,A cpi ',' jnz X048c rst 2 ; pokračovat na NEXT další proměnné call X0882 ; s uschováním adresy zdrojového ; textu (program nepokračuje ; procedurou numpar!) ; ************************************************************ ; výpočet hodnoty číselného výrazu a uložení do FP akumulátoru ; ************************************************************ ; (08c8h) numpar: call X08d6 ; vyhodnotit výraz ; ************************ ; typová kontrola na číslo ; ************************ X08cb: .db 0f6h ; ori 37h ; následující typovou kontrolu volám ; s vynulovaným CY, tedy požaduji ; číselnou proměnnou ; ************************** ; typová kontrola na řetězec ; ************************** ; (08cch) t_strg: stc ; budu testovat na řetězcový typ X08cd: call X1684 ; vlastní test rpe ; pokud je shoda, návrat X08d1: mvi e,11h rst 5 ; jinak chyba 11h - Type conv. ; ************************************************************** ; Vyčíslení hodnoty výrazu a uložení do FP akumulátoru ; s vynucením levé závorky (u funkcí nebo povinného závorkování) ; ************************************************************** X08d4: rst 1 ; vynutit levou závorku .db '(' ; ************************************************* ; vyhodnocení obecného výrazu (bez zadané priority) ; ************************************************* X08d6: dcx h mvi d,0 ; na začátku žádná priorita ; ************************************************** ; vyhodnocení obecného výrazu (s prioritou v reg. D) ; ************************************************** X08d9: push d mvi c,1 ; Bude pro novou FP proměnnou call X00df ; dost místa v paměti? call X094b ; vyčíslení dílčího výrazu před ; operátorem shld eofxpr ; uložit adresu za výrazem X08e5: lhld eofxpr ; načíst adresu za výrazem X08e8: pop b ; obnovit kód priority do reg. B mov a,b cpi 78h ; u číselných operátorů ; (tedy ne u logických) cnc X08cb ; provést typovou kontrolu na číslo mov a,m ; načíst znak mvi d,0 ; a otestovat výskyt relačních X08f2: sui 0abh ; operátorů jc X090c cpi 3 jnc X090c cpi 1 ; zde se řeší relační operátory ral ; A = 001|010|100 pro >|=|< xra d ; přičemž bitové váhy jednotlivých cmp d ; relačních operátorů lze sčítat mov d,a ; při opakování operátoru jc err_09 ; chybové hlášení 9h - Syntax err shld fncadr rst 2 ; přeskočit mezery a otestovat jmp X08f2 ; další relační znak (kombinaci) X090c: mov a,d ; pokračujeme po event. identifikaci ana a ; kombinace relačních operátorů jnz X0a24 ; (s interními čísly 0..7 v reg. D) mov a,m ; načíst znak shld fncadr ; uložit adresu operátoru sui 0a4h ; pro unární funkce rc ; NOT, FNC a BIT konec cpi 7 ; a rovněž pro ostatní unární funkce rnc ; mohou následovat pouze operátory ; +,-,*,/,^,AND,OR mov e,a ; tato sekvence řeší spojování lda vartype ; řetězcových proměnných (typ musí dcr a ; být řetězec a musí se jednat ora e ; o operaci sčítání - interní kód 0) mov a,e jz X0e1c rlc ; zde se řeší operátory add e ; +,-,*,/,^,AND,OR nad čísly mov e,a lxi h,X0096 ; z tabulky obslužných rutin dad d ; operátorů načíst mov a,b ; prioritu posledního operátoru mov d,m ; a prioritu nového operátoru cmp d ; porovnat rnc ; jestliže má "starší" operátor ; větší prioritu, pak ten nový ; nevyhodnocovat ; v opačném případě (nový operátor ; má prioritu vyšší): inx h call X08cb ; typová kontrola na číslo X0934: push b ; uschovat "starou" prioritu lxi b,X08e5 ; připravit návrat do vyhodnocovače push b ; výrazu mov b,e ; uschovat kód operátoru mov c,d ; a kód priority call pushfp ; aktuální hodnotu výrazu uložit ; do zásobníku mov e,b ; obnovit kód operátoru mov d,c ; a kód priority mov c,m ; v tabulce adres/priorit operátorů inx h ; načíst adresu obslužné rutiny mov b,m ; pro daný operátor inx h push b ; a připravit jej do zásobníku lhld fncadr ; obnovit začátek výrazu "nalevo" ; od operátoru jmp X08d9 ; a znovu se pokusit vyhodnotit ; ******************************** ; Vyčíslení hodnoty dílčího výrazu ; ******************************** X094b: xra a sta vartype ; default číselná proměnná rst 2 ; přeskočit mezery a načíst znak jz err_09 ; hlášení „Syntax err“ je-li konec řádku jc X11cc ; cifra => do FP akumulátoru načti číslo call isabcd ; test na písmeno jnc X09b9 ; vyčísli proměnnou cpi 0a4h ; je-li tím znakem unární + pak je ignoruj jz X094b cpi '.' ; při nalezení desetinné tečky se postupuje jz X11cc ; tak, že se načte číslo (bez úvodní nuly) cpi 0a5h ; při načtení unárního mínus vyčíslit výraz jz X09a8 ; a otočit mu znaménko cpi 22h ; uvozovky jz X0cf7 ; následují funkce, jimž se předává ukazatel ; na následující znak v BASICovském zápisu ; a tyto funkce si buď zjistí ukazatel ; na pracovní proměnnou nebo mají svůj vlastní ; postup, jak s argumentem naložit cpi 0a2h ; funkce NOT jz X0a82 cpi 9fh ; funkce FNC jz X0c6d cpi 0d9h ; funkce STATUS jz X220a cpi 0dfh ; funkce INKEY jz X1ee8 cpi 90h ; funkce BIT jz X1f05 cpi 0e5h ; funkce APEEK jz X163d cpi 0e6h ; funkce ADR jz X2317 cpi 27h ; apostrof jz X1652 cpi 0e8h ; funkce HEX$ jz f_hex sui 0aeh ; ostatní funkce, volané na rozdíl od těch jnc X09ca ; výše uvedených, s hodnotou jejich argumentu ; (09a2h) X09a2: call X08d4 ; takže vyčíslit hodnotu rst 1 ; a vynutit pravou ukončující závorku .db ')' ; (hodnota se při volání funkce předává ret ; v FP akumulátoru) ; ******************* ; funkce unární mínus ; ******************* ; (09a8h) X09a8: mvi d,7dh ; s jeho relativní prioritou call X08d9 ; vyčíslit následující výraz lhld eofxpr ; uložit adresu následujícího push h ; operátoru call X10f0 ; negace načtené hodnoty (vlastní ; funkce unárního mínus) X09b4: call X08cb ; typová kontrola na číslo pop h ; obnovit ukazatel na další operátor ret ; a konec ; ************************************************** ; vyčíslovaný výraz začíná písmenem (názvu proměnné) ; ************************************************** ; (09b9h) X09b9: call varadr ; do DE načíst adresu proměnné X09bc: push h xchg ; pro operace s řetězci uložit do shld fpaccum ; FP akumulátoru odkaz na vlastní ; text proměnné lda vartype ; pro operace s čísly uložit do ana a ; FP akumulátoru hodnotu FP čísla, cz X1105 ; uloženého od adresy HL pop h ; obnovit ukazatel do zdrojového ret ; textu programu v BASICu ; ***************************************** ; volání funkcí s kódy AEh..C5h (SGN..MID$) ; ***************************************** ; (09cah) X09ca: mvi b,0 ; podle hodnoty reg. A vypočtu rlc ; pozici v tabulce skokových adres mov c,a ; BC = 2 x A push b ; pozici v tabulce funkcí uschovat rst 2 ; pro všechny funkce kromě mov a,c ; LEFT$, RIGHT$ a MID$ cpi 29h jc X09eb ; jdu na samostatnou rutinu ; ****************************************************** ; rozcestník funkcí, vracejících řetězec libovolné délky ; ****************************************************** call X08d4 ; načti parametr s vynucením levé ; kulaté závorky rst 1 ; pak si vynutit .db ',' ; oddělovací čárku call t_strg ; typová kontrola parametru ; na typ řetězec xchg ; ukazatel na argument (řetězec) lhld fpaccum ; uschovat do zásobníku "pod" xthl ; pozici v tabulce skokových adres push h ; (viz výše) xchg rst 4 ; načíst 8-bitový parametr xchg ; do HL ulož pozici v tabulce xthl ; a do zásobníku adresu proměnné jmp X09f3 ; ******************************************************* ; rozcestník funkcí, vracejících FP číslo nebo jeden znak ; ******************************************************* ; (09ebh) X09eb: call X09a2 ; načíst argument v závorce xthl lxi d,X09b4 ; připravit typovou kontrolu push d ; na závěr (vyžadovat typ číslo) ; ******************************* ; společná část pro volání funkcí ; ******************************* ; (09f3h) X09f3: lxi b,tb_fnc ; k začátku tabulky adres obslužných dad b ; programů funkcí přičti pozici v HL mov c,m inx h mov h,m ; a tam vyzvedni onu adresu, mov l,c pchl ; na kterou se provede skok ; ********* ; funkce OR ; ********* ; (09fch) f_or: .db 0f6h ; ori 0afh ; ********** ; funkce AND ; ********** ; (09fdh) f_and: xra a push psw ; uschovat typ AND/OR call X08cb ; načíst druhý! parametr call tstint ; kontrola hodnoty na rozsah pop psw ; -32768..32767 xchg pop b xthl xchg call fpbcde ; první parametr obnovit push psw ; ze zásobníku, call tstint ; otestovat jej na rozsah pop psw ; -32768..32767 pop b mov a,c lxi h,ac2fp ; připravit se na převod jnz X0a1f ; zde fyzické rozlišení AND/OR ana e ; výpočet BC and DE => A:C mov c,a mov a,b ana d pchl ; převod A:C > FP akumulátor X0a1f: ora e ; výpočet BC or DE => A:C mov c,a mov a,b ora d pchl ; převod A:C > FP akumulátor ; *************************** ; obsluha relačních operátorů ; *************************** X0a24: lxi h,X001e ; podstrčit fiktivní "tabulku" ; s adresou obslužné rutiny ; pro relační operátory lda vartype ; do reg. E umístit rozlišovací kód rar ; relačního operátoru a typu mov a,d ral ; bit 0 obsahuje typ, bity 3, 2 a 1 mov e,a ; obsahují kód relačního operátoru mvi d,64h ; prioritu relačního operátoru mov a,b ; (toho aktuálně nalezeného) cmp d ; porovnat s poslední prioritou rnc ; pokud nová priorita je menší ; než ta předchozí, konec jmp X0934 ; jinak vyčíslit dílčí výraz ; za relačním operátorem ; ************************************* ; obslužná rutina pro relační operátory ; (volací vektor je na adrese 001Eh) ; ************************************* ; (0a36h) X0a36h: mov a,c ; do CY připravit hodnotu datového ana a ; typu rar pop b ; vyzvednout poslední výsledek pop d ; ze zásobníku do B:C:D:E push psw ; podle příznaku CY (0 = číslo) call X08cd ; typová kontrola číslo/řetězec lxi h,X0a78 ; po vlastním porovnání se bude push h ; volat zakončovací procedura jz X1142 ; porovnat FP a B:C:D:E ; ***************** ; porovnání řetězců ; ***************** ; (0a46h) xra a ; typ číslo sta vartype ; bude výsledným typem operace push d ; call X1523 ; do HL načte adresu proměnné ; napravo od relačního operátoru mov a,m ; načíst délku pravého řetězce inx h inx h mov c,m ; načíst adresu textu pravého inx h ; řetězce mov b,m pop d push b ; uschovat adresu pravého řetězce push psw ; uschovat délku pravého řetězce call X1527 ; do HL načte adresu proměnné ; nalevo od relačního operátoru call X1116 ; od adresy HL načte ; BC = adresu textu levého řetězce ; E = délku levého řetězce pop psw ; D = délka textu pravého řetězce mov d,a pop h ; HL = adresa textu pravého řetězce X0a60: mov a,e ; při souběžném vyčerpání všech ora d ; (shodných) znaků obou řetězců rz ; se vrátí hodnota 0 jako "shoda" mov a,d ; pokud dojdou dříve znaky pravého sui 1 ; řetězce, nastavím A = -1 rc ; (levý řetězec > pravý řetězec) xra a ; pokud dojdou dříve znaky levého cmp e ; řetězce, nastavím A = +1 inr a ; (levý řetězec < pravý řetězec) rnc ; při shodě jdu na další znak dcr d ; počitadlo znaků pravého řetězce dcr e ; počitadlo znaků levého řetězce ldax b ; aktuální znak levého řetězce cmp m ; porovnat s aktuálním znakem inx h ; pravého řetězce a posunout se inx b ; na další znaky jz X0a60 ; při shodě testovat další znaky cmc ; při neshodě znaků vrátit hodnoty jmp X10d6 ; CY = 0 => levý < pravý ; CY = 1 => levý > pravý ; ********************* ; dokončovací procedura ; ********************* ; (0a78h) X0a78: inr a ; typický bílý trpaslík, který adc a ; výsledek ve formě hodnot pop b ; -1/0/+1 podle zadané podmínky ana b ; (ta se obnoví v registru B) adi 0ffh ; převede na výslednou hodnotu sbb a ; 0 => NEPRAVDA jmp a2fp ; -1 => PRAVDA ; ************************************** ; funkce NOT (vypočte jedničkový doplněk ; šestnáctibitového čísla se znaménkem) ; ************************************** ; (0a82h) X0a82: mvi d,5ah ; relativní priorita operátoru NOT call X08d9 ; vyčíslení argumentu call X08cb ; typová kontrola na typ číslo call tstint ; test na rozsah -32768..32767 mov a,e cma mov c,a mov a,d cma ; určit jedničkový doplněk call ac2fp ; převést zpět na FP číslo pop b ; změnit návratovou adresu do funkce jmp X08e5 ; vyčíslení argumentu a formálně ; ukončit výraz ; ************************************** ; zvýšení dimenze proměnné v příkazu DIM ; ************************************** ; (0a99h) X0a99: dcx h ; rst 2 ; je aktuální znak rz ; znakem konce řádku? => pak návrat rst 1 ; vynutit oddělovací čárku .db ',' ; ********************************************************** ; příkaz DIM ; ********************************************************** ; Tímto příkazem lze definovat i jednoduché proměnné (tedy ; ne pole) a v tom případě se netestuje jejich redefinice. ; Při redefinici jednoduché proměnné se nemění její hodnota. ; Naopak při pokusu o redefinici pole se vyvolá chybové ; hlášení Arr.alloc. ; ********************************************************** ; (0a9eh) c_dim: lxi b,X0a99 ; připravit se na zvýšení dimenze push b ; pole .db 0f6h ; ori 0afh s přeskočením "xra a" ; uložení nenulové hodnoty do pro- ; měnné "dimreq" vyvolá požadavek ; na vytvoření proměnné (zde pole) ; za příkazem DIM ; **************************************************** ; test názvu proměnné a vyčíslení ukazatele na ni ; (v případě, že proměnná neexistuje, tak se vytvoří) ; vstup: HL - ukazatel do zdrojového kódu BASICu, kde ; je očekáváno jméno proměnné ; výstup: DE - adresa proměnné ; **************************************************** ; (0aa3h) varadr: xra a ; předpokládáme existenci proměnné X0aa4: sta dimreq ; (nebudeme ji vytvářet) mov b,m ; do B načíst 1. znak jména proměnné X0aa8: call isabcd ; a test na písmeno jc err_09 ; pokud není, pak chyba Syntax err xra a ; předběžně nastavit neplatný 2.znak mov c,a ; jména proměnné sta vartype ; a typ číslo rst 2 ; test dalšího znaku ze zdrojového ; kódu BASICu jc X0abd ; skok při jednopísmenné proměnné call isabcd ; jinak důkladný test 2. písmene ; názvu proměnné na znaky a cifry jc X0ac8 ; skok při jednopísmenné proměnné X0abd: mov c,a ; v BC je nyní jméno proměnné X0abe: rst 2 ; (rozlišují se jen první dva znaky) jc X0abe call isabcd ; následovat může libovolný počet jnc X0abe ; písmen a cifer X0ac8: sui '$' ; test na znak $, určující řetězec jnz X0ad5 inr a ; pokud je uveden, nastaví se typ sta vartype ; řetězec rrc ; a MSB druhého bajtu se jménem add c ; proměnné se nastaví na 1 mov c,a rst 2 ; posun na další znak ve zdrojovém ; kódu BASICu X0ad5: lda indxen ; u konstrukcí, kde chci zakázat dcr a ; použití indexované proměnné, jp X0ae2 ; přeskočím test na levou závorku ; (tím vyvolám Syntax err při jejím ; použití) mov a,m ; jinak ten test na levou závorku sui '(' ; provedu jz X0b43 ; a v případě indexu skok.. X0ae2: xra a ; závorka se nekonala, zruším zákaz sta indxen ; indexovaných proměnných push h lhld arrbase ; DE = konec proměnných xchg ; HL = začátek proměnných lhld varbase ; (jednoduché proměnné bez polí) ; ********************************************** ; smyčka pro vyhledání proměnné podle jména v BC ; ********************************************** ; (0AEEh) X0aee: rst 3 ; prošel jsem všechny proměnné ; bez nalezení té pravé? jz X0b05 ; pak ji musíme vytvořit mov a,c ; test druhého znaku jména proměnné sub m inx h jnz X0afa ; při neshodě běž na další proměnnou mov a,b ; test prvního znaku jména proměnné sub m X0afa: inx h jz X0b35 ; při shodě běž na zakončení inx h inx h ; jinak přeskočit následující inx h ; 4 bajty, které nesou vlastní inx h ; hodnotu proměnné (nebo odkaz) jmp X0aee ; a test další proměnné ; ************************************* ; vytvoření nové proměnné s názvem v BC ; ************************************* X0b05: pop h ; obnovit ukazatel zdrojového kódu xthl push d ; pokud je dotaz na adresu proměnné lxi d,X09bc ; volán z vyčíslení výrazu, pak se rst 3 ; proměnná nevytváří a do FP akumu- pop d ; látoru se uloží nula (odkaz na jz X0b38 ; nulový řetězec v případě vyčíslení xthl ; řetězcového výrazu) push h push b lxi b,6 lhld arrend push h dad b pop b push h ; pokus o alokaci 6 byte pro novou call X00d0 ; proměnnou s posunem bloku polí pop h shld arrend ; konec všech proměnných (i polí) mov h,b mov l,c shld arrbase ; konec jednoduchých proměnných X0b29: dcx h ; a nyní od konce zapíšu do nově mvi m,0 ; vzniklé proměnné šest nul rst 3 ; (DE ukazuje na adresu proměnné) jnz X0b29 pop d ; obnovím jméno proměnné z BC mov m,e ; a uložím je na pozici prvních inx h ; dvou bajtů proměnné mov m,d inx h ; *********************************************** ; společné zakončení výše uvedené rodiny procedur ; *********************************************** X0b35: xchg ; do DE uložit adresu proměnné+2 pop h ; a obnovit obsah HL ret X0b38: sta fpaccum+3 ; ve specifických případech se lxi h,nulstrg ; proměnná nevytvoří a nahradí shld fpaccum ; se nulovým výrazem (viz výše) pop h ret ; ************************************************** ; vyčíslení ukazatele na pole ; postupně načítá argumenty, oddělené čárkou a zvedá ; dimenzi pole (hodnoty indexů ukládá do zásobníku) ; ************************************************** ; (0B43h) X0b43: push h ; beze změny hodnoty HL se uloží lhld dimreq ; do zásobníku obsah adresy dimreq xthl ; (nenulová hodnota znamená požada- ; vek na vytvoření nové proměnné) mov d,a ; vynuluje se počitadlo rozměrů pole X0b49: push d ; uschovat počitadlo rozměrů push b ; uschovat jméno proměnné call X054c ; přečíst hodnotu indexu v rozsahu ; 0..31767 pop b ; obnovit jméno proměnné pop psw ; a aktuální počet rozměrů xchg ; pod poslední položku zásobníku se xthl ; uloží načtená 2B hodnota, určující push h ; počet položek v aktuálním rozměru xchg ; pole inr a ; zvednout dimenzi pole o jednu mov d,a ; a uložit do registru D mov a,m ; Je dalším znakem ve zdrojovém kódu cpi ',' ; čárka (oddělující další index)? jz X0b49 ; pokud ano, "přidáme" rozměr rst 1 ; vynutit pravou závorku .db ')' shld eofxpr ; uložit ukazatel do zdrojového kódu pop h ; a obnovit hodnotu dimreq, která se shld dimreq ; díky rekurzivnímu volnání mohla ; změnit mvi e,0 ; pozůstatek MS BASICu (nefunkční) push d ; uschovat počet načtených dimenzí lhld arrbase .db 3eh ; přeskočení následující instrukce ; DAD D (falešný kód MVI A,19h) X0b6c: dad d ; přeskočím na další pole xchg lhld arrend ; do DE načíst adresu konce polí xchg ; a porovnat s aktuální adresou rst 3 ; prohledal jsem všechna pole? jz X0b98 ; pokud ano, (a nic jsem nenašel) ; pak vytvoř nové pole mov a,m ; druhý znak jména aktuálního pole cmp c ; porovnám s druhým znakem jména inx h ; hledaného pole jnz X0b7e ; při neshodě ještě načtu adresu ; dalšího pole a test dalšího pole mov a,m ; první znak jména aktuálního pole cmp b ; porovnám s prvním znakem jména X0b7e: inx h ; hledaného pole mov e,m inx h ; do DE načtu posun adresy dalšího mov d,m ; pole oproti tomu aktuálnímu inx h jnz X0b6c ; zpožděný test shody jmén hledaného ; a aktuálního pole, při neshodě jdu ; na test dalšího pole shld arradr ; aktuální adresa v HL ukazuje "za" ; hlavičku nalezeného pole lda dimreq ; pokud jsem nalezené pole chtěl ana a ; znovu vytvořit (dimreq <> 0) jnz err_02 ; vyvolat chybu 02h - Arr.alloc. pop psw ; obnovit počet načtených dimenzí sub m ; a porovnat s počtem dimenzí pole jz X0bf4 ; při shodě běž vyhledat požadovaný ; prvek pole X0b95: mvi e,1 ; chyba 01h - Subscr.rng rst 5 ; (rozdílná dimenze pole) ; ********************* ; vytvoření nového pole ; ********************* X0b98: lxi d,4 ; pro nové pole se budou později ; alokovat 4x 2 bajty pop psw ; do A obnoví počet dimenzí ; do FLAGS načte samé nuly ; ..mvi e,0 výše.. jz X0569 ; chyba 03h - Fnc.param. ; (do FLAGS obnoví samé nuly, skok ; se nikdy neprovede - pozůstatek ; MS BASICu) mov m,c ; do prvních dvou bajtů hlavičky inx h ; nově vytvářeného pole uložit jméno mov m,b ; pole (ještě se pro něj nealokovalo inx h ; místo ale předpokládá se, že bude) mov c,a ; počet dimenzí pole do C call X00df ; vlastní alokace paměti pro pole inx h ; teď přeskočit dva bajty, kde inx h ; později (až to budu vědět) uložím ; velikost tohoto pole shld fncadr ; uložit si ukazatel mov m,c ; zapsat počet dimenzí do hlavičky inx h ; pole a přejít na další bajt lda dimreq ; pokud jsem pole nedefinoval ral ; (bylo implicitně vytvořeno mov a,c ; operací s ním) X0bb3: lxi b,0bh ; pak zvolit výchozí počet prvků 11 jnc X0bbb ; (počítá se od 0 => indexy 0..10) ; při explicitní definici pole pop b ; vybrat ze zásobníku poslední index inx b ; zvýšit rozsah indexu o prvek nula X0bbb: mov m,c ; do hlavičky pole zapsat hodnotu inx h ; maximálního rozsahu posledního mov m,b ; indexu inx h push psw ; v DE vstupuje velikost (v bajtech) push h ; o řád nižší struktury pole call hl_bxd ; vynásobit počtem prvků (v BC) xchg ; aktuálního indexu pop h ; a opět uložit do DE pop psw ; (v DE se kumuluje velikost paměti, ; kterou bude celé pole zabírat) dcr a ; jdeme na další (vyšší) index jnz X0bb3 ; pokud tedy ještě existuje push psw ; CY = požadavek na vytvoření pole mov b,d ; zálohovat velikost datové oblasti mov c,e ; pole xchg dad d ; HL = koncová adresa celého pole jc X0b95 ; test na přetečení adresy >FFFFh call X00e8 ; test volné paměti shld arrend ; uložit nový konec polí (posunuto ; o délku nového pole) X0bd9: dcx h ; celou datovou oblast nově vytvo- mvi m,0 ; řeného pole vyplnit nulami rst 3 jnz X0bd9 inx b ; zvětšit velikost pole o jeden bajt ; (bajt s údajem o počtu dimenzí) mov d,a lhld fncadr mov e,m ; DE = počet dimenzí pole xchg ; DE = celková velikost pole dad h ; (2 bajty na jednu dimenzi + dad b ; velikost datové oblasti) xchg dcx h ; ukazatel vrátit na začátek dcx h ; datové struktury založeného pole mov m,e inx h ; a zapsat do dvou vynechaných bajtů mov m,d ; celkovou velikost pole inx h pop psw ; pokud jsem pole chtěl jen založit, jc X0c16 ; tak končím ; jinak v HL předám ukazatel na ; počet dimenzí vytvořeného pole ; ***************************** ; vyhledá požadovaný prvek pole ; ***************************** X0bf4: mov b,a ; BC = 0000h (začínám sčítat prvky) mov c,a mov a,m ; A = počet dimenzí pole inx h .db 16h ; "falešná" instrukce mvi d,0e1h ; pro odstínění POP H X0bf9: pop h ; počínaje druhým indexem obnovím ; ukazatel do struktury pole ; HL "skáče" po začátcích dimenzí mov e,m ; do DE načtu maximální povolený inx h ; index pro danou dimenzi mov d,m inx h xthl ; uložím ukazatel na začátek další ; dimenze pole/do HL načtu další ; zadaný index push psw ; počitadlo dimenzí pole rst 3 ; překročil jsem povolený index? jnc X0b95 ; pak chyba 01h - Subscr.rng push h ; k HL přičtu počet prvků v nižší call hl_bxd ; dimenzi (ta vstupuje v BC) pop d dad d pop psw ; jdu na další index dcr a mov b,h ; počet prvků všech dimenzí včetně mov c,l ; té poslední uložím do BC jnz X0bf9 ; mám v zásobníku další index? dad h ; každý prvek pole zabírá 4 bajty, dad h ; proto počet prvků x 4 pop b dad b ; přičtu začátek datové oblasti xchg ; a v DE vrátím ukazatel na vybraný ; prvek pole X0c16: lhld eofxpr ; obnovit ukazatel na zdrojový text ret ; programu v BASICu ; ********** ; funkce FRE ; ********** ; (0c1ah) f_fre: lhld arrend ; funkce rozlišuje prostor xchg ; pro číselné a řetězcové proměnné lxi h,0 dad sp ; uvedením libovolné formální pro- lda vartype ; měnné daného typu jako parametru ana a ; se určí velikost dostupné paměti jz sub_de ; => pro číselné proměnné a program ; (prostor od konce posledního pole ; až po zásobník) call X1523 ; => pro řetězcové proměnné ??? X0c2c: call X0d75 lhld strlim xchg lhld strlast ; ************************************** ; do FP akumulátoru uloží rozdíl HL - DE ; ************************************** ; (0c36h) sub_de: mov a,l ; vypočte rozdíl sub e mov c,a ; A:C = HL - DE mov a,h sbb d ; ************************************************* ; převod 16-bitového čísla se znaménkem z A:C na FP ; ************************************************* ; (0c3bh) ac2fp: mov b,c ; ************************************************* ; převod 16-bitového čísla se znaménkem z A:B na FP ; ************************************************* ; (0c3ch) ab2fp: mov d,b mvi e,0 lxi h,vartype ; přepnout na číselné proměnné mov m,e mvi b,90h ; exponent 2^16 pro 16-bit integer jmp badefp ; ********** ; funkce POS ; ********** ; (0c48h) f_pos: lda colpos ; pouze načtu proměnnou ukazatele ; tiskového sloupce, která je ; zřízena jen za tímto účelem ; *********************************** ; převod hodnoty z reg. A na FP číslo ; *********************************** ; (0c4bh) X0c4b: mov b,a ; výsledek v akumulátoru postupně xra a ; převedu na FP číslo jmp ab2fp ; ********** ; příkaz DEF ; ********** ; (0c50h) c_def: call X0cb3 ; vynutit klíčové slovo FNC a ; zaregistrovat funkci jako novou ; proměnnou call prgtst ; test na programový režim lxi b,c_data ; po definici uživatelské funkce push b ; se samotný definiční výraz bude ; ignorovat jako například seznam ; položek za příkazem DATA push d ; v DE je adresa prvního bajtu ; ze čtyř, určujících obsah nově ; vytvořené proměnné ; (rozuměj Uživatelské funkce) rst 1 ; vynutit si .db '(' ; levou závorku call varadr ; vynutit si argument funkce call X08cb ; číselného typu (jeho adresa v DE) rst 1 ; vynutit si .db ')' ; pravou závorku rst 1 ; vynutit si .db 0ach ; kód znaku '=' mov b,h ; ukazatel na zápis definiční funkce mov c,l ; uložit do BC xthl ; do HL obnovit adresu na obsah ; proměnné (=funkce) jmp X0ca1 ; nadefinovat fiktivní "proměnnou", ; zastupující funkci a ignorovat ; samotný zápis funkce ; ********** ; funkce FNC ; ********** ; (0c6dh) X0c6d: call X0cb3 ; formálně vynutit klíčové slovo FNC push d ; a do DE uložit adresu na fiktivní ; proměnnou, kde je ; uložen odkaz na definiční funkci call X09a2 ; vyčíslit argument ; uživatelské funkce,který call X08cb ; musí být číselného typu xthl ; uschovat ukazatel na zdrojový kód ; programu BASICu a do HL načíst ; adresu fiktivní proměnné mov e,m inx h ; do DE načtu adresu definiční mov d,m ; funkce v zápise programu BASICu inx h mov a,m ; do HL uložím adresu proměnné, inx h ; která slouží jako argument funkce mov h,m mov l,a mov c,m ; do zásobníku uložím původní inx h ; hodnotu proměnné argumentu mov b,m ; a tuto proměnnou použiju inx h ; pro výčíslení hodnoty uživatelské push b ; funkce (poté obnovím tuto původní mov c,m ; hodnotu) inx h mov b,m push b dcx h ; do HL opět nastavím adresu dcx h ; proměnné argumentu dcx h push h ; DE = adresa zápisu definice fce rst 3 ; tento kód nedává smysl, DE ukazuje push d ; vždy do zápisu programu a HL někde jz X0569 ; na proměnnou (tento kousek není ; obsažen v originálním MS BASICu ; a autor PMD verze chtěl asi hlídat ; rekurzi, protože při té opravdu ; systém chybně zaplní celou paměť) ; v originále je pouze PUSH D call X111f ; obsah FP akumulátoru uloží ; postupně od adresy HL pop h ; obnovit ukazatel na definci funkce call numpar ; výpočet výrazu do FP akumulátoru dcx h rst 2 ; test na cifru na adrese HL jnz err_09 ; chyba 09h - Syntax err pop h ; obnovit adresu proměnné argumentu pop d ; a její obsah pop b ; vrátit na původní hodnotu ; ************************************************ ; nadefinovat fiktivní proměnnou, jejíž konstrukce ; poslouží k definici uživatelské funkce ; ************************************************ ; (0ca1h) X0ca1: mov m,c ; první dva bajty za jménem funkce inx h ; obsahují odkaz do programu BASICu, mov m,b ; kde začíná definice funkce ; za znakem rovnítko jmp X0cf0 ; do dalších dvou bajtů uložit ; adresu proměnné, která slouží jako ; argument funkce ; ************************ ; test na programový režim ; ************************ ; (0ca7h) prgtst: push h ; pokud je číslo aktuálního lhld crntln ; prováděného řádku rovno 65535 inx h ; (FFFFh), což znamená, že program mov a,h ; "nejede" (je v dialogovém režimu) ora l pop h rnz ; pak se vyvolá chyba 04.. ; ********************************** ; chybové hlášení 04h - "Only in pg" ; ********************************** ; (0cb0h) X0cb0: mvi e,4 ; vyvolání chyby 04h - Only in pg rst 5 ; přes standardní mechanismus ; ************************************************** ; zaregistrování jména funkce a kontrola jejího typu ; ************************************************** ; (0cb3h) X0cb3: rst 1 ; po příkazu DEF může následovat .db 9fh ; jedině klíčové slovo FNC mvi a,80h ; zakázat použití indexu v názvu sta indxen ; definované funkce (sami budeme ; používat závorky pro argument) ora m ; u jména funkce vnutím druhému mov b,a ; znaku nejvyšší bit = 1 call X0aa8 ; funkce se zaregistruje jako nová ; proměnná a formálně se vyčíslí jmp X08cb ; a výsledek musí být typ číslo.. ; ******** ; fce STR$ ; ******** ; (0cc2h) f_str: call X08cb ; typová kontrola argumentu na číslo call X1276 ; tisk FP čísla z FP akumulátoru do ; vyhrazeného 12-znakového buferu ; (do HL nastaví adresu zač. buferu) ; ******************************************** ; string od adresy HL přiřadím cílové proměnné ; ******************************************** X0cc8: call X0cf6 ; výpočet délky řetězce a dosazení ; odkazu na něj do pomocné proměnné ; laststg call X1523 ; ??? lxi b,X157a ; ??? push b ; ******************************************************** ; Vytvoří prac.kopii řetězcové proměnné včetně kopie textu ; ******************************************************** ; podle hlavičky proměnné na adrese HL nadefinuje hlavičku ; pomocné proměnné na adrese BE65 (tmpvar) a text proměnné ; nakopíruje do nově alokovaného prostoru ; ******************************************************** X0cd2: mov a,m ; načíst 0. bajt hlavičky řetězcové inx h ; proměnné, udávající její délku inx h push h call txaloc ; alokace volné paměti pro text pop h mov c,m ; načíst ukazatel na obsah inx h ; řetězcové proměnné mov b,m call X0cea ; inicializace hlavičky pracovní push h ; proměnné mov l,a ; a nyní samotné kopírování obsahu call strcpy ; řetězce do pomocné proměnné pop d ret ; ******************************************** ; vytvoření prázdné řetězcové proměnné délky A ; ******************************************** ; (0ce7h) X0ce7: call txaloc ; alokovat paměť pro text proměnné ; ************************************************ ; inicializace hlavičky pomocné řetězcové proměnné ; A = délka řetězce, DE = adresa obsahu (řetězce) ; ************************************************ X0cea: lxi h,tmpvar ; adresa hlavičky pomocné proměnné push h mov m,a ; zapsat délku vlastního řetězce inx h X0cf0: inx h mov m,e ; zapsat odkaz na vlastní řetězec inx h mov m,d pop h ret ; ??? ; ************************************** ; vyčíslení řetězce s predekrementací HL ; ************************************** X0cf6: dcx h ; ********************************************** ; adresu a délku řetězce uloženého od adresy HL ; dosadí do hlavičky pomocné proměnné a následně ; tuto hlavičku nakopíruju na adresu, uloženou ; v proměnné laststg ; ********************************************** ; (0cf7h) X0cf7: mvi b,22h ; řetězec může končit uvozkovkami mov d,b ; nebo alternativním znakem X0cfa: push h mvi c,0ffh ; inicializovat počitadlo délky X0cfd: inx h ; řetězce mov a,m ; načíst znak řetězce, inr c ; inkrementovat počitadlo jeho délky ana a jz X0d0c ; pokud nenastane konec řádku, cmp d jz X0d0c ; nepřijde znak dvojtečka (příkazy cmp b ; INPUT/DATA/REM) jnz X0cfd ; nebo uvozovky, pokračovat ; ve sčítání délky řetězce X0d0c: cpi 22h ; pokud byl string ukončen cz X04d1 ; uvozovkami, přeskočit je xthl inx h xchg ; DE = adresa 1. znaku řetězce mov a,c ; A = vypočtené délka call X0cea ; inicializace hlavičky pomocné ; proměnné (odkaz na text je nasmě- ; rován na zdrojový text) X0d18: lxi d,tmpvar lhld laststg ; ukazatel na předchozí proměnnou shld fpaccum ; uložit do FP akumulátoru mvi a,1 ; nastavit typ "řetězcová proměnná" sta vartype call X1122 ; zkompletovanou hlavičku řetězcové ; proměnné uložím do cílové proměnné ; jejíž adresa je v laststg rst 3 ; došlo k rekurzivnímu přepisu? shld laststg ; hodnotu zvednutou o 4 uložím zpět pop h mov a,m ; načtu znak za výrazem rnz mvi e,10h ; chyba 10h - Str.algrth rst 5 ; ************************************ ; tisk textu z adresy HL do editačního ; buferu s preinkrementací registru HL ; ************************************ ; (0d33h) X0d33: inx h ; ********************************************** ; tisk textu z adresy HL do editačního buferu ; tento text bude předtištěn v dialogovém řádku ; po přechodu do stavu, kdy BASIC čeká na příkaz ; ********************************************** tx2edi: call X0cf6 ; (0d34h) X0d37: call X1523 call X1116 ; (HL) > B:C:D:E inr e X0d3e: dcr e ; E = počet znaků k tisku rz ldax b ; BC = ukazatel na text k tisku call X03dd cpi 0dh ; přišel znak CR? cz X072d inx b ; další znak jmp X0d3e ; ****************************** ; alokace paměti pro řetězec, ; jehož délka je dodána v reg. A ; přidělenou adresu vrací v DE ; ****************************** ; (0d4dh) txaloc: ana a ; test délky řetězce .db 0eh ; mvi c,0f1h - odmaskování POP PSW X0d4f: pop psw push psw lhld strlim ; Test, zda výraz (strlast-A) xchg ; podkročí strlim (mez pro ukládání lhld strlast ; textů řetezcových proměnných). cma mov c,a mvi b,0ffh dad b inx h rst 3 ; Pokud se tam nový řetězec nevejde, jc X0d69 ; běž dále.. shld strlast ; Pokud se tam nový řetězec vejde, inx h ; zablokuj pro něj místo a vrať xchg ; ukazatel na toto volné místo pop psw ; v reg. DE. ret ; ********************************** ; uvolnění oblasti pro texty řetězců ; ********************************** X0d69: pop psw ; obnovit požadovanou délku řetězce ; (1. průchod) nebo příznak Z ; (při ostatních průchodech) mvi e,0fh ; a vyvolat chybu 0fh - No str.spc jz X0108 ; při jeho nulové délce (1. průchod) ; nebo při nulové uvolněné paměti ; (ostatní průchody) cmp a ; nahodit příznak Z=1 push psw lxi b,X0d4f ; připravit se na nový pokus push b ; o alokaci paměti X0d75: lhld stbase ; 9F00h X0d78: shld strlast lxi h,0 ; do zásobníku uložit textovou push h ; proměnnou, obsahující mimo jiné lhld strlim ; push h ; ukazatel na text proměnné lxi h,tmpstrg ; HL = BE59h X0d86: xchg lhld laststg ; DE = poslední řetězec xchg rst 3 ; ??? lxi b,X0d86 jnz X0dd2 lhld varbase X0d95: xchg ; nyní budu procházet jednoduché lhld arrbase ; proměnné s ukazatelem v HL xchg ; až po začátek polí (ARRBASE) rst 3 ; prohledal jsem všechny proměnné? jz X0da9 ; ano => skok dál mov a,m ; jinak načíst první znak jména inx h ; proměnné inx h ; a do příznaku S nastavit typ ana a ; proměnné (S = 1 => řetězcová) call X0dd5 jmp X0d95 ; jdu na další proměnnou ; *********** ; volání 0da9 X0da8: pop b ; ??? X0da9: xchg lhld arrend xchg rst 3 jz X0df7 call X1116 mov a,e push h dad b ana a jp X0da8 shld fncadr pop h mov c,m mvi b,0 dad b dad b inx h X0dc6: xchg lhld fncadr xchg rst 3 jz X0da9 lxi b,X0dc6 X0dd2: push b ori 80h ; ***************************************************** ; u řetězcové proměnné nenulové délky, která již byla ; přemístěna do uklizené oblasti změní v zásobníku ; poslední dvě položky na adresu následující proměnné ; a ukazatel na související text této proměnné ; ***************************************************** ; (0dd5h) X0dd5: mov a,m ; A = délka textu řetězcové proměnné inx h inx h mov e,m ; DE = adresa textu inx h mov d,m inx h rp ; je-li to číselná proměnná, vrať se ana a ; je-li délka řetězce rz ; nulová, pak taky návrat mov b,h ; do BC uschovat adresu proměnné mov c,l lhld strlast rst 3 ; leží text řetězce výše než ukazuje mov h,b ; hodnota HL (STRLAST)? mov l,c rc ; pak konec, taky nic neřešíme pop h ; leží text řetězce v oblasti xthl ; programu (řetězcová konstanta)? rst 3 xthl push h mov h,b mov l,c rnc ; pak s proměnnou nic nedělej, konec pop b ; ??? jinak uschovat návratovou adresu pop psw pop psw ; jinak v zásobníku změň poslední push h ; dvě položky na adresu další push d ; proměnné a její ukazatel na text push b ; obnovit návratovou adresu ret ; a konec ; ********************** ; opět stringy ; (0df7h) X0df7: pop d ; ??? pop h mov a,l ora h rz dcx h ; BC = mov b,m dcx h mov c,m push h dcx h dcx h mov l,m mvi h,0 dad b mov d,b mov e,c dcx h mov b,h mov c,l lhld strlast call X00d3 ; kopíruje (DE..BC) => (HL) pop h mov m,c inx h mov m,b mov l,c mov h,b dcx h jmp X0d78 ; ************************************ ; operace + nad řetězcovými proměnnými ; ************************************ ; (0e1ch) X0e1c: push b push h lhld fpaccum ; uschovat odkaz na první řetězec xthl ; do zásobníku call X094b ; načíst odkaz na druhý řetězec xthl ; uschovat druhý/obnovit první call t_strg ; typová kontrola na řetězec mov a,m ; délka prvního řetězce push h lhld fpaccum push h add m ; plus délka druhého řetězce mvi e,0eh ; dají při délce větší než 255 znaků jc X0108 ; chybu 0Eh - Strng long call X0ce7 ; založit 4B hlavičku proměnné ; na adrese BE65 s platnou délkou ; a odkazem na prázdné alokované ; místo pro nový řetězec pop d ; obnovit odkaz na druhou proměnnou call X1527 ; a z něj ukazatel na vlastní text xthl ; uložit ukazatel na 2. text ; do zásobníku call X1526 ; obnovený odkaz na 1. proměnnou push h ; přetvořím na ukazatel na 1. text ; a rovněž uložím do zásobníku lhld tmpvar+2 ; z pomocné proměnné načtu adresu xchg ; alokovaného místa pro výsledek call X150d ; a zkopíruji tam první řetězec call X150d ; a druhý řetězec lxi h,X08e8 ; budu se vracet do obecné vyhodno- xthl ; covací smyčky, ovšem až po push h jmp X0d18 ; zkopírování pomocné proměnné ; do bloku proměnných ; *********** ; příkaz POKE ; *********** ; (0e53h) c_poke: call numpar ; do FP aukulátoru vyčíslit adresu call tstint ; a povolit jen rozsah -32768..32767 push d rst 1 ; vynutit oddělovací čárku .db ',' X0e5c: rst 4 ; načte SHORT INTEGER pop d stax d ; uložit načtený bajt dcx h rst 2 cpi ',' ; následuje čárka? rnz inx d ; pokud ano, inkrementace adresy pro zápis push d rst 2 ; přeskočit oddělovací čárku jmp X0e5c ; a zapsat do paměti další bajt.. ; ************ ; příkaz APOKE ; ************ ; (0e6ah) c_apok: call numpar ; do FP aukulátoru vyčíslit adresu call tstint ; a povolit jen rozsah -32768..32767 push d ; adresu zápisu schovat do zásobníku rst 1 ; vynutit oddělovací čárku .db ',' .db 3eh ; mvi a,0d7h X0e74: rst 2 ; přeskočit mezery call numpar ; načíst do FP číslo call tstint ; a povolit jen rozsah -32768..32767 xthl mov m,e ; obnovit ze zásobníku adresu pro inx h ; zápis a sekvenčně zapsat načtený mov m,d ; 16-bitový parametr (little endian) inx h xthl ; adresu pro zápis znovu uložit dcx h rst 2 ; následuje po parametru čárka? cpi ',' jz X0e74 ; pokud ano, zpracovat další parametr pop d ; víceméně zrušit adresu pro zápis ret ; a konec ; ************************************* ; připočte hodnotu 0,5 k FP akumulátoru ; ************************************* ; (0e8ah) X0e8a: lxi h,X1808 ; konstanta 0,5 ; ******************************************** ; připočte konstantu z paměti k FP akumulátoru ; ******************************************** ; (0e8dh) X0e8d: call X1116 ; načíst B:C:D:E z adresy HL jmp X0e9c ; *********************************************** ; do FP akumulátoru vypočte rozdíl FP čísla ; uloženého na adrese HL a čísla v FP akumulátoru ; *********************************************** ; (0e93h) X0e93: call X1116 ; načíst B:C:D:E z adresy HL .db 21h ; lxi h,.. ; ******************************** ; obslužná procedura operátoru "-" ; ******************************** ; (0e97h) X0e97: pop b ; ze zásobníku obnovit pop d ; FP číslo do B:C:D:E ; **************************************** ; FP akumulátor := B:C:D:E - FP akumulátor ; **************************************** ; (0e99h) X0e99: call X10f0 ; otočení znaménka u čísla ; v FP akumulátoru ; **************************************** ; FP akumulátor := B:C:D:E + FP akumulátor ; **************************************** ; (0e9ch) X0e9c: mov a,b ; pokud je nulové FP číslo ana a ; v B:C:D:E, pak se obsah rz ; FP akumulátoru nemění lda fpaccum+3 ; pokud je nulové číslo v FP ana a ; akumulátoru, pak zkopírovat jz fpbcde ; B:C:D:E do FP akumulátoru sub b ; výpočet rozdílu exponentů jnc X0eb6 ; obou FP čísel cma inr a ; (pokud je rozdíl záporný, xchg ; prohodí se obě čísla, aby call pushfp ; tento rozdíl byl kladný, xchg ; tj. aby exponent čísla call fpbcde ; v FP akumulátoru byl větší) pop b pop d X0eb6: cpi 25 ; pokud je číslo B:C:D:E menší rnc ; o 25 a více dvojkových řádů, ; pak se na součtu neprojeví ; (rozlišení mantisy je totiž ; ca 24 bitů = dvojkových řádů) push psw ; převést mantisy obou čísel call X112d ; do interního kódu MS BASIC mov h,a ; a do H uschovat kód 80h při shodě pop psw ; znamének (jinak 00h) call manrgt ; mantisu FP čísla v C:D:E:B ora h ; posunout doprava o tolik bitů, lxi h,fpaccum ; kolik činí rozdíl exponentů ; (právě jsem obě čísla zarovnal ; na stejný exponent) jp X0edc ; při opačných znaménkách sčítaných ; čísel jdu na výpočet rozdílu call X0f41 ; jsou-li znaménka sčítaných čísel ; stejná, sečtu mantisy do C:D:E:B jnc X0f22 ; a pokud nedošlo k přetečení, ; převedu výsledek do FP akumulátoru ; pokud je mantisa moc velká, budu inx h ; ji posouvat o jeden bit doprava, inr m ; musím tedy inkrementovat exponent ; abych zachoval hodnotu čísla ; pokud při tom exponent přeteče jz X0f3e ; zahlásím chybu 08h - Overflow mvi l,1 ; posunu tedy mantisu doprava, abych call X0f77 ; měl kam dát ten "přetečený" bit jmp X0f22 ; výsledek převedu do FP akumulátoru ; **************************************** ; sčítání mantis čísel s opačným znaménkem ; **************************************** ; (0edch) X0edc: xra a ; začít rozšiřujícím bajtem, který sub b ; nemá poziční ekvivalent mov b,a ; v FP akumulátoru mov a,m sbb e ; a následně odečíst mov e,a inx h mov a,m sbb d ; všechny mov d,a inx h mov a,m sbb c ; tři ostatní bajty mantisy mov c,a ; přechod na závěrečnou normalizaci ; FP čísla ; ****************************************************** ; normalizace 32-bitového čísla v C:D:E:B, jeho oříznutí ; na 24 bitů C:D:E a uložení do FP akumulátoru ; ****************************************************** ; (0eeah) fpnorm: cc maninv ; v případě záporného čísla ; vynásobit mantisu x (-1) X0eed: mov l,b mov h,e xra a ; počitadlo posunů vlevo (kvůli ; korekci exponentu je záporné) X0ef0: mov b,a mov a,c ; budu rotovat sekvenci C:D:H:L ana a ; doleva tak dlouho, dokud jnz X0f0f ; na nejvyšší bit mantisy mov c,d ; nevyjede jedničkový bit mov d,h ; mov h,l ; zde je zkratka po osmi bitech, mov l,a ; pokud je C v C:D:H:L nulové mov a,b sui 8 ; cpi 0e0h ; pokud jsem vysunul (-)32 bitů jnz X0ef0 ; a nejvyšší byte mantisy je stále ; nulový, pak je i výsledek nulový ; ********************************** ; do FP akumulátoru dosadí hodnotu 0 ; ********************************** ; (0f02h) fpzero: xra a ; Nula představuje speciální stav X0f03: sta fpaccum+3 ; FP čísla, kdy stačí vynulovat ret ; exponent. ; ************************************************* ; vysouvání mantisy v C:D:H:L doleva po jednom bitu ; ************************************************* ; (0f07h) X0f07: dcr b ; dokud je nejvyšší bit mantisy dad h ; nulový, odečtu v reg. B jednu mov a,d ; shiftovací pozici a provedu ral ; posun kaskády C:D:H:L doleva mov d,a ; o jeden bit mov a,c adc a mov c,a X0f0f: jp X0f07 ; nejvyšší bit mantisy je nulový? mov a,b ; už ne, už tam je jednička mov e,h mov b,l ; B = rozšiřující bajt mantisy ana a jz X0f22 lxi h,fpaccum+3 ; exponent FP čísla zmenším o tolik add m ; řádů, o kolik pozic jsem posunul mov m,a ; mantisu vlevo (v ACC přišel počet ; posunů se záporným znaménkem) jnc fpzero ; je-li výsledný exponent příliš ; malý, vrátit hodnotu nula rz ; konec, je-li výsledek nulový ; (exponent FP akumulátoru už je 0) X0f22: mov a,b ; pokud je v rozšiřujícím byte X0f23: lxi h,fpaccum+3 ; mantisy číslo >127, zokrouhlím ana a ; mantisu tak, že cm X0f34 ; přičtu +1 k její 3-bajtové části mov b,m ; exponent výsledku do reg. B inx h mov a,m ; z rozšiřujícího byte mantisy ani 80h ; extrahuji znaménkový bit xra c ; a vložím jej na pozici MSB mov c,a ; reg. C - nejvyššího bajtu mantisy jmp fpbcde ; FP číslo z B:C:D:E dá do FP akum. ; ******************************************************* ; zaokrouhlení mantisy v C:D:E přičtením jedničky ; (při přetečení se inkrementuje exponent FP akumulátoru) ; ******************************************************* ; (0f34h) X0f34: inr e ; základní inkrementace mantisy rnz inr d rnz inr c rnz ; a pokud nepřetekla, tak konec mvi c,80h ; mantisa přetekla, tak provedeme inr m ; inkrementaci exponentu a pokud X0f3d: rnz ; zůstal v pracovním rozsahu, konec X0f3e: mvi e,8 ; ovšem při jeho přetečení rst 5 ; vyvolat chybu 08h - Overflow ; **************************** ; sčítání mantis dvou FP čísel ; **************************** ; (0f41h) X0f41: mov a,m ; ukázka sčítání čísel větší add e ; délky než 16 bitů :) mov e,a inx h mov a,m adc d mov d,a inx h mov a,m adc c mov c,a ret ; ************************************** ; negace rozšířené mantisy C:D:E:B ; (B je zde ve funkci rozšíření mantisy) ; ************************************** ; (0f4dh) maninv: lxi h,fpaccum+4 ; negace hodnoty rozšiřujícího bajtu mov a,m ; mantisy v FP akumulátoru cma mov m,a xra a ; výpočet inverze mov l,a sub b ; C:D:E:B := 0 - C:D:E:B mov b,a mov a,l sbb e mov e,a mov a,l sbb d mov d,a mov a,l sbb c mov c,a ret ; ***************************************** ; posun mantisy v C:D:E:B doprava o A pozic ; ***************************************** ; (0f61h) manrgt: mvi b,0 ; vynulovat rozšíření mantisy X0f63: sui 8 ; lze posunout najednou o 8 pozic? jc X0f70 ; pokud ne, jdi na jemný posun mov b,e ; jinak posuň mantisu o osm bitů mov e,d ; doprava s přetečením do rozšiřu- mov d,c ; jícího byte v registru B mvi c,0 jmp X0f63 ; a posouvej dál.. X0f70: adi 9 ; stornovat pokus o posun o 8 bitů mov l,a ; požadovaný počet posunů do L X0f73: xra a ; a v této smyčce otrocky posouvat dcr l ; mantisu, uloženou v sekvenci rz ; registrů C:D:E:B, vždy o jeden bit mov a,c ; vpravo X0f77: rar mov c,a mov a,d rar mov d,a mov a,e rar mov e,a mov a,b rar mov b,a jmp X0f73 ; ****************************************** ; funkce LOG - výpočet přirozeného logaritmu ; ****************************************** ; Interně je FP číslo kódováno jako m x 2^n, kde m je manti- ; sa a n je dvojkový exponent. A protože logaritmus součinu ; je roven součtu logaritmů, platí: ; LN(m x 2^n) = LN(m) + LN(2^n) ; převodem na dvojkový logaritmus dostaneme vztah: ; LN(m x 2^n) = 0,693147 x [ LOG2(m) + LOG2(2^n)] ; = 0,693147 x [ LOG2(m) + n] ; kvůli rychlosti konvergence aproximační řady použijeme ; transformaci: m <=> m/(sqrt(2)/2) ; tím nahradíme výpočet LOG2(m) výpočtem ; LOG2((m-sqrt(2)/2)/(m+sqrt(2)/2))-0,5 což je ; použitá sekvence LOG2(1-(sqrt(2)/(m+sqrt(2)/2)))-0,5 ; (0f85h) f_log: rst 6 ; znaménko čísla v FP akumulátoru jpe X0569 ; pokud parametr není kladný, ; vyvolá chybu 03h - Fnc.param. lxi h,fpaccum+3 mov a,m lxi b,8035h ; konstantu 0,5*sqrt(2) = 0.707... lxi d,04f3h ; uložíme do B:C:D:E sub b ; odečtu posun nuly exponentu (80h) push psw ; a čistý dvojkový exponent uschovám mov m,b ; exponent má nyní hodnotu 1 ; a mantisa neovlivněná exponentem ; vstupuje do dalších výpočtů push d ; FP := FP + sqrt(2)/2 push b ; (k mantise přičtu sqrt(2)/2) call X0e9c pop b pop d inr b ; B:C:D:E := sqrt(2) (tj. 1.414...) call X1021 ; FP := sqrt(2) / FP lxi h,X17f7 call X0e93 ; FP := 1 - FP lxi h,X17fb ; aproximace LOG2(x) mocninnou řadou call oaprox ; s lichými koeficienty lxi b,8080h ; FP := FP - 0,5 lxi d,0000h call X0e9c pop psw ; obnovit čistý exponent původního call X124c ; čísla a přičíst k FP ; **************************************************** ; vynásobení výsledku v FP akumulátoru číslem 0,693147 ; (přechod z dvojkového na přirozený logaritmus) ; **************************************************** X0fba: lxi b,8031h ; a vynásobením x 0,693147 převedeme lxi d,7218h ; z dvojkového na přirozený logaritmus .db 21h ; lxi h,.. ; **************************************** ; obslužná procedura operátoru krát ; do FP akumulátoru uloží součin sebe sama ; a FP čísla, uloženého v zásobníku ; **************************************** ; (0fc1h) X0fc1: pop b ; do B:C:D:E načíst FP číslo pop d ; ze zásobníku ; ********************************************* ; FACCU := FACCU x B:C:D:E ; reg. B slouží jako prodloužení mantisy vpravo ; a kumuluje vysouvané nejnižší složky součinu ; ********************************************* ; (0fc3h) X0fc3: rst 6 ; je-li ve FP akumulátoru nula, rz ; tak je to i výsledek :) mvi l,0 ; exponenty se v případě násobení call X1091 ; FP čísel pouze sečtou mov a,c ; mantisu C:D:E uložím jako přímé sta X0ff9+1 ; parametry instrukcí v těle xchg ; vlastní násobící smyčky shld X0ff4+1 lxi b,0 ; vynulovat pracovní mantisu mov d,b ; včetně jejího prodloužení v reg. B mov e,b lxi h,X0eed ; po ukončení násobení bude push h ; následovat normalizace čísla lxi h,X0fe3 ; smyčka násobení 8-bitovým číslem push h ; se po přímém vykonání vyvolá push h ; ještě 2x (push h + push h) ; tj. násobení 24-bitovou mantisou ; z FP akumulátoru lxi h,fpaccum ; začínáme od LSB FP akumulátoru X0fe3: mov a,m ; načtu aktuální bajt FP akumulátoru inx h ana a ; a pokud je nulový, provedu jz X100e ; pouze posun vlevo (urychlení) push h ; uschovat ukazatel na aktuální bajt ; FP akumulátoru xchg ; HL = LSB a NSB pracovní mantisy mvi e,8 ; postupné "násobení" všemi bity X0fed: rar ; vynásobím C:D:E:B aktuálním bitem ; FP akumulátoru mov d,a ; uschovat akt. bajt FP akumulátoru mov a,c ; A = MSB pracovní mantisy jnc X0ffb ; při násobení nulou jen rotace push d ; při násobení jedničkou i součet X0ff4: lxi d,0 ; k sekvenci A:H:L (prac. mantisa) dad d ; přičte 24-bitovou hodnotu, kterou pop d ; jsme do "LXI D,xxxx" a "ACI 80h" X0ff9: aci 80h ; uložili na začátku procedury X0ffb: rar ; rotace pracovní mantisy o jeden mov c,a ; bit vpravo, výsledek se uloží mov a,h ; do sekvence C:H:L:B rar mov h,a mov a,l rar mov l,a mov a,b rar mov b,a dcr e ; odpočet bitů aktuálního bajtu mov a,d ; obnovit aktuální bajt FP akumul. jnz X0fed ; je další bit? xchg ; pokud ne, LSB a NSB pracovní ; mantisy obnovím do DE X100c: pop h ; obnovím adresu na aktuální bajt ; FP akumulátoru ret ; a ve skutečnosti jdu na další bajt X100e: mov b,e ; v případě dílčího násobení nulovým mov e,d ; bajtem se jen posune pracovní mov d,c ; mantisa C:D:E:B vpravo o osm bitů mov c,a ret ; a ve skutečnosti jdu na další bajt ; ************************************* ; obsah FP akumulátoru vydělí číslem 10 ; ************************************* ; (1013h) X1013: call pushfp ; FP akumulátor uloží do zásobníku lxi b,8420h lxi d,0000h ; konstantu 10 call fpbcde ; uloží do FP akumulátoru ; ********************************** ; FP číslo v zásobníku vydělí číslem ; z FP akumulátoru ; ********************************** ; (101fh) X101f: pop b ; do B:C:D:E načíst FP číslo pop d ; ze zásobníku ; **************************************** ; obslužná procedura operátoru "děleno" ; FP akumulátor := B:C:D:E / FP akumulátor ; **************************************** ; (1021h) X1021: rst 6 ; při dělení nulou vyvolat jz err_0c ; chybu 0ch - Dv by zero mvi l,0ffh ; exponent FP čísla v FP akumulátoru call X1091 ; nastaví na rozdíl exponentů inr m ; dělence a dělitele a tím určí inr m ; exponent výsledného podílu dcx h mov a,m ; mantisu dělitele uložit jako sta X104f+1 ; přímé operandy instrukcí dcx h ; v sekvenci odečítání dělitele mov a,m sta X104b+1 dcx h mov a,m sta X1047+1 mov b,c ; B:H:L := mantisa dělence xchg ; C:D:E := 0 xra a mov c,a mov d,a mov e,a sta X1052+1 X1044: push h ; uschovat hodnotu průběžného push b ; zbytku v B:H:L mov a,l X1047: sui 0 ; od průběžného zbytku v B:H:L mov l,a ; odečtu mantisu dělitele mov a,h X104b: sbi 0 mov h,a mov a,b X104f: sbi 80h mov b,a X1052: mvi a,0 ; prodloužení průběžného zbytku sbi 0 ; před B:H:L (znaménko) cmc jnc X1061 ; byl-li zbytek < dělitel, pak skok sta X1052+1 ; jinak akceptovat odečet a nechat pop psw ; jej v B:H:L pop psw stc .db 0d2h X1061: pop b ; obnovit původní hodnotu průběžného pop h ; zbytku před odečtem mov a,c ; ??? inr a dcr a rar jm X0f23 ; korekce a FP := B:C:D:E ral mov a,e ; C:D:E posunout vlevo s nasunutím ral ; výsledku odečtu zprava mov e,a mov a,d ral mov d,a mov a,c ral mov c,a dad h ; posun prodloužené sekvence mov a,b ; (1052h):B:H:L vlevo jako ral ; pokračování sekvence C:D:E mov b,a lda X1052+1 ral sta X1052+1 mov a,c ; ??? ora d ora e jnz X1044 push h lxi h,fpaccum+3 ; ??? dcr m pop h jnz X1044 jmp X0f3e ; chyba 08h - Overflow ; ********************************************* ; provede součet/rozdíl exponentů dvou FP čísel ; reg. L = součet(=0) nebo rozdíl (=0FFh) ; reg. B = exponent prvního FP čísla ; (FP akumulátor+3) = exponent druhého FP čísla ; výsledný exponent uloží do (FP akumulátor+3) ; ********************************************* ; (1091h) X1091: mov a,b ; je-li exponent prvního FP čísla ana a ; nulový, pak je v FP akumulátoru jz X10b3 ; (jeho exponentu) hotový výsledek mov a,l ; přepínač součet/rozdíl lxi h,fpaccum+3 ; sečte exponenty obou FP čísel xra m ; očištěné od posunu nulové hodnoty add b ; a testuje extrémy (nula/nekonečno) mov b,a rar xra b mov a,b jp X10b2 ; skok při některém z extrémů adi 80h ; k výsledku operace nad exponenty mov m,a ; přičíst posun nuly (80h) a uložit ; do exponentu FP akumulátoru jz X100c ; nulová hodnoty FP čísla call X112d ; do mantis načíst úvodní jedničky mov m,a ; znaménko do rozšiřujícího ; byte FP akumulátoru dcx h ; posun na exponent FP akumulátoru ret ; **************************************************** ; generování mezních hodnot ; při podtečení zvolí nulu, při přetečení vyvolá chybu ; **************************************************** X10af: rst 6 ; určí znaménko exponentu (-1/0/+1) cma ; které však otočí pop h X10b2: ana a ; a podle toho.. X10b3: pop h jp fpzero ; při podtečení pod rozlišovací ; schopnost FP interpretace vrátí ; nulovou hodnotu (lim 1/e^n >> 0) jmp X0f3e ; v opačném případě ; vyvolá chybu 08h - Overflow ; ******************************************* ; vynásobí hodnotu v FP akumulátoru číslem 10 ; ******************************************* ; (10bah) fp_x10: call X1113 ; FP >> B:C:D:E mov a,b ; je-li v FP akumulátoru nula, ana a rz ; je to i výsledek adi 2 ; dvojkový exponent zvětšený o dva ; znamená vynásobit číslo čtyřmi jc X0f3e ; testovat a hlásit přetečení mov b,a ; uložit zpět exponent call X0e9c ; k FP akumulátoru přičíst FP číslo, ; uložené v kaskádě B:C:D:E ; máme vynásobeno 5x lxi h,fpaccum+3 ; vynásobíme FP akumulátor dvěma inr m ; (zvedneme dvojkový exponent o 1) jmp X0f3d ; a provedeme test na přetečení ; ****************************************** ; pokračování RST 6 - test znaménka FP čísla ; ****************************************** ; (10d0h) X10d0: lda fpaccum+2 ; MSB mantisy drží znaménko (pokud se ; ovšem nejedná o čistou nulu, pak je ; nulový exponent) .db 0feh ; cpi .. X10d4: cma ral ; CY = znaménko čísla X10d6: sbb a ; A=00h pro kladná, A=FFh pro záporná jmp X167c ; ********** ; funkce SGN ; ********** ; (10dah) f_sgn: rst 6 ; načte hodnotu -1/0/+1 dle hodnoty FP ; ***************************************************** ; převede 8-bitové číslo se znaménkem z ACC na FP číslo ; ***************************************************** ; (10dbh) a2fp: mvi b,88h ; exponent 2^8 pro FP číslo lxi d,0 ; oba MSB jsou nulové, ACC nese hodnotu ; *********************************************** ; číslo B:A:D:E převede na normalizované FP číslo ; *********************************************** ; (10e0h) badefp: lxi h,fpaccum+3 mov m,b ; uložit exponent mov c,a ; B:A:D:E >> B:C:D:E:00 >> (exp):C:D:E:B mvi b,0 ; vynulovat prodloužení inx h mvi m,80h ; do prodloužení FP akumulátoru uložit ; hodnotu 0,5 pro zaokrouhlení ; při normalizaci ral ; do CY uložit znaménko jmp fpnorm ; ********** ; funkce ABS ; ********** ; (10eeh) f_abs: rst 6 ; test znaménka rp ; a pokud je kladné, konec ; *********************************************** ; Otočení znaménka u FP čísla v akumulátoru FACCU ; *********************************************** ; (10f0h) X10f0: lxi h,fpaccum+2 ; u čísla uloženého v FP akumulátoru mov a,m xri 80h ; neguje znaménkový bit mov m,a ret ; *********************************** ; Uložení FP akumulátoru do zásobníku ; *********************************** ; (10f8h) pushfp: xchg lhld fpaccum ; "pod" návratovou adresu xthl ; v zásobníku vsune 2x 2bajty push h ; FP akumulátoru lhld fpaccum+2 xthl push h xchg ret ; **************************************************** ; FP číslo, uložené od adresy, dané obsahem reg. HL ; uloží do FP akumulátoru (s mezizápisem přes B:C:D:E) ; **************************************************** ; (1105h) X1105: call X1116 ; (HL) > B:C:D:E ; **************************************** ; FP číslo B:C:D:E uloží do FP akumulátoru ; **************************************** ; (1108h) fpbcde: xchg shld fpaccum mov h,b mov l,c shld fpaccum+2 xchg ret ; ***************************************************** ; číslo z FP akumulátoru nakopíruje do registrů B:C:D:E ; ***************************************************** ; (1113h) X1113: lxi h,fpaccum ; ************************************************** ; od adresy uložené v reg. HL načte FP číslo B:C:D:E ; ************************************************** ; (1116h) X1116: mov e,m inx h mov d,m inx h mov c,m inx h mov b,m X111d: inx h ret ; ************************************** ; obsah FP akumulátoru uloží do paměti ; od adresy, dané obsahem reg. HL ; ************************************** ; (111fh) X111f: lxi d,fpaccum ; *************************************** ; přenos 4 bajtů z adresy DE na adresu HL ; *************************************** X1122: mvi b,4 ; *************************************** ; přenos B bajtů z adresy DE na adresu HL ; *************************************** X1124: ldax d mov m,a inx d inx h dcr b jnz X1124 ret ; ************************************************ ; převod mantis dvou FP čísel z formátu dvojkového ; doplňkového kódu na meziformát MS BASICu ; ************************************************ ; (112dh) X112d: lxi h,fpaccum+2 ; nastavit úvodní jedničku na pozici mov a,m ; MSB mantisy v FP akumulátoru rlc stc rar mov m,a cmc ; a negovaný původní znaménkový bit rar ; uložit do rozšiřujícího bajtu inx h ; FP akumulátoru na pozici MSB inx h mov m,a mov a,c ; nastavit úvodní jedničku na pozici rlc ; MSB mantisy v C:D:E stc rar mov c,a rar ; v ACC vrátí 80h při shodě xra m ; znamének, jinak 00h ret ; *********************************************** ; Porovnání FP čísel v FP akumulátoru a v B:C:D:E ; *********************************************** ; (1142h) X1142: mov a,b ; Pokud je B:C:D:E nulové, provést ana a ; analýzu FP akumulátoru jz X0030 ; (vyjde to na stejno) lxi h,X10d4 ; adresa závěrečné procedury, která push h ; vrací stavy -1/0/+1 rst 6 ; při nulovém FP akumulátoru mov a,c ; test znaménka čísla v B:C:D:E rz ; (via X10d4) lxi h,fpaccum+2 ; při nerovnosti znamének čísel xra m ; porovnat jen znaménka mov a,c rm ; (via X10d4) call X115a ; jinak poctivě porovnat obě čísla ; (při shodě se sem už nevracíme) rar ; při neshodě sestavit pseudobyte xra c ; obsahující relaci a znaménko ret ; a jít na X10d4 ; ******************************************************* ; porovná FP číslo v B:C:D:E s FP číslem v FP akumulátoru ; ******************************************************* ; (115ah) X115a: inx h ; bajt po bajtu porovná mov a,b ; sekvenci B:C:D:E cmp m ; se čtveřicí hodnot v paměti rnz dcx h ; porovnává se od nejvíce významného mov a,c ; směrem k nejméně významnému cmp m rnz ; při neshodě procedura končí dcx h ; a příznaky Z, CY (ale i další) mov a,d ; reflektují relaci mezi položkami cmp m rnz ; při shodě se jde testovat další dcx h ; méně významný člen sekvence mov a,e sub m rnz pop h ; při shodě zrušit návratovou adresu pop h ; a skok na proceduru X10d4 ret ; ***************************************************** ; do B:C:D:E uloží celočíselnou část FP čísla z B:C:D:E ; ***************************************************** ; (116dh) X116d: mov b,a ; nastavit nulovou hodnotu výsledku mov c,a mov d,a mov e,a ana a ; pro případ rz ; nulového vstupního argumentu push h call X1113 ; načíst argument z FP do B:C:D:E call X112d ; C:D:E naplnit absolutní hodnotou ; mantisy čísla a převést na interní ; kódování xra m ; původní znaménko argumentu mov h,a ; uložit do registru H cm X1191 ; u záporných čísel návrat z dvojko- ; vého doplňku na jedničkový doplněk mvi a,98h ; posunout mantisu doprava o tolik sub b ; pozic, abych zbyla jen celá část call manrgt ; (odehrává se v C:D:E) mov a,h ; zde se dělá rozdíl mezi INT(+N) ral ; a INT(-N), tzn. pro záporné číslo cc X0f34 ; je absolutní hodnota výsledku ; menší o 1 oproti kladnému číslu mvi b,0 ; nulový exponent (posun mantisy) cc maninv ; negace mantisy pro záporná čísla pop h ret ; ************************* ; dekrement kaskády B:C:D:E ; ************************* X1191: dcx d ; nejprve dekrement D:E a při mov a,d ana e inr a ; podtečení na 0FFFFh se rnz dcx b ; dekrementuje i B:C ret ; ********** ; funkce INT ; ********** ; (1198h) f_int: lxi h,fpaccum+3 ; načíst dvojkový exponent mov a,m ; pokud je posun mantisy vpravo cpi 98h ; >24bitů (98h-80h=18h=24), pak lda fpaccum ; číslo v FP akumulátoru žádnou rnc ; desetinnou část nemá => konec mov a,m ; načíst původní exponent pro případ ; nulové hodnoty call X116d ; výpočet celé části v B:C:D:E mvi m,98h ; celá mantisa bude před des. tečkou ; (zatím je v FP akumulátoru původní ; číslo) mov a,e ; některé funkce vyžadují hodnotu push psw ; LSB mantisy, tak ji schováme mov a,c ; načíst znaménko mantisy ral ; do příznakového bitu CY call fpnorm ; a provést její normalizaci pop psw ; do ACC obnovit LSB mantisy ret ; ******************** ; výpočet HL = BC x DE ; ******************** ;(11b1h) hl_bxd: lxi h,0 ; vynulovat průběžný akumulátor mov a,b ; test triviálního případu BC = 0 ora c ; nulová hodnota registru BC rz ; vyvolá konec s nulovou hodnotou HL mvi a,16 ; 16 kroků násobení (délka DE) X11b9: dad h ; posun akumulátoru vlevo jc X0b95 ; a v případě přetečení ; chyba 01h - Subscr.rng xchg ; posun DE vlevo s vysunutím MSB dad h ; do příznakového bitu CY xchg jnc X11c7 ; při nulovém bitu CY nedělat nic dad b ; ale při jedničkovém provedu jc X0b95 ; HL = HL + BC a testuju přetečení X11c7: dcr a ; pronásobit BC dalším bitem z DE jnz X11b9 ; a to celkem 16x ret ; ****************************************************** ; při vyhodnocování výrazu byla nalezena cifra, proto se ; BASIC pokusí převést sekvenci cifer na FP číslo ; ****************************************************** X11cc: cpi '-' ; bude tam unární mínus? push psw ; příznak Z uschovat pro pozdější test jz X11d8 cpi '+' ; nebo tam je unární plus? jz X11d8 ; to jen přeskočíme dcx h ; připravit na čtení dalšího znaku X11d8: call fpzero ; vynulovat FP akumulátor mov b,a ; B = počet desetinných cifer mov d,a ; D = příznak znaménka exponentu mov e,a ; E = hodnota desítkového exponentu cma ; C = rozlišení celočíselné mov c,a ; a desetinné části čísla X11e0: rst 2 ; test dalšího znaku mantisy jc X1235 ; je-li to cifra, přidej ji k číslu cpi '.' ; test na desetinnou tečku jz X1210 cpi 'E' ; test na exponenciální zápis jnz X1214 ; pokud není, přeskočit jeho načtení rst 2 ; načíst první znak exponentu push h ; a pro případ, že by to bylo lxi h,X1204 ; znaménko, připravit se na zadání xthl ; vlastní hodnoty exponentu dcr d ; příznak záporného exponentu cpi 0a5h ; otestovat token operátoru '-' rz cpi '-' ; otestovat unární mínus exponentu rz inr d ; shodit příznak zápor. exponentu cpi '+' ; a otestovat formální unární plus rz ; exponentu cpi 0a4h ; a ještě token operátoru '+' rz pop psw ; nepřišlo žádné znaménko, začínáme dcx h ; číslem (zrušíme odskok - pop psw) ; načtení a vyčíslení exponentu X1204: rst 2 ; dokud je platná cifra, jc X1257 ; načítej do E hodnotu exponentu inr d ; pokud byl nastaven příznak jnz X1214 ; záporného exponentu, pak xra a ; se znaménko exponentu v registru E sub e ; otočí mov e,a inr c ; přeskočení následujícího testu X1210: inr c ; po zadání celočíselné části volá jz X11e0 ; ještě jednou pro desetinnou část X1214: push h ; ukazatel do zdojového textu BASICu ; uschovat do zásobníku mov a,e ; exponent - počet desetinných míst sub b ; uložit do registru A X1217: cp fpscal ; podle potřeby je číslo v FP jp X1223 ; akumulátoru posouváno buď vlevo push psw ; nebo vpravo, tak aby se dosáhlo call X1013 ; výsledku ve tvaru: pop psw inr a ; 0.NNNNNN x 10^E X1223: jnz X1217 pop d ; (0,5 <= mantisa < 1) pop psw ; obnovit výsledek testu na unární cz X10f0 ; mínus (pokud bylo, provedeme ; negaci čísla v FP akumulátoru) xchg ; do HL obnovit ukazatel na zdrojový ret ; text programu v BASICu ; **************************************************** ; vynásobí FP akumulátor deseti včetně podpory iterace ; **************************************************** ; (122dh) fpscal: rz ; poslední iterace? => konec fpx10i: push psw call fp_x10 ; vlastní násobení FP := FP x 10 pop psw dcr a ; další iterace ret ; ******************************************* ; přidání cifry v registru A k FP akumulátoru ; ******************************************* ; (1235h) X1235: push d ; uschovat příznak negat. exponentu mov d,a ; uschovat hodnotu cifry mov a,b ; pokud C indikuje desetinnou část adc c ; čísla, přičítat k B počet mov b,a ; načtených desetinných míst push b ; uschovat pracovní registry push h push d call fp_x10 ; a FP akumulátor vynásobit deseti pop psw ; obnovit načítanou cifru sui 30h ; převést ji na absolutní hodnotu call X124c ; a přičíst k FP akumulátoru pop h pop b ; obnovit pracovní registry pop d jmp X11e0 ; a zpět do smyčky čtení znaků ; ************************************************** ; přičte cifru v registru A k hodnotě FP akumulátoru ; ************************************************** ; (124ch) X124c: call pushfp ; FP akumulátor do zásobníku call a2fp ; A do FP akumulátoru ; **************************************** ; obslužná procedura operátoru + ; do FP akumulátoru uloží součet sebe sama ; a FP čísla, uloženého v zásobníku ; **************************************** pop b ; do B:C:D:E zformuje FP číslo pop d ; uložené v zásobníku jmp X0e9c ; a volá samotný součet ; **************************************************** ; načte cifru ze zdrojového textu BASICu a nasune ji ; do registru E zprava (používá se pro načtení hodnoty ; exponentu s max. hodnotou 38) ; **************************************************** ; (1257h) X1257: mov a,e ; obsah registru E rlc ; vynásob dvěma.. rlc ; čtyřmi.. add e ; pěti.. rlc ; vlastně deseti add m ; a přičti cifru z adresy dané HL sui '0' mov e,a jmp X1204 ; vrať se do hlavní procedury ; *************************** ; tiskne string "at line xxx" ; *************************** ; (1263h) X1263: push h ; uschovat číslo řádku lxi h,X16ff ; text "at line " call tx2edi ; vytisknout na obrazovku pop h ; obnovit číslo řádku ; ************************************************ ; 16-bitovou hodnotu v HL převede na FP a vytiskne ; ************************************************ ; (126bh) X126b: xchg ; HL převedeme na nenormalizované xra a ; číslo B(exponent):A:H:L mvi b,98h ; pak už stačí jen (98h-80h=18h=24) call badefp ; 24 shiftů doleva, abychom z čísla lxi h,X0d33 ; 0.A:H:L udělali číslo A:H:L.0 push h ; po tisku do 12-znakového buferu ; se provede další "tisk", tentokrát ; do předtiskového buferu ; **************************************** ; vytiskne FP číslo do 12-znakového buferu ; **************************************** X1276: lxi h,fpprtbf ; adresa tiskového buferu push h rst 6 ; test na znaménko, není-li záporné, mvi m,' ' ; vynechat mezeru jp X1282 mvi m,'-' ; jinak tam vložit unární mínus X1282: inx h ; pokud je číslo nulové, uložit mvi m,'0' ; jen cifru "0" jz X1337 ; a zakončit push h cm X10f0 ; záporná čísla převést na kladná xra a ; vynulovat počet řádových posunů push psw ; a uschovat do zásobníku call X133d ; pokud je číslo větší než 999999, ; skočit na část, kde se posouvá ; vpravo (dělí se deseti) X1291: lxi b,9143h ; dokud je číslo menší než 100000, lxi d,4ff8h ; posouvat vlevo (násobí se deseti) call X1142 ; jpo X12ae pop psw call fpx10i push psw jmp X1291 X12a5: call X1013 ; FP := FP/10 pop psw ; počitadlo snížených řádů inr a ; zvětšit o jedna push psw call X133d ; opakuj dokud je FP číslo > 999999 ; nyní máme prvních šest cifer ; mantisy jako integer a upravenou ; (nenormovanou) hodnotu exponentu X12ae: call X0e8a ; šestimístnou mantisu inr a ; ve FP akumulátoru call X116d ; zaokrouhlit call fpbcde ; (+0,5 > INT > COPY to FP) lxi b,0306h ; B : standardně 1 cifra před čárkou ; C : standardně 6 cifer přesnost pop psw ; počitadlo snížených řádů add c ; inr a ; čísla menší než 0,01 jsou tištěna jm X12ca ; v exponenciálním tvaru cpi 8 ; a čísla větší než 999999 jsou také jnc X12ca ; tištěna v exponenciálním tvaru inr a mov b,a ; nulový exponent (N x 10^0 = N) mvi a,2 ; tedy zápis bez exponentu X12ca: dcr a ; A = 2 + exponent dcr a ; B = 2 + počet cifer před čárkou pop h push psw lxi d,tb10ex ; tab. desítkové báze dcr b jnz X12db mvi m,'.' ; pro rozšíření rozsahu čísel, kdy inx h ; není použit exponenciální tvar, mvi m,30h ; je pro B=2 použito ještě zápisu inx h ; 0.0xxxxxx (rozlišení 6 cifer) X12db: dcr b ; vyčerpal jsem cifry celé části mvi m,'.' ; čísla a nastal čas pro vložení cz X111d ; desetinné čárky? push b ; uschovat počitadlo cifer push h ; a ukazatel do tiskového buferu push d ; uschovat tab. desítkové báze call X1113 ; (B):C:D:E := FP pop h ; HL = tab. desítkové báze mvi b,'0'-1 ; inicializace cifry X12ea: inr b ; od celočíselné hodnoty mantisy mov a,e ; v C:D:E odečítá zvolený desítkový sub m ; řád a v registru B formuje mov e,a ; ASCII interpretaci cifry, určující inx h ; počet daných desítkových řádů mov a,d ; v hodnotě mantisy sbb m mov d,a inx h mov a,c sbb m mov c,a dcx h dcx h ; a to se opakuje, dokud mantisa jnc X12ea ; není menší než nula call X0f41 ; pak stornovat poslední odečet inx h call fpbcde ; do FP uložit C:D:E xchg pop h ; obnovit ukazatel do tiskového mov m,b ; buferu a zapsat cifru aktuálně inx h ; zjištěného řádu, pak posun pop b ; obnovit počitadlo platných číslic dcr c ; a pokud je co tisknout, jnz X12db ; tak tisk další cifry dcr b ; jsou poslední cifry desetinné? jz X131b ; pokud ne, přeskočit test.. X130f: dcx h ; odmazání nevýznamných nul mov a,m ; desetinného čísla zprava cpi '0' jz X130f cpi '.' ; je-li posledním znakem desetinná cnz X111d ; tečka, umazat i tuto X131b: pop psw ; pokud je exponent nulový, jz X133a ; zakončit "tiskem" nulového bajtu mvi m,'E' ; jinak pokračujeme tiskem znaku 'E' inx h ; jako prefixem exponentu mvi m,'+' jp X132b ; podle polarity exponentu zvolíme mvi m,'-' ; a zapíšeme jeho znaménko cma ; pro převod hodnoty exponentu inr a ; na ASCII změníme jeho znaménko X132b: mvi b,'0'-1 ; do B uložit přímo ASCII znak, X132d: inr b ; reprezentující počet desítek sui 0ah ; hodnoty exponentu jnc X132d adi 3ah ; korekce zbytku na výpočet jednotek inx h ; exponentu do registru A mov m,b ; zapsat cifru desítek exponentu X1337: inx h ; (včetně nevýznamné nuly) mov m,a ; zapsat cifru jednotek exponentu inx h X133a: mov m,c ; a zakončit nulovým bajtem pop h ret X133d: lxi b,9474h ; pomocná rutina, která se podílí lxi d,23f7h ; na opakovaném dělení čísla call X1142 ; v FP akumulátoru deseti, dokud je pop h ; větší než 999999 jpo X12a5 pchl ; ******************************************************** ; uloží do zásobníku adresu procedury pro otočení znaménka ; ******************************************************** ; (134bh) X134b: lxi h,X10f0 ; volací adresu procedury pro negaci xthl ; zamění s navrátovou adresou, pchl ; na kterou se vrátí řízení programu ; ************************************* ; funkce SQR (druhá odmocnina) ; ************************************* ; její výpočet je realizován dle vztahu ; SQR(X) = x ^ 0.5 ; ************************************* ; (1350h) f_sqr: call pushfp ; argument schovat do zásobníku lxi h,X1808 ; do FP akumulátoru načíst hodnotu call X1105 ; konstanty mocnitele 0.5 ; *********************************************** ; funkce ^ (obecná mocnina) ; *********************************************** ; vypočte obecnou mocninu ; základ mocniny (mocněnec) je uložen v zásobníku ; exponent (mocnitel) je uložen v FP akumulátoru ; *********************************************** ; výpočet je realizován pomocí funkcí LOG a EXP ; dle vztahu: x^n = e^(n x ln(x)) ; *********************************************** ; pozn. k odlišení exponentu z definice mocniny ; od exponentu z interpretace FP čísla je ; v textu použito výrazů mocněnec/mocnitel ; *********************************************** X1359: pop b ; mocněnec načíst ze zásobníku pop d ; do sekvence registrů B:C:D:E rst 6 ; test mocnitele (x^0 je vždy 1) mov a,b ; (zatím nezavázně načíst znaménko ; mocněnce) jz f_exp ; při nulovém mocniteli převést ; výpočet na EXP(0), což je 1 jp X1367 ; pro kladné hodnoty mocnitele ; přeskočit test dělení nulou ; (x^-n) = 1/(x^n) ana a ; a pokud bych chtěl dělit tou nulou ; (mocněnec = 0) jp err_0c ; pak chyba 0c - Dv by zero ; chyba! zde měla být instrukce ; jz err_0c ; jinak totiž kromě dělení nulou se ; jako chyba vyhodnotí i všichni ; mocněnci s hodnotou <0,5 X1367: ana a ; test mocněnce na případnou nulu jz X0f03 ; 0^n je vždy nula push d ; mocněnec uschovat do zásobníku push b mov a,c ; test znaménka mocněnce ori 7fh call X1113 ; mocnitel z FP akum. do B:C:D:E jp X1384 ; kladný mocněnec => výpočet přímo ; pro záporné hodnoty mocněnce je ; nutno ohlídat znaménko push d ; následující sekvence vypočte push b ; rozdíl mezi mocnitelem a jeho call f_int ; celočíselnou hodnotou pop b pop d ; a nastaví příznaky push psw call X1142 ; Z = 1 pro záporný mocněnec (kladné pop h ; jsme totiž vyloučili) mov a,h ; CY = 1 pro kombinaci lichý mocni- rar ; tel/záporný mocněnec X1384: pop h ; mocněnec do FP akumulátoru shld fpaccum+2 pop h shld fpaccum cc X134b ; pro liché hodnoty mocnitele ; záporného mocněnce bude na závěr ; výpočtu otočeno znaménko cz X10f0 ; záporný mocněnec vždy převést ; na kladný push d ; a nyní už počítáme podle předpisu push b call f_log ; ..logaritmus mocněnce.. pop b pop d call X0fc3 ; ..vynásobíme mocnitelem.. ; a použijeme jako exponent ; funkce e^x ; ********************************************************* ; funkce EXP - exponenciální funkce nad přirozeným základem ; ********************************************************* ; (139ch) f_exp: call pushfp ; argument uložený v FP akumulátoru lxi b,8138h ; a konstantu 1/ln(2) lxi d,0aa3bh ; (přirozený logaritmus) call X0fc3 ; vzájemně vynásobit ; =přechod z přirozeného na dvojkový ; základ logaritmu lda fpaccum+3 ; pokud je exponent větší než 127, cpi 88h ; (2^7) pak ihned vyvolat přetečení jnc X10af ; pokud je argument menší než -127, ; (2^-7), je výsledek pod mezí ; rozlišení, tedy nula call f_int ; nyní přesněji otestovat argument adi 80h ; na max. +87 (větší generuje chybu adi 2 ; přetečení) a min. -88 (menší jc X10af ; generuje podtečení, tedy nulu) ; ..testuje se LSB mantisy.. push psw ; uschovat LSB mantisy FP čísla lxi h,X17f7 ; FP konstanta 1.0 call X0e8d ; bude připčtena k FP akumulátoru call X0fba ; vynásobení konstantou 0,693147 pop psw ; pro přechod z dvojkového na přiro- ; zený logaritmus pop b ; obnovit původní argument funkce pop d push psw call X0e99 ; a od něj odečíst poslední výsledek call X10f0 ; změnit znaménko lxi h,X181e ; aproximace polynomem call approx ; se sadou 8 koeficientů lxi d,0 ; obnovit závěrečnou konstantu pop b mov c,d jmp X0fc3 ; pro finální vynásobení ; ********* ;funkce RND ; ********* ; (13dch) f_rnd: rst 6 ; test znaménka argumentu lxi h,X183f ; při záporném argumentu skok jm X143b ; na samostatnou rutinu ; pro nulový argument lxi h,X1860 ; poslední hodnotu funkce RND call X1105 ; načíst do FP akumulátoru lxi h,X183f ; rz ; a předat ven jako hodnotu funkce ; pro kladný argument add m ; připravit další ze sady osmi! ani 7 ; multiplikativních konstant mov m,a inx h mvi b,0 ; dle pořadí konstanty add a ; určit její adresu add a mov c,a dad b call X1116 ; načíst multiplikativní konstantu call X0fc3 ; a vynásobit obsah FP akumulátoru lda X23f3 ; připravit další ze sady tří inr a ; aditivních konstant ani 3 ; (proměnná na adrese 23F3h nabývá mvi b,0 ; pouze hodnot 1, 2 nebo 3) cpi 1 adc b sta X23f3 lxi h,X1860 ; dle pořadí konstanty add a ; načíst její adresu add a mov c,a dad b call X0e8d ; a tuto konstantu přičíst ; *********************************************** ; společná část RND pro kladný a záporný argument ; *********************************************** X1416: call X1113 ; obsah FP akumulátoru uloží ; do sekvence B:C:D:E mov a,e ; nyní se provedou bitové mov e,c ; manipulace, které je xri 4fh ; těžké (a zbytečné) mov c,a ; popisovat matematicky mvi m,80h ; opět nějaké hardcore dcx h ; bitové manipulace nad mov b,m ; vlastním FP akumulátorem mvi m,80h ; (někdy méně znamená více) lxi h,X2177 ; další prvek, vnášející inr m ; nahodilost mov a,m sui 0abh jnz X1432 mov m,a inr c dcr d inr e X1432: call X0eed ; provést normalizaci ; čísla v B:C:D:E ; (zde konečně dochází k ; expanzi rozsahu 0.5 < n < 1 ; na rozsah 0 < n < 1) lxi h,X1860 ; uložit nově vypočtené jmp X111f ; pseudonáhodné číslo ; ************************** ; RND se záporným parametrem ; ************************** X143b: mov m,a ; chyba! RND se záporným dcx h ; argumentem přepíše mov m,a ; poslední koeficient dcx h ; aproximačního polynomu mov m,a ; pro výpočet funkce EXP jmp X1416 ; a tak pak hlásí přetečení! ; ********** ; příkaz DEG ; ********** ; (1443h) c_deg: .db 0f6h ; ori 0afh - maskování XRA A ; a uložení nenulové hodnoty ; ********** ; příkaz RAD ; ********** ; (1444h) c_rad: xra a ; jen uložit atribut zvolené sta v_dgrd ; obloukové míry ret ; ********** ; funkce COS ; ********** ; (1449h) f_cos: lxi h,X1870 ; konstantu 1.5708 (RAD) lda v_dgrd ana a jz X1456 ; nebo lxi h,X22fe ; konstantu 90° (DEG) X1456: call X0e8d ; přidat k argumentu funkce jako ; fázový posun COS vůči SIN ; ********************************************************** ; funkce SIN(x) ; ********************************************************** ; k výpočtu se použije součet mocninné řady: ; SIN(x) = x-(x^3)/3!+(x^5)/5!-(x^7)/7!+(x^9)/9! ; upravené pro jednodušší aplikaci do tvaru: ; SIN(x) = x(1+x^2(-1/3!+x^2(1/5!+x^2(-1/7!+x^2(1/9!))))) ; argument je kvůli normalizaci dělen číslem 2PI, proto jed- ; notlivé koeficienty řady obsahují kumulativní mocniny 2PI ; ********************************************************** ; (1459h) f_sin: call pushfp ; uložit argument do zásobníku lxi b,8349h lxi d,0fdbh ; podle zvolené obloukové míry se lda v_dgrd ana a ; buď konstantou 360° (DEG) jz X146f ; nebo 6,28319 (RAD) lxi b,8934h lxi d,0000h X146f: call fpbcde pop b pop d ; obnovený argument funkce call X1021 ; vydělí (360° resp. 2PI => 1.0) call pushfp ; odečteme celočíselné násobky 2PI call f_int ; čímž dosáhneme předpokládané pop b ; periodicity 2PI pop d call X0e99 lxi h,X1874 ; pro -0,25 < argument < 0,25 call X0e93 ; (0..45°) je aproximace dostatečně rst 6 ; přesná stc jp X1492 ; a tak jdeme hned na součet řady call X0e8a ; převod argumentu z rozsahu rst 6 ; 0,25 až 0,5 zrcadlově na rozsah ana a ; 0 až 0,25 X1492: push psw ; kompenzace posunu 0,25 z testu cp X10f0 ; nicméně základní interval lxi h,X1874 ; aproximace pro hodnoty call X0e8d ; -0,25 < argument < 0,25 zůstává.. pop psw cnc X10f0 lxi h,X1878 ; se sadou koeficientů aproximační ; řady jít na aproximaci funkce SIN ; ********************************************** ; součet mocninné řady pouze lichých koeficientů ; ********************************************** ; (14a3h) oaprox: call pushfp ; každý člen řady vypočítat vydělený lxi d,X0fc1 ; vstupní hodnotou X a tímto X pak push d ; vynásobit výsledek (vytknutí X) push h ; dále lze výpočet zjednodušit call X1113 ; "zkvadratizováním" X - pak je call X0fc3 ; řada počítána defacto jen pro pop h ; každý druhý člen (zde pro liché) ; ********************************************** ; obecný součet mocninné řady ; (všimněte si pořadí operací krát a plus, řada ; je sčítána ve tvaru s postupným vytýkáním X, ; což ovšem nic nemění na hodnotách koeficientů) ; ********************************************** ; (14b2h) approx: call pushfp ; argument uložit do zásobníku mov a,m ; od adresy HL načíst postupně inx h ; počet koeficientů a následně ; samotné koeficienty call X1105 ; do FP načíst první koeficient .db 06h ; mvi b,0f1h - maskování POP PSW ; při výpočtu prvního člene řady X14bb: pop psw ; obnovit počet zbývajících členů pop b ; obnovit argument pro výpočet pop d ; do B:C:D:E dcr a ; je celá řada sečtena? rz ; pokud ano, pak konec push d ; jinak uložit argument pro výpočet push b ; dalšího člene řady zpět push psw ; a uložit počet zbývajících členů push h ; průběžný výsledek vynásobit call X0fc3 ; argumentem X (nebo taky X^2, že?) pop h call X1116 ; načíst další koeficient řady push h call X0e9c ; a přičíst k průběžnému výsledku pop h jmp X14bb ; běž na další člen řady ; ********** ; funkce TAN ; ********** ; (14d3h) f_tan: call pushfp ; argument uložit pro výpočet COS call f_sin ; nyní vypočíst hodnotu SIN pop b pop h call pushfp ; výsledek funkce SIN uschovat xchg call fpbcde ; FP nyní nese opět vstupní argument, call f_cos ; ze kterého vypočteme hodnotu COS jmp X101f ; a dle definice ; TAN(x)=SIN(x)/COS(x) vydělíme.. ; ********** ; funkce ATN ; ********** ; (14e8h) f_atn: rst 6 ; funkce je lichá, takže pro záporné ; argumenty připraví otočení cm X134b ; znaménka výsledku a provede cm X10f0 ; otočení znaménka argumentu lda fpaccum+3 ; pro čísla menší než 1 cpi 81h jc X1503 ; provede výpočet přímo lxi b,8100h ; v ostatních případech vypočte mov d,c ; převrácenou hodnotu argumentu mov e,c call X1021 lxi h,X0e93 ; a připraví korekci výsledku ve push h ; tvaru (PI/2) - výsledek X1503: lxi h,X188d ; aproximaci mocninnou řadou call oaprox ; s lichými koeficienty lxi h,X1870 ; adresa aditivní konstanty PI/2 pro ret ; případnou korekci výsledku při ; argumentu >1 ; *********************************************** ; kopírování řetězce podle jeho hlavičky, uložené ; v zásobníku pod návratovou adresou ; DE - cílová adresa pro uložení řetězce ; *********************************************** ; (150dh) X150d: pop h xthl ; zpod návratové adresy mov a,m ; vytáhnout adresu řetězcové inx h ; proměnné (její hlavičky) inx h ; a načíst: mov c,m ; inx h ; do reg. L - délku mov b,m ; do reg. BC - adresu textu mov l,a ; (DE se dodá zvenku) ; *********************************** ; kopírování řetězce ; (délka L, z adresy BC na adresu DE) ; *********************************** ; (1516h) strcpy: inr l X1517: dcr l ; test zbývající délky přenosu rz ; a konec při posledním znaku ldax b stax d ; samotný přenos znaku inx b inx d ; posun adres jmp X1517 ; další znak ; ************************************************* ; do HL uloží adresu 4b hlavičky řetězcové proměnné ??? ; ************************************************* X1520: call t_strg ; typová kontrola na řetězec X1523: lhld fpaccum ; do DE uloží adresu X1526: xchg ; řetězcové proměnné ; *************************************** ; v DE vstupuje adresa řetězcové proměnné ; *************************************** X1527: call X153f ; BC <= adresa tmpstrg xchg ; DE <= adresa zdrojové proměnné rnz ; není to poslední proměnná ; HL = původní hodnota DE push d ; mov d,b mov e,c dcx d mov c,m lhld strlast rst 3 jnz X153d mov b,a ; HL = HL + délka textu aktuálního dad b ; řetězce shld strlast X153d: pop h ret ; ***************************************************** ; pomocná vyhledávací procedura pro řetězcové proměnné ; do BC načte odkaz na text aktuální řetězcové proměnné ; a posune se na předchozí proměnnou ; ***************************************************** X153f: lhld laststg ; ??? dcx h mov b,m dcx h mov c,m dcx h dcx h rst 3 rnz shld laststg ret ; ********** ; funkce LEN ; ********** ; (154eh) f_len: lxi b,X0c4b ; funkci převodu reg. A na FP číslo push b ; uložím do zásobníku ; *************************************** ; do HL nastaví adresu řetězcové proměnné ; a do A jeho délku ; *************************************** ; (1552h) getlen: call X1520 ; do HL uloží adresu proměnné ; z 0. a 1. bajtu FP akumulátoru xra a mov d,a sta vartype ; výsledkem funkce je typ číslo mov a,m ; načíst délku řetězce ana a ; a test s ovlivněním příznaků CPU ret ; návrat nebo přepočet A >> FP ; ********** ; funkce ASC ; ********** f_asc: lxi b,X0c4b ; funkci převodu hodnoty z reg. A push b ; na FP číslo uložím do zásobníku call getlen ; do HL načtu adresu zadané proměnné jz X0569 ; chyba 03h - Fnc.param. ; (nulová délka řetězce) inx h inx h ; třetí a čtvrtý bajt řetězcové mov e,m ; proměnné nese adresu uložení inx h ; vlastního textu mov d,m ldax d ; první bajt textu (jeho hodnotu) ret ; uložím do reg. A a převedu na FP ; *********** ; funkce CHR$ ; *********** ; (156eh) f_chr: mvi a,1 ; pro délku 1 bajt call X0ce7 ; vytvořit řetězcovou proměnnou call tst255 ; test argumentu na rozsah 0..255 lhld tmpvar+2 ; načíst adresu vytvořené řetězcové proměnné mov m,e ; a zapsat ten znak, přetypovaný ; z typu int256 na typ char X157a: pop b jmp X0d18 ; zkopírovat 4bajtovou hlavičku ; proměnné z tmpvar do laststg ; a ukazatel do FP akumulátoru ; ************ ; funkce LEFT$ ; ************ ; (157eh) f_left: call X1600 ; do reg. B načíst číselný parametr ; a vynutit si pravou závorku xra a ; výběr začne "prvním" znakem ; v reg. A je první znak výběru X1582: xthl ; HL = ukazatel na zdrojový řetězec ; (jeho hlavičku) ; BASIC programu schovám do STACKu) mov c,a ; C = první znak výběru X1584: push h ; (vstup od MID$) mov a,m ; načíst délku řetězce cmp b ; porovnat s požadovanou délkou jc X158c ; překračuje-li délka výběru délku ; zdrojového řetězce, přenést celý ; zdrojový řetězec mov a,b ; jinak přenést požadovanou délku X158b: .db 11h ; (..lxi d,000eh) a nenulovat reg. C X158c: mvi c,0 ; při nedostatku znaků u RIGHT začít ; paušálně od "prvního" znaku push b ; C = první znak výběru z řetězce call txaloc ; alokace paměti délky A ; (v DE se vrátí adresa) pop b ; obnovit meze výběru pop h ; obnovit adresu hlavičky proměnné push h ; z hlavičky proměnné přečtu do inx h ; HL adresu začátku řetězce inx h mov b,m ; sice se nám zde ztratí informace inx h ; o délce výběru (reg. B) ale tu mov h,m ; délku zjistíme z délky alokované mov l,b ; paměti pro cílový řetězec (reg. A) mvi b,0 ; v reg. C nám zůstala pozice dad b ; prvního znaku výběru ze zdrojového mov b,h ; řetězce a tak adresu začátku mov c,l ; vypočteme do HL=BC call X0cea ; dle délky a adresy vybraného ; textu nastavit hlavičku pomocné ; proměnné na adrese tmpvar mov l,a ; vybraný text se zkopíruje do nově call strcpy ; alokovaného místa pop d ; do DE obnovit adresu hlavičky ; zdrojové proměnné call X1527 ; ??? jmp X0d18 ; zkopírovat 4bajtovou hlavičku ; proměnné z tmpvar do laststg ; a ukazatel do FP akumulátoru ; ************* ; funkce RIGHT$ ; ************* ; (15aeh) f_rajt: call X1600 ; do reg. B načíst číselný parametr ; a vynutit si pravou závorku pop d ; obnovit do DE ukazatel push d ; na zdrojový řetězec ldax d ; a načíst jeho délku sub b ; odečíst požadovaný počet znaků jmp X1582 ; zprava a dále už je to stejné ; pro LEFT$ / MID$ / RIGHT$ ; *********** ; funkce MID$ ; *********** f_mid: xchg ; (15b8h) mov a,m call X1603 ; načíst adresu proměnné a první push b ; dva parametry mvi e,255 ; default třetí parametr cpi ')' ; je 3. parametr uveden explicitně? jz X15c8 ; => NE rst 1 ; pokud ano, pak vynutit .db ',' ; oddělovací čárku a načíst rst 4 ; třetí parametr X15c8: rst 1 ; teď už musí přijít pravá závorka .db ')' pop psw ; v reg. A je první znak výběru xthl lxi b,X1584 ; připravit se na přechod ke kopí- push b ; rování výběru dcr a ; pozici 1. znaku odpovídá adresa 0 cmp m ; test dostatečné délky zdrojového ; řetězce mvi b,0 ; pokud není dost znaků, rnc ; kopíruju vše od prvního znaku ; je-li dost znaků, mov c,a ; pak C = první znak mov a,m ; je od něj doprava dost znaků? sub c cmp e ; pokud chybí v řetězci znaky, vzít mov b,a ; od prvního znaku výběru doprava rc ; všechny další znaky mov b,e ; jinak použít tolik znaků, kolik ret ; předepisuje 3. parametr ; ********** ; funkce VAL ; ********** ; (15ddh) f_val: call getlen ; načíst délku řetězce argumentu jz fpzero ; je-li nulová, pak je výsledek nula mov e,a ; E = délka řetězce inx h ; v HL vstupuje odkaz na proměnnou inx h mov a,m inx h mov h,m ; z té proměnné načteme adresu mov l,a ; vlastního textu do HL push h ; a tu uschováme do zásobníku dad d ; posunout se na konec řetězce mov b,m ; načíst znakovou zarážku (uvozovky) mov m,d ; místo ní vložit nulu xthl ; uschovat adresu změněné zarážky ; a obnovit adresu začátku řetězce push b ; uschovat původní zarážku call X023d ; řetězec do buferu c_odloz inx h ; ukazatel na začátek buferu c_odloz call numpar ; do FP akumulátoru vyhodnotit ; hodnotu číselného výrazu mov a,m ; řetězec musí jít vyhodnotit celý ana a ; (musí následovat koncová nula) jnz err_09 ; jinak chyba 09h - Syntax err. pop b ; obnovit zarážku pop h ; a adresu její změny mov m,b ; vrátit původní zarážku zpět ret ; a konec ; ************************* ; podpora LEFT$/RIGHT$/MID$ ; ************************* ; (1600h) X1600: xchg rst 1 ; vynutit ukončující závorku .db ')' X1603: pop b pop d ; DE = hodnota prvního parametru po stringu push b mov b,e inr b dcr b rnz ; při nulové pozici výběru vyvolat jmp X0569 ; chybu 03h - Fnc.param. ; ********** ; funkce INP ; ********** ; (160dh) f_inp: call tst255 ; parametr, který si funkce sebou sta X1613+1 ; nese ve FP akumulátoru otestovat X1613: in 0 ; na 8-bitový rozsah a použít jako jmp X0c4b ; adresu portu. Načtený bajt z portu ; převést na FP číslo. ; ********** ; příkaz OUT ; ********** ; (1618h) c_out: call X161e ; Načíst adresu portu a hodnotu X161b: out 0 ; a tuto hodnotu poslat na port. ret ; Nothing else matters.. ; **************************************** ; příkaz OUT/WAIT - načte adresu periferie ; **************************************** ; (161eh) X161e: rst 4 ; načte SHORT INTEGER sta X198d+1 ; uloží adresu portu pro WAIT sta X161b+1 ; uloží adresu portu pro OUT rst 1 ; vynutit .db ',' ; oddělovací čárku ; ********************** ; GET SHORT INT (0..255) ; ********************** ; (1627h) X1627: call numpar ; vyčíslení FP výrazu.. ; ******************************************** ; test hodnoty FP akumulátoru na rozsah 0..255 ; ******************************************** ; (162ah) tst255: call tstpin ; povolit jen kladná čísla mov a,d ; a povolit pouze rozsah ana a ; 0..255, jinak se zobrazí jnz X0569 ; chybové hlášení 03 Fnc.param. dcx h rst 2 mov a,e ; v ACC se vrací načtená hodnota ret ; *********** ; funkce PEEK ; *********** ; (1636h) f_peek: call tstint ; test argumentu (adresy) na rozsah ldax d ; z této adresy přečtu bajt, jmp X0c4b ; který převedu na FP číslo ; ************ ; funkce APEEK ; ************ ; (163dh) X163d: push b rst 2 ; přeskočit mezery, načíst argument call X09a2 ; (adresu) povinně v závorkách call tstint ; otestovat rozsah -32768..32767 ldax d ; načíst nižší byte mov c,a inx d ; o adresu výše ldax d ; načíst vyšší bajt pop d X164a: push h ; a než provedu závěrečnou typovou lxi h,X09b4 ; kontrolu výsledku, push h jmp ac2fp ; převedu hodnotu v A:C na FP číslo ; *************************************************** ; načtení hexadecimálního čísla s prefixem (apostrof) ; *************************************************** ; (1652h) X1652: xchg ; BIOS využívá ke čtení řádku DE mvi b,1 ; bude minimálně jeden platný znak lxi h,0 ; vynulovat akumulátor výsledku X1658: inx d ; další znak v analyzovaném řádku ldax d ; načíst a otestovat, zda je call hex ; platným hexadecimálním znakem jc X1671 ; pokud není, rozhodne se dále mov c,a ; platný znak (převedený na hodnotu mvi b,0 ; 0..15) uložit do BC mov a,h ani 0f0h ; pokud už je hodnota akumulátoru jnz X0f3e ; příliš vysoká, ; vyvolat chybu 08h - Overflow dad h dad h ; jinak posunout akumulátor o čtyři dad h ; bity (jedna cifra) vlevo a přičíst dad h ; k němu nově načtený znak v BC dad b jmp X1658 ; a načíst další znak z řádku ; ******************************************************* ; při načítání hexadecimálního čísla přišel neplatný znak ; ******************************************************* ; (1671h) X1671: mov a,b ; pokud počet načtených platných ana a ; znaků je nulový, vyvolat jnz err_09 ; chybu 09h - Syntax err xchg ; jinak obnovit ukazatel znaků dcx h ; v řádku, platný pro BASIC rst 2 ; a přeskočit mezery jmp X231f ; výsledek v DE převést na FP číslo ; ****************************** ; Dokončení testu FP akumulátoru ; ****************************** ; (167ch) X167c: call X1688 ; vypočtu (pouze) příznak parity a rnz ; při záporném FP akumulátoru konec inr a ; upravit výsledek SGN() na +1 jmp X1688 ; a nastavit (pouze) příznak parity ; ; celá tato kaskáda funkcí od RST6 ; sem nastavuje kromě příznakových ; bitů také hodnotu reg. A takto: ; A = 0 => nulová hodnota FP ; A = +1 => kladná hodnota FP ; A = -1 => záporná hodnota FP ; ********************** ; typová kontrola výrazu ; ********************** ; (1684h) X1684: lda vartype ; tato procedura nastaví příznak adc a ; parity na hodnotu 1 (skok při JPE) X1688: push h ; pokud je typ vyhodnoceného výrazu push psw ; shodný s typem, který specifikuji pop h ; v dodané hodnotě příznakového bitu ana a ; CY: 0 => požaduji číselný výraz mov a,l ; 1 => požaduji řetězcový výraz jpe X1695 ani 0fbh jmp X1697 X1695: ori 4 ; celá tahle sekvence dělá to samé X1697: mov l,a ; co instrukce "ANA A" jen s tím push h ; rozdílem, že ovlivňuje pouze pop psw ; příznak parity P pop h ret ; ******************************************* ; Tisk chybového hlášení do dialogového řádku ; ******************************************* ; (169ch) X169c: mvi d,0 ; vstup v reg. E dcx d xchg mov b,h mov c,l dad h dad h dad b dad h ; hl = 10 x reg.E lxi d,X1711 ; začátek tabulky chybových hlášení dad d lxi d,X16f3 xchg mvi c,0ah ; délka všech hlášení je 10 znaků X16b0: ldax d ; chybové hlášení nakopírovat mov m,a ; do stringu od adresy 16ech inx h inx d dcr c jnz X16b0 lxi h,X0324 ; tisknout se bude nejprve do buferu shld cout+1 lxi h,X16ec call tx2edi lhld crntln ; pokud je v režimu PROGRAM mov a,h ana l inr a cnz X1263 ; přidat "at line xxx" lxi h,X1708 jmp tx2edi ; jinak zakončit chybové hlášení ; ********** ; funkce USR ; ********** ; (16d3h) f_usr: call tstint ; načíst parametr příkazu, což je push h ; adresa programu ve strojovém kódu push d push b xchg shld X16dd+1 ; tuto adresu uložit do následující X16dd: call 0ffffh ; instrukce CALL pop b pop d pop h jmp X0c4b ; výsledek v A převést na FP číslo ; ************************************************ ; příkaz _ (alternativa DISP s čekáním na klávesu) ; ************************************************ ; (16e6h) c___: call c_disp ; zavolat samotný kód příkazu DISP jmp inklav ; a počkat na stisk nějaké klávesy ; ***************************************** ; jednotlivé části chybových hlášení BASICu ; ***************************************** X16ec: .db " + + + " X16f3: .db 0,0,0,0,0,0,0,0,0,0 X16fd: .db " ",0 X16ff: .db "at line ",0h X1708: .db " + + +",0dh,0ah,0h X1711: .db "Subscr.rng" ; 01h X171b: .db "Arr.alloc." ; 02h X1725: .db "Fnc.param." ; 03h X172f: .db "Only in pg" ; 04h X1739: .db "No for stm" ; 05h X1743: .db "Data exhau" ; 06h X174d: .db "Pg too big" ; 07h X1757: .db "Overflow ",0 ; 08h X1761: .db "Syntax err" ; 09h X176b: .db "Return err" ; 0ah X1775: .db "Numb.nonex" ; 0bh X177f: .db "Dv by zero" ; 0ch X1789: .db "Can't cont" ; 0dh X1793: .db "Strng long" ; 0eh X179d: .db "No str.spc" ; 0fh X17a7: .db "Str.algrth" ; 10h X17b1: .db "Type conv." ; 11h X17bb: .db "File small" ; 12h X17c5: .db "Input err " ; 13h X17cf: .db "Field lost" ; 14h X17d9: .db "File bound" ; 15h X17e3: .db "Stop ",0,0,0,0,0 ; 16h X17ed: .db "File error" ; 17h ; ************ ; FP konstanta ; ************ ; (17f7h) X17f7: .db 000h,000h,000h,081h ; +1.0 ; **************************************************** ; aproximační data funkce N x LOG2(X) ; (dvojkový logaritmus včetně transformační konstanty) ; **************************************************** ; (17fbh) X17fb: .db 003h ; 3 koeficienty řady .db 0aah,056h,019h,080h ; 1/5 x 2.88539 = 0.598979 .db 0f1h,022h,076h,080h ; 1/3 x 2.88539 = 0.961471 .db 045h,0aah,038h,082h ; 1/1 x 2.88539 = 2.88539 ; ************ ; FP konstanta ; ************ ; (1808h) X1808: .db 000h,000h,000h,080h ; +0.5 ; ******************* ; FP mocniny čísla 10 ; ******************* ; (180ch) tb10ex: .db 0a0h,086h,001h ; 100.000 .db 010h,027h,000h ; 10.000 .db 0e8h,003h,000h ; 1.000 .db 064h,000h,000h ; 100 .db 00ah,000h,000h ; 10 .db 001h,000h,000h ; 1 ; *************************** ; aproximační data funkce EXP ; *************************** ; (181eh) X181e: .db 08h ; 8 koeficientů mocninné řady ; (ty první se dosti liší ale ; postupně se přesnost zvyšuje) .db 040h,02eh,094h,074h ; -1/7! .db 070h,04fh,02eh,077h ; +1/6! .db 06eh,002h,088h,07ah ; -1/5! .db 0e6h,0a0h,02ah,07ch ; +1/4! .db 050h,0aah,0aah,07eh ; -1/3! .db 0ffh,0ffh,07fh,07fh ; +1/2! .db 000h,000h,080h,081h ; -1/1! .db 000h,000h,000h,081h ; +1/0! ; ******************************************** ; ukazatel pro výběr multiplikativní konstanty ; ******************************************** ; (183fh) X183f: .db 000h ; výběrový ukazatel 0..7 na jednu ; z následujících konstant ; ******************************************************** ; multiplikativní konstanty pro výpočet hodnoty funkce RND ; ******************************************************** ; (1840h) X1840: .db 035h,04ah,0cah,099h X1844: .db 039h,01ch,076h,098h X1848: .db 022h,095h,0b3h,098h X184c: .db 00ah,0ddh,047h,098h X1850: .db 053h,0d1h,099h,099h X1854: .db 00ah,01ah,09fh,098h X1858: .db 065h,0bch,0cdh,098h X185c: .db 0d6h,077h,03eh,098h ; ****************************** ; poslední vypočtená hodnota RND ; ****************************** ; (1860h) X1860: .db 052h,0c7h,04fh,080h ; ************************************************* ; aditivní konstanty pro výpočet hodnoty funkce RND ; ************************************************* X1864: .db 068h,0b1h,046h,068h X1868: .db 099h,0e9h,092h,069h X186c: .db 010h,0d1h,075h,068h ; ************************************ ; převodní FP konstanta stupně/radiány ; ************************************ ; (1870h) X1870: .db 0dbh,00fh,049h,081h ; +1.5708 ; ************************************ ; konstanta pro výpočet funkcí SIN/COS ; ************************************ ; (1874h) X1874: .db 000h,000h,000h,07fh ; +0.25 ; **************************************************** ; koeficienty mocninné (Taylorovy) řady pro aproximaci ; funkcí SIN/COS (přes Hornerovo schéma) ; **************************************************** ; (1878h) X1878: .db 05h ; počet koeficientů .db 0bah,0d7h,01eh,086h ; +1/9! x (2PI)^9 = +39.7107 .db 064h,026h,099h,087h ; -1/7! x (2PI)^7 = -76.575 .db 058h,034h,023h,087h ; +1/5! x (2PI)^5 = +81.6022 .db 0e0h,05dh,0a5h,086h ; -1/3! x (2PI)^3 = -41.3417 .db 0dah,00fh,049h,083h ; +1/1! x (2PI)^1 = +6.28319 ; ***************************************************** ; koeficienty mocninné řady pro aproximaci funkce ATN ; (koeficienty se postupně odchylují od Taylorovy řady) ; ***************************************************** ; (188dh) X188d: .db 9 ; počet koeficientů .db 04ah,0d7h,03bh,078h ; +0.00286623 <> +1/17 .db 002h,06eh,084h,07bh ; -0.0161657 <> -1/15 .db 0feh,0c1h,02fh,07ch ; +0.0429096 <> +1/13 .db 074h,031h,09ah,07dh ; -0.752896 <> -1/11 .db 084h,03dh,05ah,07dh ; +1.06563 ~ +1/9 .db 0c8h,07fh,091h,07eh ; -0.142089 ~ -1/7 .db 0e4h,0bbh,04ch,07eh ; +0.199936 ~ +1/5 .db 06ch,0aah,0aah,07fh ; -0.333331 ~ -1/3 .db 000h,000h,000h,081h ; +1.00000 = +1/1 ; ******************************** ; titulní nadpis při startu BASICu ; ******************************** ; (18b2h) t_init: .db 1ch,"BASIC-G /V2.A",0dh,0 ; **************************************** ; vektory pro interpretaci unárních funkcí ; **************************************** ; (18c2h) tb_fnc: .dw f_sgn ; SGN .dw f_int ; INT .dw f_abs ; ABS .dw f_usr ; USR .dw f_fre ; FRE .dw f_inp ; INP .dw f_pos ; POS .dw f_sqr ; SQR .dw f_rnd ; RND .dw f_log ; LOG .dw f_exp ; EXP .dw f_cos ; COS .dw f_sin ; SIN .dw f_tan ; TAN .dw f_atn ; ATN .dw f_peek ; PEEK .dw f_len ; LEN .dw f_str ; STR$ .dw f_val ; VAL .dw f_asc ; ASC .dw f_chr ; CHR$ .dw f_left ; LEFT$ .dw f_rajt ; RIGHT$ .dw f_mid ; MID$ ; ******************************** ; Vektory pro interpretaci příkazů ; ******************************** ; (18f2h) tb_cmd: .dw c_end ; 80h END .dw c_for ; 81h FOR .dw c_next ; 82h NEXT .dw c_data ; 83h DATA .dw c_inpt ; 84h INPUT .dw c_dim ; 85h DIM .dw c_read ; 86h READ .dw c_let ; 87h LET .dw c_goto ; 88h GOTO .dw c_run ; 89h RUN .dw c_if ; 8ah IF .dw c_rstr ; 8bh RESTORE .dw c_gosb ; 8ch GOSUB .dw c_retr ; 8dh RETURN .dw c_rem ; 8eh REM .dw c_stop ; 8fh STOP .dw err_09 ; 90h BIT (vektor na Syntax err) .dw c_on ; 91h ON .dw c_null ; 92h NULL .dw c_wait ; 93h WAIT .dw c_def ; 94h DEF .dw c_poke ; 95h POKE .dw c_prnt ; 96h PRINT .dw err_09 ; 97h ERR (vektor na Syntax err) .dw c_list ; 98h LIST .dw c_clea ; 99h CLEAR .dw c_llst ; 9ah LLIST .dw c_rad ; 9bh RAD .dw c_new ; 9ch NEW .dw c_scal ; c6h SCALE .dw c_plot ; c7h PLOT .dw c_move ; c8h MOVE .dw c_beep ; c9h BEEP .dw c_axes ; cah AXES .dw c_gclr ; cbh GCLEAR .dw c_paus ; cch PAUSE .dw c_disp ; cdh DISP .dw c___ ; ceh _ .dw c_bmov ; cfh BMOVE .dw c_bplo ; d0h BPLOT .dw c_load ; d1h LOAD .dw c_save ; d2h SAVE .dw c_dloa ; d3h DLOAD .dw c_dsav ; d4h DSAVE .dw c_labl ; d5h LABEL .dw c_fill ; d6h FILL .dw c_auto ; d7h AUTO .dw c_otpt ; d8h OUTPUT .dw err_09 ; d9h STATUS (vektor na Syntax err) .dw c_entr ; dah ENTER .dw c_ctrl ; dbh CONTROL .dw c_chck ; dch CHECK .dw c_cont ; ddh CONT .dw c_out ; deh OUT .dw err_09 ; dfh INKEY (vektor na Syntax err) .dw c_code ; e0h CODE .dw c_rom ; e1h ROM .dw c_apok ; e2h APOKE .dw c_pen ; e3h PEN .dw err_09 ; e4h INK (vektor na Syntax err) .dw err_09 ; e5h APEEK (vektor na Syntax err) .dw err_09 ; e6h ADR (vektor na Syntax err) .dw err_09 ; e7h AT (vektor na Syntax err) .dw err_09 ; e8h HEX$ (vektor na Syntax err) .dw c_deg ; e9h DEG .db 0ffh,0ffh,0ffh,0ffh,0ffh .db 0ffh,0ffh,0ffh,0ffh,0ffh ; ******************************** ; příkaz WAIT port,[maska,]hodnota ; ******************************** ; (197eh) c_wait: call X161e ; načíst číslo portu a komparační push psw ; hodnotu mvi e,0 ; default maskovací parametr dcx h rst 2 jz X198c ; dva nebo tři parametry? rst 1 ; když tři, .db ',' ; tak vynutit znak čárka rst 4 ; a přečíst maskovací parametr X198c: pop b X198d: in 0 ; načíst data z portu xra e ; maskovací parametr ana b ; komparační hodnota jz X198d ; čekání na shodu ret ; ************************************************* ; Tabulka klíčových slov a jejich překladových kódů ; ************************************************* ; (1995h) tb_tok: .db 'E'+80h,"ND" ; 80h END .db 'F'+80h,"OR" ; 81h FOR .db 'N'+80h,"EXT" ; 82h NEXT .db 'D'+80h,"ATA" ; 83h DATA .db 'I'+80h,"NPUT" ; 84h INPUT .db 'D'+80h,"IM" ; 85h DIM .db 'R'+80h,"EAD" ; 86h READ .db 'L'+80h,"ET" ; 87h LET .db 'G'+80h,"OTO" ; 88h GOTO .db 'R'+80h,"UN" ; 89h RUN .db 'I'+80h,"F" ; 8ah IF .db 'R'+80h,"ESTORE" ; 8bh RESTORE .db 'G'+80h,"OSUB" ; 8ch GOSUB .db 'R'+80h,"ETURN" ; 8dh RETURN .db 'R'+80h,"EM" ; 8eh REM .db 'S'+80h,"TOP" ; 8fh STOP .db 'B'+80h,"IT" ; 90h BIT .db 'O'+80h,"N" ; 91h ON .db 'N'+80h,"ULL" ; 92h NULL .db 'W'+80h,"AIT" ; 93h WAIT .db 'D'+80h,"EF" ; 94h DEF .db 'P'+80h,"OKE" ; 95h POKE .db 'P'+80h,"RINT" ; 96h PRINT .db 'E'+80h,"RR" ; 97h ERR .db 'L'+80h,"IST" ; 98h LIST .db 'C'+80h,"LEAR" ; 99h CLEAR .db 'L'+80h,"LIST" ; 9ah LLIST .db 'R'+80h,"AD" ; 9bh RAD .db 'N'+80h,"EW" ; 9ch NEW .db 'T'+80h,"AB(" ; 9dh TAB( .db 'T'+80h,"O" ; 9eh TO .db 'F'+80h,"NC" ; 9fh FNC .db 'S'+80h,"PC(" ; a0h SPC( .db 'T'+80h,"HEN" ; a1h THEN .db 'N'+80h,"OT" ; a2h NOT .db 'S'+80h,"TEP" ; a3h STEP .db '+'+80h ; a4h + .db '-'+80h ; a5h - .db '*'+80h ; a6h * .db '/'+80h ; a7h / .db '^'+80h ; a8h ^ .db 'A'+80h,"ND" ; a9h AND .db 'O'+80h,"R" ; aah OR .db '>'+80h ; abh > .db '='+80h ; ach = .db '<'+80h ; adh < .db 'S'+80h,"GN" ; aeh SGN .db 'I'+80h,"NT" ; afh INT .db 'A'+80h,"BS" ; b0h ABS .db 'U'+80h,"SR" ; b1h USR .db 'F'+80h,"RE" ; b2h FRE .db 'I'+80h,"NP" ; b3h INP .db 'P'+80h,"OS" ; b4h POS .db 'S'+80h,"QR" ; b5h SQR .db 'R'+80h,"ND" ; b6h RND .db 'L'+80h,"OG" ; b7h LOG .db 'E'+80h,"XP" ; b8h EXP .db 'C'+80h,"OS" ; b9h COS .db 'S'+80h,"IN" ; bah SIN .db 'T'+80h,"AN" ; bbh TAN .db 'A'+80h,"TN" ; bch ATN .db 'P'+80h,"EEK" ; bdh PEEK .db 'L'+80h,"EN" ; beh LEN .db 'S'+80h,"TR$" ; bfh STR$ .db 'V'+80h,"AL" ; c0h VAL .db 'A'+80h,"SC" ; c1h ASC .db 'C'+80h,"HR$" ; c2h CHR$ .db 'L'+80h,"EFT$" ; c3h LEFT$ .db 'R'+80h,"IGHT$" ; c4h RIGHT$ .db 'M'+80h,"ID$" ; c5h MID$ .db 'S'+80h,"CALE" ; c6h SCALE .db 'P'+80h,"LOT" ; c7h PLOT .db 'M'+80h,"OVE" ; c8h MOVE .db 'B'+80h,"EEP" ; c9h BEEP .db 'A'+80h,"XES" ; cah AXES .db 'G'+80h,"CLEAR" ; cbh GCLEAR .db 'P'+80h,"AUSE" ; cch PAUSE .db 'D'+80h,"ISP" ; cdh DISP .db '_'+80h ; ceh _ .db 'B'+80h,"MOVE" ; cfh BMOVE .db 'B'+80h,"PLOT" ; d0h BPLOT .db 'L'+80h,"OAD" ; d1h LOAD .db 'S'+80h,"AVE" ; d2h SAVE .db 'D'+80h,"LOAD" ; d3h DLOAD .db 'D'+80h,"SAVE" ; d4h DSAVE .db 'L'+80h,"ABEL" ; d5h LABEL .db 'F'+80h,"ILL" ; d6h FILL .db 'A'+80h,"UTO" ; d7h AUTO .db 'O'+80h,"UTPUT" ; d8h OUTPUT .db 'S'+80h,"TATUS" ; d9h STATUS .db 'E'+80h,"NTER" ; dah ENTER .db 'C'+80h,"ONTROL" ; dbh CONTROL .db 'C'+80h,"HECK" ; dch CHECK .db 'C'+80h,"ONT" ; ddh CONT .db 'O'+80h,"UT" ; deh OUT .db 'I'+80h,"NKEY" ; dfh INKEY .db 'C'+80h,"ODE" ; e0h CODE .db 'R'+80h,"OM" ; e1h ROM .db 'A'+80h,"POKE" ; e2h APOKE .db 'P'+80h,"EN" ; e3h PEN .db 'I'+80h,"NK(" ; e4h INK( .db 'A'+80h,"PEEK" ; e5h APEEK .db 'A'+80h,"DR" ; e6h ADR .db 'A'+80h,"T" ; e7h AT .db 'H'+80h,"EX$" ; e8h HEX$ .db 'D'+80h,"EG" ; e9h DEG .db 080h ; zarážka posledního slova .fill 17,0FFh ; rezerva ; *********** ; funkce HEX$ ; *********** ; (1b27h) f_hex: push b rst 2 call X09a2 ; vyčíslit číselný argument call tstint ; a jeho test na rozsah ; -32768..32767 xthl lxi h,X09b4 ; na závěr bude typová kontrola push h ; (na číselný typ) lxi h,fpprtbf ; předtím ovšem převod na string push h mov a,d call prevo2 ; převedeme vyšší bajt hodnoty inx h call prevo2-1 ; pak nižší bajt inx h mvi m,0 ; a koncová zarážka stringu pop h jmp X0cc8 ; vzniklý string přiřadím cílové ; proměnné (až pak následuje zmíněná ; typová kontrola argumentu) ; ********************************************************** ; zde se simuluje zdrojový kód BASICu, když se přepočítávají ; interní grafické proměnné (bože, možná to je cesta ale..) ; ********************************************************** ; (1b47h) ; následující zápis je komprimovaný kód: @6=255/(@4-@2) EOL ; @7=242/(@3-@5) EOL ; @0=-@2*@6 EOL ; @1=-@5*@7 EOL ; (@X=)@0+@6*@X EOL ; (@Y=)@1+@7*@Y EOL X1b47: .db "@6",0ach,"255",0a7h,"(@4",0a5h,"@2)",0 X1b56: .db "@7",0ach,"242",0a7h,"(@3",0a5h,"@5)",0 X1b65: .db "@0",0ach,0a5h,"@2",0a6h,"@6",0 X1b6f: .db "@1",0ach,0a5h,"@5",0a6h,"@7",0 X1b79: .db "@0",0a4h,"@6",0a6h X1b7f: .db "@X",0 ; (velké X) X1b82: .db "@1",0a4h,"@7",0a6h X1b88: .db "@Y",0 ; (velké Y) ; ********************************************************** ; názvy fiktivních proměnných grafického subsystému @2..@5 ; (u verze 1 se používaly zakázané proměnné X0..X2 a Y0..Y3) ; ********************************************************** ; (1b8bh) X1b8b: .db "@2",0 ; tento zápis napodobuje zdrojový .db "@4",0 ; text BASICu kvůli zjednodušení .db "@3",0 ; přiřazení hodnot .db "@5",0 ; ************ ; příkaz SCALE ; ************ ; (1b97h) c_scal: lxi d,X1b8b ; seznam proměnných, které budu mvi c,3 ; načítat budou 3 v cyklu a pak X1b9c: push d ; ještě jedna push b push h xchg call varadr ; vždy přečíst ze seznamu název pop h ; proměnné, pak načíst hodnotu call X0619 ; ze seznamu parametrů příkazu SCALE rst 1 ; a tuto hodnotu přiřadit proměnné .db ',' ; ..vynutit oddělovací čárku pop b pop d inx d inx d inx d dcr c jnz X1b9c push h xchg call varadr ; a dost nechutně to udělat pop h ; pro čtvrtou proměnnou call X0619 ; a čtvrtý parametr push h lxi h,X1b47 ; fiktivní BASIC kód do procedury call c_let ; vyhodnocení hodnoty proměnné @6 lxi h,X1b56 ; fiktivní BASIC kód do procedury call c_let ; vyhodnocení hodnoty proměnné @7 lxi h,X1b65 ; fiktivní BASIC kód do procedury call c_let ; vyhodnocení hodnoty proměnné @0 lxi h,X1b6f ; fiktivní BASIC kód do procedury call c_let ; vyhodnocení hodnoty proměnné @1 pop h ret ; ********************************************************** ; pomocná procedura grafických příkazů - přepočet jedné ; souřadnice dle zvoleného měřítka SCALE pomocí simulovaných ; výrazů (adresy výrazů se dodají v registrech BC a DE) ; ********************************************************** ; (1bd6h) X1bd6: push b ; push h ; xchg ; na adrese DE si přečte jméno call varadr ; interní proměnné za příkazem pop h ; vyčíslí hodnotu výrazu a přiřadí call X0619 ; uvedené interní proměnné, poté xthl ; provede přepočítávací výraz ve call numpar ; fiktivním kódu BASICu od adresy BC call tstint ; ořeže na rozsah -32768 .. 32767 mov a,d ; ora a ; cnz X1c1a ; a ošetří přetečení >255 pop h ; mov a,e ; ret ; ; ********************************************************* ; pomocná procedura grafických příkazů - obě souřadnice X/Y ; ********************************************************* ; (1befh) X1bef: lxi b,X1b79 ; načtení X-ové souřadnice do inter- lxi d,X1b7f ; ní proměnné @X a poté simulace call X1bd6 ; rovnice: @X = @0+@6*@X sta x2 ; uložit vypočtenou souřadnici X rst 1 ; vynutit oddělovací čárku .db ',' lxi b,X1b82 ; načtení Y-ové souřadnice do inter- lxi d,X1b88 ; ní proměnné @Y a poté simulace call X1bd6 ; rovnice: @Y = @1+@7*@Y cpi 0f3h ; navíc u Y-ové souřadnice omezit cnc X1c1a ; rozsah na 0..242 sta y2 ; uložit vypočtenou souřadnici Y X1c0e: mvi a,0 ; pokud jsem při kreslení úseček ana a ; vyjel mimo obrazovku, pak se dvě rz ; úsečky (tam+zpět) nebudou kreslit sui 1 ; zde odpočítávám to "tam" a "zpět" sta X1c0e+1 ; ale při doběhu úsečky "zpět" už jmp X1c58 ; musím nastavit koncové souřadnice ; jako výchozí pro nový PLOT X1c1a: mvi a,2 ; došlo k překročení povoleného roz- sta X1c0e+1 ; sahu v grafické oblasti pro danou mvi e,0 ; souřadnici => 2 následující úsečky ret ; se nebudou kreslit - jedna tam a ; druhá zpět (pokud pokračuji PLOTem ; za hranicemi viditelné části obra- ; zovky, trvale se nastavuje odpočet ; na zhasnutí následujících dvou ; úseček) ; *********** ; příkaz PLOT ; *********** ; (1c22h) c_plot: call X1bef ; načíst souřadnice prvního bodu dcx h ; (ty jsou povinné) rst 2 ; pokud následuje dvojtečka, nebo jz X1c36 ; končí řádek, jdi kreslit cpi 59 ; pokud následuje středník jz X1c36 ; tak jdi taky kreslit ; (lomená čára se řeší až tam) rst 1 ; v opačném případě očekáváme třetí .db ',' ; parametr a tak vynutíme čárku, rst 4 ; načteme ten třetí parametr, ora a ; který, je-li nenulový, způsobí jnz X1c3c ; vykreslování jen koncových bodů ; dílčích úseček X1c36: call X1c90 ; jinak se vykreslí celá úsečka jmp X1c44 ; test na případné pokračování ; lomené úsečky z posledního bodu X1c3c: push h ; v případě uvedení třetího nenul- call X1c58 ; ového parametru příkazu PLOT se cz point ; vykreslí jen koncový bod úsečky pop h X1c44: dcx h ; úspěšně jsme zadali souřadnice rst 2 ; (event. třetí parametr) a tak, rz ; následuje-li dvojtečka nebo konec rst 1 ; řádku, je konec příkazu .db ';' ; jinak vynutit středník a jmp c_plot ; následují další souřadnice ; *********** ; příkaz MOVE ; *********** ; (1c4ch) c_move: xra a ; u příkazu MOVE se implicitně sta X1c0e+1 ; nastaví atribut "jsem v okně" call X1bef ; a načtou se souřadnice X a Y ; (netrefení se do okna způsobí ; nekreslení dalších dvou úseček) dcx h rst 2 ; cokoliv jiného než dvojtečka nebo jnz err_09 ; konec řádku vyvolá chybu ; ******************************************************* ; překlopení nových (načtených) souřadnic X,Y do starých, ; tedy výchozích pro další kreslení ; ******************************************************* X1c58: lda X1c0e+1 ; mohu kreslit? (=jsem v grafickém ana a ; okně?) rnz ; pokud ne, nic nedělám lda x2 ; pokud tam jsem, nebo jsem se tam sta x1 ; vrátil, pak nové, respektive nově mov b,a ; načtené souřadnice X2,Y2 přesunu lda y2 ; do těch výchozích X1,Y1, které sta y1 ; poslouží jako výchozí bod ret ; pro další kreslení ; *********** ; příkaz AXES ; *********** ; (1c6bh) c_axes: call c_move ; voláním MOVE zadám průsečík os lda X1c0e+1 ; otestuji opuštění grafického okna ana a rnz push b ; a pokud jsem v okně, kreslím xra a sta x1 ; z (0,y) cma sta x2 ; do (255,y) call X1c90 ; nejprve vodorovnou osu pop b mov a,b sta x1 ; a potom sta x2 xra a ; z (x,0) sta y1 mvi a,0f2h ; do (x,242) sta y2 ; i svislou osu ; ********************* ; obecné vykreslení osy ; ********************* X1c90: lda X1c0e+1 ; test na přítomnost v platném ana a ; rozmezí souřadnic grafického okna rnz push h ; a pokud jsem v okně, směle kreslím call inpol pop h ret ; *********** ; příkaz BEEP ; *********** ; (1c9bh) c_beep: push h ; schovat ukazatel na aktuální call beep ; znak v zápisu programu pop h ; a volat rutinu BIOSu pro ret ; generování pípnutí ; ********** ; příkaz PEN ; ********** ; (1ca1h) c_pen: call X2161 ; vyřešit bity 0, 1 a 2 vstupního mov a,c ; parametru příkazu (společné s INK) cpi 3fh jnz X1cb5 ; následuje nepřehledná síť, která mov a,b ; v konečném důsledku modifikuje grafickou ani 18h ; rutinu "vystup" na adrese C1F4h, která cpi 8 ; je volána grafickými příkazy BASICu jz X1cb5 xri 10h ; pro jednotlivé hodnoty parametru PEN mov b,a ; jsou uvedeny výsledné varianty této X1cb5: mov a,b ; modifikované procedury lxi d,0fefeh lxi b,0b000h ; Hodnoty příkazu PEN: ani 18h ; jnz X1cc7 ; spodní dva bity nastavující barvu lxi d,0e6f6h ; """"""""""""""""""""""""""""""""" jmp X1cd3 ; +0 .. nastaví atribut barvy na 00 X1cc7: cpi 8 ; +1 .. nastaví atribut barvy na 01 jnz X1cd1 ; +2 .. nastaví atribut barvy na 10 mvi b,0a8h ; +3 .. nastaví atribut barvy na 11 jmp X1cd3 ; X1cd1: mvi c,2fh ; další tři bity, nastavující režim ; """"""""""""""""""""""""""""""""" X1cd3: push h ; kreslí maže invertuje lxi h,vystup+1 ; mov m,d ; 0, 20 4, 16, 24 8, 12, 28 inx h ; inx h ; | | | mov m,e ; V V V inx h ; inx h ; mov a,m mov a,m mov a,m mov m,c ; ani 3fh cpi 3fh cpi 3fh inx h ; ori 00h cpi 00h cpi 00h mov m,b ; nop cma nop inx h ; ora b ora b xra b mov m,c ; nop cma nop pop h ; mov m,a mov m,a mov m,a ret ; ret ret ret ; ************ ; příkaz BMOVE ; ************ ; (1ce4h) c_bmov: rst 4 sta bcur ; načíst a uschovat short integer cpi 30h ; při souřadnici x>47 vypsání jnc X0b95 ; chybového hlášení „Subscr.rng“ rst 1 ; test povinného znaku .db ',' ; čárka rst 4 ; načíst short integer cpi 0f3h ; při souřadnici y>242 vypsání jnc X0b95 ; chybového hlášení „Subscr.rng“ push h mvi h,0 mvi d,0c0h mov l,a dad h dad h dad h dad h dad h dad h lda bcur mov e,a dad d ; HL = 0C000h + 64.y + x shld bcur ; adresu uložit do proměnné BIOSu pop h ret ; ************ ; příkaz BPLOT ; ************ c_bplo: call varadr ; načíst STRING (ukazatel) rst 1 ; test na povinný znak .db ',' ; čárka push d rst 4 ; načíst SHORT INT pop d mov c,a ; C = parametr rozkladu obrázku sta autonr ldax d mov b,a ; B = počet znaků řetězce ana a rz push h inx d inx d ldax d mov l,a inx d ldax d mov d,a ; DE = ukazatel na znaky řetězce mov e,l lhld bcur ; HL = cílová adresa ve videoram X1d27: call X0043 ; vlastní zápis jednoho bajtu mov a,c cpi 1 cnz X1d49 ; při větší šířce pak volat push d ; universálnější algoritmus kreslení lxi d,64 ; přechod na další mikrořádek dad d ; při vykreslování obrázku pop d mov a,h cpi 0fdh ; test na přetečení obrazovky jz X1d47 inx d ; další znak řetězce shld bcur dcr b ; byl poslední? jnz X1d27 ; pokud ne, kresli další znak .db 011h ; lxi d, X1d45: .db 0e1h ; pop h .db 0e1h ; pop h X1d47: pop h ; .db 0e1h ret ; .db 0c9h X1d49: push h ; vykreslení jednoho rozkladového dcr c ; mikrořádku s šířkou C bajtů X1d4b: inx h mov a,l ani 30h ; a pokud by měl obrázek zasáhnout cpi 30h ; do zápisníku, tak ty kolizní jz X1d69 ; znaky nekreslit, pouze je přeskočit shld bcur dcr b jz X1d45 inx d call X0043 dcr c jnz X1d4b X1d63: lda autonr mov c,a pop h ret X1d69: dcr b ; přeskočení kolizních znaků jz X1d45 ; při možném poškození obsahu inx d ; zápisníku napravo od videoram dcr c jnz X1d69 jmp X1d63 ; *********************************************************** ; vykreslí v osách X a Y zvětšenou bitovou interpretaci bajtu ; (FILL volá tuto proceduru přímo pro svůj třetí parametr, ; LABEL opakovaně pro každou linku znaku) ; *********************************************************** ; (1d75h) magbyt: push psw lhld x1+1 lda x1 mov l,a pop psw push h ; C170 nese informaci o souřadnici X (0..255) push psw ; C172 nese informaci o souřadnici Y (0..255) push h call pospoint ; z toho vypčtu do HL adresu ve videoram pop d ; do B bitovou masku mov c,e xchg lhld autosp ; v C mám pixelovou pozici X xchg ; v E mám vodorovné zvětšení pop psw ; v D mám svislé zvětšení X1d8c: ora a ; bajt, jehož bitovou interpretaci kreslím jz X1dca ; (nulový bajt neřeším, hned jej přeskočím) rar ; test aktuálního bitu push d push psw X1d93: pop psw push psw jnc X1db0 ; a přeskočení jeho kreslení, pokud je nulový push b ; nejprve se nakreslí jeden svislý proužek push d ; zdola nahoru, pak se půjde na další proužek push h ; napravo odněj mov c,d lxi d,-64 X1d9f: call vystup ; modifikovatelná grafická rutina v RAM dad d ; která zohledňuje nastavení příkazem PEN mov a,h ; (pracuje s bitovou maskou na vybrané adrese) cpi 0c0h jc X1dad ; vyjel jsem mimo videoram => konec kreslení dcr c ; další pixel svislého proužku jnz X1d9f X1dad: pop h pop d pop b X1db0: mov a,b ; nyní vypočtu masku pro svislý proužek napravo add a ; posunu pixel v bitové masce cpi 40h ; a pokud už jsem v oblasti atributů jc X1dba mvi a,1 ; nastavím v masce aktivní bit na opačném konci inx h ; a posunu adresu videoram X1dba: mov b,a inr c ; posun pixelové pozice X o jednu doprava jz X1dc8 ; pokud jsem mimo grafickou zónu, konec dcr e ; budu kreslit další svislý proužek aktuálního jnz X1d93 ; testovaného bitu (celkem E proužků)? pop psw pop d jmp X1d8c ; běž na test dalšího z osmi bitů bajtu X1dc8: pop psw ; zakončení: pop d ; do DE obnovím zvětšení v obou osách X1dca: pop h ; do HL obnovím pixelové souřadnice X,Y mov a,h ; vleze do videoram na výšku další zvětšený sub d ; pixel? jnc X1dd1 xra a ; pokud ne, vynuluji a X1dd1: sta y1 ; uložím nový stav souřadnice Y mov a,e add a ; a pro účely příkazu LABEL add e ; posunu pixelovou souřadnici X add a ; o 6 pixelů doprava (zatím bez jejího add l ; uložení, to si LABEL udělá sám) rnc mvi a,0ffh ret ; ******************************************** ; tiskový ovladač LABEL pro universální výstup ; ******************************************** ; (1dddh) X1ddd: cpi 0dh ; ASCII znak CR rz ; ukončí tisk cpi 0ah ; znak LF rz ; rovněž push d push h call adras ; podle znaku určí adresu fontu mvi e,7 ; bude se kreslit jeho 7 mikrořádků lda autofl ; vertikální zvětšení mov b,a lda y1 ; a aktuální pozici Y push psw add b ; sečtu (dostanu novou souřadnici Y) dcx h ; připravím první platný bajt znaku jc X1e07 ; při překročení maximální hodnoty cpi 0f3h ; souřadnice Y (=242) přeskočím jnc X1e01 ; její uložení, jinak sta y1 ; uložím novou Y adresu inr e ; nesmyslný kód, který v zásadě inx h ; nic neřeší X1e01: jmp X1e07 ; běž kreslit X1e04: jmp X2296 ; ukazatel do bloku MGF operací X1e07: dcx h ; další bajt předlohy znaku push h push d mov a,m ; další bajt z generátoru znaků rrc ; rotace znaku o jeden pixel vlevo call magbyt ; vykreslím zvětšeninu v ose X pop d pop h dcr e ; byla poslední linka znaku? jnz X1e07 ; ne => kreslí další linku sta x1 ; uložit nové souřadnice, které se vykreslením pop psw ; nápisu posunuly za tento nápis sta y1 pop h pop d ret ; ************ ; příkaz LABEL ; ************ ; (1e1fh) c_labl: mov a,m ; je místo zvětšovacích parametrů znak cpi 0a6h ; krát (hvězdička)? cnz X1e45 ; pokud ne, načíst zvětšovací parametry inx h ; (jinak zůstávají v platnosti ty poslední) rst 1 ; vynutit oddělovací středník .db ';' lxi d,X1ddd ; LABELovský tiskový ovladač X1e2b: xchg ; pro universální výstup shld cout+1 xchg call X06c9 ; odskok defacto na PRINT bez testu ; kanálového výstupu (LABEL, stejně jako ; např. i DISP sídlí stejný formát řazení ; tiskových parametrů jako PRINT a to včetně ; oddělovačů typ čárka, středník atd.) ; ********************************************** ; nastaví standardní textový výstup na obrazovku ; a editační bufer do standardní lokality 7F82h ; ********************************************** ; (1e33h) X1e33: push h lxi h,prtout ; na standardní tiskovou rutinu BIOSu shld cout+1 ; navedu skokový vektor universálního výstupu lxi h,edibuff ; a nastavím standardní editační a odkládací shld X002c ; bufery (7F82h) shld mess pop h ret ; **************************************** ; načtení zvětšovacích parametrů pro LABEL ; **************************************** ; (1e45h) X1e45: rst 4 ; první parametr (horizontální zvětšení) sta autosp ; (funkci AUTO to teď určitě vadit nebude) rst 1 ; vynutit oddělovací čárku .db ',' rst 4 ; druhý parametr (vertikální zvětšení) sta autofl dcx h ret ; a návrat do příkazu LABEL ; *********** ; příkaz FILL ; *********** ; (1e51h) c_fill: call X1e45 ; povinně načíst zvětšovací parametry inx h rst 1 ; vynutit znak středník .db ';' rst 4 ; načíst bajt, jehož bitovou interpretaci push h call magbyt ; budeme touto procedurou zvětšovat pop h ret ; *********** ; příkaz DISP ; *********** c_disp: mvi a,0 ; vynulovat sta colpos ; formální počitadlo znaků na řádku lxi d,X0324 ; universální výstup přesměrovat do buferu ; dialogového řádku call X1e2b ; provést tisk PRINTem do tohoto buferu push h ; zobrazit textový bufer do dialogového call prbtxt+5 ; řádku ale bez pípnutí pop h ret ; a konec.. ; *********** ; příkaz AUTO ; *********** ; (1e6fh) c_auto: push h lxi h,10 ; standardní rozteč řádků shld autosp ; bez uvedeného parametru pop h mov a,m ora a jz X1e96 ; AUTO úplně bez parametrů call numpar call tstint push h xchg shld autonr pop h mov a,m ; pokud je jen jeden parametr ora a ; pak číslovat od zadaného jz X0149 ; čísla s krokem 10.. rst 1 .db ',' ; jinak vynutit čárku a načíst rst 4 ; ještě i krok číslování.. sta autosp X1e93: jmp X0149 X1e96: lhld pgbase ; je v paměti nějaký program? mov e,m inx h mov d,m mov a,d ora e jz X1eb2 ; není => číslování 10,20,30.. X1ea1: xchg push d mov e,m inx h mov d,m mov a,d ora e pop b jnz X1ea1 push b pop h inx h mov e,m ; jinak načíst číslo posledního inx h ; řádku mov d,m X1eb2: xchg shld autonr lxi d,10 ; a zvýšit jej o 10.. dad d shld autonr jmp X1e93 ; ******************* ; obsluha režimu AUTO ; ******************* ; (1ec0h) X1ec0: lda autofl ; je aktivní režim AUTO? ora a rnz ; NE => pak konec lxi h,X1ee2 ; ANO => tisk přesměrovat shld cout+1 ; do buferu dialogového řádku lhld autonr push h call X126b ; vytisknout číslo řádku, mvi a,20h ; mezeru call X1ee2 lhld autosp ; aktualizovat nové číslo řádku pop d dad d shld autonr jmp X1e33 ; a tisk přesměrovat na obrazovku X1ee2: sta ascii ; vlastní ovladač tisku do buferu jmp edit ; dialogového řádku ; ************ ; funkce INKEY ; ************ ; (1ee8h) X1ee8: push b rst 2 mvi c,0ch ; začít s klávesou K11 X1eec: dcr c mov a,c out 0f4h in 0f5h ani 1 mov a,c jz X1efd ; stisknuto ora a jnz X1eec ; postupovat až ke klávese K0 cma ; žádná klávesa = kód 255 X1efd: xthl lxi d,X09b4 ; typová kontrola na typ "číslo" po převodu push d ; hodnoty z reg. A na FP jmp X0c4b ; a samotný hodnoty v reg. A na FP číslo ; ********** ; funkce BIT ; ********** ; (1f05h) X1f05: push b ; formalita, na konci typové kontroly se ; holt vybírá hodnota ze STACKu rst 2 ; přeskočit mezery a rst 4 ; načíst první parametr push psw rst 1 ; vynutit oddělovací čárku .db ',' rst 4 ; načíst druhý parametr, ani 7 ; který ořežeme na rozsah 0..7 mov c,a jz X1f19 pop psw ; obnovit první parametr X1f13: rar ; rotovat jej doprava tolikrát, dcr c ; kolikrát určuje druhý parametr jnz X1f13 .db 0eh ; mvi c,0f1h X1f19: pop psw ani 1 ; a zeptám se na hodnotu bitu 1, ve kterém jmp X1efd ; se nyní nalézá testovaný bit ; *********** ; příkaz CODE ; *********** c_code: call varadr ; (1f1fh) push h ; v DE vrátí adresu $-proměnné xchg mov a,m ; délka stringu musí být sudá rrc ; jinak se zahlásí jc X08d1 ; Chyba 11h - "Type conv." mov c,a ; C = počet dvojic znaků ASCII inx h inx h mov e,m inx h mov h,m mov l,e ; HL = ukazatel na text lxi d,usrexec ; transfer uživatel. programu X1f33: mov a,m ; zbytečná instrukce, protože call pairin ; zde se do ACC načte číslo, jc X08d1 ; uvedené v hexadecimální ascii stax d ; interpretaci od (HL) inx d ; pak už jen tento bajt uložit dcr c ; a zpracovat další ASCII znak jnz X1f33 call usrexec ; volat uživatelský program pop h ; obnovit ukazatel na zdrojový text dcx h rst 2 rz ; je-li další znak dvojtečka, pak konec rst 1 ; jinak trvat na nutnosti vložit .db ',' ; povinný znak čárka jmp c_code ; a zpracovat další string ; ************ ; příkaz PAUSE ; ************ ; (1f4ch) c_paus: mvi a,0 ; implicitní hodnota cnz X1627 ; event. načíst SHORT INTEGER mov d,a X1f52: lxi b,3400h ; konstanta 1msec X1f55: dcr c jnz X1f55 dcr b jnz X1f55 dcr d rz out 0f4h ; test STOP/SPACE pro přerušení in 0f5h ; časování PAUSE cma ani 50h jz X1f52 ret ; ******************************************************* ; Tato procedura se vykoná ihned po natažení hlavičky ; datového bloku v případě, že chci natahovat řetězcové ; pole - porovnají se délky požadovaného pole a pole ; na MGF pásce (bez testu vlastních textů proměnných). ; Čtení dat a přiřazování hodnot jednotlivým položkám ; pole se děje v uživatelské smyčce mimo procedury BIOSu. ; ******************************************************* ; (1f6ah) X1f6a: lhld adrfil ; to, co je u ostatních datových dcx h ; bloků na MGF pásce považováno za call X23a7 ; adresu, to je u řetězcových polí ; použito jako délka hlavičky pole ; => nejprve tedy porovnám délky ; hlaviček obou polí (natahovaného ; z MGF a toho formálního v paměti) call X23d4 ; BC = počet dimenzí pole ; DE = adresa za posledním prvkem ; HL = ukazatel na 1. prvek pole ; nyní budu načítat čtveřice bajtů, ; což jsou jednotlivé položky ; řetězcového pole ; ***************************************************** ; cyklus načítání jednotlivých položek řetězcového pole ; ***************************************************** X1f74: call ldbyte ; 1. bajt čtveřice určuje délku mov c,a ; textu, přiřazeného této položce mov m,a ; pole - tu načtu do reg. C add b mov b,a inx h inx h push h ; adresa aktuálního prvku pole push b ; CRC a délka textu položky mvi b,0ffh ; v oblasti pro texty řetězcových lhld strlast ; proměnných snížím ukazatel mov a,c ; na poslední použitou položku cma ; o délku nového textu mov c,a dad b ; v BC je dvojkový doplněk délky, inx h ; proto místo odečítání přičítám BC mov a,h ; pokud je dat příliš mnoho cpi 5fh ; (klesnou pod adresu 6000h) jc X00f4 ; pak chyba 07h - Pg too big ; není to chyba? neměl by u verze ; 2A být namísto 5Fh limit 8Fh či ; spíše ještě přesněji 90h? shld strlast pop b ; obnovit CRC a délku položky inx h ; v HL je nyní adresa textu push h ; aktuálního prvku pole a pokud inr c ; délka tohoto prvku dcr c ; je nenulová, dojde k načtení mov a,b ; vlastního textu znak po znaku jz X1fa6 X1f9b: call ldbyte ; načítám jednotlivé znaky textu mov m,a ; a v oblasti od 9000h je ukládám add b ; na adresu, která byla pro načíta- mov b,a ; nou položku pole alokována inx h ; CRC je v reg. B dcr c ; a délka textu je v reg. C jnz X1f9b X1fa6: pop b ; CRC mi ještě zůstalo v reg. A pop h ; obnovit adresu 4B hlavičky aktuál- ; ního prvku pole mov m,c ; do samotné proměnné (4 bajty) inx h ; uložím odkaz na nově založený text mov m,b ; (proměnné jsou již v dolní inx h ; polovině RAM za zdrojovým kódem mov b,a ; gramu v BASICu) rst 3 jnz X1f74 ; a registr DE mi nese koncovou ; adresu pole pro testování konce pop psw ; zrušit "návratovou" adresu pro ; faktické natažení bloku dat za ; hlavičkou (právě jsme to udělali ; sami bez BIOSovské procedury, ; která se na tento formát nehodí) call ldbyte ; načíst standardní CRC bajt cmp b ; porovnat s průběžně vytvářeným ret ; CRC a ukončit příkaz ; ******************************************** ; odeslání hlavičky zprávy dle protokolu IMS-2 ; ******************************************** ; (1fb7h) X1fb7: lxi h,imsbuf ; Popis protokolu přesahuje rámec call X2005 ; tohoto dokumentu, více v Uživa- X1fbd: in 7dh ; telské příručce IV - OUTPUT/ENTER ani 0ch rz ; Z délky dostupného buferu cpi 8 ; (6 bajtů od adresy C33Ah) jnz X1fbd ; lze usuzovat na oslovení max. mov a,m ; tří příjemců dat v síti IMS-2 ora a jz X2005 out 7ch call X200c mvi a,62h out 7eh X1fd5: in 7dh ani 8 jnz X1fd5 mvi a,60h out 7eh inx h jmp X1fbd ; ******************************************************** ; driver IMS-2 8255 pro konzolový výstup (příkazem OUTPUT) ; ******************************************************** ; (1fe4h) X1fe4: mov c,a ; počkat na stav NRFD a NDAC X1fe5: in 7dh ani 0ch rz cpi 8 jnz X1fe5 mov a,c ; vyslat nová data out 7ch call X200c ; a po ustálení dat na sběrnici mvi a,42h ; aktivovat DAV out 7eh X1ff9: in 7dh ani 8 jnz X1ff9 ; počkat na potvrzení příjmu dat mvi a,40h ; deaktivovat DAV out 7eh ret X2005: mvi a,60h ; nastavit handshake signály out 7eh call X200c ; a počkat trochu déle (2x) X200c: xra a X200d: dcr a rz jmp X200d ; ************************************************* ; inicializace driveru IMS-2 8255 pro příkaz OUTPUT ; ************************************************* ; (2012h) odrv7c: lxi h,X1fe4 ; přesměrovat konzolový výstup shld cout+1 ; na driver IMS-2 8255 na adrese 7ch lxi h,imsbuf ; do buferu hlavičky zprávy mvi m,3fh ; zapsat adresní část inx h mvi m,55h shld imsptr ; a uložit ukazatel na konec pop h ; hlavičky v buferu X2024: inx h rst 4 ; načíst druhou cifru kanálové push h ; specifikace lhld imsptr ; a do buferu hlavičky zprávy inx h ori 20h ; zakomponovat adresu příjemce mov m,a ; dat v systému IMS-2 shld imsptr ; (bližší popis viz Uživatelská inx h ; příručka IV - OUTPUT/ENTER) mvi m,0 pop h ; pokud následuje za druhou cifrou mov a,m ; (určuje adresáta) čárka, pak cpi ',' ; předpokládám a načtu další cifru jz X2024 ; pro specifikaci dalšího adresáta rst 1 .db ';' ; na konci vynutit odděl. středník call X204a ; inicializace 8255 push h call X1fb7 ; poslat hlavičku zprávy pop h dcx h rst 2 X2047: jmp X06cb ; a odskok na přesměrovaný PRINT X204a: mvi a,82h ; nastavit směr portů a režim out 7fh ; IMS-2 8255 na adrese 7Ch mvi a,40h ; pro funkční emulaci HW protokolu out 7eh ; IMS-2 ret ; ************** ; příkaz CONTROL ; ************** ; (2053h) c_ctrl: rst 4 ; Velmi diskutabilní příkaz, ral ; který lze nahradit jednoduchým ral ; příkazem OUT. ral ral ; 1. parametr určuje horní čtveřici ori 0ch ; bitů čísla portu (AAAA) push psw ; 2. parametr určuje nejnižší dva inx h ; bity čísla portu (BB) rst 4 ; ani 3 ; výsledné č. portu je: AAAA11BB mov c,a ; např. CONTROL 7,1,5 zapíše do IO pop psw ; s bázovou adresou 7X na jeho port 01 ora c ; hodnotu 5 (ekvivalent OUT 7dh,5) sta c_ctrp+1 c_ctrn: inx h ; Počínaje třetím parametrem rst 4 ; zapisovat jejich hodnoty c_ctrp: out 0 ; na vypočtený port mov a,m ; dokud jsou tyto parametry cpi ',' ; (oddělené čárkou) přítomny. jz c_ctrn ret ; V důsledku maskovací konstanty ; ori 0ch nemůže zapisovat do 8255 ; obsluhující klávesnici a ROM modul. ; ********************************************** ; příkaz OUTPUT (plný ekvivalent příkazu PRINT#) ; ********************************************** ; Příkaz OUTPUT má před středníkem specifikaci kanálu ; (záměrně nepoužívám výraz "číslo"), která obsahuje jak ; vlastní adresu I/O obvodu, tak způsob zápisu na vybraný ; port. Například u USART (adresa 1Ch) je možný jediný zápis ; tj. zápis do buferu vysílače a proto v případě příkazu ; OUTPUT 1;[seznam] je za jedničkou, označující I/O adresu ; hned středník. Ale u PIO 8255 je variant zápisu více ; a tyto jsou rozlišeny druhou cifrou specifikace kanálu. ; Kanálová specifikace u PIO 8255 na adrese 4Ch nemusí být ; v této verzi BASICu zadána třímístným číslem, stačí ; 2 cifry. Ta první, která nemusí ani cifrou být ; (z ASCII kódu prvního znaku se instrukcí ANI 7 odmaskují ; 3 nejnižší bity) určuje adresu I/O portu a ta druhá ; cifra s rozsahem opět 0..7 označuje číslo obslužného ; driveru. Funguje tedy například OUTPUT D3;"WAIT FOR INTR" ; (Příklad posílá jednotlivé znaky řetězce za středníkem ; na port PA obvodu GPIO 8255 na adrese 4Ch a před zápisem ; každého bajtu na port PA testuje připravenost na PC3, což ; je dáno charakterem obslužného driveru č.3. Písmeno D je ; pak ekvivalent cifry 4 a určuje adresu GPIO.) ; (2070h) c_otpt: dcx h X2071: rst 2 ; načíst znak, určující číslo lxi b,c_otdr ; I/O obvodu push h lxi h,X06cb ; pokračování příkazem PRINT X2079: shld X2047+1 X207c: ani 7 ; max. 8 různých I/O obvodů ral mvi h,0 ; do HL zformuje adresu obslužné mov l,a ; rutiny pro zvolený I/O obvod dad b mov c,m inx h mov h,m mov l,c pchl ; a skok na vybranou rutinu ; ****************************************************** ; tabulka obslužných rutin příkazu OUTPUT pro I/O obvody ; ****************************************************** ; (2088h) c_otdr: .dw err_09 ; neobsazeno .dw odrv1c ; USART 8251 (adresa 1Ch) .dw err_09 ; neobsazeno .dw err_09 ; neobsazeno .dw odrv4c ; GPIO 8255 (adresa 4ch) .dw err_09 ; CTC 8253 (ovšem bez ovladače) .dw err_09 ; neobsazeno .dw odrv7c ; IMS-2 8255 (adresa 7ch) ; *********************************************** ; adresové ofsety driverů pro výstup dat příkazem ; OUTPUT při zápisu na GPIO 8255 na adrese 4ch ; *********************************************** ; (2098h) X2098: .db 0a0h ; => 20a0h: přímý zápis na port PA .db 0a3h ; => 20a3h: přímý zápis na port PB .db 0a6h ; => 20a6h: přímý zápis na port PC .db 0b6h ; => 20b6h: zápis na port PA ; s čekáním na READY na pinu PC3 .db 0a9h ; => 20a9h: zápis na port PB ; s čekáním na READY na pinu PC0 .db 0b5h ; => 20b5h: zápis negovaných dat ; na port PA s čekáním na READY ; na pinu PC3 .db 0e5h ; => 20e5h: uživatelský driver .db 0e8h ; => 20e8h: uživatelský driver ; ******************************************************** ; drivery GPIO 8255 pro konzolový výstup (příkazem OUTPUT) ; ******************************************************** X20a0: out 4ch ; driver 0 ret ; přímý zápis na port PA X20a3: out 4dh ; driver 1 ret ; přímý zápis na port PB X20a6: out 4eh ; driver 2 ret ; přímý zápis na port PC X20a9: mov c,a ; driver 4 X20aa: in 4eh ; zápis na port PB s čekáním ani 1 ; na stav READY na pinu PC0 jz X20aa mov a,c out 4dh ret X20b5: cma ; driver 5 ; zápis negovaných dat na port PA ; s čekáním na stav READY na PC3 X20b6: mov c,a ; driver 3 X20b7: in 4eh ; zápis na port PA s čekáním ani 8 ; na stav READY na pinu PC3 jz X20b7 mov a,c out 4ch ret ; ****************************************************** ; rutina DSAVE pro uložení řetězcových polí na MGF pásku ; ****************************************************** ; (20C2h) X20c2: call X23d4 ; do BC uloží dimenzi pole ; do DE koncovou adresu pole ; do HL adresu prvního prvku pole X20c5: mov c,m ; délku textu aktuálního prvku pole call X23ea ; vyšle na MGF inx h mov a,m inx h push h mov h,m ; do HL připraví ukazatel na vlastní mov l,a ; text aktuálního prvku inr c X20d0: dcr c ; a celý tento text, postupně znak jz X20da ; po znaku pošle na MGF call X23ea jmp X20d0 X20da: pop h ; po dokončení textu aktuál. prvku inx h ; se posune na další prvek pole, rst 3 ; otestuje případný konec pole jnz X20c5 ; a pokud není, jde na další prvek pop h ; je-li konec, zruší nepotřebný mov a,b ; vektor (8F8Ah) na BIOSovský SAVE jmp usartout ; a vyšle (svůj) CRC kód z reg. B ; ******************************************************** ; drivery GPIO 8255 pro konzolový výstup (příkazem OUTPUT) ; ******************************************************** X20e5: jmp err_09 ; driver 6 - uživatelský X20e8: jmp err_09 ; driver 7 - uživatelský ; ******************************** ; deaktivace režimu AUTO-matického ; číslování vkládaných řádků ; ******************************** X20eb: mvi a,0ffh ; (20ebh) sta autofl ; samotná deaktivace AUTO jmp X04ac ; a skok na vykonání příkazu ; ****************************************************** ; driver IMS-2 8255 pro konzolový vstup (příkazem ENTER) ; ****************************************************** ; (20f3h) X20f3: mvi a,92h ; směr portu PA přepnout na čtení out 7fh mvi a,4dh ; nastavit handshake signály out 7eh X20fb: mvi a,49h out 7eh X20ff: in 7dh ; počkat na potvrzení platných dat ani 2 jz X20ff in 7ch ; přečíst vstupní data mov m,a ; a uložit je do buferu mvi a,45h ; out 7eh ; potvrdit příjem dat X210d: in 7dh ; počkat na výchozí stav ani 2 ; handshake signálů jnz X210d mvi a,4dh ; výchozí stav komunikačních out 7eh ; handshake signálů mov a,m ; přijatý bajt otestovat inx h cpi 0ah ; na koncovou zarážku LF a pokud jnz X20fb ; nepřišla, příjem dalšího bajtu jmp X21e2 ; jinak zakončit bufer kódem 00h ; a jít na INPUT ; ********************************************* ; příkaz ENTER (plný ekvivalent příkazu INPUT#) ; ********************************************* ; doporučuji přečíst si poznámky k příkazu OUTPUT ; (2122h) c_entr: dcx h ; dle prvni cifry kanálové specifi- X2123: rst 2 ; kace se vybere obslužná rutina lxi b,c_endr ; pro jednotlivé I/O obvody push h jmp X207c ; ************************************************ ; inicializace driveru IMS-2 8255 pro příkaz ENTER ; ************************************************ ; (212bh) idrv7c: lxi h,X20f3 ; driver IMS-2 8255 vnutit shld X080b+1 ; do procedury INPUT pop h inx h rst 4 ; druhou cifru kanálové specifikace ori 40h ; převést na formát IMS-2 a použít push psw ; ji jako adresu TALKER rst 1 ; vynutit .db ';' ; oddělovač středník pop psw ; (na rozdíl od příkazu OUTPUT, kde push h ; adresátů LISTENER může být více, ; TALKER může být jen jeden) lxi h,353fh ; definice hlavičky protokolu IMS-2 shld imsbuf ; do výstupního buferu mov l,a mvi h,0 shld imsbuf+2 ; (včetně čísla TALKERa) call X204a ; inicializace obvodu IMS-2 8255 call X1fb7 ; vyslat iniciační zprávu do sítě pop h X214e: jmp X07e3 ; a jít na INPUT ; ***************************************************** ; tabulka obslužných rutin příkazu ENTER pro I/O obvody ; ***************************************************** ; (2151h) c_endr: .dw err_09 ; neobsazeno .dw idrv1c ; USART 8251 (adresa 1Ch) .dw err_09 ; neobsazeno .dw err_09 ; neobsazeno .dw idrv4c ; GPIO 8255 (adresa 4ch) .dw err_09 ; CTC 8253 (ovšem bez ovladače) .dw err_09 ; neobsazeno .dw idrv7c ; IMS-2 8255 (adresa 7ch) ; ********************************************************* ; rutina pro načtení a nastavení barvového atributu INK/PEN ; ********************************************************* ; (2161h) X2161: rst 4 ; načíst konstantu v rozsahu 0..255 mov b,a ani 4 ; parametr za klíčovým slovem INK jz X216a ; má smysluplný rozsah 0..7, hodnoty mvi a,3fh ; větší se upraví aplikací modulo 8 X216a: mov c,a ; (PEN má rozsah větší) mov a,b ani 7 ; 2 LSB parametru se nakopírují do rrc ; dvou atributových (barvových) bitů rrc ; tiskové masky, třetí bit parametru ani 0c0h ; (váha 4) určuje případnou inverzi ora c sta color ; 0 = atribut 0 (00h) / černé pozadí ret ; 1 = atribut 1 (40h) / černé pozadí ; 2 = atribut 2 (80h) / černé pozadí ; 3 = atribut 3 (C0h) / černé pozadí ; 4 = atribut 0 (00h) / inverze ; 5 = atribut 1 (40h) / inverze ; 6 = atribut 2 (80h) / inverze ; 7 = atribut 3 (C0h) / inverze ; ******************************* ; proměnná pro výpočet funkce RND ; ******************************* X2177: .db 0 ; pořadí multiplikativního parametru ; ************************************************ ; inicializace driveru GPIO 8255 pro příkaz OUTPUT ; ************************************************ ; (2178h) odrv4c: pop h inx h rst 4 ; načíst druhou cifru kanálové ani 7 ; specifikace push h lxi h,X2098 mvi b,0 mov c,a dad b ; podle této cifry s hodnotou 0..7 mov l,m ; zvolit odpovídající driver mvi h,20h shld cout+1 ; pro konzolový výstup pop h rst 1 ; ještě si vynutit .db ';' ; oddělovací středník jmp X2047 ; a jít na příkaz PRINT ; *********************************************** ; inicializace driveru GPIO 8255 pro příkaz ENTER ; *********************************************** ; (2191h) idrv4c: pop h inx h rst 4 ; načíst druhou cifru kanálové ani 7 ; specifikace push h lxi h,X21aa mvi b,0 mov c,a dad b ; podle této cifry s hodnotou 0..7 mov l,m ; zvolit odpovídající driver mvi h,21h shld X080b+1 ; pro konzolový vstup pop h rst 1 ; ještě si vynutit .db ';' ; oddělovací středník jmp X214e ; a jít na příkaz INPUT ; ********************************************** ; adresové ofsety driverů pro vstup dat příkazem ; ENTER při čtení z GPIO 8255 na adrese 4ch ; ********************************************** ; (21aah) X21aa: .db 0b2h ; => 21b2h: přímé čtení z portu PA .db 0b5h ; => 21b5h: přímé čtení z portu PB .db 0b8h ; => 21b8h: přímé čtení z portu PC .db 0bfh ; => 21bfh: čtení z portu PA ; s čekáním na STROBE na pinu PC5 .db 0d2h ; => 21d2h: čtení z portu PB ; s čekáním na STROBE na pinu PC1 .db 0bfh ; => 21bfh: driver 5 <=> driver 3 .db 0f7h ; => 21f7h: uživatelský driver .db 0fah ; => 21fah: uživatelský driver ; ****************************************************** ; drivery GPIO 8255 pro konzolový vstup (příkazem ENTER) ; ****************************************************** X21b2: in 4ch ; driver 0 ; přímé čtení z portu PA .db 01h ; lxi b,X4ddb X21b5: in 4dh ; driver 1 ; přímé čtení z portu PB .db 01h ; lxi b,X4edb X21b8: in 4eh ; driver 2 ; přímé čtení z portu PC mov m,a ; načtený bajt uložit inx h ; a protože se bez strobování jmp X21e4 ; mohlo jednat jen o jediný bajt, ; zakončit bufer kódem 00h X21bf: in 4eh ; driver 3 ani 20h ; počkat na strobovací signál jz X21bf ; na pinu PC5, přečíst hodnotu in 4ch ; z portu PA mov m,a ; zapsat ji do buferu inx h ; posunout ukazatel pro další bajt cpi 0ah ; a pokud nepřišel koncový znak LF jnz X21bf ; pokračovat ve čtení celé zprávy jmp X21e2 ; zakončit bufer a nastavit ; ukazatel na jeho začátek X21d2: in 4eh ; driver 4 ani 2 ; počkat na strobovací signál jz X21d2 ; na pinu PC1, přečíst hodnotu in 4dh ; z portu PB mov m,a ; zapsat ji do buferu inx h ; posunout ukazatel pro další bajt cpi 0ah ; a pokud nepřišel koncový znak LF jnz X21d2 ; pokračovat ve čtení celé zprávy X21e2: dcx h ; "odstranit" přijaté znaky CR+LF dcx h ; a místo nich zapsat interní X21e4: mvi m,0 ; ukončovací znak 00h lxi h,usrexec ; ukazatel do editačního buferu ret ; nastavit na jeho začátek ; ************************************************ ; inicializace driveru USART 8251 pro příkaz ENTER ; ************************************************ ; (21eah) idrv1c: lxi h,X21fd ; adresu driveru pro příjem dat shld X080b+1 ; z USARTu vnutit proceduře pop h ; INPUT inx h rst 1 ; vynutit .db ';' ; oddělovač středník jmp X214e ; a jít na INPUT ; ****************************************************** ; drivery GPIO 8255 pro konzolový vstup (příkazem ENTER) ; ****************************************************** X21f7: jmp err_09 ; driver 6 - uživatelský X21fa: jmp err_09 ; driver 7 - uživatelský ; ****************************************************** ; driver USART 8251 pro konzolový vstup (příkazem ENTER) ; ****************************************************** X21fd: call inb ; počkat na bajt z USARTu mov m,a ; zapsat jej do paměti inx h cpi 0ah ; a dokud to není koncový znak LF jnz X21fd ; číst celý seznam jmp X21e2 ; pak zakončit bufer kódem 00h a ; nastavit ukazatel na jeho začátek ; ************* ; funkce STATUS ; ************* ; (220ah) X220a: push b rst 2 rst 4 ; načíst 1. parametr (kanál) ral ral ; pounout do horních 4 bitů, čímž ral ; se v registru A ustaví bázová ral ; adresa pro vybraný obvod/kanál ori 0ch ; odmaskovat klávesnici a ROMPACK push psw rst 1 ; vynutit .db ',' ; oddělovací čárku mezi parametry rst 4 ; načíst druhý parametr ani 3 ; (jeden ze čtyř registrů vybraného mov c,a ; obvodu/kanálu) pop psw ora c ; a přidat k bázové adrese sta X1613+1 ; uložit jako parametr instrukce IN xthl lxi d,X09b4 ; po vyčíslení se bude provádět push d ; typová kontrola jmp X1613 ; a teď už načíst hodnotu z vybra- ; ného portu a převést na FP číslo ; *********** ; příkaz SAVE ; *********** ; (2227h) c_save: call X22b4 ; inicializace ovladače a načtení sta numfil ; čísla souboru mvi a,'>' sta typfil ; typ BASIC rst 2 ; nyní přeskočit mezery a ukazatel dcx h ; na text uložit do proměnné shld curch ; BIOSu pro čtení editačního buferu X2237: inx h mov a,m ; přeskočit veškerý další platný ana a ; text.. jnz X2237 mvi m,0dh ; a na konci řádku nasimulovat znak push h ; CR namísto BASICovského kódu 00h lhld varbase xchg ; ..s hodnotami začátku (HL) lhld pgbase ; a konce (DE) programu v BASICu shld adrfil ; zavolat rutinu BIOSu pro SAVE call save ; která si i načte jméno souboru.. X224d: pop h ; nyní obnovit ukazatel na místo mvi m,0 ; v editačním buferu, kde jsme ret ; provedli změnu a znak CR změníme ; zpět na 00h. ; *********** ; příkaz LOAD ; *********** ; (2251h) c_load: mvi b,'>' cpi 0e0h ; test na sekvenci LOAD CODE jnz X225b rst 2 ; přeskočit kód příkazu "CODE" mvi b,'?' ; a typ MGF záznamu zvolit BIN X225b: mov a,b .db 1eh ; mvi e,0afh ; ************ ; příkaz CHECK ; ************ ; (225dh) c_chck: xra a ; typ nahrávky > (BASIC) push psw ; ? (CODE) sta findtp ; 00 (CHECK) call X22b4 ; načíst číslo souboru s jeho testem sta findnr ; a uložit je push h call X2395 ; načíst soubor lda typfil ; a pokud typ načteného souboru cpi '?' ; není BINární, pokračovat níže jnz X2277 pop h pop psw ret ; jinak konec ; soubor tedy není BINární, takže ; to budou data nebo BASIC program X2277: call X2295 ; nastavit ukazatele podle délky pop h ; načteného programu pop psw ana a ; byl-li to jen CHECK, rz ; pak konec lda namfil ; ale jinak (jedná se o LOAD) se cpi '*' ; otestuje první znak jména a pokud rnz ; to není hvězdička, skončili jsme ; pokud to ale hvězdička je, jedná ; se o chráněný soubor => pak nasta- sta ochr ; vit příznak mazání RAM po RESETu mvi a,0c9h sta X04f2 ; odstavit test klávesy STOP lxi h,837bh ; tabulku vektorů obslužných proce- shld kdir ; dur řídicích kláves zkrátit jmp X01ff ; o funkce PTL, SHIFT+RCL, SHIFT+CD ; a ihned spustit (simulace RUN) ; ********************************************** ; nalezení konce programu po jeho natažení z MGF ; ********************************************** ; (2295h) X2295: push h X2296: xra a lhld pgbase ; počínaje začátkem programu X229a: cmp m ; najít tři nulové bajty za sebou, inx h ; indikující konec programu jnz X229a cmp m inx h jnz X229a cmp m inx h jnz X229a ; nalezenou adresu uložíme jako shld varbase ; konec programu/začátek proměnných lxi h,0 ; pro případ autostartu chráněného shld stopadr ; souboru nastavíme neplatnou pop h ; adresu funkce STOP ret ; ****************************************************** ; nastaví modifikační vektor, volaný po načtení/uložení ; hlavičky MGF záznamu a přečte a otestuje číslo souboru ; ****************************************************** ; (22b4h) X22b4: push h lxi h,edibuff shld odloz pop h call mgfhead ; modifikační vektor MGF/terminál rst 4 ; načtení čísla souboru cpi 100 ; a test na 00..99 mvi e,15h ; pokud je číslo větší, vyvolá se jnc X0108 ; chyba ++ File bound ++ ret ; **************************************************** ; příprava pro DLOAD a DSAVE ; načte číslo souboru, definuje modifikační vektor, ; nastaví typ souboru 44h a načte proměnnou, se kterou ; se bude pracovat ; **************************************************** ; (22c8h) X22c8: call X22b4 ; definice MGF vektoru a čísla push h mov l,a mvi h,44h shld findnr ; požadovaný typ/číslo souboru shld numfil ; načtený typ/číslo souboru xra a sta arradr+1 ; proměnná nebyla zadána pop h rst 1 ; vynutit si znak středník .db ';' call varadr ; zjistit parametry pole dcx h rst 1 .db ')' ; vynutit si závěrečnou závorku shld curch ; uložit ukazatel v editačním buferu lhld arradr ; otestovat třetí a čtvrtý bajt xra a ; proměnné, kde je uložen ukazatel cmp h ; na samotný obsah pole jz err_02 ; neplatný => chyba 02 - Arr.alloc. dcx h ; z hlavičky indexované proměnné mov d,m ; (pole) načíst jeho délku a tuto dcx h mov e,m xchg dcx h shld lenfil ; uložit jako délku souboru shld arrlen ; a délku pole dcx d dcx d ldax d ; test na první znak názvu pole ora a ; (následná instrukce JP rozliší ret ; číselné/řetězcové proměnné) ; ******************************************* ; fázovací FP konstanta COS >> SIN pro DEGREE ; ******************************************* X22fe: .db 000h,000h,034h,087h ; 90.0 ; ************** ; příkaz RESTORE ; ************** ; (2302h) c_rstr: jz datrst ; bez parametru nastavit ukazatel ; pro čtení DATA příkazem READ úplně ; na začátek programu call rdlnnr ; jinak načíst číslo řádku, push h call fndlin ; řádek se pokusit nalézt a pokud jnc err_0b ; neexistuje, chyba 0Bh - Numb.nonex mov h,b mov l,c dcx h shld dataadr ; adresu nalezeného řádku uložit pop h ret ; ********** ; funkce ADR ; ********** ; Funkce ADR vrací ukazatel na třetí bajt šestibytové ; proměnné. U číselných proměnných tam začíná vlastní ; hodnota čísla, u řetězcových tam je délka, nulový bajt ; a adresa, kde se nalézá vlastní obsah řetězce. ; (2317h) X2317: rst 2 ; defacto přeskočit mezery rst 1 ; vynutit si .db '(' ; levou závorku call varadr ; do DE uložit adresu proměnné rst 1 ; a vynutit si .db ')' ; pravou závorku X231f: mov c,e mov a,d jmp X164a ; adresu převést na FP číslo ; ********** ; příkaz ROM ; ********** c_rom: rst 4 ; načíst short int (8 bitů) ani 7 ; parametr N ořezat na rozsah 0..7 push h rlc ; a z toho vyrobit počáteční adresu rlc ; pro přenos dat z ROMPACKu do RAM adi 24h ; s hodnotou 2400h + (N x 400h) sta c_roml+1 call transfer ; přenos dat z ROMPACKu do RAM c_roml: .dw 0000h ; výchozí adresa v ROMPACKu .dw 0500h ; délka přenášeného bloku (501h!) .dw romarea ; cílová adresa v RAM (běžně 7000h) pop h jmp romarea ; a načtený kód ihned spustit.. ; ************* ; příkaz GCLEAR ; ************* c_gclr: xra a ; vynulovat číslo tiskového sloupce sta colpos ; pro příkaz POS mvi a,1ch ; samotné vymazání obrazovky tiskem jmp prtout ; znaku s ASCII kódem 28 (1Ch) ; FS (FILE SEPARATOR) ; ************ ; příkaz DSAVE ; ************ ; (2345h) c_dsav: call X22c8 ; načíst číslo souboru, nadefinovat ; typ záznamu 'D' jako DATA, zjistit ; adresu požadovaného pole lhld arradr ; adresu, kde začíná požadované pole shld adrfil ; uložit jako začátek MGF záznamu jp X2373 ; skok při číselných proměnných ; (u nich je pozice v paměti jasná) ; uložení řetězcového pole: lxi h,0ffffh ; inicializovat délku bloku s texty shld lenfil ; jednotlivých prvků pole call X23d4 ; BC = dimenze pole (B je nulové) ; DE = adresa konce pole ; HL = adresa 1. prvku pole X235a: mov c,m ; z aktuálního prvku pole zjistit push h ; délku textu lhld lenfil ; a přičíst k proměnné "lenfil", dad b ; která tentokrát neurčuje délku inx h ; celého souboru ale jen délku shld lenfil ; "textové" části bez samotné pop h ; datové struktury inx h inx h inx h inx h ; posun na další prvek pole rst 3 ; otestovat konec pole jnz X235a ; a sečíst délky všech prvků pole lxi h,X20c2 ; po natažení hlavičky (společná shld ram+2 ; část s číselnými poli) se spustí ; specifická rutina pro řetězcová ; pole ; **************************************************** ; rutina DSAVE pro uložení číselných polí na MGF pásku ; (společná část i pro řetězcová pole) ; **************************************************** X2373: lhld curch ; ukončovací kód řádku v editačním dcx h ; buferu (00h) zaměnit za kód X2377: inx h ; CR (0Dh) mov a,m ana a jnz X2377 mvi m,0dh push h ; zapamatovat si adresu záměny call save2 ; načíst název souboru a uložit blok ; paměti na MGF jmp X224d ; na konci editačního buferu obnovit ; kód konce řádku (00h) namísto ; dočasně zapsaného kódu CR (0Dh) ; ************ ; příkaz DLOAD ; ************ ; (2386h) c_dloa: call X22c8 ; načíst číslo souboru, nadefinovat ; typ záznamu 'D' jako DATA, zjistit ; adresu požadované proměnné (pole) lxi h,X23a4 ; adresa obslužné rutiny pro číselné jp X2392 lxi h,X1f6a ; a pro řetězcové proměnné X2392: shld ram+2 X2395: call shead ; natáhnout blok dat ; a vykonat obslužnou rutinu mvi e,17h ; „File error“ jnz X0108 ; při chybě CRC jc X0108 ; nebo chybě časování lhld curch ; obnovit ukazatel na program ret ; a konec příkazu ; *************************************************** ; Tato procedura se vykoná ihned po natažení hlavičky ; datového bloku v případě, že chci natahovat číselné ; pole - porovnají se délky požadovaného pole a pole ; na MGF pásce a pokud je vše OK, procedura končí ; a datový blok se prostě natáhne. Jinak hlásí chybu. ; *************************************************** ; (23A4h) X23a4: lhld lenfil ; délku pole na MGF pásce X23a7: xchg lhld arrlen ; a délku pole v paměti rst 3 ; porovnat lhld arradr ; připravit si ukazatel na pole a rz ; pokud se velikosti shodují, jde ; se nahrávat samotná data mvi e,12h ; jinak chyba 12h - File small rst 5 ; *********************************************** ; záplata příkazu LIST, testující kanálový výstup ; *********************************************** ; (23b3h) X23b3: call X1e33 ; universální výstup přesměrovat dcx h ; do pracovní části obrazovky rst 2 ; přeskočit mezery za příkazem LIST cpi '#' ; test na kanálový výstup rnz ; při nekanálovém LISTu návrat zpět pop psw ; jinak zrušit návratovou adresu rst 2 ; přeskočit případné mezery lxi b,c_otdr ; připravit tabulku driverů OUTPUT push h lxi h,X0403 ; načíst návratovou adresu do LISTu jmp X2079 ; a inicializovat vybraný driver ; ************************************************* ; inicializace driveru USART 8251 pro příkaz OUTPUT ; ************************************************* ; (23c7h) odrv1c: lxi h,usartout ; přesměrování konzolového výstupu shld cout+1 ; na USART (využije se driver BIOSu) pop h inx h rst 1 ; vynutit oddělovací .db ';' ; středník jmp X2047 ; a jít přímo na příkaz PRINT ; ******************************************************** ; příprava pro DLOAD/DSAVE a řetězcová pole ; ******************************************************** ; v BC vrací dimenzi pole 1 = A$(x), 2 = A$(x,y), ... ; v DE vrací koncovou adresu pole ; v HL vrací adresu za hlavičkou řetězcového pole, ukazuje ; tedy na první (čtyřbajtový) prvek pole ; ******************************************************** X23d4: lhld arrlen ; délka hlavičky řetězcového pole inx h ; se uloží tam, kde zpravidla bývá shld adrfil ; začátek datového bloku xchg lhld arradr ; adresa začátku pole push h dad d xchg pop h mov c,m mvi b,0 inx h dad b dad b ret ; ******************************************************* ; vyšle znak z paměti na adrese HL na USART a aktualizuje ; kontrolní součet - pomocná procedura pro DSAVE ; ******************************************************* ; (23eah) X23ea: mov a,m ; znak z (HL) poslat na USART call usartout mov a,m ; aktualizovat kontrolní součet add b ; v registru B mov b,a inx h ret ; ******************************* ; proměnná pro výpočet funkce RND ; ******************************* X23f3: .db 00h ; pořadí aditivní konstanty ; ********************************************* ; následující obsah se už z ROMPACKu nekopíruje ; ********************************************* ; *********************** ; nevyužitý zbytek paměti ; *********************** X23f4: .db 0e5h,00h,00h,00h,00h,00h,00h,00h,00h ; ******** ; proměnné ; ******** ; (23fdh) v_dgrd: .db 0 ; RAD(00h)/DEG(nenulový obsah) oneradr: .dw 0 ; ON ERROR GOTO (ukazatel na GOTO) .end