Skip to content

Instantly share code, notes, and snippets.

@maly
Created March 31, 2018 13:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save maly/e83e51d70a71ba0cb3468b1f7bf20317 to your computer and use it in GitHub Desktop.
Save maly/e83e51d70a71ba0cb3468b1f7bf20317 to your computer and use it in GitHub Desktop.
mm73
.pragma segment
org 0100h
jp begin
.dseg
org 8000h
data: db 10
.eseg
db "Nevim co s tim tady"
.bsseg
org 9000h
dest: ds 1
.cseg
begin:
ld hl, data
ld de, dest
ld bc, 1
ldir
ld hl, data2
ld de, dest2
ld c, (hl)
inc bc
ldir
ret
.dseg
data2: .pstr "Ahoj"
.bsseg
dest2: ds 100
LDA #1
STA $c880
LDA #0
CMPA $c880
:0A0000008601B7C8808600B1C880F1
:00000001FF
0000 86 01 LDA #1
0002 B7 C8 80 STA $c880
0005 86 00 LDA #0
0007 B1 C8 80 CMPA $c880
_PC 0007
mvi a,1
out 1
inr a
jmp 2
:080000003E01D3013CC30200E4
:00000001FF
0000 3E 01 MVI a,1
0002 D3 01 OUT 1
0004 3C INR a
0005 C3 02 00 JMP 2
_PC 0005
; ************************************
; dekompilace hry AUTO pro PMD-85
; kontrola provedena na binární úrovni
; 20.09.2013 dekompilace programu
; ************************************
; *************
; konstanty hry
; *************
A_LOGO equ 0c224h ; adresa pro vykreslení loga
A_POHA equ 0c602h ; adresa textu počet havárií
A_POSC equ 0c800h ; adresa horního konce cesty
A_POSCL equ 0c802h ; adresa výchozí hodnoty levé krajnice
A_POSCR equ 0c82bh ; adresa výchozí hodnoty pravé krajnice
A_POSPA equ 0c600h ; adresa cílové pásky
A_NAPCL equ 0c814h ; adresa nápisu cíl
A_POSVL equ 0efffh ; adresa horizontály autíčka
A_POSV equ 0f018h ; adresa výchozí pozice autíčka
A_UPSCR equ 0c2h ; high byte adresy VRAM pro dojezd auta
A_DNPTH equ 0fch ; high byte adresy dolního konce cesty
A_NKOL equ 5 ; počet kol po zúžení cesty
A_SPFKT equ 4 ; poměr rychlosti jízdy a řízení
A_DELAY equ 1770h ; initial delay
A_VPIXS equ 8 ; počet vert. scrolů na 1 pohyb
; **************************
; konstanty hardware a BIOSu
; **************************
kbdout equ 0f4h ; výstupní port klávesnice
kbdin equ 0f5h ; vstupní port klávesnice
kbdled equ 0f6h ; LED port klávesnice
prnpos equ 0c03eh ; pozice na obrazovce pro tisk znaku
bios equ 8000h ; začátek BIOSu - zde vzorek šumu
prtout equ 8500h ; tisk znaku
; ***************
; vlastní program
; ***************
.org 2000h
; ************
; inicializace
; ************
A_RST: lxi h,A_NHAV ; vynulovat počet kolizí
mvi m,'0'
dcx h
mvi m,'0'
dcx h
mvi m,'0'
lxi h,A_MLDY ; připravit závěrečnou melodii
shld A_PSND
mvi a,1ch ; vymazat obrazovku
call prtout
lxi h,A_PATH ; tabulka mapy cesty
shld A_UPTH
mvi a,A_SPFKT ; poměr rychlosti jízdy a řízení
sta A_SPED
mvi a,A_NKOL ; počet okruhů k odjetí
sta A_KOLA
lxi h,A_POSCL ; výchozí pozice levé krajnice
shld A_LPTH
lxi h,A_POSCR ; výchozí pozice pravé krajnice
shld A_RPTH
xra a ; bitová pozice auta
sta A_CARS
lxi h,A_POSV ; výchozí pozice autíčka
shld A_CARA
mvi a,A_VPIXS ; počet jemných vert. scrollů
sta A_ROLL
lxi h,A_DELAY ; počáteční rychlost jízdy
shld A_TIMR
shld A_VDLY
lxi h,A_SPDT ; zrychlovací tabulka
shld A_PGAZ
call A_SHWC ; nakreslit autíčko
call A_SHLG ; nakreslit logo
call A_PRNH ; vytisknout počet havárií
jmp A_LOOP ; a skok do hlavní smyčky
; ***************************************
; posune krajnici a okolí dolů o 8 pixelů
; ***************************************
A_SCRL: mvi a,3fh
A_SCR1: cmp m
jnz A_SCR2
inr h ; posunout o 8 mikrořádků dolů
inr h
jmp A_SCR1
A_SCR2: mov m,a
inr l
cmp m
jz A_SCR3
dcr l
dcr l
cmp m
jnz A_SCR4
mov m,c ; cesta jde směrem dolů doleva
inr h
inr h
jmp A_SCR1
A_SCR3: mov m,b ; cesta jde směrem dolů doprava
inr h
inr h
jmp A_SCR1
A_SCR4: inr l ; návrat zpět do přímého kurzu
mov a,h ; a odmazání spodního konce cesty
ani 1
ori A_DNPTH
mov h,a
mvi m,0
ret
; ******************
; jeden scroll cesty
; ******************
A_SCRO: lhld A_LPTH ; odscrolovat levou krajnici
lxi b,7fh ; C = vzorek cesty nalevo od krajnice
call A_SCRL ; B = vzorek cesty napravo od krajnice
lhld A_LPTH ; posun na další mikrořádek
lxi d,64
dad d
shld A_LPTH
lhld A_RPTH ; adekvátně odscrolovat pravou krajnici
lxi b,7f00h
call A_SCRL
lhld A_RPTH
lxi d,64
dad d
shld A_RPTH
lda A_CARA ; zase jeden test na kolizi
mov l,a
mvi h,A_POSV/256 ; část "adresy" autíčka
mvi a,3fh
cmp m
jz A_KOLI ; kolize "levým kolem"
inr l
cmp m
jz A_KOLI ; kolize "pravým kolem"
A_NXTP: lxi h,A_ROLL ; další z 8 pixelových rovin
dcr m
rnz
mvi m,A_VPIXS
lhld A_LPTH ; odmaskovat adresu scrollingu
mov a,h
ani A_POSC/256
mov h,a
mov a,l
ani 3fh
mov l,a
shld A_LPTH
lhld A_RPTH ; totéž u pravé krajnice
mov a,h
ani A_POSC/256
mov h,a
mov a,l
ani 3fh
mov l,a
shld A_RPTH
lxi h,A_SPED
dcr m
jnz A_NXT2
mvi m,A_SPFKT
lhld A_UPTH
inx h
A_NXT1: shld A_UPTH
A_NXT2: lhld A_UPTH
mov a,m
cpi 80h ; test na konec jednoho kola
jnz A_ADDP
lda A_KOLA ; je-li konec kola, jedno odečíst
dcr a
sta A_KOLA
jz A_ENDE ; je-li poslední, závěrečný dojezd
lxi h,A_PTHL ; jinak další kolo
jmp A_NXT1
; ****************************
; přidání dalšího kousku cesty
; ****************************
A_ADDP: mov b,a
ani 1
jz A_ADD2
lhld A_RPTH ; xxxx xxx1 => pravá krajnice
mov a,b
ani 2 ; xxxx xx11 => pravá krajnice doprava
inx h ; xxxx xx01 => pravá krajnice doleva
jnz A_ADD1
dcx h
dcx h
A_ADD1: shld A_RPTH
A_ADD2: mov a,b
ani 10h
rz
lhld A_LPTH ; xxx1 xxxx => levá krajnice
mov a,b
ani 20h ; xx11 xxxx => levá krajnice doprava
inx h ; xx01 xxxx => levá krajnice doleva
jnz A_ADD3
dcx h
dcx h
A_ADD3: shld A_LPTH
ret
; ******************
; chování při kolizi
; ******************
A_KOLI: call A_INCR ; zvednout počet havárií
lxi h,A_POSVL
mvi a,3fh
A_KOLF: inx h
cmp m
jnz A_KOLF
lda A_CARA
cmp L
jz A_KOLL
call A_LEFT ; posun autíčka o tři fáze doleva
call A_LEFT
call A_LEFT
jmp A_NXTP
A_KOLL: call A_RGHT ; posun autíčka o tři fáze doprava
call A_RGHT
call A_RGHT
jmp A_NXTP
; *********************
; ovládání z klávesnice
; *********************
A_KEYB: mvi a,4
out kbdout
in kbdin
ani 20h
jz A_LEFT ; test SHIFTu
in kbdin
ani 10h ; test písmene V
jz A_RGHT
ret
; **********************************
; posun autíčka doprava o jednu fázi
; **********************************
A_RGHT: lda A_CARS ; pohyb doprava
inr a
cpi 3
sta A_CARS
jnz A_SHWC ; buď jen fáze autíčka,
xra a ; nebo i změna adresy
sta A_CARS
lhld A_CARA
inr l
shld A_CARA
inr l
mvi a,3fh
cmp m ; test na stěnu
jz A_BUMP
lxi d,200h
dad d
cmp m ; test na stěnu o 4 mikrořádky níže
jz A_BUMP
lhld A_CARA
lxi b,A_CAR0
lxi d,62 ; překreslení autíčka o jeden byte
dad d ; více vpravo spolu s odmazáním
inx h ; "opuštěného" sloupce nalevo
A_RGHL: mvi m,0 ; od nové pozice autíčka
inx h
ldax b
ana a
rm
inx b
mov m,a
ldax b
inx h
inx b
mov m,a
dad d
jmp A_RGHL
; *********************************
; posun autíčka doleva o jednu fázi
; *********************************
A_LEFT: lda A_CARS ; a analogicky doleva
dcr a
sta A_CARS
jp A_SHWC
mvi a,2
sta A_CARS
lhld A_CARA
dcr l
shld A_CARA
mvi a,3fh
cmp m
jz A_BUML
lxi d,200h
dad d
cmp m
jz A_BUML
lhld A_CARA
lxi b,A_CAR2
lxi d,62
inx h
inx h
A_LFTL: dad d
ldax b
ora a
rm
mov m,a
inx h
inx b
ldax b
mov m,a
inx h
inx b
mvi m,0
jmp A_LFTL
; ******************
; nakreslení autíčka
; ******************
A_SHWC: lda A_CARS
lxi b,A_CAR0 ; bitová fáze 0
dcr a
jm A_SHCM
lxi b,A_CAR1 ; bitová fáze 1
dcr a
jm A_SHCM
lxi b,A_CAR2 ; bitová fáze 2
A_SHCM: lxi d,63 ; vykreslení autíčka
lhld A_CARA ; dle bitové fáze
inx h ; a adresy
A_SHCL: dad d
ldax b
ora a
rm
mov m,a
inx b
inx h
ldax b
mov m,a
inx b
jmp A_SHCL
; ************
; náraz vpravo
; ************
A_BUMP: call A_INCR ; přičíst jednu havárii
lhld A_CARA ; a odskok o 4 fáze vlevo
dcr l
shld A_CARA
jmp A_LEFT
; ***********
; náraz vlevo
; ***********
A_BUML: call A_INCR ; přičíst jednu havárii
lhld A_CARA ; a odskok o 4 fáze vpravo
inr l
shld A_CARA
jmp A_RGHT
; *********************
; hlavní závodní smyčka
; *********************
A_LOOP: call A_KEYB ; ovládání z klávesnice
call A_SCRO
call A_SCRO
in kbdled ; prsknutí BEEPru
xri 4
out kbdled
A_LOO1: lhld A_TIMR ; provést zpoždění
dcx h
shld A_TIMR
mov a,h
ora l
jnz A_LOO1
lhld A_VDLY ; obnovit aktuální zpoždění
shld A_TIMR
xchg
lhld A_GAZ
dad d
shld A_GAZ
jnc A_LOOP
call A_ACLR
jmp A_LOOP
; ******************************
; akcelerace dle ukazatele P_GAZ
; ******************************
A_ACLR: lhld A_PGAZ
inx h
inx h
mov a,m
cpi 0ffh
jz A_LOOP ; chyba - trvale sníží SP
shld A_PGAZ
inx h
mov h,m
mov l,a
shld A_VDLY
ret
; *****************
; počitadlo havárií
; *****************
A_INCR: lxi h,A_SPDT ; základní rychlost po kolizi
shld A_PGAZ
call A_ACLR
lxi h,A_NHAV
A_CRSM: mov a,m ; přidat počet havárií
inr m
cpi '9'
jnz A_PRNH ; a toto číslo vytisknout
mvi m,'0'
dcx h
jmp A_CRSM
A_THAV: DB "HAVAROVAL SI 00"
A_NHAV: DB "3 KRAT",0dh
; **********************************
; vytiskne informaci o počtu havárií
; **********************************
A_PRNH: lxi h,A_POHA
shld prnpos
lxi h,A_THAV
mov a,m
A_PRNL: call prtout
inx h
mov a,m
cpi 0dh
jnz A_PRNL
lxi d,1000h ; zvuk při kolizi
call A_NOIS
ret
; ******************************
; tabulka postupného zrychlování
; ******************************
A_SPDT: DW 1388h ; přičítáním konstanty
DW 0e74h ; z této tabulky se čeká
DW 0af0h ; na přetečení v rámci
DW 0834h ; 16-bitového akumulátoru
DW 0640h
DW 04b0h ; když k tomu dojde,
DW 0384h ; zvýší se rychlost
DW 0258h ; a přepne na další
DW 01f4h ; přičítací konstantu
DW 017ch ; z této tabulky
DW 0118h
DW 00c8h
DW 00a0h
DW 0078h
DW 0050h
DW 0032h
DW 0019h
DW 000ah
DW 0002h ; už jen max. rychlost
DW 00ffh
; ************
; zobrazí logo
; ************
A_SHLG: lxi h,A_LOGO ; jednoduchý algoritmus
lxi b,A_PTRN ; kopírování dvouřezového
mvi d,16 ; loga do videoram
A_LOGL: ldax b
mov m,a
inx b
inx h
ldax b
mov m,a
inx b
push d
lxi d,63
dad d
pop d
dcr d
jnz A_LOGL
ret
; *******************
; závěrečná procedura
; *******************
A_ENDE: CALL A_PASK ; vytiskne cílovou pásku
call A_PCIL ; vytiskne nápis CIEL
jmp A_CIL ; dojezdová smyčka s hudbou
; *****************
; tisk cílové pásky
; *****************
A_PASK: lxi h,A_POSPA ; imitace cílové pásky
lxi d,16 ; s vyplněním drobnou
mvi b,8 ; šachovnicí (to jsou
A_PAS1: mvi c,48 ; ty střídavé kódy
mov a,l ; 2Ah/15h)
A_PAS2: ani 40h
mvi m,2ah
jz A_PAS3
mvi m,15h
A_PAS3: inx h
dcr c
jnz A_PAS2
dad d
dcr b
jnz A_PAS1
ret
; ******************
; vytiskne nápis CÍL
; ******************
A_PCIL: lxi h,A_NAPCL ; potisk cílové pásky
shld prnpos
lxi h,A_PCIT
mov a,m
jmp A_PRNL
A_PCIT: DB " CIEL ",0dh
; ************
; obrázek loga
; ************
A_PTRN: DB 3fh,01h ; *******.....
DB 02h,02h ; .*.....*....
DB 02h,02h ; .*.....*....
DB 3ah,0fh ; .*.*******..
DB 12h,12h ; .*..*..*..*.
DB 12h,12h ; .*..*..*..*.
DB 12h,21h ; .*..*.*....*
DB 3eh,20h ; .*****.....*
DB 12h,21h ; .*..*.*....*
DB 12h,22h ; .*..*..*...*
DB 12h,24h ; .*..*...*..*
DB 12h,24h ; .*..*...*..*
DB 12h,24h ; .*..*...*..*
DB 10h,10h ; ....*.....*.
DB 10h,10h ; ....*.....*.
DB 38h,0fh ; ...*******..
; **************
; motivy autíčka
; **************
A_CAR0: DB 1ah,01h ; .*.**.*.....
DB 1ah,01h ; .*.**.*.....
DB 3ch,00h ; ..****......
DB 24h,00h ; ..*..*......
DB 3ch,00h ; ..****......
DB 1bh,03h ; **.**.**....
DB 3eh,01h ; .******.....
DB 1dh,03h ; *.***.**....
DB 80h
A_CAR1: DB 28h,05h ; ...*.**.*...
DB 28h,05h ; ...*.**.*...
DB 30h,03h ; ....****....
DB 10h,02h ; ....*..*....
DB 30h,03h ; ....****....
DB 2ch,0dh ; ..**.**.**..
DB 38h,07h ; ...******...
DB 2ch,0dh ; ..**.**.**..
DB 80h
A_CAR2: DB 20h,16h ; .....*.**.*.
DB 20h,16h ; .....*.**.*.
DB 00h,0fh ; ......****..
DB 00h,09h ; ......*..*..
DB 00h,0fh ; ......****..
DB 30h,36h ; ....**.**.**
DB 20h,1fh ; .....******.
DB 30h,36h ; ....**.**.**
DB 80h
; ********
; proměnné
; ********
A_PSND: DW 24beh ; ukazatel na přehrávaný zvuk
A_UPTH: DW 23e3h ; ukazatel na mapu cesty
A_SPED: DB 1 ; poměr rychlosti a řízení
A_KOLA: DB 5 ; počitadlo ujetých kol
A_LPTH: DW 0c80ah ; levá krajnice
A_RPTH: DW 0c817h ; pravá krajnice
A_CARS: DB 1 ; bitový posun autíčka
A_CARA: DW 0dc9eh ; adresa autíčka
A_ROLL: DB 8 ; počitadlo vert. scrollů
A_TIMR: DW 682h ; zpožďovací smyčka
A_GAZ: DW 2e68h ; zrychlovač
A_PGAZ: DW 22c9h ; tabulka pro zrychlovač
A_VDLY: DW 0e74h ; rychlost jízdy
; **************************
; mapa cesty (zaváděcí kolo)
; **************************
A_PATH: DB 00h
DB 31h,31h,30h,33h,00h,30h,30h
DB 33h,30h,00h,10h,11h,11h,00h,30h
DB 00h,10h,11h,01h
; *****************************
; mapa cesty (opakovaná smyčka)
; *****************************
A_PTHL: DB 00h,10h,11h,11h,11h,01h,03h,30h
DB 10h,01h,03h,33h,33h,33h,33h,00h
DB 11h,33h,33h,33h,33h,00h,30h,00h
DB 10h,11h,01h,03h,30h,10h,11h,11h
DB 11h,11h,01h,03h,33h,30h,10h,11h
DB 11h,11h,01h,00h,03h,33h,33h,33h
DB 11h,30h,00h,03h,30h,00h,00h,00h
DB 00h,00h,00h,80h
; *******************
; dojezd auta do cíle
; *******************
A_CIL: in kbdin ; test na SHIFT, kterým
ani 20h ; mohu přerušit melodii
jz A_RST ; a restartovat hru
mvi a,1
sta A_CARS ; bitová fáze autíčka..
lhld A_CARA ; postupné sunutí auta
mov a,h ; směrem nahoru po obrazovce
cpi A_UPSCR ; až k cílové pásce
jz A_CIL
lxi d,255-64
dad d
shld A_CARA
call A_SHWC ; vykreslení autíčka
mvi m,0
inx h
mvi m,0
call A_SND ; přehrávání hudby
jmp A_CIL
; ****************
; přehrávání hudby
; ****************
A_SND: lhld A_PSND ; víceméně standardní rutina
mov a,m ; pro řazení tónů za sebou
cpi 0ffh
lxi d,1080h
jz A_NOIS
inx h
shld A_PSND
ana a
lxi h,0D000h
jnz A_TONE
A_SND1: mov b,e
mvi d,0
A_SND2: dcr b
jnz A_SND2
dad d
jnc A_SND1
ret
; ***************
; generování tónu
; ***************
A_TONE: mvi c,0 ; střídáním hodnot 0 a 1
mov e,a ; 2. bitu (váha 04h)
mvi d,0 ; na portu 0F6h, což je
A_TON1: mov b,e ; služební PPI 8255,
A_TON2: dcr b ; dochází k vyluzování
jnz A_TON2 ; tónů.. :)
mov a,c
xri 4 ; ..to jen aby bylo co
mov c,a ; napsat..
out kbdled
dad d
jnc A_TON1
ret
; ***************
; generování šumu
; ***************
A_NOIS: lxi b,bios ; využívá se pseudonáhodné
A_NOIL: ldax b ; posloupnosti bajtů v ROM
ani 4 ; a ono to doopravdy gene-
out kbdled ; ruje něco jako šum..
dcx d
inx b
mov a,d
ora e
jnz A_NOIL
ret
; **********************
; data závěrečné melodie
; **********************
A_MLDY: DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,74h,00h,7bh,00h
DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,74h,00h,7bh,00h
DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,9ch,00h,0afh,00h
DB 0c5h,00h,61h,61h,61h,61h,80h,0h
DB 74h,00h,74h,82h,00h,74h,82h,00h
DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,74h,00h,7bh,00h
DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,74h,00h,7bh,00h
DB 82h,00h,00h,00h,74h,00h,00h,7bh
DB 82h,00h,74h,00h,9ch,00h,0afh,00h
DB 0c5h,0c5h,0c5h,0c5h,0ffh
:1020000021A52236302B36302B36302170242298F1
:10201000233E1CCD008521AE23229A233E04329C10
:10202000233E05329D232102C8229E23212BC82254
:10203000A023AF32A2232118F022A3233E0832A509
:102040002321701722A62322AC2321C72222AA23F0
:10205000CDF421CDEF22CDAC22C336223E3FBEC20D
:1020600067202424C35E20772CBECA79202D2DBE84
:10207000C27F20712424C35E20702424C35E202CE0
:102080007CE601F6FC673600C92A9E23017F00CD5D
:102090005C202A9E2311400019229E232AA023019E
:1020A000007FCD5C202AA0231140001922A0233AF2
:1020B000A3236F26F03E3FBECA35212CBECA352170
:1020C00021A52335C036082A9E237CE6C8677DE615
:1020D0003F6F229E232AA0237CE6C8677DE63F6FE0
:1020E00022A023219C2335C2F32036042A9A2323DD
:1020F000229A232A9A237EFE80C20C213A9D233DF8
:10210000329D23CA092321C223C3F02047E601CA16
:1021100021212AA02378E60223C21E212B2B22A0F4
:102120002378E610C82A9E2378E62023C231212B8B
:102130002B229E23C9CD7D2221FFEF3E3F23BEC22D
:102140003D213AA323BDCA5521CDB521CDB521CD21
:10215000B521C3C020CD7421CD7421CD7421C3C05D
:10216000203E04D3F4DBF5E620CAB521DBF5E6100A
:10217000CA7421C93AA2233CFE0332A223C2F4212D
:10218000AF32A2232AA3232C22A3232C3E3FBECA74
:102190001C2211000219BECA1C222AA32301652396
:1021A000113E0019233600230AA7F803770A2303F8
:1021B0007719C3A5213AA2233D32A223F2F4213E8E
:1021C0000232A2232AA3232D22A3233E3FBECA29E3
:1021D0002211000219BECA29222AA3230187231132
:1021E0003E002323190AB7F87723030A772303361F
:1021F00000C3E4213AA2230165233DFA08220176B7
:10220000233DFA0822018723113F002AA323231923
:102210000AB7F87703230A7703C30F22CD7D222A5A
:10222000A3232D22A323C3B521CD7D222AA3232CB2
:1022300022A323C37421CD6121CD8920CD8920DB48
:10224000F6EE04D3F62AA6232B22A6237CB5C2459C
:10225000222AAC2322A623EB2AA8231922A823D2C0
:102260003622CD6822C336222AAA2323237EFEFFEC
:10227000CA362222AA2323666F22AC23C921C72291
:1022800022AA23CD682221A5227E34FE39C2AC22A7
:1022900036302BC3892248415641524F56414C207B
:1022A000534920303033204B5241540D2102C62275
:1022B0003EC02196227ECD0085237EFE0DC2B62231
:1022C000110010CD6024C98813740EF00A34084040
:1022D00006B00484035802F4017C011801C800A070
:1022E0000078005000320019000A000200FF0021AF
:1022F00024C201452316100A7703230A7703D51158
:102300003F0019D115C2F722C9CD1223CD3123C305
:10231000FE232100C611100006080E307DE640366F
:102320002ACA26233615230DC21D231905C21A23D6
:10233000C92114C8223EC0213E237EC3B6222043B9
:1023400049454C200D3F01020202023A0F121212BF
:102350001212213E201221122212241224122410C1
:10236000101010380F1A011A013C0024003C001B09
:10237000033E011D038028052805300310023003A9
:102380002C0D38072C0D8020162016000F00090098
:102390000F3036201F303680BE24E32301050AC8E3
:1023A00017C8019EDC088206682EC922740E00310F
:1023B0003130330030303330001011110030001054
:1023C00011010010111111010330100103333333D7
:1023D0003300113333333300300010110103301058
:1023E00011111111010333301011111101000333C8
:1023F0003333113000033000000000000080DBF5B3
:10240000E620CA00203E0132A2232AA3237CFEC27A
:10241000CAFE2311BF001922A323CDF421360023C5
:102420003600CD2824C3FE232A98237EFEFF118088
:1024300010CA602423229823A72100D0C24B244332
:10244000160005C2422419D23F24C90E005F1600AF
:102450004305C2512479EE044FD3F619D25024C952
:102460000100800AE604D3F61B037AB3C26324C9D1
:10247000820000007400007B8200740074007B0006
:10248000820000007400007B8200740074007B00F6
:10249000820000007400007B820074009C00AF008A
:1024A000C500616161618000740074820074820003
:1024B000820000007400007B8200740074007B00C6
:1024C000820000007400007B8200740074007B00B6
:1024D000820000007400007B820074009C00AF004A
:0524E000C5C5C5C5FFE4
:00000001FF
0000 ; ************************************
0000 ; dekompilace hry AUTO pro PMD-85
0000 ; kontrola provedena na binární úrovni
0000 ; 20.09.2013 dekompilace programu
0000 ; ************************************
0000 ; *************
0000 ; konstanty hry
0000 ; *************
0000 A_LOGO: EQU 0c224h
0000 A_POHA: EQU 0c602h
0000 A_POSC: EQU 0c800h
0000 A_POSCL: EQU 0c802h
0000 A_POSCR: EQU 0c82bh
0000 A_POSPA: EQU 0c600h
0000 A_NAPCL: EQU 0c814h
0000 A_POSVL: EQU 0efffh
0000 A_POSV: EQU 0f018h
0000 A_UPSCR: EQU 0c2h
0000 A_DNPTH: EQU 0fch
0000 A_NKOL: EQU 5
0000 A_SPFKT: EQU 4
0000 A_DELAY: EQU 1770h
0000 A_VPIXS: EQU 8
0000 ; **************************
0000 ; konstanty hardware a BIOSu
0000 ; **************************
0000 KBDOUT: EQU 0f4h
0000 KBDIN: EQU 0f5h
0000 KBDLED: EQU 0f6h
0000 PRNPOS: EQU 0c03eh
0000 BIOS: EQU 8000h
0000 PRTOUT: EQU 8500h
0000 ; ***************
0000 ; vlastní program
0000 ; ***************
2000 .ORG 2000h
2000 ; ************
2000 ; inicializace
2000 ; ************
2000 21 A5 22 A_RST: LXI h,A_NHAV ; vynulovat počet kolizí
2003 36 30 MVI m,'0'
2005 2B DCX h
2006 36 30 MVI m,'0'
2008 2B DCX h
2009 36 30 MVI m,'0'
200B 21 70 24 LXI h,A_MLDY ; připravit závěrečnou melodii
200E 22 98 23 SHLD A_PSND
2011 3E 1C MVI a,1ch ; vymazat obrazovku
2013 CD 00 85 CALL prtout
2016 21 AE 23 LXI h,A_PATH ; tabulka mapy cesty
2019 22 9A 23 SHLD A_UPTH
201C 3E 04 MVI a,A_SPFKT ; poměr rychlosti jízdy a řízení
201E 32 9C 23 STA A_SPED
2021 3E 05 MVI a,A_NKOL ; počet okruhů k odjetí
2023 32 9D 23 STA A_KOLA
2026 21 02 C8 LXI h,A_POSCL ; výchozí pozice levé krajnice
2029 22 9E 23 SHLD A_LPTH
202C 21 2B C8 LXI h,A_POSCR ; výchozí pozice pravé krajnice
202F 22 A0 23 SHLD A_RPTH
2032 AF XRA a ; bitová pozice auta
2033 32 A2 23 STA A_CARS
2036 21 18 F0 LXI h,A_POSV ; výchozí pozice autíčka
2039 22 A3 23 SHLD A_CARA
203C 3E 08 MVI a,A_VPIXS ; počet jemných vert. scrollů
203E 32 A5 23 STA A_ROLL
2041 21 70 17 LXI h,A_DELAY ; počáteční rychlost jízdy
2044 22 A6 23 SHLD A_TIMR
2047 22 AC 23 SHLD A_VDLY
204A 21 C7 22 LXI h,A_SPDT ; zrychlovací tabulka
204D 22 AA 23 SHLD A_PGAZ
2050 CD F4 21 CALL A_SHWC ; nakreslit autíčko
2053 CD EF 22 CALL A_SHLG ; nakreslit logo
2056 CD AC 22 CALL A_PRNH ; vytisknout počet havárií
2059 C3 36 22 JMP A_LOOP ; a skok do hlavní smyčky
205C ; ***************************************
205C ; posune krajnici a okolí dolů o 8 pixelů
205C ; ***************************************
205C 3E 3F A_SCRL: MVI a,3fh
205E BE A_SCR1: CMP m
205F C2 67 20 JNZ A_SCR2
2062 24 INR h ; posunout o 8 mikrořádků dolů
2063 24 INR h
2064 C3 5E 20 JMP A_SCR1
2067 77 A_SCR2: MOV m,a
2068 2C INR l
2069 BE CMP m
206A CA 79 20 JZ A_SCR3
206D 2D DCR l
206E 2D DCR l
206F BE CMP m
2070 C2 7F 20 JNZ A_SCR4
2073 71 MOV m,c ; cesta jde směrem dolů doleva
2074 24 INR h
2075 24 INR h
2076 C3 5E 20 JMP A_SCR1
2079 70 A_SCR3: MOV m,b ; cesta jde směrem dolů doprava
207A 24 INR h
207B 24 INR h
207C C3 5E 20 JMP A_SCR1
207F 2C A_SCR4: INR l ; návrat zpět do přímého kurzu
2080 7C MOV a,h ; a odmazání spodního konce cesty
2081 E6 01 ANI 1
2083 F6 FC ORI A_DNPTH
2085 67 MOV h,a
2086 36 00 MVI m,0
2088 C9 RET
2089 ; ******************
2089 ; jeden scroll cesty
2089 ; ******************
2089 2A 9E 23 A_SCRO: LHLD A_LPTH ; odscrolovat levou krajnici
208C 01 7F 00 LXI b,7fh ; C = vzorek cesty nalevo od krajnice
208F CD 5C 20 CALL A_SCRL ; B = vzorek cesty napravo od krajnice
2092 2A 9E 23 LHLD A_LPTH ; posun na další mikrořádek
2095 11 40 00 LXI d,64
2098 19 DAD d
2099 22 9E 23 SHLD A_LPTH
209C 2A A0 23 LHLD A_RPTH ; adekvátně odscrolovat pravou krajnici
209F 01 00 7F LXI b,7f00h
20A2 CD 5C 20 CALL A_SCRL
20A5 2A A0 23 LHLD A_RPTH
20A8 11 40 00 LXI d,64
20AB 19 DAD d
20AC 22 A0 23 SHLD A_RPTH
20AF 3A A3 23 LDA A_CARA ; zase jeden test na kolizi
20B2 6F MOV l,a
20B3 26 F0 MVI h,A_POSV/256 ; část "adresy" autíčka
20B5 3E 3F MVI a,3fh
20B7 BE CMP m
20B8 CA 35 21 JZ A_KOLI ; kolize "levým kolem"
20BB 2C INR l
20BC BE CMP m
20BD CA 35 21 JZ A_KOLI ; kolize "pravým kolem"
20C0 21 A5 23 A_NXTP: LXI h,A_ROLL ; další z 8 pixelových rovin
20C3 35 DCR m
20C4 C0 RNZ
20C5 36 08 MVI m,A_VPIXS
20C7 2A 9E 23 LHLD A_LPTH ; odmaskovat adresu scrollingu
20CA 7C MOV a,h
20CB E6 C8 ANI A_POSC/256
20CD 67 MOV h,a
20CE 7D MOV a,l
20CF E6 3F ANI 3fh
20D1 6F MOV l,a
20D2 22 9E 23 SHLD A_LPTH
20D5 2A A0 23 LHLD A_RPTH ; totéž u pravé krajnice
20D8 7C MOV a,h
20D9 E6 C8 ANI A_POSC/256
20DB 67 MOV h,a
20DC 7D MOV a,l
20DD E6 3F ANI 3fh
20DF 6F MOV l,a
20E0 22 A0 23 SHLD A_RPTH
20E3 21 9C 23 LXI h,A_SPED
20E6 35 DCR m
20E7 C2 F3 20 JNZ A_NXT2
20EA 36 04 MVI m,A_SPFKT
20EC 2A 9A 23 LHLD A_UPTH
20EF 23 INX h
20F0 22 9A 23 A_NXT1: SHLD A_UPTH
20F3 2A 9A 23 A_NXT2: LHLD A_UPTH
20F6 7E MOV a,m
20F7 FE 80 CPI 80h ; test na konec jednoho kola
20F9 C2 0C 21 JNZ A_ADDP
20FC 3A 9D 23 LDA A_KOLA ; je-li konec kola, jedno odečíst
20FF 3D DCR a
2100 32 9D 23 STA A_KOLA
2103 CA 09 23 JZ A_ENDE ; je-li poslední, závěrečný dojezd
2106 21 C2 23 LXI h,A_PTHL ; jinak další kolo
2109 C3 F0 20 JMP A_NXT1
210C ; ****************************
210C ; přidání dalšího kousku cesty
210C ; ****************************
210C 47 A_ADDP: MOV b,a
210D E6 01 ANI 1
210F CA 21 21 JZ A_ADD2
2112 2A A0 23 LHLD A_RPTH ; xxxx xxx1 => pravá krajnice
2115 78 MOV a,b
2116 E6 02 ANI 2 ; xxxx xx11 => pravá krajnice doprava
2118 23 INX h ; xxxx xx01 => pravá krajnice doleva
2119 C2 1E 21 JNZ A_ADD1
211C 2B DCX h
211D 2B DCX h
211E 22 A0 23 A_ADD1: SHLD A_RPTH
2121 78 A_ADD2: MOV a,b
2122 E6 10 ANI 10h
2124 C8 RZ
2125 2A 9E 23 LHLD A_LPTH ; xxx1 xxxx => levá krajnice
2128 78 MOV a,b
2129 E6 20 ANI 20h ; xx11 xxxx => levá krajnice doprava
212B 23 INX h ; xx01 xxxx => levá krajnice doleva
212C C2 31 21 JNZ A_ADD3
212F 2B DCX h
2130 2B DCX h
2131 22 9E 23 A_ADD3: SHLD A_LPTH
2134 C9 RET
2135 ; ******************
2135 ; chování při kolizi
2135 ; ******************
2135 CD 7D 22 A_KOLI: CALL A_INCR ; zvednout počet havárií
2138 21 FF EF LXI h,A_POSVL
213B 3E 3F MVI a,3fh
213D 23 A_KOLF: INX h
213E BE CMP m
213F C2 3D 21 JNZ A_KOLF
2142 3A A3 23 LDA A_CARA
2145 BD CMP L
2146 CA 55 21 JZ A_KOLL
2149 CD B5 21 CALL A_LEFT ; posun autíčka o tři fáze doleva
214C CD B5 21 CALL A_LEFT
214F CD B5 21 CALL A_LEFT
2152 C3 C0 20 JMP A_NXTP
2155 CD 74 21 A_KOLL: CALL A_RGHT ; posun autíčka o tři fáze doprava
2158 CD 74 21 CALL A_RGHT
215B CD 74 21 CALL A_RGHT
215E C3 C0 20 JMP A_NXTP
2161 ; *********************
2161 ; ovládání z klávesnice
2161 ; *********************
2161 3E 04 A_KEYB: MVI a,4
2163 D3 F4 OUT kbdout
2165 DB F5 IN kbdin
2167 E6 20 ANI 20h
2169 CA B5 21 JZ A_LEFT ; test SHIFTu
216C DB F5 IN kbdin
216E E6 10 ANI 10h ; test písmene V
2170 CA 74 21 JZ A_RGHT
2173 C9 RET
2174 ; **********************************
2174 ; posun autíčka doprava o jednu fázi
2174 ; **********************************
2174 3A A2 23 A_RGHT: LDA A_CARS ; pohyb doprava
2177 3C INR a
2178 FE 03 CPI 3
217A 32 A2 23 STA A_CARS
217D C2 F4 21 JNZ A_SHWC ; buď jen fáze autíčka,
2180 AF XRA a ; nebo i změna adresy
2181 32 A2 23 STA A_CARS
2184 2A A3 23 LHLD A_CARA
2187 2C INR l
2188 22 A3 23 SHLD A_CARA
218B 2C INR l
218C 3E 3F MVI a,3fh
218E BE CMP m ; test na stěnu
218F CA 1C 22 JZ A_BUMP
2192 11 00 02 LXI d,200h
2195 19 DAD d
2196 BE CMP m ; test na stěnu o 4 mikrořádky níže
2197 CA 1C 22 JZ A_BUMP
219A 2A A3 23 LHLD A_CARA
219D 01 65 23 LXI b,A_CAR0
21A0 11 3E 00 LXI d,62 ; překreslení autíčka o jeden byte
21A3 19 DAD d ; více vpravo spolu s odmazáním
21A4 23 INX h ; "opuštěného" sloupce nalevo
21A5 36 00 A_RGHL: MVI m,0 ; od nové pozice autíčka
21A7 23 INX h
21A8 0A LDAX b
21A9 A7 ANA a
21AA F8 RM
21AB 03 INX b
21AC 77 MOV m,a
21AD 0A LDAX b
21AE 23 INX h
21AF 03 INX b
21B0 77 MOV m,a
21B1 19 DAD d
21B2 C3 A5 21 JMP A_RGHL
21B5 ; *********************************
21B5 ; posun autíčka doleva o jednu fázi
21B5 ; *********************************
21B5 3A A2 23 A_LEFT: LDA A_CARS ; a analogicky doleva
21B8 3D DCR a
21B9 32 A2 23 STA A_CARS
21BC F2 F4 21 JP A_SHWC
21BF 3E 02 MVI a,2
21C1 32 A2 23 STA A_CARS
21C4 2A A3 23 LHLD A_CARA
21C7 2D DCR l
21C8 22 A3 23 SHLD A_CARA
21CB 3E 3F MVI a,3fh
21CD BE CMP m
21CE CA 29 22 JZ A_BUML
21D1 11 00 02 LXI d,200h
21D4 19 DAD d
21D5 BE CMP m
21D6 CA 29 22 JZ A_BUML
21D9 2A A3 23 LHLD A_CARA
21DC 01 87 23 LXI b,A_CAR2
21DF 11 3E 00 LXI d,62
21E2 23 INX h
21E3 23 INX h
21E4 19 A_LFTL: DAD d
21E5 0A LDAX b
21E6 B7 ORA a
21E7 F8 RM
21E8 77 MOV m,a
21E9 23 INX h
21EA 03 INX b
21EB 0A LDAX b
21EC 77 MOV m,a
21ED 23 INX h
21EE 03 INX b
21EF 36 00 MVI m,0
21F1 C3 E4 21 JMP A_LFTL
21F4 ; ******************
21F4 ; nakreslení autíčka
21F4 ; ******************
21F4 3A A2 23 A_SHWC: LDA A_CARS
21F7 01 65 23 LXI b,A_CAR0 ; bitová fáze 0
21FA 3D DCR a
21FB FA 08 22 JM A_SHCM
21FE 01 76 23 LXI b,A_CAR1 ; bitová fáze 1
2201 3D DCR a
2202 FA 08 22 JM A_SHCM
2205 01 87 23 LXI b,A_CAR2 ; bitová fáze 2
2208 11 3F 00 A_SHCM: LXI d,63 ; vykreslení autíčka
220B 2A A3 23 LHLD A_CARA ; dle bitové fáze
220E 23 INX h ; a adresy
220F 19 A_SHCL: DAD d
2210 0A LDAX b
2211 B7 ORA a
2212 F8 RM
2213 77 MOV m,a
2214 03 INX b
2215 23 INX h
2216 0A LDAX b
2217 77 MOV m,a
2218 03 INX b
2219 C3 0F 22 JMP A_SHCL
221C ; ************
221C ; náraz vpravo
221C ; ************
221C CD 7D 22 A_BUMP: CALL A_INCR ; přičíst jednu havárii
221F 2A A3 23 LHLD A_CARA ; a odskok o 4 fáze vlevo
2222 2D DCR l
2223 22 A3 23 SHLD A_CARA
2226 C3 B5 21 JMP A_LEFT
2229 ; ***********
2229 ; náraz vlevo
2229 ; ***********
2229 CD 7D 22 A_BUML: CALL A_INCR ; přičíst jednu havárii
222C 2A A3 23 LHLD A_CARA ; a odskok o 4 fáze vpravo
222F 2C INR l
2230 22 A3 23 SHLD A_CARA
2233 C3 74 21 JMP A_RGHT
2236 ; *********************
2236 ; hlavní závodní smyčka
2236 ; *********************
2236 CD 61 21 A_LOOP: CALL A_KEYB ; ovládání z klávesnice
2239 CD 89 20 CALL A_SCRO
223C CD 89 20 CALL A_SCRO
223F DB F6 IN kbdled ; prsknutí BEEPru
2241 EE 04 XRI 4
2243 D3 F6 OUT kbdled
2245 ;
2245 2A A6 23 A_LOO1: LHLD A_TIMR ; provést zpoždění
2248 2B DCX h
2249 22 A6 23 SHLD A_TIMR
224C 7C MOV a,h
224D B5 ORA l
224E C2 45 22 JNZ A_LOO1
2251 2A AC 23 LHLD A_VDLY ; obnovit aktuální zpoždění
2254 22 A6 23 SHLD A_TIMR
2257 EB XCHG
2258 2A A8 23 LHLD A_GAZ
225B 19 DAD d
225C 22 A8 23 SHLD A_GAZ
225F D2 36 22 JNC A_LOOP
2262 CD 68 22 CALL A_ACLR
2265 C3 36 22 JMP A_LOOP
2268 ; ******************************
2268 ; akcelerace dle ukazatele P_GAZ
2268 ; ******************************
2268 2A AA 23 A_ACLR: LHLD A_PGAZ
226B 23 INX h
226C 23 INX h
226D 7E MOV a,m
226E FE FF CPI 0ffh
2270 CA 36 22 JZ A_LOOP ; chyba - trvale sníží SP
2273 22 AA 23 SHLD A_PGAZ
2276 23 INX h
2277 66 MOV h,m
2278 6F MOV l,a
2279 22 AC 23 SHLD A_VDLY
227C C9 RET
227D ; *****************
227D ; počitadlo havárií
227D ; *****************
227D 21 C7 22 A_INCR: LXI h,A_SPDT ; základní rychlost po kolizi
2280 22 AA 23 SHLD A_PGAZ
2283 CD 68 22 CALL A_ACLR
2286 21 A5 22 LXI h,A_NHAV
2289 7E A_CRSM: MOV a,m ; přidat počet havárií
228A 34 INR m
228B FE 39 CPI '9'
228D C2 AC 22 JNZ A_PRNH ; a toto číslo vytisknout
2290 36 30 MVI m,'0'
2292 2B DCX h
2293 C3 89 22 JMP A_CRSM
2296 48 41 56 41 52 4F 56 41 4C 20 53 49 20 30 30 A_THAV: DB "HAVAROVAL SI 00"
22A5 33 20 4B 52 41 54 0D A_NHAV: DB "3 KRAT",0dh
22AC ; **********************************
22AC ; vytiskne informaci o počtu havárií
22AC ; **********************************
22AC 21 02 C6 A_PRNH: LXI h,A_POHA
22AF 22 3E C0 SHLD prnpos
22B2 21 96 22 LXI h,A_THAV
22B5 7E MOV a,m
22B6 CD 00 85 A_PRNL: CALL prtout
22B9 23 INX h
22BA 7E MOV a,m
22BB FE 0D CPI 0dh
22BD C2 B6 22 JNZ A_PRNL
22C0 11 00 10 LXI d,1000h ; zvuk při kolizi
22C3 CD 60 24 CALL A_NOIS
22C6 C9 RET
22C7 ; ******************************
22C7 ; tabulka postupného zrychlování
22C7 ; ******************************
22C7 88 13 A_SPDT: DW 1388h ; přičítáním konstanty
22C9 74 0E DW 0e74h ; z této tabulky se čeká
22CB F0 0A DW 0af0h ; na přetečení v rámci
22CD 34 08 DW 0834h ; 16-bitového akumulátoru
22CF 40 06 DW 0640h
22D1 B0 04 DW 04b0h ; když k tomu dojde,
22D3 84 03 DW 0384h ; zvýší se rychlost
22D5 58 02 DW 0258h ; a přepne na další
22D7 F4 01 DW 01f4h ; přičítací konstantu
22D9 7C 01 DW 017ch ; z této tabulky
22DB 18 01 DW 0118h
22DD C8 00 DW 00c8h
22DF A0 00 DW 00a0h
22E1 78 00 DW 0078h
22E3 50 00 DW 0050h
22E5 32 00 DW 0032h
22E7 19 00 DW 0019h
22E9 0A 00 DW 000ah
22EB 02 00 DW 0002h ; už jen max. rychlost
22ED FF 00 DW 00ffh
22EF ; ************
22EF ; zobrazí logo
22EF ; ************
22EF 21 24 C2 A_SHLG: LXI h,A_LOGO ; jednoduchý algoritmus
22F2 01 45 23 LXI b,A_PTRN ; kopírování dvouřezového
22F5 16 10 MVI d,16 ; loga do videoram
22F7 0A A_LOGL: LDAX b
22F8 77 MOV m,a
22F9 03 INX b
22FA 23 INX h
22FB 0A LDAX b
22FC 77 MOV m,a
22FD 03 INX b
22FE D5 PUSH d
22FF 11 3F 00 LXI d,63
2302 19 DAD d
2303 D1 POP d
2304 15 DCR d
2305 C2 F7 22 JNZ A_LOGL
2308 C9 RET
2309 ; *******************
2309 ; závěrečná procedura
2309 ; *******************
2309 CD 12 23 A_ENDE: CALL A_PASK ; vytiskne cílovou pásku
230C CD 31 23 CALL A_PCIL ; vytiskne nápis CIEL
230F C3 FE 23 JMP A_CIL ; dojezdová smyčka s hudbou
2312 ; *****************
2312 ; tisk cílové pásky
2312 ; *****************
2312 21 00 C6 A_PASK: LXI h,A_POSPA ; imitace cílové pásky
2315 11 10 00 LXI d,16 ; s vyplněním drobnou
2318 06 08 MVI b,8 ; šachovnicí (to jsou
231A 0E 30 A_PAS1: MVI c,48 ; ty střídavé kódy
231C 7D MOV a,l ; 2Ah/15h)
231D E6 40 A_PAS2: ANI 40h
231F 36 2A MVI m,2ah
2321 CA 26 23 JZ A_PAS3
2324 36 15 MVI m,15h
2326 23 A_PAS3: INX h
2327 0D DCR c
2328 C2 1D 23 JNZ A_PAS2
232B 19 DAD d
232C 05 DCR b
232D C2 1A 23 JNZ A_PAS1
2330 C9 RET
2331 ; ******************
2331 ; vytiskne nápis CÍL
2331 ; ******************
2331 21 14 C8 A_PCIL: LXI h,A_NAPCL ; potisk cílové pásky
2334 22 3E C0 SHLD prnpos
2337 21 3E 23 LXI h,A_PCIT
233A 7E MOV a,m
233B C3 B6 22 JMP A_PRNL
233E 20 43 49 45 4C 20 0D A_PCIT: DB " CIEL ",0dh
2345 ; ************
2345 ; obrázek loga
2345 ; ************
2345 3F 01 A_PTRN: DB 3fh,01h ; *******.....
2347 02 02 DB 02h,02h ; .*.....*....
2349 02 02 DB 02h,02h ; .*.....*....
234B 3A 0F DB 3ah,0fh ; .*.*******..
234D 12 12 DB 12h,12h ; .*..*..*..*.
234F 12 12 DB 12h,12h ; .*..*..*..*.
2351 12 21 DB 12h,21h ; .*..*.*....*
2353 3E 20 DB 3eh,20h ; .*****.....*
2355 12 21 DB 12h,21h ; .*..*.*....*
2357 12 22 DB 12h,22h ; .*..*..*...*
2359 12 24 DB 12h,24h ; .*..*...*..*
235B 12 24 DB 12h,24h ; .*..*...*..*
235D 12 24 DB 12h,24h ; .*..*...*..*
235F 10 10 DB 10h,10h ; ....*.....*.
2361 10 10 DB 10h,10h ; ....*.....*.
2363 38 0F DB 38h,0fh ; ...*******..
2365 ; **************
2365 ; motivy autíčka
2365 ; **************
2365 1A 01 A_CAR0: DB 1ah,01h ; .*.**.*.....
2367 1A 01 DB 1ah,01h ; .*.**.*.....
2369 3C 00 DB 3ch,00h ; ..****......
236B 24 00 DB 24h,00h ; ..*..*......
236D 3C 00 DB 3ch,00h ; ..****......
236F 1B 03 DB 1bh,03h ; **.**.**....
2371 3E 01 DB 3eh,01h ; .******.....
2373 1D 03 DB 1dh,03h ; *.***.**....
2375 80 DB 80h
2376 28 05 A_CAR1: DB 28h,05h ; ...*.**.*...
2378 28 05 DB 28h,05h ; ...*.**.*...
237A 30 03 DB 30h,03h ; ....****....
237C 10 02 DB 10h,02h ; ....*..*....
237E 30 03 DB 30h,03h ; ....****....
2380 2C 0D DB 2ch,0dh ; ..**.**.**..
2382 38 07 DB 38h,07h ; ...******...
2384 2C 0D DB 2ch,0dh ; ..**.**.**..
2386 80 DB 80h
2387 20 16 A_CAR2: DB 20h,16h ; .....*.**.*.
2389 20 16 DB 20h,16h ; .....*.**.*.
238B 00 0F DB 00h,0fh ; ......****..
238D 00 09 DB 00h,09h ; ......*..*..
238F 00 0F DB 00h,0fh ; ......****..
2391 30 36 DB 30h,36h ; ....**.**.**
2393 20 1F DB 20h,1fh ; .....******.
2395 30 36 DB 30h,36h ; ....**.**.**
2397 80 DB 80h
2398 ; ********
2398 ; proměnné
2398 ; ********
2398 BE 24 A_PSND: DW 24beh ; ukazatel na přehrávaný zvuk
239A E3 23 A_UPTH: DW 23e3h ; ukazatel na mapu cesty
239C 01 A_SPED: DB 1 ; poměr rychlosti a řízení
239D 05 A_KOLA: DB 5 ; počitadlo ujetých kol
239E 0A C8 A_LPTH: DW 0c80ah ; levá krajnice
23A0 17 C8 A_RPTH: DW 0c817h ; pravá krajnice
23A2 01 A_CARS: DB 1 ; bitový posun autíčka
23A3 9E DC A_CARA: DW 0dc9eh ; adresa autíčka
23A5 08 A_ROLL: DB 8 ; počitadlo vert. scrollů
23A6 82 06 A_TIMR: DW 682h ; zpožďovací smyčka
23A8 68 2E A_GAZ: DW 2e68h ; zrychlovač
23AA C9 22 A_PGAZ: DW 22c9h ; tabulka pro zrychlovač
23AC 74 0E A_VDLY: DW 0e74h ; rychlost jízdy
23AE ; **************************
23AE ; mapa cesty (zaváděcí kolo)
23AE ; **************************
23AE 00 A_PATH: DB 00h
23AF 31 31 30 33 00 30 30 DB 31h,31h,30h,33h,00h,30h,30h
23B6 33 30 00 10 11 11 00 30 DB 33h,30h,00h,10h,11h,11h,00h,30h
23BE 00 10 11 01 DB 00h,10h,11h,01h
23C2 ; *****************************
23C2 ; mapa cesty (opakovaná smyčka)
23C2 ; *****************************
23C2 00 10 11 11 11 01 03 30 A_PTHL: DB 00h,10h,11h,11h,11h,01h,03h,30h
23CA 10 01 03 33 33 33 33 00 DB 10h,01h,03h,33h,33h,33h,33h,00h
23D2 11 33 33 33 33 00 30 00 DB 11h,33h,33h,33h,33h,00h,30h,00h
23DA 10 11 01 03 30 10 11 11 DB 10h,11h,01h,03h,30h,10h,11h,11h
23E2 11 11 01 03 33 30 10 11 DB 11h,11h,01h,03h,33h,30h,10h,11h
23EA 11 11 01 00 03 33 33 33 DB 11h,11h,01h,00h,03h,33h,33h,33h
23F2 11 30 00 03 30 00 00 00 DB 11h,30h,00h,03h,30h,00h,00h,00h
23FA 00 00 00 80 DB 00h,00h,00h,80h
23FE ; *******************
23FE ; dojezd auta do cíle
23FE ; *******************
23FE DB F5 A_CIL: IN kbdin ; test na SHIFT, kterým
2400 E6 20 ANI 20h ; mohu přerušit melodii
2402 CA 00 20 JZ A_RST ; a restartovat hru
2405 3E 01 MVI a,1
2407 32 A2 23 STA A_CARS ; bitová fáze autíčka..
240A 2A A3 23 LHLD A_CARA ; postupné sunutí auta
240D 7C MOV a,h ; směrem nahoru po obrazovce
240E FE C2 CPI A_UPSCR ; až k cílové pásce
2410 CA FE 23 JZ A_CIL
2413 11 BF 00 LXI d,255-64
2416 19 DAD d
2417 22 A3 23 SHLD A_CARA
241A CD F4 21 CALL A_SHWC ; vykreslení autíčka
241D 36 00 MVI m,0
241F 23 INX h
2420 36 00 MVI m,0
2422 CD 28 24 CALL A_SND ; přehrávání hudby
2425 C3 FE 23 JMP A_CIL
2428 ; ****************
2428 ; přehrávání hudby
2428 ; ****************
2428 2A 98 23 A_SND: LHLD A_PSND ; víceméně standardní rutina
242B 7E MOV a,m ; pro řazení tónů za sebou
242C FE FF CPI 0ffh
242E 11 80 10 LXI d,1080h
2431 CA 60 24 JZ A_NOIS
2434 23 INX h
2435 22 98 23 SHLD A_PSND
2438 A7 ANA a
2439 21 00 D0 LXI h,0D000h
243C C2 4B 24 JNZ A_TONE
243F 43 A_SND1: MOV b,e
2440 16 00 MVI d,0
2442 05 A_SND2: DCR b
2443 C2 42 24 JNZ A_SND2
2446 19 DAD d
2447 D2 3F 24 JNC A_SND1
244A C9 RET
244B ; ***************
244B ; generování tónu
244B ; ***************
244B 0E 00 A_TONE: MVI c,0 ; střídáním hodnot 0 a 1
244D 5F MOV e,a ; 2. bitu (váha 04h)
244E 16 00 MVI d,0 ; na portu 0F6h, což je
2450 43 A_TON1: MOV b,e ; služební PPI 8255,
2451 05 A_TON2: DCR b ; dochází k vyluzování
2452 C2 51 24 JNZ A_TON2 ; tónů.. :)
2455 79 MOV a,c
2456 EE 04 XRI 4 ; ..to jen aby bylo co
2458 4F MOV c,a ; napsat..
2459 D3 F6 OUT kbdled
245B 19 DAD d
245C D2 50 24 JNC A_TON1
245F C9 RET
2460 ; ***************
2460 ; generování šumu
2460 ; ***************
2460 01 00 80 A_NOIS: LXI b,bios ; využívá se pseudonáhodné
2463 0A A_NOIL: LDAX b ; posloupnosti bajtů v ROM
2464 E6 04 ANI 4 ; a ono to doopravdy gene-
2466 D3 F6 OUT kbdled ; ruje něco jako šum..
2468 1B DCX d
2469 03 INX b
246A 7A MOV a,d
246B B3 ORA e
246C C2 63 24 JNZ A_NOIL
246F C9 RET
2470 ; **********************
2470 ; data závěrečné melodie
2470 ; **********************
2470 82 00 00 00 74 00 00 7B A_MLDY: DB 82h,00h,00h,00h,74h,00h,00h,7bh
2478 82 00 74 00 74 00 7B 00 DB 82h,00h,74h,00h,74h,00h,7bh,00h
2480 82 00 00 00 74 00 00 7B DB 82h,00h,00h,00h,74h,00h,00h,7bh
2488 82 00 74 00 74 00 7B 00 DB 82h,00h,74h,00h,74h,00h,7bh,00h
2490 82 00 00 00 74 00 00 7B DB 82h,00h,00h,00h,74h,00h,00h,7bh
2498 82 00 74 00 9C 00 AF 00 DB 82h,00h,74h,00h,9ch,00h,0afh,00h
24A0 C5 00 61 61 61 61 80 00 DB 0c5h,00h,61h,61h,61h,61h,80h,0h
24A8 74 00 74 82 00 74 82 00 DB 74h,00h,74h,82h,00h,74h,82h,00h
24B0 82 00 00 00 74 00 00 7B DB 82h,00h,00h,00h,74h,00h,00h,7bh
24B8 82 00 74 00 74 00 7B 00 DB 82h,00h,74h,00h,74h,00h,7bh,00h
24C0 82 00 00 00 74 00 00 7B DB 82h,00h,00h,00h,74h,00h,00h,7bh
24C8 82 00 74 00 74 00 7B 00 DB 82h,00h,74h,00h,74h,00h,7bh,00h
24D0 82 00 00 00 74 00 00 7B DB 82h,00h,00h,00h,74h,00h,00h,7bh
24D8 82 00 74 00 9C 00 AF 00 DB 82h,00h,74h,00h,9ch,00h,0afh,00h
24E0 C5 C5 C5 C5 FF DB 0c5h,0c5h,0c5h,0c5h,0ffh
_PC 24E0
A_LOGO C224
A_POHA C602
A_POSC C800
A_POSCL C802
A_POSCR C82B
A_POSPA C600
A_NAPCL C814
A_POSVL EFFF
A_POSV F018
A_UPSCR 00C2
A_DNPTH 00FC
A_NKOL 0005
A_SPFKT 0004
A_DELAY 1770
A_VPIXS 0008
KBDOUT 00F4
KBDIN 00F5
KBDLED 00F6
PRNPOS C03E
BIOS 8000
PRTOUT 8500
A_RST 2000
A_SCRL 205C
A_SCR1 205E
A_SCR2 2067
A_SCR3 2079
A_SCR4 207F
A_SCRO 2089
A_NXTP 20C0
A_NXT1 20F0
A_NXT2 20F3
A_ADDP 210C
A_ADD1 211E
A_ADD2 2121
A_ADD3 2131
A_KOLI 2135
A_KOLF 213D
A_KOLL 2155
A_KEYB 2161
A_RGHT 2174
A_RGHL 21A5
A_LEFT 21B5
A_LFTL 21E4
A_SHWC 21F4
A_SHCM 2208
A_SHCL 220F
A_BUMP 221C
A_BUML 2229
A_LOOP 2236
A_LOO1 2245
A_ACLR 2268
A_INCR 227D
A_CRSM 2289
A_THAV 2296
A_NHAV 22A5
A_PRNH 22AC
A_PRNL 22B6
A_SPDT 22C7
A_SHLG 22EF
A_LOGL 22F7
A_ENDE 2309
A_PASK 2312
A_PAS1 231A
A_PAS2 231D
A_PAS3 2326
A_PCIL 2331
A_PCIT 233E
A_PTRN 2345
A_CAR0 2365
A_CAR1 2376
A_CAR2 2387
A_PSND 2398
A_UPTH 239A
A_SPED 239C
A_KOLA 239D
A_LPTH 239E
A_RPTH 23A0
A_CARS 23A2
A_CARA 23A3
A_ROLL 23A5
A_TIMR 23A6
A_GAZ 23A8
A_PGAZ 23AA
A_VDLY 23AC
A_PATH 23AE
A_PTHL 23C2
A_CIL 23FE
A_SND 2428
A_SND1 243F
A_SND2 2442
A_TONE 244B
A_TON1 2450
A_TON2 2451
A_NOIS 2460
A_NOIL 2463
A_MLDY 2470
;
; Disassembled by:
; DASMx object code disassembler
; (c) Copyright 1996-1999 Conquest Consultants
; Version 1.30 (Oct 6 1999)
;
; File: BOB85.ROM
;
; Size: 1024 bytes
; Checksum: 5988
; CRC-32: 284BACE1
;
; Date: Sat Feb 19 21:07:42 2011
; WWW.NOSTALCOMP.CZ
;
; CPU: Intel 8085 (MCS-80/85 family)
;
;
;
org 00000H
L09FD equ 0x09fd
X09FE equ 0x09fe
;
;
; Disassembled by:
; DASMx object code disassembler
; (c) Copyright 1996-1999 Conquest Consultants
; Version 1.30 (Oct 6 1999)
;
; File: BOB85.ROM
;
; Size: 1024 bytes
; Checksum: 5988
; CRC-32: 284BACE1
;
; Date: Sat Feb 19 21:07:42 2011
; WWW.NOSTALCOMP.CZ
;
; CPU: Intel 8085 (MCS-80/85 family)
;
;
;
org 0000H
;
RS0:
lxi sp,009E6H
mvi a,008H
sim
ei
lxi h,08085H
call ZOBR
jmp DAL1
;
RS2:
xthl
push psw
mov a,m
call ZOBR
ZAS:
call ZNAK
cpi 060H
jnz ZAS
call TMA
pop psw
xthl
ret
;
TRA:
nop
nop
nop
nop
RS5:
nop
nop
nop
nop
RS55:
nop
nop
nop
nop
RS6:
nop
nop
nop
nop
RS65:
nop
nop
nop
nop
RS7:
nop
nop
nop
ret
;
RS75:
nop
nop
nop
DAL2:
call TMA
DAL1:
call POMLK
START:
call ZNAK
cpi 010H
jc CHYBA
jz GO
cpi 020H
jz SMEM
cpi 040H
jz RS0
cpi 050H
jz RS0
jmp MGF
;
GO:
call POM
shld X09FE
push psw
mvi a,0C3H
lxi d,L09FD
stax d
call TMA
pop psw
jmp L09FD
;
POM:
call ZOBR
call ADR
call ZNAK
TESTQ:
cpi 060H
jnz CHYBA
ret
;
ADR:
push psw
call TESTD
call ROT
push psw
mov a,h
call POSUV
mov h,a
pop psw
add h
mov h,a
pop psw
call ZOBR
push psw
call TESTD
push psw
mov a,h
call ROT
call POSUV
call ROT
mov h,a
pop psw
add h
mov h,a
pop psw
call ZOBR
push psw
call TESTD
call ROT
push psw
mov a,l
call POSUV
mov l,a
pop psw
add l
mov l,a
pop psw
call ZOBR
push psw
call TESTD
push psw
mov a,l
call ROT
call POSUV
call ROT
mov l,a
pop psw
add l
mov l,a
pop psw
call ZOBR
jmp ADR
;
TESTD:
call ZNAK
cpi 010H
rc
inx sp
inx sp
inx sp
inx sp
ora e
inx sp
jmp TESTQ
;
POMLK:
lxi h,RS0
push psw
mvi a,004H
out 00EH
out 00FH
pop psw
ret
;
TMA:
push psw
xra a
out 00AH
out 00BH
out 00CH
out 00DH
out 00EH
out 00FH
pop psw
ret
;
SMEM:
call POM
PAMET:
mov a,m
call ZOBR
call ZNAK
cpi 010H
jc DATA1
TESTSR:
cpi 060H
jnz ZPET
inx h
jmp PAMET
;
ZPET:
cpi 030H
jnz CHYBA
dcx h
jmp PAMET
;
DATA1:
call ROT
push psw
mov a,m
call POSUV
mov m,a
pop psw
add m
call ZOBR
push psw
mov b,a
mov m,a
call ZNAK
cpi 010H
jc DATA2
pop b
jmp TESTSR
;
DATA2:
mov m,a
mov a,b
call ROT
call POSUV
call ROT
add m
mov m,a
pop b
jmp PAMET
;
CHYBA:
lxi h,0EEEEH
call ZOBR
jmp DAL1
;
ROT:
rlc
rlc
rlc
rlc
ret
;
nop
ZNAK:
push b
call JEDEN
mov c,a
call MS3
VSTUP1:
in 00AH
ral
stc
cmc
rar
cmp c
pop b
rz
push b
mov c,a
jmp VSTUP1
;
JEDEN:
in 00AH
ral
jnc JEDEN
cmc
rar
ret
;
MS3:
push d
push psw
lxi d,0019DH
DC:
dcx d
mov a,d
adi 000H
jnz DC
pop psw
pop d
ret
;
ZOBR:
push psw
push d
push h
call KODNUL
out 00FH
mov a,d
call ROT
call KODNUL
out 00EH
pop h
push h
mov a,h
call KODNUL
out 00BH
mov a,d
call ROT
call KODNUL
out 00AH
pop h
push h
mov a,l
call KODNUL
out 00DH
mov a,d
call ROT
call KODNUL
out 00CH
pop h
pop d
pop psw
ret
;
nop
nop
POSUV:
mov d,a
mvi c,004H
CYKL:
stc
cmc
ral
dcr c
jnz CYKL
rrc
rrc
rrc
rrc
ret
;
KODNUL:
call POSUV
call KOD
ret
;
KOD:
push h
lxi h,TABK
add l
mov l,a
mov a,m
pop h
ret
;
TABK:
db 0F3H
db 060H
db 0B5H
db 0F4H
db 066H
db 0D6H
db 0D7H
db 070H
db 0F7H
db 076H
db 077H
db 0C7H
db 093H
db 0E5H
db 097H
db 017H
;
nop
MGF:
cpi 030H
jnz CHYBA
call POMLK
mvi a,005H
out 00FH
MGF1:
call ZNAK
cpi 050H
jz PM
cpi 040H
jnz MGF1
MP:
call UVOD
push h
call KS
nop
mov m,a
pop h
inr b
MP1:
mvi c,0FAH
mvi a,0C0H
MP2:
call OBDEL
dcr c
jnz MP2
xra a
call OBDEL
MP3:
mov c,m
dcr c
dcx sp
stax b
inx h
dcr b
stax b
lxi sp,0C702H
TAPEO:
di
push d
push b
mvi b,009H
TO1:
xra a
mvi a,0C0H
call OBDEL
mov a,c
rar
mov c,a
mvi a,001H
rar
rar
call OBDEL
xra a
call OBDEL
dcr b
jnz TO1
pop b
pop d
ei
ret
;
OBDEL:
mvi d,010H
OB1:
sim
mvi e,01EH
OB2:
dcr e
jnz OB2
xri 080H
dcr d
jnz OB1
ret
;
PM:
call UVOD
inr b
push h
push b
PM1:
mvi c,0FAH
PM2:
call VSTUP2
jnc PM1
dcr c
jnz PM2
PM3:
push b
call TAPEIN
mov m,c
inx h
pop b
dcr b
jnz PM3
pop b
pop h
dcr b
call KS
cmp m
jnz CHYBA
rst 0
TAPEIN:
mvi b,009H
TI1:
mvi d,016H
TI2:
dcr d
call VSTUP2
jc TI2
call VSTUP2
jc TI2
TI3:
inr d
call VSTUP2
jnc TI3
call VSTUP2
jnc TI3
mov a,d
ral
mov a,c
rar
mov c,a
dcr b
jnz TI1
ret
;
VSTUP2:
mvi e,016H
L02BE:
dcr e
jnz L02BE
rim
ral
ret
;
UVOD:
call POM
xra a
call POCETB
call TMA
ret
;
POCETB:
call TESTZN
call ROT
mov b,a
call TESTZN
add b
mov b,a
jmp POCETB
;
TESTZN:
call ZOBR
call ZNAK
cpi 060H
pop d
rz
push d
cpi 010H
jnc CHYBA
ret
;
KS:
push b
xra a
add h
add l
add b
KS1:
add m
inx h
dcr b
jnz KS1
cma
inr a
pop b
ret
;
nop
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
:1000000031E6093EE630FB218580CD9501C34200F3
:10001000E3F57ECD9501CD6701FE67C21600CDF9EF
:1000200000F1E3C900000000000000000000000033
:100030000000000000000000000000C9000000CD2A
:10004000F900CDED00CD6701FE67DA5801CA620004
:10005000FE62CA0901FE09CA0000FE00CA0000C310
:10006000FE01CD760022FE09F53EFE11FD0912CDFE
:10007000F900F1C3FD09CD9501CD8500CD6701FEE5
:1000800067C25801C9F5CDDE00CD6101F57CCDCE4A
:100090000167F18467F1CD9501F5CDDE00F57CCDEA
:1000A0006101CDCE01CD610167F18467F1CD95018C
:1000B000F5CDDE00CD6101F57DCDCE016FF1856F0F
:1000C000F1CD9501F5CDDE00F57DCD6101CDCE01FF
:1000D000CD61016FF1856FF1CD9501C38500CD67CD
:1000E00001FE67D833333333B333C37F00210000BD
:1000F000F53E00D300D300F1C9F5AFD300D300D350
:1001000000D300D300D300F1C9CD76007ECD950198
:10011000CD6701FE67DA2A01FE2AC2210123C30C42
:1001200001FE0CC258012BC30C01CD6101F57ECD3F
:10013000CE0177F186CD9501F54777CD6701FE6752
:10014000DA4701C1C318017778CD6101CDCE01CD69
:1001500061018677C1C30C0121EEEECD9501C3424A
:100160000007070707C900C5CD7D014FCD8601DB1C
:100170008617373F1FB9C1C8C54FC36F01DB6F1763
:10018000D27D013F1FC9D5F5119D011B7AC69DC2C5
:100190008B01F1D1C9F5D5E5CDDD01D3DD7ACD6196
:1001A00001CDDD01D3DDE1E57CCDDD01D3DD7ACD0F
:1001B0006101CDDD01D3DDE1E57DCDDD01D3DD7A6A
:1001C000CD6101CDDD01D3DDE1D1F1C90000570ED4
:1001D000DD373F170DC2D1010F0F0F0FC9CDCE0173
:1001E000CDE401C9E521ED01856F7EE1C9F360B57C
:1001F000F466D6D770F77677C793E5971700FEEDCC
:10020000C25801CDED003EEDD3EDCD6701FE67CACA
:100210006C02FE6CC20A02CDC502E5CDF002007789
:10022000E1040EF03EF0CD5C020DC22602AFCD5CC3
:10023000024E0D3B022305023102C7F3D5C506026B
:10024000AF3E02CD5C02791F4F3E5C1F1FCD5C02AA
:10025000AFCD5C0205C24002C1D1FBC91640301EC1
:10026000401DC26102EE6115C25E02C9CDC5020425
:10027000E5C50EC5CDBC02D272020DC27402C5CD59
:1002800094027123C105C27E02C1E105CDF002BE18
:10029000C25801C70658165815CDBC02DA9802CDCF
:1002A000BC02DA980214CDBC02D2A502CDBC02D2A7
:1002B000A5027A17791F4F05C29602C91E961DC264
:1002C000BE022017C9CD7600AFCDD002CDF900C94E
:1002D000CDDF02CD610147CDDF028047C3D002CD23
:1002E0009501CD6701FE67D1C8D5FE67D25801C917
:1002F000C5AF848580862305C2F5022F3CC1C900A5
:10030000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFD
:10031000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFED
:10032000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDD
:10033000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCD
:10034000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBD
:10035000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAD
:10036000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF9D
:10037000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8D
:10038000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7D
:10039000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6D
:1003A000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D
:1003B000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D
:1003C000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF3D
:1003D000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF2D
:1003E000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1D
:1003F000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0D
:00000001FF
0000 ;
0000 ; Disassembled by:
0000 ; DASMx object code disassembler
0000 ; (c) Copyright 1996-1999 Conquest Consultants
0000 ; Version 1.30 (Oct 6 1999)
0000 ;
0000 ; File: BOB85.ROM
0000 ;
0000 ; Size: 1024 bytes
0000 ; Checksum: 5988
0000 ; CRC-32: 284BACE1
0000 ;
0000 ; Date: Sat Feb 19 21:07:42 2011
0000 ; WWW.NOSTALCOMP.CZ
0000 ;
0000 ; CPU: Intel 8085 (MCS-80/85 family)
0000 ;
0000 ;
0000 ;
0000 .ORG 00000H
0000 L09FD: EQU 0x09fd
0000 X09FE: EQU 0x09fe
0000 ;
0000 ;
0000 ; Disassembled by:
0000 ; DASMx object code disassembler
0000 ; (c) Copyright 1996-1999 Conquest Consultants
0000 ; Version 1.30 (Oct 6 1999)
0000 ;
0000 ; File: BOB85.ROM
0000 ;
0000 ; Size: 1024 bytes
0000 ; Checksum: 5988
0000 ; CRC-32: 284BACE1
0000 ;
0000 ; Date: Sat Feb 19 21:07:42 2011
0000 ; WWW.NOSTALCOMP.CZ
0000 ;
0000 ; CPU: Intel 8085 (MCS-80/85 family)
0000 ;
0000 ;
0000 ;
0000 .ORG 0000H
0000 ;
0000 RS0:
0000 31 E6 09 LXI sp,009E6H
0003 3E E6 MVI a,008H
0005 30 SIM
0006 FB EI
0007 21 85 80 LXI h,08085H
000A CD 95 01 CALL ZOBR
000D C3 42 00 JMP DAL1
0010 ;
0010 RS2:
0010 E3 XTHL
0011 F5 PUSH psw
0012 7E MOV a,m
0013 CD 95 01 CALL ZOBR
0016 ZAS:
0016 CD 67 01 CALL ZNAK
0019 FE 67 CPI 060H
001B C2 16 00 JNZ ZAS
001E CD F9 00 CALL TMA
0021 F1 POP psw
0022 E3 XTHL
0023 C9 RET
0024 ;
0024 TRA:
0024 00 NOP
0025 00 NOP
0026 00 NOP
0027 00 NOP
0028 RS5:
0028 00 NOP
0029 00 NOP
002A 00 NOP
002B 00 NOP
002C RS55:
002C 00 NOP
002D 00 NOP
002E 00 NOP
002F 00 NOP
0030 RS6:
0030 00 NOP
0031 00 NOP
0032 00 NOP
0033 00 NOP
0034 RS65:
0034 00 NOP
0035 00 NOP
0036 00 NOP
0037 00 NOP
0038 RS7:
0038 00 NOP
0039 00 NOP
003A 00 NOP
003B C9 RET
003C ;
003C RS75:
003C 00 NOP
003D 00 NOP
003E 00 NOP
003F DAL2:
003F CD F9 00 CALL TMA
0042 DAL1:
0042 CD ED 00 CALL POMLK
0045 START:
0045 CD 67 01 CALL ZNAK
0048 FE 67 CPI 010H
004A DA 58 01 JC CHYBA
004D CA 62 00 JZ GO
0050 FE 62 CPI 020H
0052 CA 09 01 JZ SMEM
0055 FE 09 CPI 040H
0057 CA 00 00 JZ RS0
005A FE 00 CPI 050H
005C CA 00 00 JZ RS0
005F C3 FE 01 JMP MGF
0062 ;
0062 GO:
0062 CD 76 00 CALL POM
0065 22 FE 09 SHLD X09FE
0068 F5 PUSH psw
0069 3E FE MVI a,0C3H
006B 11 FD 09 LXI d,L09FD
006E 12 STAX d
006F CD F9 00 CALL TMA
0072 F1 POP psw
0073 C3 FD 09 JMP L09FD
0076 ;
0076 POM:
0076 CD 95 01 CALL ZOBR
0079 CD 85 00 CALL ADR
007C CD 67 01 CALL ZNAK
007F TESTQ:
007F FE 67 CPI 060H
0081 C2 58 01 JNZ CHYBA
0084 C9 RET
0085 ;
0085 ADR:
0085 F5 PUSH psw
0086 CD DE 00 CALL TESTD
0089 CD 61 01 CALL ROT
008C F5 PUSH psw
008D 7C MOV a,h
008E CD CE 01 CALL POSUV
0091 67 MOV h,a
0092 F1 POP psw
0093 84 ADD h
0094 67 MOV h,a
0095 F1 POP psw
0096 CD 95 01 CALL ZOBR
0099 F5 PUSH psw
009A CD DE 00 CALL TESTD
009D F5 PUSH psw
009E 7C MOV a,h
009F CD 61 01 CALL ROT
00A2 CD CE 01 CALL POSUV
00A5 CD 61 01 CALL ROT
00A8 67 MOV h,a
00A9 F1 POP psw
00AA 84 ADD h
00AB 67 MOV h,a
00AC F1 POP psw
00AD CD 95 01 CALL ZOBR
00B0 F5 PUSH psw
00B1 CD DE 00 CALL TESTD
00B4 CD 61 01 CALL ROT
00B7 F5 PUSH psw
00B8 7D MOV a,l
00B9 CD CE 01 CALL POSUV
00BC 6F MOV l,a
00BD F1 POP psw
00BE 85 ADD l
00BF 6F MOV l,a
00C0 F1 POP psw
00C1 CD 95 01 CALL ZOBR
00C4 F5 PUSH psw
00C5 CD DE 00 CALL TESTD
00C8 F5 PUSH psw
00C9 7D MOV a,l
00CA CD 61 01 CALL ROT
00CD CD CE 01 CALL POSUV
00D0 CD 61 01 CALL ROT
00D3 6F MOV l,a
00D4 F1 POP psw
00D5 85 ADD l
00D6 6F MOV l,a
00D7 F1 POP psw
00D8 CD 95 01 CALL ZOBR
00DB C3 85 00 JMP ADR
00DE ;
00DE TESTD:
00DE CD 67 01 CALL ZNAK
00E1 FE 67 CPI 010H
00E3 D8 RC
00E4 33 INX sp
00E5 33 INX sp
00E6 33 INX sp
00E7 33 INX sp
00E8 B3 ORA e
00E9 33 INX sp
00EA C3 7F 00 JMP TESTQ
00ED ;
00ED POMLK:
00ED 21 00 00 LXI h,RS0
00F0 F5 PUSH psw
00F1 3E 00 MVI a,004H
00F3 D3 00 OUT 00EH
00F5 D3 00 OUT 00FH
00F7 F1 POP psw
00F8 C9 RET
00F9 ;
00F9 TMA:
00F9 F5 PUSH psw
00FA AF XRA a
00FB D3 00 OUT 00AH
00FD D3 00 OUT 00BH
00FF D3 00 OUT 00CH
0101 D3 00 OUT 00DH
0103 D3 00 OUT 00EH
0105 D3 00 OUT 00FH
0107 F1 POP psw
0108 C9 RET
0109 ;
0109 SMEM:
0109 CD 76 00 CALL POM
010C PAMET:
010C 7E MOV a,m
010D CD 95 01 CALL ZOBR
0110 CD 67 01 CALL ZNAK
0113 FE 67 CPI 010H
0115 DA 2A 01 JC DATA1
0118 TESTSR:
0118 FE 2A CPI 060H
011A C2 21 01 JNZ ZPET
011D 23 INX h
011E C3 0C 01 JMP PAMET
0121 ;
0121 ZPET:
0121 FE 0C CPI 030H
0123 C2 58 01 JNZ CHYBA
0126 2B DCX h
0127 C3 0C 01 JMP PAMET
012A ;
012A DATA1:
012A CD 61 01 CALL ROT
012D F5 PUSH psw
012E 7E MOV a,m
012F CD CE 01 CALL POSUV
0132 77 MOV m,a
0133 F1 POP psw
0134 86 ADD m
0135 CD 95 01 CALL ZOBR
0138 F5 PUSH psw
0139 47 MOV b,a
013A 77 MOV m,a
013B CD 67 01 CALL ZNAK
013E FE 67 CPI 010H
0140 DA 47 01 JC DATA2
0143 C1 POP b
0144 C3 18 01 JMP TESTSR
0147 ;
0147 DATA2:
0147 77 MOV m,a
0148 78 MOV a,b
0149 CD 61 01 CALL ROT
014C CD CE 01 CALL POSUV
014F CD 61 01 CALL ROT
0152 86 ADD m
0153 77 MOV m,a
0154 C1 POP b
0155 C3 0C 01 JMP PAMET
0158 ;
0158 CHYBA:
0158 21 EE EE LXI h,0EEEEH
015B CD 95 01 CALL ZOBR
015E C3 42 00 JMP DAL1
0161 ;
0161 ROT:
0161 07 RLC
0162 07 RLC
0163 07 RLC
0164 07 RLC
0165 C9 RET
0166 ;
0166 00 NOP
0167 ZNAK:
0167 C5 PUSH b
0168 CD 7D 01 CALL JEDEN
016B 4F MOV c,a
016C CD 86 01 CALL MS3
016F VSTUP1:
016F DB 86 IN 00AH
0171 17 RAL
0172 37 STC
0173 3F CMC
0174 1F RAR
0175 B9 CMP c
0176 C1 POP b
0177 C8 RZ
0178 C5 PUSH b
0179 4F MOV c,a
017A C3 6F 01 JMP VSTUP1
017D ;
017D JEDEN:
017D DB 6F IN 00AH
017F 17 RAL
0180 D2 7D 01 JNC JEDEN
0183 3F CMC
0184 1F RAR
0185 C9 RET
0186 ;
0186 MS3:
0186 D5 PUSH d
0187 F5 PUSH psw
0188 11 9D 01 LXI d,0019DH
018B DC:
018B 1B DCX d
018C 7A MOV a,d
018D C6 9D ADI 000H
018F C2 8B 01 JNZ DC
0192 F1 POP psw
0193 D1 POP d
0194 C9 RET
0195 ;
0195 ZOBR:
0195 F5 PUSH psw
0196 D5 PUSH d
0197 E5 PUSH h
0198 CD DD 01 CALL KODNUL
019B D3 DD OUT 00FH
019D 7A MOV a,d
019E CD 61 01 CALL ROT
01A1 CD DD 01 CALL KODNUL
01A4 D3 DD OUT 00EH
01A6 E1 POP h
01A7 E5 PUSH h
01A8 7C MOV a,h
01A9 CD DD 01 CALL KODNUL
01AC D3 DD OUT 00BH
01AE 7A MOV a,d
01AF CD 61 01 CALL ROT
01B2 CD DD 01 CALL KODNUL
01B5 D3 DD OUT 00AH
01B7 E1 POP h
01B8 E5 PUSH h
01B9 7D MOV a,l
01BA CD DD 01 CALL KODNUL
01BD D3 DD OUT 00DH
01BF 7A MOV a,d
01C0 CD 61 01 CALL ROT
01C3 CD DD 01 CALL KODNUL
01C6 D3 DD OUT 00CH
01C8 E1 POP h
01C9 D1 POP d
01CA F1 POP psw
01CB C9 RET
01CC ;
01CC 00 NOP
01CD 00 NOP
01CE POSUV:
01CE 57 MOV d,a
01CF 0E DD MVI c,004H
01D1 CYKL:
01D1 37 STC
01D2 3F CMC
01D3 17 RAL
01D4 0D DCR c
01D5 C2 D1 01 JNZ CYKL
01D8 0F RRC
01D9 0F RRC
01DA 0F RRC
01DB 0F RRC
01DC C9 RET
01DD ;
01DD KODNUL:
01DD CD CE 01 CALL POSUV
01E0 CD E4 01 CALL KOD
01E3 C9 RET
01E4 ;
01E4 KOD:
01E4 E5 PUSH h
01E5 21 ED 01 LXI h,TABK
01E8 85 ADD l
01E9 6F MOV l,a
01EA 7E MOV a,m
01EB E1 POP h
01EC C9 RET
01ED ;
01ED TABK:
01ED F3 DB 0F3H
01EE 60 DB 060H
01EF B5 DB 0B5H
01F0 F4 DB 0F4H
01F1 66 DB 066H
01F2 D6 DB 0D6H
01F3 D7 DB 0D7H
01F4 70 DB 070H
01F5 F7 DB 0F7H
01F6 76 DB 076H
01F7 77 DB 077H
01F8 C7 DB 0C7H
01F9 93 DB 093H
01FA E5 DB 0E5H
01FB 97 DB 097H
01FC 17 DB 017H
01FD ;
01FD 00 NOP
01FE MGF:
01FE FE ED CPI 030H
0200 C2 58 01 JNZ CHYBA
0203 CD ED 00 CALL POMLK
0206 3E ED MVI a,005H
0208 D3 ED OUT 00FH
020A MGF1:
020A CD 67 01 CALL ZNAK
020D FE 67 CPI 050H
020F CA 6C 02 JZ PM
0212 FE 6C CPI 040H
0214 C2 0A 02 JNZ MGF1
0217 MP:
0217 CD C5 02 CALL UVOD
021A E5 PUSH h
021B CD F0 02 CALL KS
021E 00 NOP
021F 77 MOV m,a
0220 E1 POP h
0221 04 INR b
0222 MP1:
0222 0E F0 MVI c,0FAH
0224 3E F0 MVI a,0C0H
0226 MP2:
0226 CD 5C 02 CALL OBDEL
0229 0D DCR c
022A C2 26 02 JNZ MP2
022D AF XRA a
022E CD 5C 02 CALL OBDEL
0231 MP3:
0231 4E MOV c,m
0232 0D DCR c
0233 3B DCX sp
0234 02 STAX b
0235 23 INX h
0236 05 DCR b
0237 02 STAX b
0238 31 02 C7 LXI sp,0C702H
023B TAPEO:
023B F3 DI
023C D5 PUSH d
023D C5 PUSH b
023E 06 02 MVI b,009H
0240 TO1:
0240 AF XRA a
0241 3E 02 MVI a,0C0H
0243 CD 5C 02 CALL OBDEL
0246 79 MOV a,c
0247 1F RAR
0248 4F MOV c,a
0249 3E 5C MVI a,001H
024B 1F RAR
024C 1F RAR
024D CD 5C 02 CALL OBDEL
0250 AF XRA a
0251 CD 5C 02 CALL OBDEL
0254 05 DCR b
0255 C2 40 02 JNZ TO1
0258 C1 POP b
0259 D1 POP d
025A FB EI
025B C9 RET
025C ;
025C OBDEL:
025C 16 40 MVI d,010H
025E OB1:
025E 30 SIM
025F 1E 40 MVI e,01EH
0261 OB2:
0261 1D DCR e
0262 C2 61 02 JNZ OB2
0265 EE 61 XRI 080H
0267 15 DCR d
0268 C2 5E 02 JNZ OB1
026B C9 RET
026C ;
026C PM:
026C CD C5 02 CALL UVOD
026F 04 INR b
0270 E5 PUSH h
0271 C5 PUSH b
0272 PM1:
0272 0E C5 MVI c,0FAH
0274 PM2:
0274 CD BC 02 CALL VSTUP2
0277 D2 72 02 JNC PM1
027A 0D DCR c
027B C2 74 02 JNZ PM2
027E PM3:
027E C5 PUSH b
027F CD 94 02 CALL TAPEIN
0282 71 MOV m,c
0283 23 INX h
0284 C1 POP b
0285 05 DCR b
0286 C2 7E 02 JNZ PM3
0289 C1 POP b
028A E1 POP h
028B 05 DCR b
028C CD F0 02 CALL KS
028F BE CMP m
0290 C2 58 01 JNZ CHYBA
0293 C7 RST 0
0294 TAPEIN:
0294 06 58 MVI b,009H
0296 TI1:
0296 16 58 MVI d,016H
0298 TI2:
0298 15 DCR d
0299 CD BC 02 CALL VSTUP2
029C DA 98 02 JC TI2
029F CD BC 02 CALL VSTUP2
02A2 DA 98 02 JC TI2
02A5 TI3:
02A5 14 INR d
02A6 CD BC 02 CALL VSTUP2
02A9 D2 A5 02 JNC TI3
02AC CD BC 02 CALL VSTUP2
02AF D2 A5 02 JNC TI3
02B2 7A MOV a,d
02B3 17 RAL
02B4 79 MOV a,c
02B5 1F RAR
02B6 4F MOV c,a
02B7 05 DCR b
02B8 C2 96 02 JNZ TI1
02BB C9 RET
02BC ;
02BC VSTUP2:
02BC 1E 96 MVI e,016H
02BE L02BE:
02BE 1D DCR e
02BF C2 BE 02 JNZ L02BE
02C2 20 RIM
02C3 17 RAL
02C4 C9 RET
02C5 ;
02C5 UVOD:
02C5 CD 76 00 CALL POM
02C8 AF XRA a
02C9 CD D0 02 CALL POCETB
02CC CD F9 00 CALL TMA
02CF C9 RET
02D0 ;
02D0 POCETB:
02D0 CD DF 02 CALL TESTZN
02D3 CD 61 01 CALL ROT
02D6 47 MOV b,a
02D7 CD DF 02 CALL TESTZN
02DA 80 ADD b
02DB 47 MOV b,a
02DC C3 D0 02 JMP POCETB
02DF ;
02DF TESTZN:
02DF CD 95 01 CALL ZOBR
02E2 CD 67 01 CALL ZNAK
02E5 FE 67 CPI 060H
02E7 D1 POP d
02E8 C8 RZ
02E9 D5 PUSH d
02EA FE 67 CPI 010H
02EC D2 58 01 JNC CHYBA
02EF C9 RET
02F0 ;
02F0 KS:
02F0 C5 PUSH b
02F1 AF XRA a
02F2 84 ADD h
02F3 85 ADD l
02F4 80 ADD b
02F5 KS1:
02F5 86 ADD m
02F6 23 INX h
02F7 05 DCR b
02F8 C2 F5 02 JNZ KS1
02FB 2F CMA
02FC 3C INR a
02FD C1 POP b
02FE C9 RET
02FF ;
02FF 00 NOP
0300 FF RST 7
0301 FF RST 7
0302 FF RST 7
0303 FF RST 7
0304 FF RST 7
0305 FF RST 7
0306 FF RST 7
0307 FF RST 7
0308 FF RST 7
0309 FF RST 7
030A FF RST 7
030B FF RST 7
030C FF RST 7
030D FF RST 7
030E FF RST 7
030F FF RST 7
0310 FF RST 7
0311 FF RST 7
0312 FF RST 7
0313 FF RST 7
0314 FF RST 7
0315 FF RST 7
0316 FF RST 7
0317 FF RST 7
0318 FF RST 7
0319 FF RST 7
031A FF RST 7
031B FF RST 7
031C FF RST 7
031D FF RST 7
031E FF RST 7
031F FF RST 7
0320 FF RST 7
0321 FF RST 7
0322 FF RST 7
0323 FF RST 7
0324 FF RST 7
0325 FF RST 7
0326 FF RST 7
0327 FF RST 7
0328 FF RST 7
0329 FF RST 7
032A FF RST 7
032B FF RST 7
032C FF RST 7
032D FF RST 7
032E FF RST 7
032F FF RST 7
0330 FF RST 7
0331 FF RST 7
0332 FF RST 7
0333 FF RST 7
0334 FF RST 7
0335 FF RST 7
0336 FF RST 7
0337 FF RST 7
0338 FF RST 7
0339 FF RST 7
033A FF RST 7
033B FF RST 7
033C FF RST 7
033D FF RST 7
033E FF RST 7
033F FF RST 7
0340 FF RST 7
0341 FF RST 7
0342 FF RST 7
0343 FF RST 7
0344 FF RST 7
0345 FF RST 7
0346 FF RST 7
0347 FF RST 7
0348 FF RST 7
0349 FF RST 7
034A FF RST 7
034B FF RST 7
034C FF RST 7
034D FF RST 7
034E FF RST 7
034F FF RST 7
0350 FF RST 7
0351 FF RST 7
0352 FF RST 7
0353 FF RST 7
0354 FF RST 7
0355 FF RST 7
0356 FF RST 7
0357 FF RST 7
0358 FF RST 7
0359 FF RST 7
035A FF RST 7
035B FF RST 7
035C FF RST 7
035D FF RST 7
035E FF RST 7
035F FF RST 7
0360 FF RST 7
0361 FF RST 7
0362 FF RST 7
0363 FF RST 7
0364 FF RST 7
0365 FF RST 7
0366 FF RST 7
0367 FF RST 7
0368 FF RST 7
0369 FF RST 7
036A FF RST 7
036B FF RST 7
036C FF RST 7
036D FF RST 7
036E FF RST 7
036F FF RST 7
0370 FF RST 7
0371 FF RST 7
0372 FF RST 7
0373 FF RST 7
0374 FF RST 7
0375 FF RST 7
0376 FF RST 7
0377 FF RST 7
0378 FF RST 7
0379 FF RST 7
037A FF RST 7
037B FF RST 7
037C FF RST 7
037D FF RST 7
037E FF RST 7
037F FF RST 7
0380 FF RST 7
0381 FF RST 7
0382 FF RST 7
0383 FF RST 7
0384 FF RST 7
0385 FF RST 7
0386 FF RST 7
0387 FF RST 7
0388 FF RST 7
0389 FF RST 7
038A FF RST 7
038B FF RST 7
038C FF RST 7
038D FF RST 7
038E FF RST 7
038F FF RST 7
0390 FF RST 7
0391 FF RST 7
0392 FF RST 7
0393 FF RST 7
0394 FF RST 7
0395 FF RST 7
0396 FF RST 7
0397 FF RST 7
0398 FF RST 7
0399 FF RST 7
039A FF RST 7
039B FF RST 7
039C FF RST 7
039D FF RST 7
039E FF RST 7
039F FF RST 7
03A0 FF RST 7
03A1 FF RST 7
03A2 FF RST 7
03A3 FF RST 7
03A4 FF RST 7
03A5 FF RST 7
03A6 FF RST 7
03A7 FF RST 7
03A8 FF RST 7
03A9 FF RST 7
03AA FF RST 7
03AB FF RST 7
03AC FF RST 7
03AD FF RST 7
03AE FF RST 7
03AF FF RST 7
03B0 FF RST 7
03B1 FF RST 7
03B2 FF RST 7
03B3 FF RST 7
03B4 FF RST 7
03B5 FF RST 7
03B6 FF RST 7
03B7 FF RST 7
03B8 FF RST 7
03B9 FF RST 7
03BA FF RST 7
03BB FF RST 7
03BC FF RST 7
03BD FF RST 7
03BE FF RST 7
03BF FF RST 7
03C0 FF RST 7
03C1 FF RST 7
03C2 FF RST 7
03C3 FF RST 7
03C4 FF RST 7
03C5 FF RST 7
03C6 FF RST 7
03C7 FF RST 7
03C8 FF RST 7
03C9 FF RST 7
03CA FF RST 7
03CB FF RST 7
03CC FF RST 7
03CD FF RST 7
03CE FF RST 7
03CF FF RST 7
03D0 FF RST 7
03D1 FF RST 7
03D2 FF RST 7
03D3 FF RST 7
03D4 FF RST 7
03D5 FF RST 7
03D6 FF RST 7
03D7 FF RST 7
03D8 FF RST 7
03D9 FF RST 7
03DA FF RST 7
03DB FF RST 7
03DC FF RST 7
03DD FF RST 7
03DE FF RST 7
03DF FF RST 7
03E0 FF RST 7
03E1 FF RST 7
03E2 FF RST 7
03E3 FF RST 7
03E4 FF RST 7
03E5 FF RST 7
03E6 FF RST 7
03E7 FF RST 7
03E8 FF RST 7
03E9 FF RST 7
03EA FF RST 7
03EB FF RST 7
03EC FF RST 7
03ED FF RST 7
03EE FF RST 7
03EF FF RST 7
03F0 FF RST 7
03F1 FF RST 7
03F2 FF RST 7
03F3 FF RST 7
03F4 FF RST 7
03F5 FF RST 7
03F6 FF RST 7
03F7 FF RST 7
03F8 FF RST 7
03F9 FF RST 7
03FA FF RST 7
03FB FF RST 7
03FC FF RST 7
03FD FF RST 7
03FE FF RST 7
03FF FF RST 7
org $0100
.include pokus.a80
goeshere $ab
jmp 0
.cpu 8080
goeshere 26
.macro goeshere
adi %%1
ani $0f
.endm
:10010000EE17F6FBFBC9C6ABE60FC30000C61AE646
:010110000FDF
:00000001FF
0100 .ORG $0100
0100 EE 17 MAJNE: XRI 23
0102 F6 FB ORI 251
0104 FB EI
0105 C9 RET
**MACRO UNROLL - GOESHERE
0106 C6 AB ADI $ab
0108 E6 0F ANI $0f
010A C3 00 00 JMP 0
010D .CPU 8080
**MACRO UNROLL - GOESHERE
010D C6 1A ADI 26
010F E6 0F ANI $0f
_PC 010F
MAJNE 0100
; ___ _ __ ___ __ ___
; / __|_ _ __ _| |_____ / /| __|/ \_ )
; \__ \ ' \/ _` | / / -_) _ \__ \ () / /
; |___/_||_\__,_|_\_\___\___/___/\__/___|
; Change direction: W A S D
; $00-01 => screen location of apple
; $10-11 => screen location of snake head
; $12-?? => snake body (in byte pairs)
; $02 => direction (1 => up, 2 => right, 4 => down, 8 => left)
; $03 => snake length
org $0600
nop
jsr init
jsr loop
init:
jsr initSnake
jsr generateApplePosition
rts
initSnake:
lda #2 ;start direction
sta $02
lda #4 ;start length
sta $03
lda #$11
sta $10
lda #$10
sta $12
lda #$0f
sta $14
lda #$04
sta $11
sta $13
sta $15
rts
generateApplePosition:
;load a new random byte into $00
lda $fe
sta $00
;load a new random number from 2 to 5 into $01
lda $fe
and #$03 ;mask out lowest 2 bits
clc
adc #2
sta $01
rts
loop:
jsr readKeys
jsr checkCollision
jsr updateSnake
jsr drawApple
jsr drawSnake
jsr spinWheels
jmp loop
readKeys:
lda $ff
cmp #$77
beq upKey
cmp #$64
beq rightKey
cmp #$73
beq downKey
cmp #$61
beq leftKey
rts
upKey:
lda #4
bit $02
bne illegalMove
lda #1
sta $02
rts
rightKey:
lda #8
bit $02
bne illegalMove
lda #2
sta $02
rts
downKey:
lda #1
bit $02
bne illegalMove
lda #4
sta $02
rts
leftKey:
lda #2
bit $02
bne illegalMove
lda #8
sta $02
rts
illegalMove:
rts
checkCollision:
jsr checkAppleCollision
jsr checkSnakeCollision
rts
checkAppleCollision:
lda $00
cmp $10
bne doneCheckingAppleCollision
lda $01
cmp $11
bne doneCheckingAppleCollision
;eat apple
inc $03
inc $03 ;increase length
jsr generateApplePosition
doneCheckingAppleCollision:
rts
checkSnakeCollision:
ldx #2 ;start with second segment
snakeCollisionLoop:
lda $10,x
cmp $10
bne continueCollisionLoop
maybeCollided:
lda $11,x
cmp $11
beq didCollide
continueCollisionLoop:
inx
inx
cpx $03 ;got to last section with no collision
beq didntCollide
jmp snakeCollisionLoop
didCollide:
jmp gameOver
didntCollide:
rts
updateSnake:
ldx $03 ;location of length
dex
txa
updateloop:
lda $10,x
sta $12,x
dex
bpl updateloop
lda $02
lsr
bcs up
lsr
bcs right
lsr
bcs down
lsr
bcs left
up:
lda $10
sec
sbc #$20
sta $10
bcc upup
rts
upup:
dec $11
lda #$1
cmp $11
beq collision
rts
right:
inc $10
lda #$1f
bit $10
beq collision
rts
down:
lda $10
clc
adc #$20
sta $10
bcs downdown
rts
downdown:
inc $11
lda #$6
cmp $11
beq collision
rts
left:
dec $10
lda $10
and #$1f
cmp #$1f
beq collision
rts
collision:
jmp gameOver
drawApple:
ldy #0
lda $fe
sta ($00),y
rts
drawSnake:
ldx #0
lda #1
sta ($10,x)
ldx $03
lda #0
sta ($10,x)
rts
spinWheels:
ldx #0
spinloop:
nop
nop
dex
bne spinloop
rts
gameOver:
:10060000EA200706203906200E06202B0660A902E4
:100610008502A9048503A9118510A9108512A90FC7
:100620008514A90485118513851560A5FE8500A58F
:10063000FE2903186902850160204E06208E0620DF
:10064000C406201A07202107202E074C3906A5FFD3
:10065000C977F00DC964F014C973F01BC961F022A9
:1006600060A9042402D026A901850260A9082402F9
:10067000D01BA902850260A9012402D010A904851B
:100680000260A9022402D005A908850260602095B5
:100690000620A90660A500C510D00DA501C511D082
:1006A00007E603E603202B0660A202B510C510D0B2
:1006B00006B511C511F009E8E8E403F0064CAB06F5
:1006C0004C360760A603CA8AB5109512CA10F9A560
:1006D000024AB0094AB0194AB01F4AB02FA51038D3
:1006E000E9208510900160C611A901C511F02860AC
:1006F000E610A91F2410F01F60A5101869208510AE
:10070000B00160E611A906C511F00C60C610A51075
:10071000291FC91FF001604C3607A000A5FE9100FB
:1007200060A200A9018110A603A900811060A200A7
:06073000EAEACAD0FB60FA
:00000001FF
0000 ; ___ _ __ ___ __ ___
0000 ; / __|_ _ __ _| |_____ / /| __|/ \_ )
0000 ; \__ \ ' \/ _` | / / -_) _ \__ \ () / /
0000 ; |___/_||_\__,_|_\_\___\___/___/\__/___|
0000 ; Change direction: W A S D
0000 ; $00-01 => screen location of apple
0000 ; $10-11 => screen location of snake head
0000 ; $12-?? => snake body (in byte pairs)
0000 ; $02 => direction (1 => up, 2 => right, 4 => down, 8 => left)
0000 ; $03 => snake length
0600 .ORG $0600
0600 EA NOP
0601 20 07 06 JSR init
0604 20 39 06 JSR loop
0607 INIT:
0607 20 0E 06 JSR initSnake
060A 20 2B 06 JSR generateApplePosition
060D 60 RTS
060E INITSNAKE:
060E A9 02 LDA 2 ;start direction
0610 85 02 STA $02
0612 A9 04 LDA 4 ;start length
0614 85 03 STA $03
0616 A9 11 LDA $11
0618 85 10 STA $10
061A A9 10 LDA $10
061C 85 12 STA $12
061E A9 0F LDA $0f
0620 85 14 STA $14
0622 A9 04 LDA $04
0624 85 11 STA $11
0626 85 13 STA $13
0628 85 15 STA $15
062A 60 RTS
062B GENERATEAPPLEPOSITION:
062B ;load a new random byte into $00
062B A5 FE LDA $fe
062D 85 00 STA $00
062F ;load a new random number from 2 to 5 into $01
062F A5 FE LDA $fe
0631 29 03 AND $03 ;mask out lowest 2 bits
0633 18 CLC
0634 69 02 ADC 2
0636 85 01 STA $01
0638 60 RTS
0639 LOOP:
0639 20 4E 06 JSR readKeys
063C 20 8E 06 JSR checkCollision
063F 20 C4 06 JSR updateSnake
0642 20 1A 07 JSR drawApple
0645 20 21 07 JSR drawSnake
0648 20 2E 07 JSR spinWheels
064B 4C 39 06 JMP loop
064E READKEYS:
064E A5 FF LDA $ff
0650 C9 77 CMP $77
0652 F0 0D BEQ upKey
0654 C9 64 CMP $64
0656 F0 14 BEQ rightKey
0658 C9 73 CMP $73
065A F0 1B BEQ downKey
065C C9 61 CMP $61
065E F0 22 BEQ leftKey
0660 60 RTS
0661 UPKEY:
0661 A9 04 LDA 4
0663 24 02 BIT $02
0665 D0 26 BNE illegalMove
0667 A9 01 LDA 1
0669 85 02 STA $02
066B 60 RTS
066C RIGHTKEY:
066C A9 08 LDA 8
066E 24 02 BIT $02
0670 D0 1B BNE illegalMove
0672 A9 02 LDA 2
0674 85 02 STA $02
0676 60 RTS
0677 DOWNKEY:
0677 A9 01 LDA 1
0679 24 02 BIT $02
067B D0 10 BNE illegalMove
067D A9 04 LDA 4
067F 85 02 STA $02
0681 60 RTS
0682 LEFTKEY:
0682 A9 02 LDA 2
0684 24 02 BIT $02
0686 D0 05 BNE illegalMove
0688 A9 08 LDA 8
068A 85 02 STA $02
068C 60 RTS
068D ILLEGALMOVE:
068D 60 RTS
068E CHECKCOLLISION:
068E 20 95 06 JSR checkAppleCollision
0691 20 A9 06 JSR checkSnakeCollision
0694 60 RTS
0695 CHECKAPPLECOLLISION:
0695 A5 00 LDA $00
0697 C5 10 CMP $10
0699 D0 0D BNE doneCheckingAppleCollision
069B A5 01 LDA $01
069D C5 11 CMP $11
069F D0 07 BNE doneCheckingAppleCollision
06A1 ;eat apple
06A1 E6 03 INC $03
06A3 E6 03 INC $03 ;increase length
06A5 20 2B 06 JSR generateApplePosition
06A8 DONECHECKINGAPPLECOLLISION:
06A8 60 RTS
06A9 CHECKSNAKECOLLISION:
06A9 A2 02 LDX 2 ;start with second segment
06AB SNAKECOLLISIONLOOP:
06AB B5 10 LDA $10,x
06AD C5 10 CMP $10
06AF D0 06 BNE continueCollisionLoop
06B1 MAYBECOLLIDED:
06B1 B5 11 LDA $11,x
06B3 C5 11 CMP $11
06B5 F0 09 BEQ didCollide
06B7 CONTINUECOLLISIONLOOP:
06B7 E8 INX
06B8 E8 INX
06B9 E4 03 CPX $03 ;got to last section with no collision
06BB F0 06 BEQ didntCollide
06BD 4C AB 06 JMP snakeCollisionLoop
06C0 DIDCOLLIDE:
06C0 4C 36 07 JMP gameOver
06C3 DIDNTCOLLIDE:
06C3 60 RTS
06C4 UPDATESNAKE:
06C4 A6 03 LDX $03 ;location of length
06C6 CA DEX
06C7 8A TXA
06C8 UPDATELOOP:
06C8 B5 10 LDA $10,x
06CA 95 12 STA $12,x
06CC CA DEX
06CD 10 F9 BPL updateloop
06CF A5 02 LDA $02
06D1 4A LSR
06D2 B0 09 BCS up
06D4 4A LSR
06D5 B0 19 BCS right
06D7 4A LSR
06D8 B0 1F BCS down
06DA 4A LSR
06DB B0 2F BCS left
06DD UP:
06DD A5 10 LDA $10
06DF 38 SEC
06E0 E9 20 SBC $20
06E2 85 10 STA $10
06E4 90 01 BCC upup
06E6 60 RTS
06E7 UPUP:
06E7 C6 11 DEC $11
06E9 A9 01 LDA $1
06EB C5 11 CMP $11
06ED F0 28 BEQ collision
06EF 60 RTS
06F0 RIGHT:
06F0 E6 10 INC $10
06F2 A9 1F LDA $1f
06F4 24 10 BIT $10
06F6 F0 1F BEQ collision
06F8 60 RTS
06F9 DOWN:
06F9 A5 10 LDA $10
06FB 18 CLC
06FC 69 20 ADC $20
06FE 85 10 STA $10
0700 B0 01 BCS downdown
0702 60 RTS
0703 DOWNDOWN:
0703 E6 11 INC $11
0705 A9 06 LDA $6
0707 C5 11 CMP $11
0709 F0 0C BEQ collision
070B 60 RTS
070C LEFT:
070C C6 10 DEC $10
070E A5 10 LDA $10
0710 29 1F AND $1f
0712 C9 1F CMP $1f
0714 F0 01 BEQ collision
0716 60 RTS
0717 COLLISION:
0717 4C 36 07 JMP gameOver
071A DRAWAPPLE:
071A A0 00 LDY 0
071C A5 FE LDA $fe
071E 91 00 STA $00,y
0720 60 RTS
0721 DRAWSNAKE:
0721 A2 00 LDX 0
0723 A9 01 LDA 1
0725 81 10 STA $10,x)
0727 A6 03 LDX $03
0729 A9 00 LDA 0
072B 81 10 STA $10,x)
072D 60 RTS
072E SPINWHEELS:
072E A2 00 LDX 0
0730 SPINLOOP:
0730 EA NOP
0731 EA NOP
0732 CA DEX
0733 D0 FB BNE spinloop
0735 60 RTS
0736 GAMEOVER:
_PC 0736
INIT 0607
INITSNAKE 060E
GENERATEAPPLEPOSITION062B
LOOP 0639
READKEYS 064E
UPKEY 0661
RIGHTKEY 066C
DOWNKEY 0677
LEFTKEY 0682
ILLEGALMOVE 068D
CHECKCOLLISION068E
CHECKAPPLECOLLISION0695
DONECHECKINGAPPLECOLLISION06A8
CHECKSNAKECOLLISION06A9
SNAKECOLLISIONLOOP06AB
MAYBECOLLIDED06B1
CONTINUECOLLISIONLOOP06B7
DIDCOLLIDE 06C0
DIDNTCOLLIDE06C3
UPDATESNAKE 06C4
UPDATELOOP 06C8
UP 06DD
UPUP 06E7
RIGHT 06F0
DOWN 06F9
DOWNDOWN 0703
LEFT 070C
COLLISION 0717
DRAWAPPLE 071A
DRAWSNAKE 0721
SPINWHEELS 072E
SPINLOOP 0730
GAMEOVER 0736
a6aec0f1bcf596c03f1465e6ec407681
; ___ _ __ ___ __ ___
; / __|_ _ __ _| |_____ / /| __|/ \_ )
; \__ \ ' \/ _` | / / -_) _ \__ \ () / /
; |___/_||_\__,_|_\_\___\___/___/\__/___|
; Change direction: W A S D
; $00-01 => screen location of apple
; $10-11 => screen location of snake head
; $12-?? => snake body (in byte pairs)
; $02 => direction (1 => up, 2 => right, 4 => down, 8 => left)
; $03 => snake length
org $0600
nop
jsr init
jsr loop
init:
jsr initSnake
jsr generateApplePosition
rts
initSnake:
lda #2 ;start direction
sta $02
lda #4 ;start length
sta $03
lda #$11
sta $10
lda #$10
sta $12
lda #$0f
sta $14
lda #$04
sta $11
sta $13
sta $15
rts
generateApplePosition:
;load a new random byte into $00
lda $fe
sta $00
;load a new random number from 2 to 5 into $01
lda $fe
and #$03 ;mask out lowest 2 bits
clc
adc #2
sta $01
rts
loop:
jsr readKeys
jsr checkCollision
jsr updateSnake
jsr drawApple
jsr drawSnake
jsr spinWheels
jmp loop
readKeys:
lda $ff
cmp #$77
beq upKey
cmp #$64
beq rightKey
cmp #$73
beq downKey
cmp #$61
beq leftKey
rts
upKey:
lda #4
bit $02
bne illegalMove
lda #1
sta $02
rts
rightKey:
lda #8
bit $02
bne illegalMove
lda #2
sta $02
rts
downKey:
lda #1
bit $02
bne illegalMove
lda #4
sta $02
rts
leftKey:
lda #2
bit $02
bne illegalMove
lda #8
sta $02
rts
illegalMove:
rts
checkCollision:
jsr checkAppleCollision
jsr checkSnakeCollision
rts
checkAppleCollision:
lda $00
cmp $10
bne doneCheckingAppleCollision
lda $01
cmp $11
bne doneCheckingAppleCollision
;eat apple
inc $03
inc $03 ;increase length
jsr generateApplePosition
doneCheckingAppleCollision:
rts
checkSnakeCollision:
ldx #2 ;start with second segment
snakeCollisionLoop:
lda $10,x
cmp $10
bne continueCollisionLoop
maybeCollided:
lda $11,x
cmp $11
beq didCollide
continueCollisionLoop:
inx
inx
cpx $03 ;got to last section with no collision
beq didntCollide
jmp snakeCollisionLoop
didCollide:
jmp gameOver
didntCollide:
rts
updateSnake:
ldx $03 ;location of length
dex
txa
updateloop:
lda $10,x
sta $12,x
dex
bpl updateloop
lda $02
lsr
bcs up
lsr
bcs right
lsr
bcs down
lsr
bcs left
up:
lda $10
sec
sbc #$20
sta $10
bcc upup
rts
upup:
dec $11
lda #$1
cmp $11
beq collision
rts
right:
inc $10
lda #$1f
bit $10
beq collision
rts
down:
lda $10
clc
adc #$20
sta $10
bcs downdown
rts
downdown:
inc $11
lda #$6
cmp $11
beq collision
rts
left:
dec $10
lda $10
and #$1f
cmp #$1f
beq collision
rts
collision:
jmp gameOver
drawApple:
ldy #0
lda $fe
sta ($00),y
rts
drawSnake:
ldx #0
lda #1
sta ($10,x)
ldx $03
lda #0
sta ($10,x)
rts
spinWheels:
ldx #0
spinloop:
nop
nop
dex
bne spinloop
rts
gameOver:
:10060000EA200706203906200E06202B0660A902E4
:100610008502A9048503A9118510A9108512A90FC7
:100620008514A90485118513851560A5FE8500A58F
:10063000FE2903186902850160204E06208E0620DF
:10064000C406201A07202107202E074C3906A5FFD3
:10065000C977F00DC964F014C973F01BC961F022A9
:1006600060A9042402D026A901850260A9082402F9
:10067000D01BA902850260A9012402D010A904851B
:100680000260A9022402D005A908850260602095B5
:100690000620A90660A500C510D00DA501C511D082
:1006A00007E603E603202B0660A202B510C510D0B2
:1006B00006B511C511F009E8E8E403F0064CAB06F5
:1006C0004C360760A603CA8AB5109512CA10F9A560
:1006D000024AB0094AB0194AB01F4AB02FA51038D3
:1006E000E9208510900160C611A901C511F02860AC
:1006F000E610A91F2410F01F60A5101869208510AE
:10070000B00160E611A906C511F00C60C610A51075
:10071000291FC91FF001604C3607A000A5FE9100FB
:1007200060A200A9018110A603A900811060A200A7
:06073000EAEACAD0FB60FA
:00000001FF
0000 ; ___ _ __ ___ __ ___
0000 ; / __|_ _ __ _| |_____ / /| __|/ \_ )
0000 ; \__ \ ' \/ _` | / / -_) _ \__ \ () / /
0000 ; |___/_||_\__,_|_\_\___\___/___/\__/___|
0000 ; Change direction: W A S D
0000 ; $00-01 => screen location of apple
0000 ; $10-11 => screen location of snake head
0000 ; $12-?? => snake body (in byte pairs)
0000 ; $02 => direction (1 => up, 2 => right, 4 => down, 8 => left)
0000 ; $03 => snake length
0600 .ORG $0600
0600 EA NOP
0601 20 07 06 JSR init
0604 20 39 06 JSR loop
0607 INIT:
0607 20 0E 06 JSR initSnake
060A 20 2B 06 JSR generateApplePosition
060D 60 RTS
060E INITSNAKE:
060E A9 02 LDA 2 ;start direction
0610 85 02 STA $02
0612 A9 04 LDA 4 ;start length
0614 85 03 STA $03
0616 A9 11 LDA $11
0618 85 10 STA $10
061A A9 10 LDA $10
061C 85 12 STA $12
061E A9 0F LDA $0f
0620 85 14 STA $14
0622 A9 04 LDA $04
0624 85 11 STA $11
0626 85 13 STA $13
0628 85 15 STA $15
062A 60 RTS
062B GENERATEAPPLEPOSITION:
062B ;load a new random byte into $00
062B A5 FE LDA $fe
062D 85 00 STA $00
062F ;load a new random number from 2 to 5 into $01
062F A5 FE LDA $fe
0631 29 03 AND $03 ;mask out lowest 2 bits
0633 18 CLC
0634 69 02 ADC 2
0636 85 01 STA $01
0638 60 RTS
0639 LOOP:
0639 20 4E 06 JSR readKeys
063C 20 8E 06 JSR checkCollision
063F 20 C4 06 JSR updateSnake
0642 20 1A 07 JSR drawApple
0645 20 21 07 JSR drawSnake
0648 20 2E 07 JSR spinWheels
064B 4C 39 06 JMP loop
064E READKEYS:
064E A5 FF LDA $ff
0650 C9 77 CMP $77
0652 F0 0D BEQ upKey
0654 C9 64 CMP $64
0656 F0 14 BEQ rightKey
0658 C9 73 CMP $73
065A F0 1B BEQ downKey
065C C9 61 CMP $61
065E F0 22 BEQ leftKey
0660 60 RTS
0661 UPKEY:
0661 A9 04 LDA 4
0663 24 02 BIT $02
0665 D0 26 BNE illegalMove
0667 A9 01 LDA 1
0669 85 02 STA $02
066B 60 RTS
066C RIGHTKEY:
066C A9 08 LDA 8
066E 24 02 BIT $02
0670 D0 1B BNE illegalMove
0672 A9 02 LDA 2
0674 85 02 STA $02
0676 60 RTS
0677 DOWNKEY:
0677 A9 01 LDA 1
0679 24 02 BIT $02
067B D0 10 BNE illegalMove
067D A9 04 LDA 4
067F 85 02 STA $02
0681 60 RTS
0682 LEFTKEY:
0682 A9 02 LDA 2
0684 24 02 BIT $02
0686 D0 05 BNE illegalMove
0688 A9 08 LDA 8
068A 85 02 STA $02
068C 60 RTS
068D ILLEGALMOVE:
068D 60 RTS
068E CHECKCOLLISION:
068E 20 95 06 JSR checkAppleCollision
0691 20 A9 06 JSR checkSnakeCollision
0694 60 RTS
0695 CHECKAPPLECOLLISION:
0695 A5 00 LDA $00
0697 C5 10 CMP $10
0699 D0 0D BNE doneCheckingAppleCollision
069B A5 01 LDA $01
069D C5 11 CMP $11
069F D0 07 BNE doneCheckingAppleCollision
06A1 ;eat apple
06A1 E6 03 INC $03
06A3 E6 03 INC $03 ;increase length
06A5 20 2B 06 JSR generateApplePosition
06A8 DONECHECKINGAPPLECOLLISION:
06A8 60 RTS
06A9 CHECKSNAKECOLLISION:
06A9 A2 02 LDX 2 ;start with second segment
06AB SNAKECOLLISIONLOOP:
06AB B5 10 LDA $10,x
06AD C5 10 CMP $10
06AF D0 06 BNE continueCollisionLoop
06B1 MAYBECOLLIDED:
06B1 B5 11 LDA $11,x
06B3 C5 11 CMP $11
06B5 F0 09 BEQ didCollide
06B7 CONTINUECOLLISIONLOOP:
06B7 E8 INX
06B8 E8 INX
06B9 E4 03 CPX $03 ;got to last section with no collision
06BB F0 06 BEQ didntCollide
06BD 4C AB 06 JMP snakeCollisionLoop
06C0 DIDCOLLIDE:
06C0 4C 36 07 JMP gameOver
06C3 DIDNTCOLLIDE:
06C3 60 RTS
06C4 UPDATESNAKE:
06C4 A6 03 LDX $03 ;location of length
06C6 CA DEX
06C7 8A TXA
06C8 UPDATELOOP:
06C8 B5 10 LDA $10,x
06CA 95 12 STA $12,x
06CC CA DEX
06CD 10 F9 BPL updateloop
06CF A5 02 LDA $02
06D1 4A LSR
06D2 B0 09 BCS up
06D4 4A LSR
06D5 B0 19 BCS right
06D7 4A LSR
06D8 B0 1F BCS down
06DA 4A LSR
06DB B0 2F BCS left
06DD UP:
06DD A5 10 LDA $10
06DF 38 SEC
06E0 E9 20 SBC $20
06E2 85 10 STA $10
06E4 90 01 BCC upup
06E6 60 RTS
06E7 UPUP:
06E7 C6 11 DEC $11
06E9 A9 01 LDA $1
06EB C5 11 CMP $11
06ED F0 28 BEQ collision
06EF 60 RTS
06F0 RIGHT:
06F0 E6 10 INC $10
06F2 A9 1F LDA $1f
06F4 24 10 BIT $10
06F6 F0 1F BEQ collision
06F8 60 RTS
06F9 DOWN:
06F9 A5 10 LDA $10
06FB 18 CLC
06FC 69 20 ADC $20
06FE 85 10 STA $10
0700 B0 01 BCS downdown
0702 60 RTS
0703 DOWNDOWN:
0703 E6 11 INC $11
0705 A9 06 LDA $6
0707 C5 11 CMP $11
0709 F0 0C BEQ collision
070B 60 RTS
070C LEFT:
070C C6 10 DEC $10
070E A5 10 LDA $10
0710 29 1F AND $1f
0712 C9 1F CMP $1f
0714 F0 01 BEQ collision
0716 60 RTS
0717 COLLISION:
0717 4C 36 07 JMP gameOver
071A DRAWAPPLE:
071A A0 00 LDY 0
071C A5 FE LDA $fe
071E 91 00 STA $00,y
0720 60 RTS
0721 DRAWSNAKE:
0721 A2 00 LDX 0
0723 A9 01 LDA 1
0725 81 10 STA $10,x)
0727 A6 03 LDX $03
0729 A9 00 LDA 0
072B 81 10 STA $10,x)
072D 60 RTS
072E SPINWHEELS:
072E A2 00 LDX 0
0730 SPINLOOP:
0730 EA NOP
0731 EA NOP
0732 CA DEX
0733 D0 FB BNE spinloop
0735 60 RTS
0736 GAMEOVER:
_PC 0736
INIT 0607
INITSNAKE 060E
GENERATEAPPLEPOSITION062B
LOOP 0639
READKEYS 064E
UPKEY 0661
RIGHTKEY 066C
DOWNKEY 0677
LEFTKEY 0682
ILLEGALMOVE 068D
CHECKCOLLISION068E
CHECKAPPLECOLLISION0695
DONECHECKINGAPPLECOLLISION06A8
CHECKSNAKECOLLISION06A9
SNAKECOLLISIONLOOP06AB
MAYBECOLLIDED06B1
CONTINUECOLLISIONLOOP06B7
DIDCOLLIDE 06C0
DIDNTCOLLIDE06C3
UPDATESNAKE 06C4
UPDATELOOP 06C8
UP 06DD
UPUP 06E7
RIGHT 06F0
DOWN 06F9
DOWNDOWN 0703
LEFT 070C
COLLISION 0717
DRAWAPPLE 071A
DRAWSNAKE 0721
SPINWHEELS 072E
SPINLOOP 0730
GAMEOVER 0736
[255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,85,85,85,85,85,85,85,85,85,85,85,85,85,85,85,85,22,62,1,36,81,38,75,65,82,69,76,50,68,32,245,7,36,5,0,203,0,17,36,10,0,136,55,48,48,48,0,38,36,20,0,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,63,36,23,0,68,49,36,172,197,40,68,36,44,68,166,50,52,165,50,51,44,50,52,41,0,84,36,24,0,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,95,36,25,0,208,68,49,36,44,50,0,125,36,26,0,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,138,36,27,0,73,172,65,40,88,44,89,41,0,152,36,28,0,138,32,73,172,48,32,161,51,48,0,172,36,29,0,208,78,36,44,50,58,73,172,73,165,49,58,136,50,56,0,216,36,30,0,138,32,68,172,49,32,169,32,88,173,49,48,32,169,32,65,40,88,164,49,44,89,41,173,171,49,48,32,161,32,88,172,88,164,49,58,136,55,48,0,4,37,40,0,138,32,68,172,50,32,169,32,89,173,49,48,32,169,32,65,40,88,44,89,164,49,41,173,171,49,48,32,161,32,89,172,89,164,49,58,136,55,48,0,47,37,50,0,138,32,68,172,51,32,169,32,88,171,49,32,169,32,65,40,88,165,49,44,89,41,173,171,49,48,32,161,32,88,172,88,165,49,58,136,55,48,0,90,37,60,0,138,32,68,172,52,32,169,32,89,171,49,32,169,32,65,40,88,44,89,165,49,41,173,171,49,48,32,161,32,89,172,89,165,49,58,136,55,48,0,117,37,65,0,90,36,172,34,78,65,82,65,90,73,76,32,74,83,69,77,34,58,140,57,48,48,0,149,37,66,0,83,84,172,48,58,129,32,73,172,49,32,158,32,50,48,48,58,222,32,49,51,52,44,49,58,130,73,0,179,37,70,0,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,192,37,72,0,73,172,65,40,88,44,89,41,0,206,37,73,0,138,32,73,172,48,32,161,55,53,0,226,37,74,0,208,78,36,44,50,58,73,172,73,165,49,58,136,55,51,0,247,37,75,0,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,16,38,80,0,68,49,36,172,197,40,68,36,44,68,166,50,52,165,50,51,44,50,52,41,0,27,38,85,0,208,68,49,36,44,50,0,33,38,90,0,141,0,54,38,100,0,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,79,38,105,0,68,49,36,172,197,40,68,36,44,68,166,50,52,165,50,51,44,50,52,41,0,90,38,110,0,208,68,49,36,44,50,0,112,38,120,0,138,32,68,173,52,32,161,32,68,172,68,164,49,58,136,55,53,0,132,38,130,0,138,32,68,172,52,32,161,32,68,172,49,58,136,55,53,0,153,38,150,0,138,32,65,40,88,44,89,41,173,49,32,161,32,49,56,48,0,183,38,160,0,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,193,38,165,0,208,75,36,44,50,0,213,38,170,0,65,40,88,44,89,41,172,65,40,88,44,89,41,165,49,0,219,38,175,0,141,0,18,39,180,0,83,84,172,48,58,90,36,172,34,78,69,78,73,32,67,79,32,90,86,69,68,78,79,85,84,34,58,140,57,48,48,58,129,73,172,49,158,50,48,48,58,222,49,51,52,44,49,58,130,73,0,24,39,190,0,141,0,44,39,200,0,138,32,65,40,88,44,89,41,171,52,32,161,50,51,53,0,64,39,210,0,65,40,88,44,89,41,172,65,40,88,44,89,41,164,49,0,94,39,220,0,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,104,39,225,0,208,75,36,44,50,0,110,39,230,0,141,0,165,39,235,0,83,84,172,48,58,90,36,172,34,78,69,78,73,32,75,65,77,32,80,79,76,79,90,73,84,34,58,140,57,48,48,58,129,73,172,49,158,50,48,48,58,222,49,51,52,44,49,58,130,73,0,171,39,240,0,141,0,183,39,250,0,83,84,172,83,84,165,49,0,189,39,4,1,141,0,215,39,44,1,83,40,83,84,41,172,189,40,65,86,164,50,41,58,83,84,172,83,84,164,49,0,247,39,54,1,65,86,172,65,86,164,54,58,83,40,83,84,41,172,65,86,58,83,40,83,84,164,49,41,172,65,86,0,17,40,64,1,78,172,83,40,83,84,165,49,41,165,49,58,83,40,83,84,165,49,41,172,78,0,53,40,74,1,138,32,78,173,48,32,161,32,83,84,172,83,84,165,49,58,83,40,83,84,41,172,83,40,83,84,164,50,41,58,141,0,97,40,84,1,83,84,172,83,84,164,49,58,83,40,83,84,41,172,83,40,83,84,165,49,41,58,83,40,83,84,165,49,41,172,83,40,83,84,41,165,50,58,141,0,106,40,144,1,140,53,48,48,0,121,40,154,1,138,32,80,172,48,32,161,52,53,48,0,136,40,164,1,83,40,83,84,41,172,65,86,165,50,0,159,40,174,1,83,84,172,83,84,164,49,58,83,40,83,84,41,172,65,86,164,52,0,165,40,184,1,141,0,195,40,194,1,83,40,83,84,41,172,189,40,65,86,164,50,41,164,50,53,54,166,189,40,65,86,164,51,41,0,201,40,204,1,141,0,232,40,244,1,65,86,172,83,40,83,84,41,58,80,172,189,40,65,86,41,58,82,172,189,40,65,86,164,49,41,0,6,41,254,1,145,32,80,32,136,32,53,53,48,44,53,53,48,44,53,53,48,44,53,53,48,44,53,55,48,0,32,41,8,2,145,32,68,32,136,32,53,50,49,44,53,50,50,44,53,50,51,44,53,50,52,0,53,41,9,2,88,88,172,88,164,49,58,89,89,172,89,58,136,53,51,48,0,74,41,10,2,88,88,172,88,58,89,89,172,89,164,49,58,136,53,51,48,0,95,41,11,2,88,88,172,88,165,49,58,89,89,172,89,58,136,53,51,48,0,111,41,12,2,88,88,172,88,58,89,89,172,89,165,49,0,170,41,18,2,80,172,48,58,138,32,88,88,172,48,32,170,32,88,88,172,49,49,32,170,32,89,89,172,48,32,170,32,89,89,172,49,49,32,170,32,65,40,88,88,44,89,89,41,172,49,48,32,161,32,80,172,165,49,0,179,41,28,2,136,53,57,48,0,196,41,38,2,80,172,40,80,172,68,41,58,136,53,57,48,0,225,41,58,2,80,172,40,65,40,88,44,89,41,171,48,32,169,32,65,40,88,44,89,41,173,49,48,41,0,245,41,78,2,138,32,82,172,48,32,161,32,80,172,162,32,80,58,141,0,251,41,83,2,141,0,4,42,88,2,140,53,48,48,0,42,42,93,2,83,40,83,84,41,172,189,40,65,86,164,50,41,164,50,53,54,166,189,40,65,86,164,51,41,58,83,84,172,83,84,164,49,0,57,42,98,2,138,32,80,172,48,32,161,54,53,48,0,74,42,118,2,83,40,83,84,41,172,65,86,164,54,58,141,0,106,42,138,2,83,40,83,84,41,172,189,40,65,86,164,52,41,164,50,53,54,166,189,40,65,86,164,53,41,58,141,0,117,42,32,3,200,50,50,44,51,48,0,143,42,42,3,149,165,49,53,56,55,56,44,49,55,54,58,214,50,48,44,49,50,59,54,51,0,154,42,52,3,200,50,50,44,51,48,0,180,42,62,3,149,165,49,53,56,55,56,44,49,54,56,58,214,50,48,44,49,50,59,54,51,0,191,42,72,3,200,50,50,44,51,48,0,216,42,82,3,213,49,44,49,59,72,59,189,40,72,165,50,41,59,189,40,72,165,49,41,0,222,42,92,3,141,0,233,42,132,3,200,48,44,50,51,51,0,245,42,142,3,213,49,44,49,59,89,36,0,255,42,152,3,89,36,172,90,36,0,10,43,162,3,200,48,44,50,51,51,0,22,43,172,3,213,49,44,49,59,89,36,0,28,43,182,3,141,0,43,43,192,3,200,176,40,83,84,41,44,50,48,56,0,55,43,202,3,213,49,44,49,59,73,36,0,63,43,212,3,224,83,36,0,72,43,213,3,224,83,51,36,0,78,43,222,3,141,0,109,43,232,3,90,36,172,34,78,65,80,73,83,32,80,82,73,75,65,90,34,58,140,57,48,48,58,132,73,36,0,118,43,234,3,83,84,172,48,0,126,43,237,3,224,83,36,0,135,43,238,3,224,83,51,36,0,145,43,242,3,140,50,50,48,48,0,163,43,252,3,138,32,65,86,172,48,32,161,32,51,49,48,48,0,196,43,254,3,138,32,65,86,171,50,56,55,54,48,32,169,32,65,86,173,50,56,55,56,57,32,161,32,49,53,48,48,0,205,43,1,4,140,57,54,48,0,214,43,16,4,83,84,172,49,0,251,43,26,4,138,32,65,86,173,50,56,55,53,51,32,161,32,83,84,172,48,58,65,87,172,189,40,65,86,41,58,136,49,50,50,48,0,38,44,66,4,90,36,172,34,90,65,83,84,65,86,73,77,32,83,69,32,75,68,89,90,32,83,84,73,83,75,78,69,83,32,75,48,34,58,140,57,48,48,0,63,44,76,4,65,87,172,189,40,65,86,41,164,50,53,54,166,189,40,65,86,164,49,41,0,93,44,186,4,83,40,83,84,41,172,65,86,164,50,58,138,32,83,84,172,53,48,32,161,32,49,52,48,48,0,114,44,196,4,138,32,65,87,173,50,53,53,32,161,32,140,49,51,48,48,0,133,44,201,4,138,32,65,87,172,50,54,53,32,161,140,50,53,48,0,170,44,206,4,138,32,65,87,171,50,56,55,56,57,32,161,32,83,84,172,83,84,164,49,58,65,86,172,65,87,58,136,49,49,48,48,0,186,44,211,4,138,32,223,172,48,32,161,49,48,48,48,0,203,44,216,4,138,32,83,84,173,49,32,161,49,48,48,48,0,221,44,221,4,138,32,83,84,171,52,56,32,161,49,52,48,48,0,234,44,226,4,65,86,172,83,40,83,84,41,0,244,44,236,4,136,49,49,48,48,0,54,45,20,5,145,32,65,87,32,136,32,55,50,52,48,44,52,48,48,48,44,54,48,48,48,44,53,53,48,48,44,50,48,44,49,48,48,44,50,48,48,44,49,53,48,44,50,53,48,44,51,48,48,44,52,48,48,44,54,48,48,44,51,50,48,0,72,45,30,5,138,32,65,87,172,50,54,53,32,161,50,53,48,0,115,45,120,5,90,36,172,34,85,90,32,77,78,69,32,84,79,32,78,69,66,65,86,73,44,32,68,69,74,32,80,82,73,75,65,90,34,58,140,57,48,48,0,134,45,130,5,132,73,36,58,83,84,172,48,58,136,49,48,48,53,0,178,45,220,5,90,36,172,34,84,79,32,76,90,69,32,74,69,78,32,85,86,78,73,84,82,32,80,82,73,75,65,90,85,34,58,140,57,48,48,58,204,49,48,0,188,45,108,7,136,49,48,48,48,0,216,45,208,7,90,36,172,34,78,65,80,73,83,32,90,78,65,77,89,32,80,82,73,75,65,90,34,0,225,45,218,7,140,57,48,48,0,233,45,228,7,132,73,36,0,2,46,238,7,138,32,73,36,172,34,34,32,161,32,73,36,172,34,75,79,78,69,67,34,0,14,46,152,8,80,172,50,56,54,55,50,0,39,46,162,8,138,32,196,40,73,36,44,49,41,172,34,46,34,32,161,32,50,52,48,48,0,51,46,172,8,68,69,172,189,40,80,41,0,74,46,182,8,138,32,190,40,73,36,41,173,171,68,69,32,161,32,50,51,48,48,0,92,46,192,8,129,32,73,172,49,32,158,32,190,40,73,36,41,0,123,46,202,8,138,32,193,40,197,40,73,36,44,73,41,41,173,171,189,40,80,164,73,41,161,32,50,51,48,48,0,130,46,212,8,130,73,0,144,46,222,8,65,86,172,80,164,68,69,164,51,0,184,46,224,8,73,36,172,34,34,58,129,32,73,172,49,32,158,32,68,69,58,73,36,172,73,36,164,194,40,189,40,80,164,73,41,41,58,130,73,0,190,46,232,8,141,0,204,46,252,8,80,80,172,80,164,68,69,164,49,0,228,46,6,9,80,172,189,40,80,80,41,164,50,53,54,166,189,40,80,80,164,49,41,0,248,46,16,9,138,32,80,171,172,72,32,161,32,65,86,172,48,58,141,0,2,47,26,9,136,50,50,50,48,0,16,47,96,9,87,172,190,40,73,36,41,165,49,0,28,47,106,9,68,69,172,189,40,80,41,0,42,47,116,9,129,32,73,172,49,32,158,32,87,0,73,47,126,9,138,32,193,40,197,40,73,36,44,73,41,41,173,171,189,40,80,164,73,41,161,32,50,52,54,48,0,80,47,136,9,130,73,0,90,47,146,9,136,50,50,55,48,0,104,47,156,9,80,80,172,80,164,68,69,164,49,0,128,47,166,9,80,172,189,40,80,80,41,164,50,53,54,166,189,40,80,80,164,49,41,0,148,47,176,9,138,32,80,171,172,72,32,161,32,65,86,172,48,58,141,0,158,47,186,9,136,50,52,49,48,0,178,47,28,12,142,32,42,78,79,86,89,32,80,82,73,75,65,90,42,0,195,47,33,12,138,73,36,172,34,34,161,32,49,48,48,48,0,214,47,38,12,72,172,72,72,58,149,32,72,44,190,40,73,36,41,0,232,47,48,12,129,32,73,172,49,32,158,32,190,40,73,36,41,0,242,47,58,12,72,172,72,164,49,0,7,48,68,12,149,32,72,44,193,40,197,40,73,36,44,73,44,49,41,41,0,14,48,78,12,130,73,0,32,48,83,12,149,72,164,49,44,48,58,149,72,164,50,44,48,0,53,48,88,12,72,172,72,164,49,58,83,84,172,48,58,83,80,172,50,50,0,65,48,98,12,83,40,83,84,41,172,72,0,73,48,108,12,224,83,36,0,103,48,118,12,73,36,172,34,78,79,86,89,32,80,82,73,75,65,90,32,34,164,73,36,58,140,57,54,48,0,121,48,128,12,73,36,172,34,90,78,65,77,69,78,65,58,34,0,130,48,138,12,140,57,54,48,0,140,48,148,12,72,172,72,164,50,0,150,48,158,12,140,50,48,48,48,0,164,48,163,12,73,36,172,34,32,34,164,73,36,0,208,48,168,12,138,32,65,86,172,48,32,161,32,90,36,172,73,36,164,34,32,78,69,90,78,65,77,34,58,140,57,48,48,58,204,49,48,58,136,51,50,51,48,0,217,48,173,12,140,57,54,48,0,239,48,178,12,138,32,65,86,173,50,56,55,56,57,32,161,32,51,51,48,48,0,0,49,188,12,86,65,172,175,40,65,86,167,50,53,54,41,0,18,49,198,12,149,32,72,44,65,86,165,50,53,54,166,86,65,0,31,49,208,12,149,32,72,164,49,44,86,65,0,41,49,218,12,136,51,50,50,48,0,67,49,228,12,65,87,172,189,40,65,86,41,58,149,72,44,65,87,58,149,72,164,49,44,48,0,82,49,233,12,138,65,87,173,52,161,51,51,50,48,0,140,49,238,12,145,32,65,87,165,51,32,136,32,53,48,48,48,44,51,50,50,48,44,51,50,50,48,44,51,50,50,48,44,51,50,50,48,44,51,51,53,48,44,51,52,53,48,44,51,54,48,48,44,51,56,48,48,0,153,49,248,12,224,83,49,36,44,83,50,36,0,187,49,253,12,90,36,172,73,36,164,34,32,32,84,69,68,32,78,69,77,79,72,85,34,58,140,57,48,48,58,204,49,48,0,197,49,2,13,136,51,50,51,48,0,217,49,22,13,86,65,172,175,40,40,72,164,50,41,167,50,53,54,41,0,239,49,32,13,149,83,40,83,84,41,44,72,165,50,53,54,166,86,65,164,50,0,255,49,42,13,149,83,40,83,84,41,164,49,44,86,65,0,12,50,44,13,224,83,49,36,44,83,50,36,0,32,50,47,13,73,36,172,197,40,73,36,44,50,41,58,140,57,54,48,0,73,50,50,13,138,32,189,40,83,40,83,84,41,165,54,41,172,49,50,32,169,32,189,40,83,40,83,84,41,165,53,41,172,48,32,161,51,52,49,48,0,85,50,52,13,83,84,172,83,84,165,49,0,120,50,62,13,138,32,83,84,173,48,32,161,32,72,172,72,164,50,58,72,72,172,72,58,83,84,172,48,58,136,49,48,48,48,0,130,50,72,13,136,51,50,50,48,0,143,50,82,13,224,83,49,36,44,83,50,36,0,168,50,92,13,149,72,164,49,44,49,58,83,40,83,84,41,172,83,40,83,84,41,165,50,0,193,50,102,13,73,36,172,73,36,164,34,44,74,73,78,65,75,34,58,136,51,50,49,48,0,228,50,122,13,90,36,172,34,75,79,76,73,75,82,65,84,32,63,32,40,77,65,88,46,50,53,53,41,34,58,140,57,48,48,0,255,50,132,13,132,87,58,149,72,164,50,44,87,58,149,72,164,51,44,48,58,72,172,72,164,52,0,16,51,142,13,149,72,44,49,51,58,149,72,164,49,44,48,0,36,51,152,13,83,84,172,83,84,164,49,58,83,40,83,84,41,172,48,0,49,51,157,13,224,83,49,36,44,83,50,36,0,83,51,162,13,73,36,172,197,40,73,36,44,50,41,164,191,40,87,41,164,34,32,75,82,65,84,34,58,136,51,50,49,48,0,93,51,16,14,140,51,54,53,48,0,119,51,36,14,72,172,72,164,52,58,83,84,172,83,84,164,49,58,83,40,83,84,41,172,72,0,129,51,46,14,136,51,50,49,48,0,169,51,66,14,90,36,172,34,77,65,32,66,89,84,32,80,79,68,77,73,78,75,65,32,83,80,76,78,69,78,65,32,63,34,58,140,57,48,48,0,191,51,76,14,132,82,36,58,138,32,82,36,172,34,34,32,161,51,54,54,48,0,199,51,86,14,82,172,49,0,220,51,96,14,138,32,193,40,82,36,41,172,55,56,32,161,32,82,172,48,0,11,52,126,14,90,36,172,34,75,84,69,82,65,32,80,79,68,77,73,78,75,65,32,63,32,32,90,69,44,90,78,44,90,65,44,86,44,83,44,74,34,58,140,57,48,48,0,44,52,136,14,132,32,82,36,58,138,32,193,40,82,36,41,173,171,57,48,32,161,32,73,172,52,58,136,51,55,53,48,0,67,52,141,14,73,172,49,58,138,32,190,40,82,36,41,173,50,161,51,55,50,48,0,104,52,146,14,138,32,197,40,82,36,44,50,44,49,41,172,197,40,80,36,44,54,166,73,165,52,44,49,41,32,161,32,51,55,55,48,0,127,52,156,14,73,172,73,164,49,58,138,32,73,173,52,32,161,32,51,55,51,48,0,162,52,166,14,138,32,195,40,82,36,44,49,41,172,197,40,80,36,44,54,166,73,165,53,44,49,41,32,161,32,51,55,55,48,0,185,52,176,14,73,172,73,164,49,58,138,32,73,173,55,32,161,32,51,55,53,48,0,202,52,181,14,138,32,73,171,54,32,161,32,51,55,50,48,0,215,52,186,14,224,83,49,36,44,83,50,36,0,11,53,196,14,73,36,172,197,40,73,36,44,50,41,164,34,32,34,164,197,40,80,36,44,52,51,165,54,166,82,44,53,165,50,166,82,41,164,197,40,80,36,44,54,166,73,165,53,44,54,41,0,34,53,206,14,149,72,164,50,44,80,40,73,41,58,149,72,164,51,44,82,58,141,0,44,53,216,14,140,51,54,53,48,0,62,53,226,14,72,172,72,164,54,58,83,84,172,83,84,164,49,0,80,53,236,14,83,40,83,84,41,172,72,58,136,51,50,49,48,0,92,53,160,15,80,172,50,56,54,55,50,0,100,53,172,15,224,83,36,0,109,53,173,15,224,83,51,36,0,120,53,175,15,200,48,44,50,48,52,0,132,53,180,15,68,69,172,189,40,80,41,0,150,53,185,15,138,32,80,171,172,72,32,161,32,52,50,48,48,0,160,53,195,15,140,52,49,48,48,0,176,53,200,15,213,49,44,49,59,73,36,59,34,32,34,0,186,53,240,15,136,52,48,49,50,0,226,53,4,16,73,36,172,34,34,58,129,32,73,172,80,164,49,158,80,164,68,69,58,73,36,172,73,36,164,194,40,189,40,73,41,41,58,130,73,0,4,54,14,16,80,80,172,80,164,68,69,164,49,58,80,172,189,40,80,80,41,164,50,53,54,166,189,40,80,80,164,49,41,0,10,54,34,16,141,0,18,54,104,16,224,83,36,0,27,54,105,16,224,83,51,36,0,75,54,114,16,73,36,172,34,32,32,58,58,58,32,80,73,83,32,86,90,68,89,32,74,69,68,78,79,32,83,76,79,86,79,32,65,32,40,69,79,76,41,32,58,58,58,34,0,84,54,124,16,140,57,54,48,0,100,54,134,16,73,36,172,34,32,34,58,140,57,54,48,0,110,54,204,16,136,49,48,48,48,0,120,54,136,19,72,172,72,165,50,0,146,54,146,19,138,32,189,40,72,41,164,189,40,72,164,49,41,172,48,32,161,53,50,48,48,0,189,54,156,19,138,32,189,40,72,165,51,41,172,48,32,169,40,189,40,72,41,172,49,51,32,170,32,189,40,72,165,52,41,172,49,49,41,161,53,49,48,48,0,223,54,166,19,138,32,189,40,72,165,54,41,172,49,50,32,169,32,189,40,72,165,53,41,172,48,32,161,32,53,49,53,48,0,1,55,176,19,138,32,189,40,72,41,172,57,32,169,32,189,40,72,164,49,41,172,48,32,161,32,83,84,172,83,84,164,49,0,41,55,186,19,138,32,189,40,72,41,172,57,32,169,32,189,40,72,164,49,41,172,49,32,161,32,83,40,83,84,41,172,83,40,83,84,41,164,50,0,58,55,201,19,224,83,49,36,44,83,49,36,44,83,50,36,0,68,55,206,19,136,51,50,51,48,0,99,55,236,19,83,84,172,83,84,165,49,58,72,172,72,165,52,58,224,83,49,36,44,83,49,36,44,83,50,36,0,109,55,246,19,136,51,50,51,48,0,140,55,30,20,83,84,172,83,84,165,49,58,72,172,72,165,54,58,224,83,49,36,44,83,49,36,44,83,50,36,0,150,55,40,20,136,51,50,51,48,0,176,55,80,20,72,172,72,72,58,224,83,49,36,44,83,49,36,44,83,49,36,44,83,50,36,0,186,55,90,20,136,49,48,48,48,0,210,55,124,21,80,172,50,56,55,56,57,58,138,32,72,172,80,32,161,49,48,48,48,0,253,55,134,21,68,69,172,189,40,80,41,58,65,83,172,80,164,68,69,164,49,58,80,80,172,189,40,65,83,41,164,50,53,54,166,189,40,65,83,164,49,41,0,15,56,144,21,138,32,80,80,171,172,72,32,161,53,53,53,48,0,30,56,154,21,80,172,80,80,58,136,53,53,49,48,0,43,56,174,21,224,83,49,36,44,83,50,36,0,85,56,179,21,73,36,172,34,34,58,129,32,73,172,80,164,49,32,158,32,80,164,68,69,58,73,36,172,73,36,164,194,40,189,40,73,41,41,58,130,73,0,111,56,184,21,73,36,172,34,90,82,85,83,69,78,79,32,34,164,73,36,58,140,57,54,48,0,135,56,194,21,72,72,172,80,58,72,172,80,58,83,84,172,48,58,136,49,48,48,48,0,159,56,112,23,90,36,172,34,75,84,69,82,89,32,80,82,73,75,65,90,32,63,34,0,168,56,117,23,83,84,172,48,0,178,56,122,23,140,50,48,49,48,0,229,56,127,23,138,32,65,86,173,50,56,55,56,57,32,161,90,36,172,34,78,69,76,90,69,32,82,79,90,76,79,90,73,84,34,58,140,57,48,48,58,204,49,48,58,136,49,48,48,48,0,5,57,132,23,83,84,172,48,58,73,36,172,73,36,164,34,32,90,78,65,77,69,78,65,58,34,58,140,57,54,48,0,14,57,142,23,83,84,172,49,0,23,57,162,23,80,172,65,86,0,46,57,172,23,65,87,172,189,40,80,41,164,50,53,54,166,189,40,80,164,49,41,0,69,57,177,23,138,32,65,87,173,50,53,54,32,161,65,87,172,84,40,65,87,41,0,114,57,179,23,138,32,65,87,172,50,54,53,32,161,73,36,172,34,75,79,78,69,67,44,74,73,78,65,75,34,58,83,84,172,83,84,165,49,58,136,54,50,52,53,0,128,57,182,23,73,172,51,58,73,36,172,34,34,0,143,57,192,23,67,72,172,189,40,65,87,165,73,41,0,163,57,202,23,138,32,67,72,172,73,165,51,32,161,32,54,49,53,48,0,191,57,212,23,73,172,73,164,49,58,73,36,172,194,40,67,72,41,164,73,36,58,136,54,48,56,48,0,224,57,6,24,138,32,65,87,171,50,56,55,53,51,32,169,32,65,87,173,50,56,55,56,57,32,161,32,54,50,48,48,0,233,57,16,24,140,57,54,48,0,0,58,26,24,80,172,80,164,50,58,138,32,83,84,171,48,32,161,54,48,54,48,0,10,58,36,24,136,49,48,48,48,0,41,58,56,24,138,32,65,87,172,50,56,55,54,49,32,161,32,83,84,172,83,84,165,49,58,136,54,49,54,48,0,62,58,66,24,138,32,65,87,173,171,50,56,55,55,49,161,54,51,48,48,0,90,58,76,24,73,36,172,73,36,164,191,40,189,40,80,164,50,41,41,164,34,32,75,82,65,84,34,0,100,58,96,24,80,172,80,164,52,0,123,58,101,24,140,57,54,48,58,83,84,172,83,84,164,49,58,136,54,49,55,48,0,144,58,156,24,138,32,65,87,173,171,50,56,55,56,48,161,54,52,48,48,0,166,58,166,24,81,172,189,40,80,164,50,41,58,82,172,189,40,80,164,51,41,0,213,58,176,24,73,36,172,73,36,164,34,32,34,164,197,40,80,36,44,52,51,165,54,166,82,44,53,165,50,166,82,41,164,197,40,81,36,44,81,166,54,165,53,44,54,41,0,223,58,186,24,136,54,50,52,48,0,251,58,0,25,81,172,189,40,80,164,50,41,58,82,172,189,40,80,164,51,41,58,80,172,80,164,50,0,5,59,10,25,136,54,51,50,48,0,15,59,244,26,136,49,48,48,48,0,29,59,88,27,133,65,40,49,49,44,49,49,41,0,42,59,89,27,198,48,44,49,44,48,44,49,0,53,59,90,27,200,46,49,44,46,50,0,71,59,91,27,213,55,44,49,53,59,34,75,65,82,69,76,34,0,84,59,92,27,200,46,49,51,44,46,55,50,0,140,59,93,27,133,84,40,49,50,41,58,84,40,53,41,172,50,56,55,49,57,58,84,40,54,41,172,50,56,55,51,51,58,84,40,55,41,172,50,56,55,52,50,58,84,40,56,41,172,50,56,55,53,50,58,0,191,59,94,27,84,40,57,41,172,50,56,55,54,49,58,84,40,49,48,41,172,50,56,55,55,49,58,84,40,49,49,41,172,50,56,55,56,48,58,84,40,49,50,41,172,50,56,55,56,56,0,218,59,95,27,213,50,44,51,59,34,42,42,42,42,32,82,79,66,79,84,32,42,42,42,42,34,0,231,59,96,27,200,46,49,56,44,46,48,55,0,13,60,97,27,213,49,44,49,59,34,80,82,79,32,67,69,78,84,82,85,77,32,77,86,84,32,80,82,73,32,85,86,32,83,83,77,34,0,47,60,98,27,68,36,172,34,34,58,75,36,172,194,40,48,41,164,194,40,52,56,41,164,194,40,51,41,164,194,40,48,41,0,61,60,99,27,200,32,46,50,48,44,46,48,50,0,97,60,100,27,213,49,44,49,59,34,86,89,84,86,79,82,73,76,32,84,79,77,65,83,32,66,65,82,84,79,86,83,75,89,34,0,109,60,101,27,200,46,48,57,53,44,48,0,123,60,102,27,214,51,51,44,51,48,59,54,51,0,154,60,103,27,78,36,172,194,40,54,48,41,164,194,40,49,53,41,164,194,40,54,48,41,164,194,40,49,53,41,0,172,60,108,27,72,72,172,50,56,55,56,57,58,72,172,72,72,0,224,60,118,27,133,80,40,56,41,58,80,40,49,41,172,54,58,80,40,50,41,172,53,58,80,40,51,41,172,51,58,80,40,52,41,172,49,58,80,40,53,41,172,50,58,80,40,54,41,172,52,0,235,60,128,27,133,83,40,53,48,41,0,37,61,138,27,80,36,172,34,90,69,68,32,32,32,90,78,65,67,75,65,90,65,80,65,68,32,86,89,67,72,79,68,83,69,86,69,82,32,74,73,72,32,32,32,74,69,32,32,32,32,78,69,78,73,32,32,34,0,83,61,143,27,81,36,172,34,86,89,67,72,79,68,83,69,86,69,82,32,90,65,80,65,68,32,74,73,72,32,32,32,90,78,65,67,75,65,90,69,68,32,32,32,34,0,151,61,153,27,83,36,172,34,48,69,68,50,49,49,67,48,67,49,48,54,49,54,50,49,52,48,48,50,49,57,55,69,49,50,50,51,49,51,48,53,67,50,48,66,55,70,50,49,50,65,48,48,49,57,69,66,48,68,67,50,48,53,55,70,67,57,34,0,220,61,154,27,83,49,36,172,34,48,69,67,49,49,49,67,48,70,51,48,54,49,54,50,49,67,48,70,68,49,57,55,69,49,50,50,51,49,51,48,53,67,50,48,66,55,70,50,49,65,65,70,70,49,57,69,66,48,68,67,50,48,53,55,70,67,57,34,0,33,62,155,27,83,50,36,172,34,48,69,48,57,49,49,67,48,70,49,48,54,49,54,50,49,52,48,48,50,49,57,55,69,49,50,50,51,49,51,48,53,67,50,48,66,55,70,50,49,50,65,48,48,49,57,69,66,48,68,67,50,48,53,55,70,67,57,34,0,102,62,156,27,83,51,36,172,34,48,69,51,51,49,49,57,54,69,57,48,54,49,54,50,49,52,48,48,50,49,57,55,69,49,50,50,51,49,51,48,53,67,50,48,66,55,70,50,49,50,65,48,48,49,57,69,66,48,68,67,50,48,53,55,70,67,57,34,0,121,62,158,27,129,73,172,50,56,54,55,50,158,50,56,55,56,56,0,136,62,168,27,134,65,58,149,73,44,65,58,130,73,0,146,62,178,27,68,36,172,34,34,0,158,62,188,27,129,73,172,49,158,57,54,0,176,62,198,27,134,65,58,68,36,172,68,36,164,194,40,65,41,0,183,62,208,27,130,73,0,189,62,223,27,203,0,208,62,228,27,198,48,44,52,50,46,54,54,44,50,52,50,44,48,0,238,62,233,27,76,36,172,34,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,34,0,7,63,238,27,76,36,172,76,36,164,76,36,164,76,36,164,76,36,164,76,36,164,76,36,0,18,63,243,27,207,50,51,44,51,52,0,29,63,248,27,208,76,36,44,50,48,0,41,63,253,27,207,50,51,44,49,54,48,0,52,63,2,28,208,76,36,44,50,48,0,77,63,7,28,76,36,172,76,36,164,34,63,63,63,63,63,63,63,63,63,63,63,63,34,0,88,63,12,28,207,50,50,44,51,52,0,98,63,17,28,208,76,36,44,49,0,109,63,22,28,207,52,51,44,51,52,0,119,63,27,28,208,76,36,44,49,0,151,63,32,28,90,69,36,172,194,40,52,50,41,164,194,40,52,50,41,164,194,40,50,49,41,164,194,40,50,49,41,0,183,63,37,28,90,69,36,172,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,0,214,63,42,28,76,36,172,194,40,50,49,41,164,194,40,50,49,41,164,194,40,52,50,41,164,194,40,52,50,41,0,239,63,47,28,76,36,172,76,36,164,76,36,164,76,36,164,76,36,164,76,36,164,76,36,0,251,63,52,28,129,88,172,49,158,49,48,0,23,64,57,28,129,89,172,49,158,49,48,58,138,65,40,88,44,89,41,173,171,48,161,55,54,48,48,0,33,64,62,28,130,89,58,130,88,0,43,64,67,28,136,56,54,48,48,0,49,64,72,28,203,0,72,64,82,28,150,34,68,79,76,69,86,65,32,32,32,32,32,45,32,75,49,34,0,95,64,92,28,150,34,68,79,80,82,65,86,65,32,32,32,32,45,32,75,50,34,0,118,64,102,28,150,34,68,79,76,85,32,32,32,32,32,32,32,45,32,75,51,34,0,141,64,112,28,150,34,78,65,72,79,82,85,32,32,32,32,32,45,32,75,52,34,0,164,64,122,28,150,34,90,69,68,32,32,32,32,32,32,32,32,45,32,75,53,34,0,187,64,132,28,150,34,90,78,65,67,75,65,32,32,32,32,32,45,32,75,54,34,0,210,64,142,28,150,34,86,89,77,65,90,65,84,32,32,32,32,45,32,75,55,34,0,233,64,152,28,150,34,78,79,86,69,32,77,69,83,84,79,32,45,32,75,56,34,0,246,64,162,28,150,34,75,79,78,69,67,34,0,13,65,172,28,150,34,32,32,75,82,69,83,76,69,78,73,32,45,32,75,57,34,0,27,65,182,28,150,58,150,58,150,58,150,58,150,0,46,65,232,28,198,48,44,52,50,46,54,54,44,50,52,50,44,48,0,76,65,242,28,76,36,172,34,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,34,0,101,65,247,28,76,36,172,76,36,164,76,36,164,76,36,164,76,36,164,76,36,164,76,36,0,112,65,252,28,207,50,51,44,51,52,0,123,65,6,29,208,76,36,44,50,48,0,135,65,16,29,207,50,51,44,49,54,48,0,146,65,26,29,208,76,36,44,50,48,0,171,65,36,29,76,36,172,76,36,164,34,63,63,63,63,63,63,63,63,63,63,63,63,34,0,182,65,46,29,207,50,50,44,51,52,0,192,65,56,29,208,76,36,44,49,0,203,65,66,29,207,52,51,44,51,52,0,213,65,76,29,208,76,36,44,49,0,245,65,86,29,90,69,36,172,194,40,52,50,41,164,194,40,52,50,41,164,194,40,50,49,41,164,194,40,50,49,41,0,21,66,96,29,90,69,36,172,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,164,90,69,36,0,52,66,106,29,76,36,172,194,40,50,49,41,164,194,40,50,49,41,164,194,40,52,50,41,164,194,40,52,50,41,0,77,66,116,29,76,36,172,76,36,164,76,36,164,76,36,164,76,36,164,76,36,164,76,36,0,89,66,126,29,129,88,172,49,158,49,48,0,117,66,136,29,129,89,172,49,158,49,48,58,138,65,40,88,44,89,41,173,171,48,161,55,54,48,48,0,127,66,146,29,130,89,58,130,88,0,137,66,156,29,136,55,54,57,48,0,158,66,176,29,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,178,66,186,29,138,65,40,88,44,89,41,173,49,48,161,55,54,52,48,0,188,66,196,29,208,76,36,44,50,0,198,66,206,29,136,55,53,55,48,0,217,66,216,29,129,32,75,172,49,32,158,32,65,40,88,44,89,41,0,242,66,226,29,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,75,0,252,66,231,29,208,75,36,44,50,0,21,67,236,29,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,75,0,34,67,241,29,208,78,36,44,50,58,130,75,0,44,67,246,29,136,55,53,55,48,0,68,67,10,30,88,172,49,58,89,172,49,58,68,172,49,58,89,36,172,34,32,32,34,0,123,67,20,30,145,32,223,32,136,32,55,56,48,48,44,55,57,48,48,44,56,48,48,48,44,56,49,48,48,44,56,50,48,48,44,56,51,48,48,44,56,52,48,48,44,56,53,48,48,44,56,54,48,48,0,144,67,30,30,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,154,67,50,30,208,76,36,44,50,0,175,67,60,30,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,185,67,70,30,208,76,36,44,50,0,195,67,80,30,136,55,55,48,48,0,213,67,120,30,138,32,88,171,49,32,161,32,88,172,88,165,49,0,223,67,130,30,136,55,55,49,48,0,241,67,220,30,138,32,88,173,49,48,161,32,88,172,88,164,49,0,251,67,230,30,136,55,55,49,48,0,13,68,64,31,138,32,89,171,49,32,161,32,89,172,89,165,49,0,23,68,74,31,136,55,55,49,48,0,42,68,164,31,138,32,89,173,49,48,32,161,32,89,172,89,164,49,0,52,68,174,31,136,55,55,49,48,0,74,68,8,32,138,32,65,40,88,44,89,41,173,171,48,32,161,55,55,49,48,0,88,68,28,32,65,40,88,44,89,41,172,49,48,0,109,68,38,32,207,50,49,164,50,166,88,44,49,54,48,165,49,50,166,89,0,120,68,48,32,208,90,69,36,44,50,0,130,68,58,32,136,55,55,49,48,0,151,68,108,32,138,32,65,40,88,44,89,41,171,52,32,161,55,55,49,48,0,171,68,118,32,65,40,88,44,89,41,172,65,40,88,44,89,41,164,49,0,201,68,128,32,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,211,68,138,32,208,75,36,44,50,0,241,68,148,32,207,50,49,164,50,166,88,44,49,55,49,165,49,50,166,89,165,50,166,65,40,88,44,89,41,0,251,68,158,32,208,78,36,44,50,0,5,69,168,32,136,55,55,49,48,0,15,69,208,32,140,56,52,48,56,0,25,69,210,32,136,55,55,49,48,0,46,69,216,32,200,49,57,164,50,166,88,44,49,55,50,165,49,50,166,89,0,71,69,218,32,149,165,49,53,56,55,56,44,49,55,54,58,214,50,44,49,50,59,54,51,0,92,69,219,32,200,49,57,164,50,166,88,44,49,55,50,165,49,50,166,89,0,117,69,220,32,149,165,49,53,56,55,56,44,49,54,56,58,214,50,44,49,50,59,54,51,0,130,69,228,32,65,40,88,44,89,41,172,48,0,136,69,238,32,141,0,148,69,52,33,129,88,172,49,158,49,48,0,179,69,62,33,129,89,172,49,158,49,48,58,138,32,65,40,88,44,89,41,171,48,32,161,32,140,56,52,48,56,0,189,69,72,33,130,89,58,130,88,0,199,69,82,33,136,55,53,53,48,0,223,69,152,33,88,172,49,58,89,172,49,58,68,172,49,58,89,36,172,34,32,32,34,0,231,69,162,33,140,55,48,0,10,70,192,33,90,36,172,34,68,79,80,79,83,85,68,32,90,78,65,77,32,84,89,84,79,32,80,82,73,75,65,90,89,34,0,19,70,202,33,140,57,48,48,0,29,70,252,33,136,52,48,48,48,0,48,70,16,39,129,73,172,50,56,54,55,50,158,50,56,55,56,56,0,60,70,26,39,134,65,58,149,73,44,65,0,67,70,36,39,130,73,0,86,70,116,39,129,73,172,50,56,54,55,50,158,50,56,56,48,48,0,106,70,126,39,150,73,59,189,40,73,41,59,194,40,189,40,73,41,41,0,113,70,136,39,130,73,0,119,70,166,39,143,0,181,70,216,39,131,53,44,55,55,44,54,57,44,56,51,44,56,52,44,55,57,44,57,44,49,49,50,44,49,44,55,44,56,51,44,55,54,44,55,57,44,56,54,44,55,56,44,55,51,44,55,53,44,50,48,44,49,49,50,44,50,0,245,70,217,39,131,32,55,44,56,50,44,55,57,44,57,48,44,55,53,44,55,54,44,54,53,44,54,56,44,51,49,44,49,49,50,44,51,44,53,44,54,55,44,55,50,44,56,57,44,54,54,44,54,53,44,52,48,44,49,49,50,44,52,0,60,71,218,39,131,32,52,44,55,53,44,56,50,44,55,57,44,55,53,44,52,56,44,49,49,50,44,53,44,49,48,44,56,54,44,55,54,44,54,57,44,56,54,44,55,57,44,52,53,44,56,54,44,54,54,44,55,57,44,55,53,44,54,50,44,49,49,50,44,54,0,121,71,219,39,131,32,53,44,56,48,44,55,57,44,55,54,44,55,57,44,57,48,44,55,49,44,49,49,50,44,55,44,54,44,57,48,44,56,54,44,54,57,44,54,56,44,55,56,44,55,51,44,56,49,44,49,49,50,44,56,0,183,71,220,39,131,53,44,55,53,44,55,57,44,55,56,44,54,57,44,54,55,44,57,48,44,49,49,50,44,57,44,54,44,55,57,44,56,48,44,54,53,44,55,53,44,56,53,44,55,52,44,49,48,48,44,49,49,50,44,49,48,0,241,71,221,39,131,53,44,54,56,44,55,57,44,55,53,44,56,53,44,54,56,44,49,48,57,44,49,49,50,44,49,49,44,52,44,55,53,44,54,56,44,56,57,44,57,48,44,49,49,55,44,49,49,50,44,49,50,0,51,72,70,40,131,52,56,44,51,44,52,56,44,51,44,52,56,44,51,44,54,48,44,49,52,44,54,48,44,49,50,44,52,44,56,44,52,44,56,44,54,48,44,49,50,44,53,54,44,54,44,53,54,44,55,44,50,52,44,54,44,50,52,44,54,0,119,72,71,40,131,52,56,44,51,44,52,56,44,51,44,52,56,44,51,44,50,56,44,49,52,44,49,50,44,49,50,44,52,44,56,44,50,56,44,49,52,44,50,56,44,49,52,44,50,52,44,54,44,53,54,44,55,44,50,52,44,54,44,50,52,44,54,0,185,72,72,40,131,52,56,44,51,44,52,56,44,51,44,52,56,44,51,44,50,56,44,49,53,44,49,50,44,49,53,44,52,44,56,44,52,44,56,44,49,50,44,49,53,44,50,52,44,55,44,53,54,44,55,44,50,52,44,54,44,50,52,44,54,0,253,72,73,40,131,52,56,44,51,44,52,56,44,51,44,52,56,44,51,44,50,56,44,49,52,44,50,56,44,49,52,44,50,56,44,49,52,44,52,44,56,44,49,50,44,49,50,44,50,52,44,54,44,53,54,44,55,44,50,52,44,54,44,50,52,44,54,0,62,73,80,40,131,50,52,44,48,44,53,54,44,48,44,49,54,44,48,44,53,54,44,49,53,44,54,48,44,49,53,44,54,48,44,48,44,54,48,44,48,44,53,54,44,48,44,53,54,44,49,44,49,50,44,51,44,54,44,54,44,51,44,54,0,130,73,81,40,131,48,44,48,44,48,44,48,44,50,52,44,48,44,50,52,44,52,56,44,50,52,44,53,54,44,50,52,44,49,50,44,53,56,44,55,44,54,51,44,49,53,44,53,57,44,51,49,44,52,56,44,52,57,44,48,44,51,50,44,48,44,48,0,194,73,82,40,131,48,44,54,44,48,44,55,44,48,44,50,44,54,48,44,55,44,54,48,44,49,53,44,48,44,49,53,44,48,44,49,53,44,48,44,55,44,51,50,44,55,44,52,56,44,54,44,50,52,44,50,52,44,50,52,44,52,56,0,255,73,83,40,131,48,44,48,44,49,44,48,44,51,53,44,51,44,54,50,44,53,53,44,54,48,44,54,51,44,53,54,44,50,51,44,49,50,44,54,44,55,44,54,44,51,44,54,44,48,44,54,44,48,44,48,44,48,44,48,0,18,74,248,42,129,73,172,50,56,54,55,50,158,50,57,48,48,48,0,38,74,2,43,150,73,59,189,40,73,41,59,194,40,189,40,73,41,41,0,45,74,12,43,130,73,0,74,74,92,43,129,73,172,50,56,55,56,57,158,50,56,57,48,48,58,149,73,44,50,53,53,58,130,73,0,80,74,102,43,137,0,0,0,49,166]
;***********************************************************************
; MICROCOSM ASSOCIATES 8080/8085 CPU DIAGNOSTIC VERSION 1.0 (C) 1980
;***********************************************************************
; Load into virtual altair with: ALTAIR L=TEST.HEX
; Then press F2 to view screen, and 'G' to execute the test.
;
;DONATED TO THE "SIG/M" CP/M USER'S GROUP BY:
;KELLY SMITH, MICROCOSM ASSOCIATES
;3055 WACO AVENUE
;SIMI VALLEY, CALIFORNIA, 93065
;(805) 527-9321 (MODEM, CP/M-NET (TM))
;(805) 527-0518 (VERBAL)
;
.CPU 8080
org 5
ret
ORG 00100H
.ent $
LXI H, LOLZ
LXI SP, STACK
;CALL MSG
JMP CPU ;JUMP TO 8080 CPU DIAGNOSTIC
;
LOLZ: DB "MICROCOSM ASSOCIATES 8080/8085 CPU DIAGNOSTIC VERSION 1.0 (C) 1980", 0dh, 0ah, 24h
;
BDOS EQU 00005H ;BDOS ENTRY TO CP/M
WBOOT: JMP 0
;
;MESSAGE OUTPUT ROUTINE
;
MSG: MOV A,M ; Get data
CPI '$' ; End?
RZ
CALL PCHAR ; Output
INX H ; Next
JMP MSG ; Do all
;
;
;CHARACTER OUTPUT ROUTINE
;
PCHAR: PUSH PSW
PUSH D
PUSH H
MOV E,A
MVI C,2
CALL BDOS
POP H
POP D
POP PSW
RET
;
;
;
BYTEO: PUSH PSW
CALL BYTO1
MOV E,A
CALL PCHAR
POP PSW
CALL BYTO2
MOV E,A
JMP PCHAR
BYTO1: RRC
RRC
RRC
RRC
BYTO2: ANI 0FH
CPI 0AH
JM BYTO3
ADI 7
BYTO3: ADI 30H
RET
;
;
;
;************************************************************
; MESSAGE TABLE FOR OPERATIONAL CPU TEST
;************************************************************
;
OKCPU: DB 0DH,0AH
DB "CPU IS OPERATIONAL$"
;
NGCPU: DB 0DH,0AH
DB " CPU HAS FAILED! ERROR EXIT=$"
;
;
;
;************************************************************
; 8080/8085 CPU TEST/DIAGNOSTIC
;************************************************************
;
;NOTE: (1) PROGRAM ASSUMES "CALL",AND "LXI SP" INSTRUCTIONS WORK!
;
; (2) INSTRUCTIONS NOT TESTED ARE "HLT","DI","EI",
; AND "RST 0" THRU "RST 7"
;
;
;
;TEST JUMP INSTRUCTIONS AND FLAGS
;
CPU: LXI SP,STACK ;SET THE STACK POINTER
ANI 0 ;INITIALIZE A REG. AND CLEAR ALL FLAGS
JZ J010 ;TEST "JZ"
CALL CPUER
J010: JNC J020 ;TEST "JNC"
CALL CPUER
J020: JPE J030 ;TEST "JPE"
CALL CPUER
J030: JP J040 ;TEST "JP"
CALL CPUER
J040: JNZ J050 ;TEST "JNZ"
JC J050 ;TEST "JC"
JPO J050 ;TEST "JPO"
JM J050 ;TEST "JM"
JMP J060 ;TEST "JMP" (IT'S A LITTLE LATE,BUT WHAT THE HELL!
J050: CALL CPUER
J060: ADI 6 ;A=6,C=0,P=1,S=0,Z=0
JNZ J070 ;TEST "JNZ"
CALL CPUER
J070: JC J080 ;TEST "JC"
JPO J080 ;TEST "JPO"
JP J090 ;TEST "JP"
J080: CALL CPUER
J090: ADI 070H ;A=76H,C=0,P=0,S=0,Z=0
JPO J100 ;TEST "JPO"
CALL CPUER
J100: JM J110 ;TEST "JM"
JZ J110 ;TEST "JZ"
JNC J120 ;TEST "JNC"
J110: CALL CPUER
J120: ADI 081H ;A=F7H,C=0,P=0,S=1,Z=0
JM J130 ;TEST "JM"
CALL CPUER
J130: JZ J140 ;TEST "JZ"
JC J140 ;TEST "JC"
JPO J150 ;TEST "JPO"
J140: CALL CPUER
J150: ADI 0FEH ;A=F5H,C=1,P=1,S=1,Z=0
JC J160 ;TEST "JC"
CALL CPUER
J160: JZ J170 ;TEST "JZ"
JPO J170 ;TEST "JPO"
JM AIMM ;TEST "JM"
J170: CALL CPUER
;
;
;
;TEST ACCUMULATOR IMMEDIATE INSTRUCTIONS
;
AIMM: CPI 0 ;A=F5H,C=0,Z=0
JC CPIE ;TEST "CPI" FOR RE-SET CARRY
JZ CPIE ;TEST "CPI" FOR RE-SET ZERO
CPI 0F5H ;A=F5H,C=0,Z=1
JC CPIE ;TEST "CPI" FOR RE-SET CARRY ("ADI")
JNZ CPIE ;TEST "CPI" FOR RE-SET ZERO
CPI 0FFH ;A=F5H,C=1,Z=0
JZ CPIE ;TEST "CPI" FOR RE-SET ZERO
JC ACII ;TEST "CPI" FOR SET CARRY
CPIE: CALL CPUER
ACII: ACI 00AH ;A=F5H+0AH+CARRY(1)=0,C=1
ACI 00AH ;A=0+0AH+CARRY(0)=0BH,C=0
CPI 00BH
JZ SUII ;TEST "ACI"
CALL CPUER
SUII: SUI 00CH ;A=FFH,C=0
SUI 00FH ;A=F0H,C=1
CPI 0F0H
JZ SBII ;TEST "SUI"
CALL CPUER
SBII: SBI 0F1H ;A=F0H-0F1H-CARRY(0)=FFH,C=1
SBI 00EH ;A=FFH-OEH-CARRY(1)=F0H,C=0
CPI 0F0H
JZ ANII ;TEST "SBI"
CALL CPUER
ANII: ANI 055H ;A=F0H<AND>55H=50H,C=0,P=1,S=0,Z=0
CPI 050H
JZ ORII ;TEST "ANI"
CALL CPUER
ORII: ORI 03AH ;A=50H<OR>3AH=7AH,C=0,P=0,S=0,Z=0
CPI 07AH
JZ XRII ;TEST "ORI"
CALL CPUER
XRII: XRI 00FH ;A=7AH<XOR>0FH=75H,C=0,P=0,S=0,Z=0
CPI 075H
JZ C010 ;TEST "XRI"
CALL CPUER
;
;
;
;TEST CALLS AND RETURNS
;
C010: ANI 000H ;A=0,C=0,P=1,S=0,Z=1
CC CPUER ;TEST "CC"
CPO CPUER ;TEST "CPO"
CM CPUER ;TEST "CM"
CNZ CPUER ;TEST "CNZ"
CPI 000H
JZ C020 ;A=0,C=0,P=0,S=0,Z=1
CALL CPUER
C020: SUI 077H ;A=89H,C=1,P=0,S=1,Z=0
CNC CPUER ;TEST "CNC"
CPE CPUER ;TEST "CPE"
CP CPUER ;TEST "CP"
CZ CPUER ;TEST "CZ"
CPI 089H
JZ C030 ;TEST FOR "CALLS" TAKING BRANCH
CALL CPUER
C030: ANI 0FFH ;SET FLAGS BACK!
CPO CPOI ;TEST "CPO"
CPI 0D9H
JZ MOVI ;TEST "CALL" SEQUENCE SUCCESS
CALL CPUER
CPOI: RPE ;TEST "RPE"
ADI 010H ;A=99H,C=0,P=0,S=1,Z=0
CPE CPEI ;TEST "CPE"
ADI 002H ;A=D9H,C=0,P=0,S=1,Z=0
RPO ;TEST "RPO"
CALL CPUER
CPEI: RPO ;TEST "RPO"
ADI 020H ;A=B9H,C=0,P=0,S=1,Z=0
CM CMI ;TEST "CM"
ADI 004H ;A=D7H,C=0,P=1,S=1,Z=0
RPE ;TEST "RPE"
CALL CPUER
CMI: RP ;TEST "RP"
ADI 080H ;A=39H,C=1,P=1,S=0,Z=0
CP TCPI ;TEST "CP"
ADI 080H ;A=D3H,C=0,P=0,S=1,Z=0
RM ;TEST "RM"
CALL CPUER
TCPI: RM ;TEST "RM"
ADI 040H ;A=79H,C=0,P=0,S=0,Z=0
CNC CNCI ;TEST "CNC"
ADI 040H ;A=53H,C=0,P=1,S=0,Z=0
RP ;TEST "RP"
CALL CPUER
CNCI: RC ;TEST "RC"
ADI 08FH ;A=08H,C=1,P=0,S=0,Z=0
CC CCI ;TEST "CC"
SUI 002H ;A=13H,C=0,P=0,S=0,Z=0
RNC ;TEST "RNC"
CALL CPUER
CCI: RNC ;TEST "RNC"
ADI 0F7H ;A=FFH,C=0,P=1,S=1,Z=0
CNZ CNZI ;TEST "CNZ"
ADI 0FEH ;A=15H,C=1,P=0,S=0,Z=0
RC ;TEST "RC"
CALL CPUER
CNZI: RZ ;TEST "RZ"
ADI 001H ;A=00H,C=1,P=1,S=0,Z=1
CZ CZI ;TEST "CZ"
ADI 0D0H ;A=17H,C=1,P=1,S=0,Z=0
RNZ ;TEST "RNZ"
CALL CPUER
CZI: RNZ ;TEST "RNZ"
ADI 047H ;A=47H,C=0,P=1,S=0,Z=0
CPI 047H ;A=47H,C=0,P=1,S=0,Z=1
RZ ;TEST "RZ"
CALL CPUER
;
;
;
;TEST "MOV","INR",AND "DCR" INSTRUCTIONS
;
MOVI: MVI A,077H
INR A
MOV B,A
INR B
MOV C,B
DCR C
MOV D,C
MOV E,D
MOV H,E
MOV L,H
MOV A,L ;TEST "MOV" A,L,H,E,D,C,B,A
DCR A
MOV C,A
MOV E,C
MOV L,E
MOV B,L
MOV D,B
MOV H,D
MOV A,H ;TEST "MOV" A,H,D,B,L,E,C,A
MOV D,A
INR D
MOV L,D
MOV C,L
INR C
MOV H,C
MOV B,H
DCR B
MOV E,B
MOV A,E ;TEST "MOV" A,E,B,H,C,L,D,A
MOV E,A
INR E
MOV B,E
MOV H,B
INR H
MOV C,H
MOV L,C
MOV D,L
DCR D
MOV A,D ;TEST "MOV" A,D,L,C,H,B,E,A
MOV H,A
DCR H
MOV D,H
MOV B,D
MOV L,B
INR L
MOV E,L
DCR E
MOV C,E
MOV A,C ;TEST "MOV" A,C,E,L,B,D,H,A
MOV L,A
DCR L
MOV H,L
MOV E,H
MOV D,E
MOV C,D
MOV B,C
MOV A,B
CPI 077H
CNZ CPUER ;TEST "MOV" A,B,C,D,E,H,L,A
;
;
;
;TEST ARITHMETIC AND LOGIC INSTRUCTIONS
;
XRA A
MVI B,001H
MVI C,003H
MVI D,007H
MVI E,00FH
MVI H,01FH
MVI L,03FH
ADD B
ADD C
ADD D
ADD E
ADD H
ADD L
ADD A
CPI 0F0H
CNZ CPUER ;TEST "ADD" B,C,D,E,H,L,A
SUB B
SUB C
SUB D
SUB E
SUB H
SUB L
CPI 078H
CNZ CPUER ;TEST "SUB" B,C,D,E,H,L
SUB A
CNZ CPUER ;TEST "SUB" A
MVI A,080H
ADD A
MVI B,001H
MVI C,002H
MVI D,003H
MVI E,004H
MVI H,005H
MVI L,006H
ADC B
MVI B,080H
ADD B
ADD B
ADC C
ADD B
ADD B
ADC D
ADD B
ADD B
ADC E
ADD B
ADD B
ADC H
ADD B
ADD B
ADC L
ADD B
ADD B
ADC A
CPI 037H
CNZ CPUER ;TEST "ADC" B,C,D,E,H,L,A
MVI A,080H
ADD A
MVI B,001H
SBB B
MVI B,0FFH
ADD B
SBB C
ADD B
SBB D
ADD B
SBB E
ADD B
SBB H
ADD B
SBB L
CPI 0E0H
CNZ CPUER ;TEST "SBB" B,C,D,E,H,L
MVI A,080H
ADD A
SBB A
CPI 0FFH
CNZ CPUER ;TEST "SBB" A
MVI A,0FFH
MVI B,0FEH
MVI C,0FCH
MVI D,0EFH
MVI E,07FH
MVI H,0F4H
MVI L,0BFH
ANA A
ANA C
ANA D
ANA E
ANA H
ANA L
ANA A
CPI 024H
CNZ CPUER ;TEST "ANA" B,C,D,E,H,L,A
XRA A
MVI B,001H
MVI C,002H
MVI D,004H
MVI E,008H
MVI H,010H
MVI L,020H
ORA B
ORA C
ORA D
ORA E
ORA H
ORA L
ORA A
CPI 03FH
CNZ CPUER ;TEST "ORA" B,C,D,E,H,L,A
MVI A,000H
MVI H,08FH
MVI L,04FH
XRA B
XRA C
XRA D
XRA E
XRA H
XRA L
CPI 0CFH
CNZ CPUER ;TEST "XRA" B,C,D,E,H,L
XRA A
CNZ CPUER ;TEST "XRA" A
MVI B,044H
MVI C,045H
MVI D,046H
MVI E,047H
MVI H,(TEMP0/0FFH) ;HIGH BYTE OF TEST MEMORY LOCATION
MVI L,(TEMP0&0FFH) ;LOW BYTE OF TEST MEMORY LOCATION
MOV M,B
MVI B,000H
MOV B,M
MVI A,044H
CMP B
CNZ CPUER ;TEST "MOV" M,B AND B,M
MOV M,D
MVI D,000H
MOV D,M
MVI A,046H
CMP D
CNZ CPUER ;TEST "MOV" M,D AND D,M
MOV M,E
MVI E,000H
MOV E,M
MVI A,047H
CMP E
CNZ CPUER ;TEST "MOV" M,E AND E,M
MOV M,H
MVI H,(TEMP0/0FFH)
MVI L,(TEMP0&0FFH)
MOV H,M
MVI A,(TEMP0/0FFH)
CMP H
CNZ CPUER ;TEST "MOV" M,H AND H,M
MOV M,L
MVI H,(TEMP0/0FFH)
MVI L,(TEMP0&0FFH)
MOV L,M
MVI A,(TEMP0&0FFH)
CMP L
CNZ CPUER ;TEST "MOV" M,L AND L,M
MVI H,(TEMP0/0FFH)
MVI L,(TEMP0&0FFH)
MVI A,032H
MOV M,A
CMP M
CNZ CPUER ;TEST "MOV" M,A
ADD M
CPI 064H
CNZ CPUER ;TEST "ADD" M
XRA A
MOV A,M
CPI 032H
CNZ CPUER ;TEST "MOV" A,M
MVI H,(TEMP0/0FFH)
MVI L,(TEMP0&0FFH)
MOV A,M
SUB M
CNZ CPUER ;TEST "SUB" M
MVI A,080H
ADD A
ADC M
CPI 033H
CNZ CPUER ;TEST "ADC" M
MVI A,080H
ADD A
SBB M
CPI 0CDH
CNZ CPUER ;TEST "SBB" M
ANA M
CNZ CPUER ;TEST "ANA" M
MVI A,025H
ORA M
CPI 037H
CNZ CPUER ;TEST "ORA" M
XRA M
CPI 005H
CNZ CPUER ;TEST "XRA" M
MVI M,055H
INR M
DCR M
ADD M
CPI 05AH
CNZ CPUER ;TEST "INR","DCR",AND "MVI" M
LXI B,12FFH
LXI D,12FFH
LXI H,12FFH
INX B
INX D
INX H
MVI A,013H
CMP B
CNZ CPUER ;TEST "LXI" AND "INX" B
CMP D
CNZ CPUER ;TEST "LXI" AND "INX" D
CMP H
CNZ CPUER ;TEST "LXI" AND "INX" H
MVI A,000H
CMP C
CNZ CPUER ;TEST "LXI" AND "INX" B
CMP E
CNZ CPUER ;TEST "LXI" AND "INX" D
CMP L
CNZ CPUER ;TEST "LXI" AND "INX" H
DCX B
DCX D
DCX H
MVI A,012H
CMP B
CNZ CPUER ;TEST "DCX" B
CMP D
CNZ CPUER ;TEST "DCX" D
CMP H
CNZ CPUER ;TEST "DCX" H
MVI A,0FFH
CMP C
CNZ CPUER ;TEST "DCX" B
CMP E
CNZ CPUER ;TEST "DCX" D
CMP L
CNZ CPUER ;TEST "DCX" H
STA TEMP0
XRA A
LDA TEMP0
CPI 0FFH
CNZ CPUER ;TEST "LDA" AND "STA"
LHLD TEMPP
SHLD TEMP0
LDA TEMPP
MOV B,A
LDA TEMP0
CMP B
CNZ CPUER ;TEST "LHLD" AND "SHLD"
LDA TEMPP+1
MOV B,A
LDA TEMP0+1
CMP B
CNZ CPUER ;TEST "LHLD" AND "SHLD"
MVI A,0AAH
STA TEMP0
MOV B,H
MOV C,L
XRA A
LDAX B
CPI 0AAH
CNZ CPUER ;TEST "LDAX" B
INR A
STAX B
LDA TEMP0
CPI 0ABH
CNZ CPUER ;TEST "STAX" B
MVI A,077H
STA TEMP0
LHLD TEMPP
LXI D,00000H
XCHG
XRA A
LDAX D
CPI 077H
CNZ CPUER ;TEST "LDAX" D AND "XCHG"
XRA A
ADD H
ADD L
CNZ CPUER ;TEST "XCHG"
MVI A,0CCH
STAX D
LDA TEMP0
CPI 0CCH
STAX D
LDA TEMP0
CPI 0CCH
CNZ CPUER ;TEST "STAX" D
LXI H,07777H
DAD H
MVI A,0EEH
CMP H
CNZ CPUER ;TEST "DAD" H
CMP L
CNZ CPUER ;TEST "DAD" H
LXI H,05555H
LXI B,0FFFFH
DAD B
MVI A,055H
CNC CPUER ;TEST "DAD" B
CMP H
CNZ CPUER ;TEST "DAD" B
MVI A,054H
CMP L
CNZ CPUER ;TEST "DAD" B
LXI H,0AAAAH
LXI D,03333H
DAD D
MVI A,0DDH
CMP H
CNZ CPUER ;TEST "DAD" D
CMP L
CNZ CPUER ;TEST "DAD" B
STC
CNC CPUER ;TEST "STC"
CMC
CC CPUER ;TEST "CMC
MVI A,0AAH
CMA
CPI 055H
CNZ CPUER ;TEST "CMA"
ORA A ;RE-SET AUXILIARY CARRY
DAA
CPI 055H
CNZ CPUER ;TEST "DAA"
MVI A,088H
ADD A
DAA
CPI 076H
CNZ CPUER ;TEST "DAA"
XRA A
MVI A,0AAH
DAA
CNC CPUER ;TEST "DAA"
CPI 010H
CNZ CPUER ;TEST "DAA"
XRA A
MVI A,09AH
DAA
CNC CPUER ;TEST "DAA"
CNZ CPUER ;TEST "DAA"
STC
MVI A,042H
RLC
CC CPUER ;TEST "RLC" FOR RE-SET CARRY
RLC
CNC CPUER ;TEST "RLC" FOR SET CARRY
CPI 009H
CNZ CPUER ;TEST "RLC" FOR ROTATION
RRC
CNC CPUER ;TEST "RRC" FOR SET CARRY
RRC
CPI 042H
CNZ CPUER ;TEST "RRC" FOR ROTATION
RAL
RAL
CNC CPUER ;TEST "RAL" FOR SET CARRY
CPI 008H
CNZ CPUER ;TEST "RAL" FOR ROTATION
RAR
RAR
CC CPUER ;TEST "RAR" FOR RE-SET CARRY
CPI 002H
CNZ CPUER ;TEST "RAR" FOR ROTATION
LXI B,01234H
LXI D,0AAAAH
LXI H,05555H
XRA A
PUSH B
PUSH D
PUSH H
PUSH PSW
LXI B,00000H
LXI D,00000H
LXI H,00000H
MVI A,0C0H
ADI 0F0H
POP PSW
POP H
POP D
POP B
CC CPUER ;TEST "PUSH PSW" AND "POP PSW"
CNZ CPUER ;TEST "PUSH PSW" AND "POP PSW"
CPO CPUER ;TEST "PUSH PSW" AND "POP PSW"
CM CPUER ;TEST "PUSH PSW" AND "POP PSW"
MVI A,012H
CMP B
CNZ CPUER ;TEST "PUSH B" AND "POP B"
MVI A,034H
CMP C
CNZ CPUER ;TEST "PUSH B" AND "POP B"
MVI A,0AAH
CMP D
CNZ CPUER ;TEST "PUSH D" AND "POP D"
CMP E
CNZ CPUER ;TEST "PUSH D" AND "POP D"
MVI A,055H
CMP H
CNZ CPUER ;TEST "PUSH H" AND "POP H"
CMP L
CNZ CPUER ;TEST "PUSH H" AND "POP H"
LXI H,00000H
DAD SP
SHLD SAVSTK ;SAVE THE "OLD" STACK-POINTER!
LXI SP,TEMP4
DCX SP
DCX SP
INX SP
DCX SP
MVI A,055H
STA TEMP2
CMA
STA TEMP3
POP B
CMP B
CNZ CPUER ;TEST "LXI","DAD","INX",AND "DCX" SP
CMA
CMP C
CNZ CPUER ;TEST "LXI","DAD","INX", AND "DCX" SP
LXI H,TEMP4
SPHL
LXI H,07733H
DCX SP
DCX SP
XTHL
LDA TEMP3
CPI 077H
CNZ CPUER ;TEST "SPHL" AND "XTHL"
LDA TEMP2
CPI 033H
CNZ CPUER ;TEST "SPHL" AND "XTHL"
MVI A,055H
CMP L
CNZ CPUER ;TEST "SPHL" AND "XTHL"
CMA
CMP H
CNZ CPUER ;TEST "SPHL" AND "XTHL"
LHLD SAVSTK ;RESTORE THE "OLD" STACK-POINTER
SPHL
LXI H,CPUOK
PCHL ;TEST "PCHL"
;
;
;
CPUER: LXI H,NGCPU ;OUTPUT "CPU HAS FAILED ERROR EXIT=" TO CONSOLE
CALL MSG
XTHL
MOV A,H
CALL BYTEO ;SHOW ERROR EXIT ADDRESS HIGH BYTE
MOV A,L
CALL BYTEO ;SHOW ERROR EXIT ADDRESS LOW BYTE
JMP WBOOT ;EXIT TO CP/M WARM BOOT
;
;
;
CPUOK: LXI H,OKCPU ;OUTPUT "CPU IS OPERATIONAL" TO CONSOLE
CALL MSG
JMP WBOOT ;EXIT TO CP/M WARM BOOT
;
;
;
TEMPP: DW TEMP0 ;POINTER USED TO TEST "LHLD","SHLD",
; AND "LDAX" INSTRUCTIONS
;
TEMP0: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
TEMP1: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
TEMP2 DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
TEMP3: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
TEMP4: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
SAVSTK: DS 2 ;TEMPORARY STACK-POINTER STORAGE LOCATION
;
;
;
STACK EQU TEMPP+256 ;DE-BUG STACK POINTER STORAGE AREA
;
:01000500C931
:10010000210C0131BD07CD5501C3C4014D494352F6
:100110004F434F534D204153534F4349415445534F
:1001200020383038302F383038352043505520446F
:100130004941474E4F535449432056455253494F26
:100140004E20312E30202028432920313938300DDF
:100150000A24C300007EFE24C8CD600123C35501DC
:10016000F5D5E55F0E02CD0500E1D1F1C9F5CD7DF4
:10017000015FCD6001F1CD81015FC360010F0F0F01
:100180000FE60FFE0AFA8A01C607C630C90D0A43F8
:100190005055204953204F5045524154494F4E41EC
:1001A0004C240D0A204350552048415320464149D4
:1001B0004C454421202020204552524F5220455882
:1001C00049543D2431BD07E600CACF01CDA206D275
:1001D000D501CDA206EADB01CDA206F2E101CDA256
:1001E00006C2F001DAF001E2F001FAF001C3F30116
:1001F000CDA206C606C2FB01CDA206DA0402E204C5
:1002000002F20702CDA206C670E20F02CDA206FAE4
:100210001802CA1802D21B02CDA206C681FA230216
:10022000CDA206CA2C02DA2C02E22F02CDA206C60B
:10023000FEDA3702CDA206CA4002E24002FA4302C9
:10024000CDA206FE00DA5B02CA5B02FEF5DA5B02B3
:10025000C25B02FEFFCA5B02DA5E02CDA206CE0AD4
:10026000CE0AFE0BCA6A02CDA206D60CD60FFEF04D
:10027000CA7602CDA206DEF1DE0EFEF0CA8202CD03
:10028000A206E655FE50CA8C02CDA206F63AFE7AC8
:10029000CA9602CDA206EE0FFE75CAA002CDA20636
:1002A000E600DCA206E4A206FCA206C4A206FE004A
:1002B000CAB602CDA206D677D4A206ECA206F4A254
:1002C00006CCA206FE89CACC02CDA206E6FFE4D97E
:1002D00002FED9CA3603CDA206E8C610ECE502C676
:1002E00002E0CDA206E0C620FCF102C604E8CDA2E1
:1002F00006F0C680F4FD02C680F8CDA206F8C6401E
:10030000D40903C640F0CDA206D8C68FDC1503D6AB
:1003100002D0CDA206D0C6F7C42103C6FED8CDA216
:1003200006C8C601CC2D03C6D0C0CDA206C0C647A4
:10033000FE47C8CDA2063E773C4704480D515A639C
:100340006C7D3D4F596B4550627C57146A4D0C6172
:100350004405587B5F1C4360244C6955157A67251A
:100360005442682C5D1D4B796F2D655C534A417872
:10037000FE77C4A206AF06010E0316071E0F261F46
:100380002E3F80818283848587FEF0C4A2069091EF
:1003900092939495FE78C4A20697C4A2063E8087E5
:1003A00006010E0216031E0426052E06880680800E
:1003B000808980808A80808B80808C80808D808006
:1003C0008FFE37C4A2063E808706019806FF8099FB
:1003D000809A809B809C809DFEE0C4A2063E808720
:1003E0009FFEFFC4A2063EFF06FE0EFC16EF1E7F18
:1003F00026F42EBFA7A1A2A3A4A5A7FE24C4A206EB
:10040000AF06010E0216041E0826102E20B0B1B24F
:10041000B3B4B5B7FE3FC4A2063E00268F2E4FA848
:10042000A9AAABACADFECFC4A206AFC4A2060644D7
:100430000E4516461E4726062EBF700600463E4451
:10044000B8C4A206721600563E46BAC4A206731E6F
:10045000005E3E47BBC4A2067426062EBF663E065B
:10046000BCC4A2067526062EBF6E3EBFBDC4A20642
:1004700026062EBF3E3277BEC4A20686FE64C4A204
:1004800006AF7EFE32C4A20626062EBF7E96C4A20A
:10049000063E80878EFE33C4A2063E80879EFECD38
:1004A000C4A206A6C4A2063E25B6FE37C4A206AE66
:1004B000FE05C4A2063655343586FE5AC4A206018E
:1004C000FF1211FF1221FF120313233E13B8C4A21F
:1004D00006BAC4A206BCC4A2063E00B9C4A206BBAA
:1004E000C4A206BDC4A2060B1B2B3E12B8C4A206B2
:1004F000BAC4A206BCC4A2063EFFB9C4A206BBC4CD
:10050000A206BDC4A20632BF06AF3ABF06FEFFC4B4
:10051000A2062ABD0622BF063ABD06473ABF06B864
:10052000C4A2063ABE06473AC006B8C4A2063EAA0E
:1005300032BF06444DAF0AFEAAC4A2063C023ABF2F
:1005400006FEABC4A2063E7732BF062ABD061100E6
:1005500000EBAF1AFE77C4A206AF8485C4A2063EA4
:10056000CC123ABF06FECC123ABF06FECCC4A2069D
:10057000217777293EEEBCC4A206BDC4A206215550
:100580005501FFFF093E55D4A206BCC4A2063E5445
:10059000BDC4A20621AAAA113333193EDDBCC4A2F0
:1005A00006BDC4A20637D4A2063FDCA2063EAA2F8F
:1005B000FE55C4A206B727FE55C4A2063E8887276B
:1005C000FE76C4A206AF3EAA27D4A206FE10C4A29D
:1005D00006AF3E9A27D4A206C4A206373E4207DCE5
:1005E000A20607D4A206FE09C4A2060FD4A2060FD3
:1005F000FE42C4A2061717D4A206FE08C4A2061F14
:100600001FDCA206FE02C4A20601341211AAAA210E
:100610005555AFC5D5E5F5010000110000210000DA
:100620003EC0C6F0F1E1D1C1DCA206C4A206E4A23C
:1006300006FCA2063E12B8C4A2063E34B9C4A20605
:100640003EAABAC4A206BBC4A2063E55BCC4A206BA
:10065000BDC4A2062100003922C40631C3063B3BBB
:10066000333B3E5532C1062F32C206C1B8C4A20682
:100670002FB9C4A20621C306F92133773B3BE33AE5
:10068000C206FE77C4A2063AC106FE33C4A2063EE5
:1006900055BDC4A2062FBCC4A2062AC406F921B4C3
:1006A00006E921A201CD5501E37CCD6D017DCD6D23
:0F06B00001C35201218D01CD5501C35201BF0677
:00000001FF
0000 ;***********************************************************************
0000 ; MICROCOSM ASSOCIATES 8080/8085 CPU DIAGNOSTIC VERSION 1.0 (C) 1980
0000 ;***********************************************************************
0000 ; Load into virtual altair with: ALTAIR L=TEST.HEX
0000 ; Then press F2 to view screen, and 'G' to execute the test.
0000 ;
0000 ;DONATED TO THE "SIG/M" CP/M USER'S GROUP BY:
0000 ;KELLY SMITH, MICROCOSM ASSOCIATES
0000 ;3055 WACO AVENUE
0000 ;SIMI VALLEY, CALIFORNIA, 93065
0000 ;(805) 527-9321 (MODEM, CP/M-NET (TM))
0000 ;(805) 527-0518 (VERBAL)
0000 ;
0000 .CPU 8080
0005 .ORG 5
0005 C9 RET
0100 .ORG 00100H
0100 .ENT $
0100 21 0C 01 LXI H,LOLZ
0103 31 BD 07 LXI SP,STACK
0106 CD 55 01 CALL MSG
0109 C3 C4 01 JMP CPU ;JUMP TO 8080 CPU DIAGNOSTIC
010C ;
010C 4D 49 43 52 4F 43 4F 53 4D 20 41 53 53 4F 43 49 41 54 45 53 20 38 30 38 30 2F 38 30 38 35 20 43 50 55 20 44 49 41 47 4E 4F 53 54 49 43 20 56 45 52 53 49 4F 4E 20 31 2E 30 20 20 28 43 29 20 31 39 38 30 0D 0A 24 LOLZ: DB "MICROCOSM ASSOCIATES 8080/8085 CPU DIAGNOSTIC VERSION 1.0 (C) 1980",0dh,0ah,24h
0152 ;
0152 BDOS: EQU 00005H
0152 C3 00 00 WBOOT: JMP 0
0155 ;
0155 ;MESSAGE OUTPUT ROUTINE
0155 ;
0155 7E MSG: MOV A,M ; Get data
0156 FE 24 CPI '$' ; End?
0158 C8 RZ
0159 CD 60 01 CALL PCHAR ; Output
015C 23 INX H ; Next
015D C3 55 01 JMP MSG ; Do all
0160 ;
0160 ;
0160 ;CHARACTER OUTPUT ROUTINE
0160 ;
0160 F5 PCHAR: PUSH PSW
0161 D5 PUSH D
0162 E5 PUSH H
0163 5F MOV E,A
0164 0E 02 MVI C,2
0166 CD 05 00 CALL BDOS
0169 E1 POP H
016A D1 POP D
016B F1 POP PSW
016C C9 RET
016D ;
016D ;
016D ;
016D F5 BYTEO: PUSH PSW
016E CD 7D 01 CALL BYTO1
0171 5F MOV E,A
0172 CD 60 01 CALL PCHAR
0175 F1 POP PSW
0176 CD 81 01 CALL BYTO2
0179 5F MOV E,A
017A C3 60 01 JMP PCHAR
017D 0F BYTO1: RRC
017E 0F RRC
017F 0F RRC
0180 0F RRC
0181 E6 0F BYTO2: ANI 0FH
0183 FE 0A CPI 0AH
0185 FA 8A 01 JM BYTO3
0188 C6 07 ADI 7
018A C6 30 BYTO3: ADI 30H
018C C9 RET
018D ;
018D ;
018D ;
018D ;************************************************************
018D ; MESSAGE TABLE FOR OPERATIONAL CPU TEST
018D ;************************************************************
018D ;
018D 0D 0A OKCPU: DB 0DH,0AH
018F 43 50 55 20 49 53 20 4F 50 45 52 41 54 49 4F 4E 41 4C 24 DB "CPU IS OPERATIONAL$"
01A2 ;
01A2 0D 0A NGCPU: DB 0DH,0AH
01A4 20 43 50 55 20 48 41 53 20 46 41 49 4C 45 44 21 20 20 20 20 45 52 52 4F 52 20 45 58 49 54 3D 24 DB " CPU HAS FAILED! ERROR EXIT=$"
01C4 ;
01C4 ;
01C4 ;
01C4 ;************************************************************
01C4 ; 8080/8085 CPU TEST/DIAGNOSTIC
01C4 ;************************************************************
01C4 ;
01C4 ;NOTE: (1) PROGRAM ASSUMES "CALL",AND "LXI SP" INSTRUCTIONS WORK!
01C4 ;
01C4 ; (2) INSTRUCTIONS NOT TESTED ARE "HLT","DI","EI",
01C4 ; AND "RST 0" THRU "RST 7"
01C4 ;
01C4 ;
01C4 ;
01C4 ;TEST JUMP INSTRUCTIONS AND FLAGS
01C4 ;
01C4 31 BD 07 CPU: LXI SP,STACK ;SET THE STACK POINTER
01C7 E6 00 ANI 0 ;INITIALIZE A REG. AND CLEAR ALL FLAGS
01C9 CA CF 01 JZ J010 ;TEST "JZ"
01CC CD A2 06 CALL CPUER
01CF D2 D5 01 J010: JNC J020 ;TEST "JNC"
01D2 CD A2 06 CALL CPUER
01D5 EA DB 01 J020: JPE J030 ;TEST "JPE"
01D8 CD A2 06 CALL CPUER
01DB F2 E1 01 J030: JP J040 ;TEST "JP"
01DE CD A2 06 CALL CPUER
01E1 C2 F0 01 J040: JNZ J050 ;TEST "JNZ"
01E4 DA F0 01 JC J050 ;TEST "JC"
01E7 E2 F0 01 JPO J050 ;TEST "JPO"
01EA FA F0 01 JM J050 ;TEST "JM"
01ED C3 F3 01 JMP J060 ;TEST "JMP" (IT'S A LITTLE LATE,BUT WHAT THE HELL!
01F0 CD A2 06 J050: CALL CPUER
01F3 C6 06 J060: ADI 6 ;A=6,C=0,P=1,S=0,Z=0
01F5 C2 FB 01 JNZ J070 ;TEST "JNZ"
01F8 CD A2 06 CALL CPUER
01FB DA 04 02 J070: JC J080 ;TEST "JC"
01FE E2 04 02 JPO J080 ;TEST "JPO"
0201 F2 07 02 JP J090 ;TEST "JP"
0204 CD A2 06 J080: CALL CPUER
0207 C6 70 J090: ADI 070H ;A=76H,C=0,P=0,S=0,Z=0
0209 E2 0F 02 JPO J100 ;TEST "JPO"
020C CD A2 06 CALL CPUER
020F FA 18 02 J100: JM J110 ;TEST "JM"
0212 CA 18 02 JZ J110 ;TEST "JZ"
0215 D2 1B 02 JNC J120 ;TEST "JNC"
0218 CD A2 06 J110: CALL CPUER
021B C6 81 J120: ADI 081H ;A=F7H,C=0,P=0,S=1,Z=0
021D FA 23 02 JM J130 ;TEST "JM"
0220 CD A2 06 CALL CPUER
0223 CA 2C 02 J130: JZ J140 ;TEST "JZ"
0226 DA 2C 02 JC J140 ;TEST "JC"
0229 E2 2F 02 JPO J150 ;TEST "JPO"
022C CD A2 06 J140: CALL CPUER
022F C6 FE J150: ADI 0FEH ;A=F5H,C=1,P=1,S=1,Z=0
0231 DA 37 02 JC J160 ;TEST "JC"
0234 CD A2 06 CALL CPUER
0237 CA 40 02 J160: JZ J170 ;TEST "JZ"
023A E2 40 02 JPO J170 ;TEST "JPO"
023D FA 43 02 JM AIMM ;TEST "JM"
0240 CD A2 06 J170: CALL CPUER
0243 ;
0243 ;
0243 ;
0243 ;TEST ACCUMULATOR IMMEDIATE INSTRUCTIONS
0243 ;
0243 FE 00 AIMM: CPI 0 ;A=F5H,C=0,Z=0
0245 DA 5B 02 JC CPIE ;TEST "CPI" FOR RE-SET CARRY
0248 CA 5B 02 JZ CPIE ;TEST "CPI" FOR RE-SET ZERO
024B FE F5 CPI 0F5H ;A=F5H,C=0,Z=1
024D DA 5B 02 JC CPIE ;TEST "CPI" FOR RE-SET CARRY ("ADI")
0250 C2 5B 02 JNZ CPIE ;TEST "CPI" FOR RE-SET ZERO
0253 FE FF CPI 0FFH ;A=F5H,C=1,Z=0
0255 CA 5B 02 JZ CPIE ;TEST "CPI" FOR RE-SET ZERO
0258 DA 5E 02 JC ACII ;TEST "CPI" FOR SET CARRY
025B CD A2 06 CPIE: CALL CPUER
025E CE 0A ACII: ACI 00AH ;A=F5H+0AH+CARRY(1)=0,C=1
0260 CE 0A ACI 00AH ;A=0+0AH+CARRY(0)=0BH,C=0
0262 FE 0B CPI 00BH
0264 CA 6A 02 JZ SUII ;TEST "ACI"
0267 CD A2 06 CALL CPUER
026A D6 0C SUII: SUI 00CH ;A=FFH,C=0
026C D6 0F SUI 00FH ;A=F0H,C=1
026E FE F0 CPI 0F0H
0270 CA 76 02 JZ SBII ;TEST "SUI"
0273 CD A2 06 CALL CPUER
0276 DE F1 SBII: SBI 0F1H ;A=F0H-0F1H-CARRY(0)=FFH,C=1
0278 DE 0E SBI 00EH ;A=FFH-OEH-CARRY(1)=F0H,C=0
027A FE F0 CPI 0F0H
027C CA 82 02 JZ ANII ;TEST "SBI"
027F CD A2 06 CALL CPUER
0282 E6 55 ANII: ANI 055H ;A=F0H<AND>55H=50H,C=0,P=1,S=0,Z=0
0284 FE 50 CPI 050H
0286 CA 8C 02 JZ ORII ;TEST "ANI"
0289 CD A2 06 CALL CPUER
028C F6 3A ORII: ORI 03AH ;A=50H<OR>3AH=7AH,C=0,P=0,S=0,Z=0
028E FE 7A CPI 07AH
0290 CA 96 02 JZ XRII ;TEST "ORI"
0293 CD A2 06 CALL CPUER
0296 EE 0F XRII: XRI 00FH ;A=7AH<XOR>0FH=75H,C=0,P=0,S=0,Z=0
0298 FE 75 CPI 075H
029A CA A0 02 JZ C010 ;TEST "XRI"
029D CD A2 06 CALL CPUER
02A0 ;
02A0 ;
02A0 ;
02A0 ;TEST CALLS AND RETURNS
02A0 ;
02A0 E6 00 C010: ANI 000H ;A=0,C=0,P=1,S=0,Z=1
02A2 DC A2 06 CC CPUER ;TEST "CC"
02A5 E4 A2 06 CPO CPUER ;TEST "CPO"
02A8 FC A2 06 CM CPUER ;TEST "CM"
02AB C4 A2 06 CNZ CPUER ;TEST "CNZ"
02AE FE 00 CPI 000H
02B0 CA B6 02 JZ C020 ;A=0,C=0,P=0,S=0,Z=1
02B3 CD A2 06 CALL CPUER
02B6 D6 77 C020: SUI 077H ;A=89H,C=1,P=0,S=1,Z=0
02B8 D4 A2 06 CNC CPUER ;TEST "CNC"
02BB EC A2 06 CPE CPUER ;TEST "CPE"
02BE F4 A2 06 CP CPUER ;TEST "CP"
02C1 CC A2 06 CZ CPUER ;TEST "CZ"
02C4 FE 89 CPI 089H
02C6 CA CC 02 JZ C030 ;TEST FOR "CALLS" TAKING BRANCH
02C9 CD A2 06 CALL CPUER
02CC E6 FF C030: ANI 0FFH ;SET FLAGS BACK!
02CE E4 D9 02 CPO CPOI ;TEST "CPO"
02D1 FE D9 CPI 0D9H
02D3 CA 36 03 JZ MOVI ;TEST "CALL" SEQUENCE SUCCESS
02D6 CD A2 06 CALL CPUER
02D9 E8 CPOI: RPE ;TEST "RPE"
02DA C6 10 ADI 010H ;A=99H,C=0,P=0,S=1,Z=0
02DC EC E5 02 CPE CPEI ;TEST "CPE"
02DF C6 02 ADI 002H ;A=D9H,C=0,P=0,S=1,Z=0
02E1 E0 RPO ;TEST "RPO"
02E2 CD A2 06 CALL CPUER
02E5 E0 CPEI: RPO ;TEST "RPO"
02E6 C6 20 ADI 020H ;A=B9H,C=0,P=0,S=1,Z=0
02E8 FC F1 02 CM CMI ;TEST "CM"
02EB C6 04 ADI 004H ;A=D7H,C=0,P=1,S=1,Z=0
02ED E8 RPE ;TEST "RPE"
02EE CD A2 06 CALL CPUER
02F1 F0 CMI: RP ;TEST "RP"
02F2 C6 80 ADI 080H ;A=39H,C=1,P=1,S=0,Z=0
02F4 F4 FD 02 CP TCPI ;TEST "CP"
02F7 C6 80 ADI 080H ;A=D3H,C=0,P=0,S=1,Z=0
02F9 F8 RM ;TEST "RM"
02FA CD A2 06 CALL CPUER
02FD F8 TCPI: RM ;TEST "RM"
02FE C6 40 ADI 040H ;A=79H,C=0,P=0,S=0,Z=0
0300 D4 09 03 CNC CNCI ;TEST "CNC"
0303 C6 40 ADI 040H ;A=53H,C=0,P=1,S=0,Z=0
0305 F0 RP ;TEST "RP"
0306 CD A2 06 CALL CPUER
0309 D8 CNCI: RC ;TEST "RC"
030A C6 8F ADI 08FH ;A=08H,C=1,P=0,S=0,Z=0
030C DC 15 03 CC CCI ;TEST "CC"
030F D6 02 SUI 002H ;A=13H,C=0,P=0,S=0,Z=0
0311 D0 RNC ;TEST "RNC"
0312 CD A2 06 CALL CPUER
0315 D0 CCI: RNC ;TEST "RNC"
0316 C6 F7 ADI 0F7H ;A=FFH,C=0,P=1,S=1,Z=0
0318 C4 21 03 CNZ CNZI ;TEST "CNZ"
031B C6 FE ADI 0FEH ;A=15H,C=1,P=0,S=0,Z=0
031D D8 RC ;TEST "RC"
031E CD A2 06 CALL CPUER
0321 C8 CNZI: RZ ;TEST "RZ"
0322 C6 01 ADI 001H ;A=00H,C=1,P=1,S=0,Z=1
0324 CC 2D 03 CZ CZI ;TEST "CZ"
0327 C6 D0 ADI 0D0H ;A=17H,C=1,P=1,S=0,Z=0
0329 C0 RNZ ;TEST "RNZ"
032A CD A2 06 CALL CPUER
032D C0 CZI: RNZ ;TEST "RNZ"
032E C6 47 ADI 047H ;A=47H,C=0,P=1,S=0,Z=0
0330 FE 47 CPI 047H ;A=47H,C=0,P=1,S=0,Z=1
0332 C8 RZ ;TEST "RZ"
0333 CD A2 06 CALL CPUER
0336 ;
0336 ;
0336 ;
0336 ;TEST "MOV","INR",AND "DCR" INSTRUCTIONS
0336 ;
0336 3E 77 MOVI: MVI A,077H
0338 3C INR A
0339 47 MOV B,A
033A 04 INR B
033B 48 MOV C,B
033C 0D DCR C
033D 51 MOV D,C
033E 5A MOV E,D
033F 63 MOV H,E
0340 6C MOV L,H
0341 7D MOV A,L ;TEST "MOV" A,L,H,E,D,C,B,A
0342 3D DCR A
0343 4F MOV C,A
0344 59 MOV E,C
0345 6B MOV L,E
0346 45 MOV B,L
0347 50 MOV D,B
0348 62 MOV H,D
0349 7C MOV A,H ;TEST "MOV" A,H,D,B,L,E,C,A
034A 57 MOV D,A
034B 14 INR D
034C 6A MOV L,D
034D 4D MOV C,L
034E 0C INR C
034F 61 MOV H,C
0350 44 MOV B,H
0351 05 DCR B
0352 58 MOV E,B
0353 7B MOV A,E ;TEST "MOV" A,E,B,H,C,L,D,A
0354 5F MOV E,A
0355 1C INR E
0356 43 MOV B,E
0357 60 MOV H,B
0358 24 INR H
0359 4C MOV C,H
035A 69 MOV L,C
035B 55 MOV D,L
035C 15 DCR D
035D 7A MOV A,D ;TEST "MOV" A,D,L,C,H,B,E,A
035E 67 MOV H,A
035F 25 DCR H
0360 54 MOV D,H
0361 42 MOV B,D
0362 68 MOV L,B
0363 2C INR L
0364 5D MOV E,L
0365 1D DCR E
0366 4B MOV C,E
0367 79 MOV A,C ;TEST "MOV" A,C,E,L,B,D,H,A
0368 6F MOV L,A
0369 2D DCR L
036A 65 MOV H,L
036B 5C MOV E,H
036C 53 MOV D,E
036D 4A MOV C,D
036E 41 MOV B,C
036F 78 MOV A,B
0370 FE 77 CPI 077H
0372 C4 A2 06 CNZ CPUER ;TEST "MOV" A,B,C,D,E,H,L,A
0375 ;
0375 ;
0375 ;
0375 ;TEST ARITHMETIC AND LOGIC INSTRUCTIONS
0375 ;
0375 AF XRA A
0376 06 01 MVI B,001H
0378 0E 03 MVI C,003H
037A 16 07 MVI D,007H
037C 1E 0F MVI E,00FH
037E 26 1F MVI H,01FH
0380 2E 3F MVI L,03FH
0382 80 ADD B
0383 81 ADD C
0384 82 ADD D
0385 83 ADD E
0386 84 ADD H
0387 85 ADD L
0388 87 ADD A
0389 FE F0 CPI 0F0H
038B C4 A2 06 CNZ CPUER ;TEST "ADD" B,C,D,E,H,L,A
038E 90 SUB B
038F 91 SUB C
0390 92 SUB D
0391 93 SUB E
0392 94 SUB H
0393 95 SUB L
0394 FE 78 CPI 078H
0396 C4 A2 06 CNZ CPUER ;TEST "SUB" B,C,D,E,H,L
0399 97 SUB A
039A C4 A2 06 CNZ CPUER ;TEST "SUB" A
039D 3E 80 MVI A,080H
039F 87 ADD A
03A0 06 01 MVI B,001H
03A2 0E 02 MVI C,002H
03A4 16 03 MVI D,003H
03A6 1E 04 MVI E,004H
03A8 26 05 MVI H,005H
03AA 2E 06 MVI L,006H
03AC 88 ADC B
03AD 06 80 MVI B,080H
03AF 80 ADD B
03B0 80 ADD B
03B1 89 ADC C
03B2 80 ADD B
03B3 80 ADD B
03B4 8A ADC D
03B5 80 ADD B
03B6 80 ADD B
03B7 8B ADC E
03B8 80 ADD B
03B9 80 ADD B
03BA 8C ADC H
03BB 80 ADD B
03BC 80 ADD B
03BD 8D ADC L
03BE 80 ADD B
03BF 80 ADD B
03C0 8F ADC A
03C1 FE 37 CPI 037H
03C3 C4 A2 06 CNZ CPUER ;TEST "ADC" B,C,D,E,H,L,A
03C6 3E 80 MVI A,080H
03C8 87 ADD A
03C9 06 01 MVI B,001H
03CB 98 SBB B
03CC 06 FF MVI B,0FFH
03CE 80 ADD B
03CF 99 SBB C
03D0 80 ADD B
03D1 9A SBB D
03D2 80 ADD B
03D3 9B SBB E
03D4 80 ADD B
03D5 9C SBB H
03D6 80 ADD B
03D7 9D SBB L
03D8 FE E0 CPI 0E0H
03DA C4 A2 06 CNZ CPUER ;TEST "SBB" B,C,D,E,H,L
03DD 3E 80 MVI A,080H
03DF 87 ADD A
03E0 9F SBB A
03E1 FE FF CPI 0FFH
03E3 C4 A2 06 CNZ CPUER ;TEST "SBB" A
03E6 3E FF MVI A,0FFH
03E8 06 FE MVI B,0FEH
03EA 0E FC MVI C,0FCH
03EC 16 EF MVI D,0EFH
03EE 1E 7F MVI E,07FH
03F0 26 F4 MVI H,0F4H
03F2 2E BF MVI L,0BFH
03F4 A7 ANA A
03F5 A1 ANA C
03F6 A2 ANA D
03F7 A3 ANA E
03F8 A4 ANA H
03F9 A5 ANA L
03FA A7 ANA A
03FB FE 24 CPI 024H
03FD C4 A2 06 CNZ CPUER ;TEST "ANA" B,C,D,E,H,L,A
0400 AF XRA A
0401 06 01 MVI B,001H
0403 0E 02 MVI C,002H
0405 16 04 MVI D,004H
0407 1E 08 MVI E,008H
0409 26 10 MVI H,010H
040B 2E 20 MVI L,020H
040D B0 ORA B
040E B1 ORA C
040F B2 ORA D
0410 B3 ORA E
0411 B4 ORA H
0412 B5 ORA L
0413 B7 ORA A
0414 FE 3F CPI 03FH
0416 C4 A2 06 CNZ CPUER ;TEST "ORA" B,C,D,E,H,L,A
0419 3E 00 MVI A,000H
041B 26 8F MVI H,08FH
041D 2E 4F MVI L,04FH
041F A8 XRA B
0420 A9 XRA C
0421 AA XRA D
0422 AB XRA E
0423 AC XRA H
0424 AD XRA L
0425 FE CF CPI 0CFH
0427 C4 A2 06 CNZ CPUER ;TEST "XRA" B,C,D,E,H,L
042A AF XRA A
042B C4 A2 06 CNZ CPUER ;TEST "XRA" A
042E 06 44 MVI B,044H
0430 0E 45 MVI C,045H
0432 16 46 MVI D,046H
0434 1E 47 MVI E,047H
0436 26 06 MVI H,(TEMP0/0FFH) ;HIGH BYTE OF TEST MEMORY LOCATION
0438 2E BF MVI L,(TEMP0&0FFH) ;LOW BYTE OF TEST MEMORY LOCATION
043A 70 MOV M,B
043B 06 00 MVI B,000H
043D 46 MOV B,M
043E 3E 44 MVI A,044H
0440 B8 CMP B
0441 C4 A2 06 CNZ CPUER ;TEST "MOV" M,B AND B,M
0444 72 MOV M,D
0445 16 00 MVI D,000H
0447 56 MOV D,M
0448 3E 46 MVI A,046H
044A BA CMP D
044B C4 A2 06 CNZ CPUER ;TEST "MOV" M,D AND D,M
044E 73 MOV M,E
044F 1E 00 MVI E,000H
0451 5E MOV E,M
0452 3E 47 MVI A,047H
0454 BB CMP E
0455 C4 A2 06 CNZ CPUER ;TEST "MOV" M,E AND E,M
0458 74 MOV M,H
0459 26 06 MVI H,(TEMP0/0FFH)
045B 2E BF MVI L,(TEMP0&0FFH)
045D 66 MOV H,M
045E 3E 06 MVI A,(TEMP0/0FFH)
0460 BC CMP H
0461 C4 A2 06 CNZ CPUER ;TEST "MOV" M,H AND H,M
0464 75 MOV M,L
0465 26 06 MVI H,(TEMP0/0FFH)
0467 2E BF MVI L,(TEMP0&0FFH)
0469 6E MOV L,M
046A 3E BF MVI A,(TEMP0&0FFH)
046C BD CMP L
046D C4 A2 06 CNZ CPUER ;TEST "MOV" M,L AND L,M
0470 26 06 MVI H,(TEMP0/0FFH)
0472 2E BF MVI L,(TEMP0&0FFH)
0474 3E 32 MVI A,032H
0476 77 MOV M,A
0477 BE CMP M
0478 C4 A2 06 CNZ CPUER ;TEST "MOV" M,A
047B 86 ADD M
047C FE 64 CPI 064H
047E C4 A2 06 CNZ CPUER ;TEST "ADD" M
0481 AF XRA A
0482 7E MOV A,M
0483 FE 32 CPI 032H
0485 C4 A2 06 CNZ CPUER ;TEST "MOV" A,M
0488 26 06 MVI H,(TEMP0/0FFH)
048A 2E BF MVI L,(TEMP0&0FFH)
048C 7E MOV A,M
048D 96 SUB M
048E C4 A2 06 CNZ CPUER ;TEST "SUB" M
0491 3E 80 MVI A,080H
0493 87 ADD A
0494 8E ADC M
0495 FE 33 CPI 033H
0497 C4 A2 06 CNZ CPUER ;TEST "ADC" M
049A 3E 80 MVI A,080H
049C 87 ADD A
049D 9E SBB M
049E FE CD CPI 0CDH
04A0 C4 A2 06 CNZ CPUER ;TEST "SBB" M
04A3 A6 ANA M
04A4 C4 A2 06 CNZ CPUER ;TEST "ANA" M
04A7 3E 25 MVI A,025H
04A9 B6 ORA M
04AA FE 37 CPI 037H
04AC C4 A2 06 CNZ CPUER ;TEST "ORA" M
04AF AE XRA M
04B0 FE 05 CPI 005H
04B2 C4 A2 06 CNZ CPUER ;TEST "XRA" M
04B5 36 55 MVI M,055H
04B7 34 INR M
04B8 35 DCR M
04B9 86 ADD M
04BA FE 5A CPI 05AH
04BC C4 A2 06 CNZ CPUER ;TEST "INR","DCR",AND "MVI" M
04BF 01 FF 12 LXI B,12FFH
04C2 11 FF 12 LXI D,12FFH
04C5 21 FF 12 LXI H,12FFH
04C8 03 INX B
04C9 13 INX D
04CA 23 INX H
04CB 3E 13 MVI A,013H
04CD B8 CMP B
04CE C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" B
04D1 BA CMP D
04D2 C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" D
04D5 BC CMP H
04D6 C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" H
04D9 3E 00 MVI A,000H
04DB B9 CMP C
04DC C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" B
04DF BB CMP E
04E0 C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" D
04E3 BD CMP L
04E4 C4 A2 06 CNZ CPUER ;TEST "LXI" AND "INX" H
04E7 0B DCX B
04E8 1B DCX D
04E9 2B DCX H
04EA 3E 12 MVI A,012H
04EC B8 CMP B
04ED C4 A2 06 CNZ CPUER ;TEST "DCX" B
04F0 BA CMP D
04F1 C4 A2 06 CNZ CPUER ;TEST "DCX" D
04F4 BC CMP H
04F5 C4 A2 06 CNZ CPUER ;TEST "DCX" H
04F8 3E FF MVI A,0FFH
04FA B9 CMP C
04FB C4 A2 06 CNZ CPUER ;TEST "DCX" B
04FE BB CMP E
04FF C4 A2 06 CNZ CPUER ;TEST "DCX" D
0502 BD CMP L
0503 C4 A2 06 CNZ CPUER ;TEST "DCX" H
0506 32 BF 06 STA TEMP0
0509 AF XRA A
050A 3A BF 06 LDA TEMP0
050D FE FF CPI 0FFH
050F C4 A2 06 CNZ CPUER ;TEST "LDA" AND "STA"
0512 2A BD 06 LHLD TEMPP
0515 22 BF 06 SHLD TEMP0
0518 3A BD 06 LDA TEMPP
051B 47 MOV B,A
051C 3A BF 06 LDA TEMP0
051F B8 CMP B
0520 C4 A2 06 CNZ CPUER ;TEST "LHLD" AND "SHLD"
0523 3A BE 06 LDA TEMPP+1
0526 47 MOV B,A
0527 3A C0 06 LDA TEMP0+1
052A B8 CMP B
052B C4 A2 06 CNZ CPUER ;TEST "LHLD" AND "SHLD"
052E 3E AA MVI A,0AAH
0530 32 BF 06 STA TEMP0
0533 44 MOV B,H
0534 4D MOV C,L
0535 AF XRA A
0536 0A LDAX B
0537 FE AA CPI 0AAH
0539 C4 A2 06 CNZ CPUER ;TEST "LDAX" B
053C 3C INR A
053D 02 STAX B
053E 3A BF 06 LDA TEMP0
0541 FE AB CPI 0ABH
0543 C4 A2 06 CNZ CPUER ;TEST "STAX" B
0546 3E 77 MVI A,077H
0548 32 BF 06 STA TEMP0
054B 2A BD 06 LHLD TEMPP
054E 11 00 00 LXI D,00000H
0551 EB XCHG
0552 AF XRA A
0553 1A LDAX D
0554 FE 77 CPI 077H
0556 C4 A2 06 CNZ CPUER ;TEST "LDAX" D AND "XCHG"
0559 AF XRA A
055A 84 ADD H
055B 85 ADD L
055C C4 A2 06 CNZ CPUER ;TEST "XCHG"
055F 3E CC MVI A,0CCH
0561 12 STAX D
0562 3A BF 06 LDA TEMP0
0565 FE CC CPI 0CCH
0567 12 STAX D
0568 3A BF 06 LDA TEMP0
056B FE CC CPI 0CCH
056D C4 A2 06 CNZ CPUER ;TEST "STAX" D
0570 21 77 77 LXI H,07777H
0573 29 DAD H
0574 3E EE MVI A,0EEH
0576 BC CMP H
0577 C4 A2 06 CNZ CPUER ;TEST "DAD" H
057A BD CMP L
057B C4 A2 06 CNZ CPUER ;TEST "DAD" H
057E 21 55 55 LXI H,05555H
0581 01 FF FF LXI B,0FFFFH
0584 09 DAD B
0585 3E 55 MVI A,055H
0587 D4 A2 06 CNC CPUER ;TEST "DAD" B
058A BC CMP H
058B C4 A2 06 CNZ CPUER ;TEST "DAD" B
058E 3E 54 MVI A,054H
0590 BD CMP L
0591 C4 A2 06 CNZ CPUER ;TEST "DAD" B
0594 21 AA AA LXI H,0AAAAH
0597 11 33 33 LXI D,03333H
059A 19 DAD D
059B 3E DD MVI A,0DDH
059D BC CMP H
059E C4 A2 06 CNZ CPUER ;TEST "DAD" D
05A1 BD CMP L
05A2 C4 A2 06 CNZ CPUER ;TEST "DAD" B
05A5 37 STC
05A6 D4 A2 06 CNC CPUER ;TEST "STC"
05A9 3F CMC
05AA DC A2 06 CC CPUER ;TEST "CMC
05AD 3E AA MVI A,0AAH
05AF 2F CMA
05B0 FE 55 CPI 055H
05B2 C4 A2 06 CNZ CPUER ;TEST "CMA"
05B5 B7 ORA A ;RE-SET AUXILIARY CARRY
05B6 27 DAA
05B7 FE 55 CPI 055H
05B9 C4 A2 06 CNZ CPUER ;TEST "DAA"
05BC 3E 88 MVI A,088H
05BE 87 ADD A
05BF 27 DAA
05C0 FE 76 CPI 076H
05C2 C4 A2 06 CNZ CPUER ;TEST "DAA"
05C5 AF XRA A
05C6 3E AA MVI A,0AAH
05C8 27 DAA
05C9 D4 A2 06 CNC CPUER ;TEST "DAA"
05CC FE 10 CPI 010H
05CE C4 A2 06 CNZ CPUER ;TEST "DAA"
05D1 AF XRA A
05D2 3E 9A MVI A,09AH
05D4 27 DAA
05D5 D4 A2 06 CNC CPUER ;TEST "DAA"
05D8 C4 A2 06 CNZ CPUER ;TEST "DAA"
05DB 37 STC
05DC 3E 42 MVI A,042H
05DE 07 RLC
05DF DC A2 06 CC CPUER ;TEST "RLC" FOR RE-SET CARRY
05E2 07 RLC
05E3 D4 A2 06 CNC CPUER ;TEST "RLC" FOR SET CARRY
05E6 FE 09 CPI 009H
05E8 C4 A2 06 CNZ CPUER ;TEST "RLC" FOR ROTATION
05EB 0F RRC
05EC D4 A2 06 CNC CPUER ;TEST "RRC" FOR SET CARRY
05EF 0F RRC
05F0 FE 42 CPI 042H
05F2 C4 A2 06 CNZ CPUER ;TEST "RRC" FOR ROTATION
05F5 17 RAL
05F6 17 RAL
05F7 D4 A2 06 CNC CPUER ;TEST "RAL" FOR SET CARRY
05FA FE 08 CPI 008H
05FC C4 A2 06 CNZ CPUER ;TEST "RAL" FOR ROTATION
05FF 1F RAR
0600 1F RAR
0601 DC A2 06 CC CPUER ;TEST "RAR" FOR RE-SET CARRY
0604 FE 02 CPI 002H
0606 C4 A2 06 CNZ CPUER ;TEST "RAR" FOR ROTATION
0609 01 34 12 LXI B,01234H
060C 11 AA AA LXI D,0AAAAH
060F 21 55 55 LXI H,05555H
0612 AF XRA A
0613 C5 PUSH B
0614 D5 PUSH D
0615 E5 PUSH H
0616 F5 PUSH PSW
0617 01 00 00 LXI B,00000H
061A 11 00 00 LXI D,00000H
061D 21 00 00 LXI H,00000H
0620 3E C0 MVI A,0C0H
0622 C6 F0 ADI 0F0H
0624 F1 POP PSW
0625 E1 POP H
0626 D1 POP D
0627 C1 POP B
0628 DC A2 06 CC CPUER ;TEST "PUSH PSW" AND "POP PSW"
062B C4 A2 06 CNZ CPUER ;TEST "PUSH PSW" AND "POP PSW"
062E E4 A2 06 CPO CPUER ;TEST "PUSH PSW" AND "POP PSW"
0631 FC A2 06 CM CPUER ;TEST "PUSH PSW" AND "POP PSW"
0634 3E 12 MVI A,012H
0636 B8 CMP B
0637 C4 A2 06 CNZ CPUER ;TEST "PUSH B" AND "POP B"
063A 3E 34 MVI A,034H
063C B9 CMP C
063D C4 A2 06 CNZ CPUER ;TEST "PUSH B" AND "POP B"
0640 3E AA MVI A,0AAH
0642 BA CMP D
0643 C4 A2 06 CNZ CPUER ;TEST "PUSH D" AND "POP D"
0646 BB CMP E
0647 C4 A2 06 CNZ CPUER ;TEST "PUSH D" AND "POP D"
064A 3E 55 MVI A,055H
064C BC CMP H
064D C4 A2 06 CNZ CPUER ;TEST "PUSH H" AND "POP H"
0650 BD CMP L
0651 C4 A2 06 CNZ CPUER ;TEST "PUSH H" AND "POP H"
0654 21 00 00 LXI H,00000H
0657 39 DAD SP
0658 22 C4 06 SHLD SAVSTK ;SAVE THE "OLD" STACK-POINTER!
065B 31 C3 06 LXI SP,TEMP4
065E 3B DCX SP
065F 3B DCX SP
0660 33 INX SP
0661 3B DCX SP
0662 3E 55 MVI A,055H
0664 32 C1 06 STA TEMP2
0667 2F CMA
0668 32 C2 06 STA TEMP3
066B C1 POP B
066C B8 CMP B
066D C4 A2 06 CNZ CPUER ;TEST "LXI","DAD","INX",AND "DCX" SP
0670 2F CMA
0671 B9 CMP C
0672 C4 A2 06 CNZ CPUER ;TEST "LXI","DAD","INX", AND "DCX" SP
0675 21 C3 06 LXI H,TEMP4
0678 F9 SPHL
0679 21 33 77 LXI H,07733H
067C 3B DCX SP
067D 3B DCX SP
067E E3 XTHL
067F 3A C2 06 LDA TEMP3
0682 FE 77 CPI 077H
0684 C4 A2 06 CNZ CPUER ;TEST "SPHL" AND "XTHL"
0687 3A C1 06 LDA TEMP2
068A FE 33 CPI 033H
068C C4 A2 06 CNZ CPUER ;TEST "SPHL" AND "XTHL"
068F 3E 55 MVI A,055H
0691 BD CMP L
0692 C4 A2 06 CNZ CPUER ;TEST "SPHL" AND "XTHL"
0695 2F CMA
0696 BC CMP H
0697 C4 A2 06 CNZ CPUER ;TEST "SPHL" AND "XTHL"
069A 2A C4 06 LHLD SAVSTK ;RESTORE THE "OLD" STACK-POINTER
069D F9 SPHL
069E 21 B4 06 LXI H,CPUOK
06A1 E9 PCHL ;TEST "PCHL"
06A2 ;
06A2 ;
06A2 ;
06A2 21 A2 01 CPUER: LXI H,NGCPU ;OUTPUT "CPU HAS FAILED ERROR EXIT=" TO CONSOLE
06A5 CD 55 01 CALL MSG
06A8 E3 XTHL
06A9 7C MOV A,H
06AA CD 6D 01 CALL BYTEO ;SHOW ERROR EXIT ADDRESS HIGH BYTE
06AD 7D MOV A,L
06AE CD 6D 01 CALL BYTEO ;SHOW ERROR EXIT ADDRESS LOW BYTE
06B1 C3 52 01 JMP WBOOT ;EXIT TO CP/M WARM BOOT
06B4 ;
06B4 ;
06B4 ;
06B4 21 8D 01 CPUOK: LXI H,OKCPU ;OUTPUT "CPU IS OPERATIONAL" TO CONSOLE
06B7 CD 55 01 CALL MSG
06BA C3 52 01 JMP WBOOT ;EXIT TO CP/M WARM BOOT
06BD ;
06BD ;
06BD ;
06BD BF 06 TEMPP: DW TEMP0 ;POINTER USED TO TEST "LHLD","SHLD",
06BF ; AND "LDAX" INSTRUCTIONS
06BF ;
06BF TEMP0: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
06C0 TEMP1: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
06C1 TEMP2: DS 1
06C2 TEMP3: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
06C3 TEMP4: DS 1 ;TEMPORARY STORAGE FOR CPU TEST MEMORY LOCATIONS
06C4 SAVSTK: DS 2 ;TEMPORARY STACK-POINTER STORAGE LOCATION
06C6 ;
06C6 ;
06C6 ;
06C6 STACK: EQU TEMPP+256
06C6 ;
_PC 06C6
LOLZ 010C
BDOS 0005
WBOOT 0152
MSG 0155
PCHAR 0160
BYTEO 016D
BYTO1 017D
BYTO2 0181
BYTO3 018A
OKCPU 018D
NGCPU 01A2
CPU 01C4
J010 01CF
J020 01D5
J030 01DB
J040 01E1
J050 01F0
J060 01F3
J070 01FB
J080 0204
J090 0207
J100 020F
J110 0218
J120 021B
J130 0223
J140 022C
J150 022F
J160 0237
J170 0240
AIMM 0243
CPIE 025B
ACII 025E
SUII 026A
SBII 0276
ANII 0282
ORII 028C
XRII 0296
C010 02A0
C020 02B6
C030 02CC
CPOI 02D9
CPEI 02E5
CMI 02F1
TCPI 02FD
CNCI 0309
CCI 0315
CNZI 0321
CZI 032D
MOVI 0336
CPUER 06A2
CPUOK 06B4
TEMPP 06BD
TEMP0 06BF
TEMP1 06C0
TEMP2 06C1
TEMP3 06C2
TEMP4 06C3
SAVSTK 06C4
STACK 07BD
START LDA $10 ; address 10 to A
LDX $11 ; address 11 to x
STA $11 ; A to address 11
STX $10 ; X to address 10
BRK ; stop the program
:08000000A510A6118511861060
:00000001FF
0000 A5 10 START: LDA $10
0002 A6 11 LDX $11 ; address 11 to x
0004 85 11 STA $11 ; A to address 11
0006 86 10 STX $10 ; X to address 10
0008 ;BRK ; stop the program
_PC 0008
START 0000
cpu C6502
memory.ram.from 0x0000
memory.ram.to 0x0fff
memory.rom.from 0xf000
memory.rom.to 0xffff
;serial simple
;serial.in 1
;serial.out 1
;serial.status 0
;serial.status.available 0x20
;serial.status.ready 0x02
serial 6850
serial.data 0xa001
serial.control 0xa000
serial.map 1
;terminal.caps 1
cpu Z80
serial simple
serial.in 1
serial.out 1
serial.status 0
serial.status.available 0x20
serial.status.ready 0x02
terminal.caps 1
memory.ram.from 0x1000
memory.ram.to 0x13ff
memory.rom.from 0x0000
memory.rom.to 0x0fff
;- Ref.: 8080-8085_assembly_language_programming__1977__intel__pdf_.pdf,
; page 180.
madd:
lxi b, madd_02
lxi h, madd_03
xra a
madd_00:
ldax b
adc m
stax b
dcr e
jz madd_01
inx b
inx h
jmp madd_00
madd_01:
madd_02:
db 90H
db 0BAH
db 84H
madd_03:
db 8AH
db 0AFH
db 32H
:10000000011300211600AF0A8E021DCA130003233C
:09001000C3070090BA848AAF32E4
:00000001FF
0000 - Ref.: 8080-8085_assembly_language_programming__1977__intel__pdf_.pdf,
0000 page 180.
0000 MADD:
0000 01 13 00 LXI b,madd_02
0003 21 16 00 LXI h,madd_03
0006 AF XRA a
0007 MADD_00:
0007 0A LDAX b
0008 8E ADC m
0009 02 STAX b
000A 1D DCR e
000B CA 13 00 JZ madd_01
000E 03 INX b
000F 23 INX h
0010 C3 07 00 JMP madd_00
0013 MADD_01:
0013 MADD_02:
0013 90 DB 90H
0014 BA DB 0BAH
0015 84 DB 84H
0016 MADD_03:
0016 8A DB 8AH
0017 AF DB 0AFH
0018 32 DB 32H
0019
;
;(C) 1983,1984,1999,2000 Matthew Smith - all rights reserved
;
;Disassembly of Manic Miner, done by John Elliott with the Dazzlestar
;disassembler under CP/M.
;
;Note: I have deleted most of the data structures (from the title screen onward)
; as the format of these areas is documented elsewhere.
;
; Compared to my JSW disassembly, this is very thinly commented indeed; I've
; only looked at bits which relate to the patch I did or which appear in
; the embedded source code.
;
SCREEN EQU 4000h
ATTR EQU 5800h
WK_ATTR EQU 5C00h ;5C00h: Working attribute buffer. At 5C00h in JSW
BK_ATTR EQU 5E00h ;5E00h: Background attribute buffer. At 5E00h in JSW
T6000 EQU 6000h
T7000 EQU 7000h
T5E00 EQU 5E00h ;disasm err
SP_SWFS EQU 0B2E0h ;Room 0 vguard: SwordFish
SP_PEDE EQU 0B6E0h ;Room 1 vguard: Pedestal
SP_FOOT EQU 0BAE0h ;Room 2 vguard: Foot
ORG 8000h
.engine zxs
;
; Blank spaces in Manic Miner tend to fill up with source code. I have
; rendered these as DS directives and put the source code in comments. This
; means the code won't assemble to the same result, but it's much more
; readable.
;
; This is the source for data at T846E.
;
; [17-4-2004] Commented this section and gave it labels, based on Andrew
; Broad's room format
; <http://www.geocities.com/andrewbroad/spectrum/willy/mm_format.html>
;
ROOM_NAME: DEFS 20h ;8000: Room name
; ... 50,171,192,50,48,68
; DB 50,48,58,50,171,192,50,136,137
ELEM_AIR: DEFS 9 ;8020: Air
ELEM_WATER: DEFS 9 ;8029: Water
ELEM_CRUMBLY: DEFS 9 ;8032: Crumbling floor
ELEM_EARTH: DEFS 9 ;803B: Earth
; DB 50,136,137,50,114,115,50,76,77
ELEM_CONVEY: DEFS 9 ;8044: Conveyor
ELEM_FIRE1: DEFS 9 ;804D: Fire (1)
ELEM_FIRE2: DEFS 9 ;8056: Fire (2)
ELEM_SWITCH DEFS 9 ;805F: Switch
WILLY_Y: DEFB 0 ;8068: Willy vertical position, pixels
WILLY_FRAME: DEFB 0 ;8069: Willy's current frame
WILLY_DIR: DEFB 0 ;806A: Which way does Willy face?
AIRBORNE: DEFB 0 ;806B: Willy jumping?
WILLY_POS: DEFW 0 ;806C: Willy position in attribute file
JUMP_DIST: DEFB 0 ;806E: Jump distance
CONVEY_DIR: DEFB 0 ;806F: Conveyor direction
CONVEY_POS: DEFW 0 ;8070: Conveyor animation position
CONVEY_LEN: DEFB 0 ;8072: Conveyor length
BORDER: DEFB 0 ;8073: Border
PORTAL_CLOSED: DEFB 0 ;8074: Attribute of last item drawn
ITEMS: DEFS 25 ;8075: Up to five items to collect
; 92,50,38,484
; DB 50,38,4
DEFB 0FFh ;808E: End of item table
PORTAL_ATTR: DEFB 0 ;808F: Portal attribute
PORTAL_IMAGE: DEFS 32 ;8090: Portal image
; 50,171,192,50,48,68'
; DB 50,48,
PORTAL_XY: DEFW 0,0 ;80B0: Portal position
ITEM_GRAPHIC: DEFW 2C30h ;80B4: Item image
DEFW 3731h
DEFW 2C31h
DEFW 3931h
AIR_MAJOR: DEFB 0 ;80BC: Air supply + 32
AIR_MINOR: DEFB 0 ;80BD: Air pixel adjustment
HGUARDS: DEFS 28 ;80BE: Horizontal guardians
; 50,136,137
DEFB 0FFh ; DB 50,136,137,
B80DB: DEFB 0 ;80DB: Used when moving Eugene and Kong
EUGHGT: DEFB 0 ;80DC: Height of Eugene
VGUARDS: DEFS 20 ;80DD: Vertical guardians
; 114,115,50,76,77
; B 50,76,77,50,171,203,50,38,51
DEFB 0FFh ; DB 50,38,51,50,171,203,50,51,64
;
; 'special' graphic and guardian graphics
;
DEFS 270 ; DB 50,51,64,50,171,203,50,128,129
; DB 50,128,129,50,102,103,50,86,87
; DB 50,64,65,50,128,171,50,32,43
; DB 50,32,43,50,128,171,50,43,51
; DB 50,43,51,50,128,171,50,128,129
; DB 50,128,129,50,102
MANDAT: DEFB 6,0,3Eh,0,7Ch,0,34h,0,3Eh,0,3Ch,0,18h,0,3Ch,0,7Eh,0,7Eh
DEFB 0,0F7h,0,0FBh,0,3Ch,0,76h,0,6Eh,0,77h,0,1,80h,0Fh,80h,1Fh
DEFB 0,0Dh,0,0Fh,80h,0Fh,0,6,0,0Fh,0,1Bh,80h,1Bh,80h,1Bh,80h
DEFB 1Dh,80h,0Fh,0,6,0,6,0,7,0
DEFB 0,60h,3,0E0h,7,0C0h,3,40h,3,0E0h,3,0C0h,1,80h,3,0C0h,7
DEFB 0E0h,7,0E0h,0Fh,70h,0Fh,0B0h,3,0C0h,7,60h,6,0E0h,7,70h
DEFB 0,18h,0,0F8h,1,0F0h,0,0D0h,0,0F8h,0,0F0h,0,60h,0,0F0h,1
DEFB 0F8h,3,0FCh,7,0FEh,6,0F6h,0,0F8h,1,0DAh,3,0Eh,3,84h,18h
DEFB 0,1Fh,0,0Fh,80h,0Bh,0,1Fh,0,0Fh,0,6,0,0Fh,0,1Fh,80h,3Fh
DEFB 0C0h,7Fh,0E0h,6Fh,60h,1Fh,0,5Bh,80h,70h,0C0h,21h,0C0h,6
DEFB 0,7,0C0h,3,0E0h,2,0C0h,7,0C0h,3,0C0h,1,80h,3,0C0h,7,0E0h
DEFB 7,0E0h,0Eh,0F0h,0Dh,0F0h,3,0C0h,6,0E0h,7,60h,0Eh,0E0h,1
DEFB 80h,1,0F0h,0,0F8h,0,0B0h,1,0F0h,0,0F0h,0,60h,0,0F0h,1,0F8h
DEFB 1,0D8h,1,0D8h,1,0B8h,0,0F0h,0,60h,0,60h,0,0E0h,0,60h,0
DEFB 7Ch,0,3Eh,0,2Ch,0,7Ch,0,3Ch,0,18h,0,3Ch,0,7Eh,0,7Eh,0,0EFh
DEFB 0,0DFh,0,3Ch,0,6Eh,0,76h,0,0EEh
;
; X,Y lookup table
;
DEFW T6000 ,T6000+100h,T6000+200h,T6000+300h
DEFW T6000+400h,T6000+500h,T6000+600h,T6000+700h
DEFW T6000+ 20h,T6000+120h,T6000+220h,T6000+320h
DEFW T6000+420h,T6000+520h,T6000+620h,T6000+720h
DEFW T6000+ 40h,T6000+140h,T6000+240h,T6000+340h
DEFW T6000+440h,T6000+540h,T6000+640h,T6000+740h
DEFW T6000+ 60h,T6000+160h,T6000+260h,T6000+360h
DEFW T6000+460h,T6000+560h,T6000+660h,T6000+760h
DEFW T6000+ 80h,T6000+180h,T6000+280h,T6000+380h
DEFW T6000+480h,T6000+580h,T6000+680h,T6000+780h
DEFW T6000+0A0h,T6000+1A0h,T6000+2A0h,T6000+3A0h
DEFW T6000+4A0h,T6000+5A0h,T6000+6A0h,T6000+7A0h
DEFW T6000+0C0h,T6000+1C0h,T6000+2C0h,T6000+3C0h
DEFW T6000+4C0h,T6000+5C0h,T6000+6C0h,T6000+7C0h
DEFW T6000+0E0h,T6000+1E0h,T6000+2E0h,T6000+3E0h
DEFW T6000+4E0h,T6000+5E0h,T6000+6E0h,T6000+7E0h
;
; Main entry point
;
DI
LD SP,MEMTOP
JP START
SHEET: DEFB 0
T8408: DEFB 0,1,0,1,1,3,1,3,2,0,2,0,0,1,2,3
S_AIR: DEFB 'AIR'
DEFB '0000'
HGHSCOR: DEFB '000000'
DEFB '0000'
SCORBUF: DEFB '000000'
SCORES: DEFB 'High Score 000000'
DEFB ' Score 000000'
MESSG: DEFB 'Game'
MESSO: DEFB 'Over'
NOMEN: DEFB 0 ;No. of lives
B8458: DEFB 0
KEMP: DEFB 0 ;Kempston joystick flag
DEMO: DEFB 0 ;Demo mode?
B845B: DEFB 0
T845C: DEFB 0
CHEAT: DEFB 0 ;Cheat mode?
DEFW 01F1Fh ;---------- ;Cheat string
CHEATDT:
DEFW 0F1Fh ;----6-----
DEFW 1E1Fh ;0---------
DEFW 1F1Bh ;-------3--
DEFW 1F1Eh ;---------1
DEFW 171Fh ;---7------
DEFW 0F1Fh ;----6-----
DEFW 1D1Fh ;-9--------
T846E: DEFB 50h,80h,81h,50h,66h,67h,50h,56h,57h,32h,56h,57h,32h,0ABh
DEFB 0CBh,32h,2Bh,33h,32h,2Bh,33h,32h,0ABh,0CBh,32h,33h,40h
DEFB 32h,33h,40h,32h,0ABh,0CBh,32h,80h,81h,32h,80h,81h,32h,66h
DEFB 67h,32h,56h,57h,32h,60h,56h,32h,0ABh,0C0h,32h,2Bh,30h,32h
DEFB 2Bh,30h
;
; Source for this bit is at 08000h
;
DEFB 32h,0ABh,0C0h,32h,30h,44h,32h,30h,44h,32h,0ABh
DEFB 0C0h,32h,88h,89h,32h,88h,89h,32h,72h,73h,32h,4Ch,4Dh,32h
DEFB 4Ch,4Dh,32h,0ABh,0C0h,32h,26h,30h,32h,26h,30h,32h,0ABh
DEFB 0C0h,32h,30h,44h,32h,30h,44h,32h,0ABh,0C0h,32h,88h,89h
DEFB 32h,88h,89h,32h,72h,73h,32h,4Ch,4Dh,32h,4Ch,4Dh,32h,0ABh
DEFB 0CBh,32h,26h,33h,32h,26h,33h,32h,0ABh,0CBh,32h,33h,40h
DEFB 32h,33h,40h,32h,0ABh,0CBh,32h,80h,81h,32h,80h,81h,32h,66h
DEFB 67h,32h,56h,57h,32h,40h,41h,32h,80h,0ABh,32h,20h,2Bh,32h
DEFB 20h,2Bh,32h,80h,0ABh,32h,2Bh,33h,32h,2Bh,33h,32h,80h,0ABh
DEFB 32h,80h,81h,32h,80h,81h,32h,66h,67h,32h,56h,57h,32h,40h
DEFB 41h,32h,80h,98h,32h,20h,26h,32h,20h,26h,32h,80h,98h,32h
DEFB 26h,30h,32h,26h,30h,32h,0,0,32h,72h,73h,32h,72h,73h,32h
DEFB 60h,61h,32h,4Ch,4Dh,32h,4Ch,99h,32h,4Ch,4Dh,32h,4Ch,4Dh
DEFB 32h,4Ch,99h,32h,5Bh,5Ch,32h,56h,57h,32h,33h,0CDh,32h,33h
DEFB 34h,32h,33h,34h,32h,33h,0CDh,32h,40h,41h,32h,66h,67h,64h
DEFB 66h,67h,32h,72h,73h,64h,4Ch,4Dh,32h,56h,57h,32h,80h,0CBh
DEFB 19h,80h,0,19h,80h,81h,32h,80h,0CBh,0FFh
T858C:
DEFB 80h,72h,66h,60h,56h,66h,56h,56h,51h,60h,51h,51h,56h,66h
DEFB 56h,56h,80h,72h,66h,60h,56h,66h,56h,56h,51h,60h,51h,51h
DEFB 56h,56h,56h,56h,80h,72h,66h,60h,56h,66h,56h,56h,51h,60h
DEFB 51h,51h,56h,66h,56h,56h,80h,72h,66h,60h,56h,66h,56h,40h
DEFB 56h,66h,80h,66h,56h,56h,56h,56h
;
; Game restart point
;
START: XOR A
LD (SHEET),A
LD (KEMP),A
LD (DEMO),A
LD (B845B),A
LD (B8458),A
LD A,2 ;Initial lives count
LD (NOMEN),A
LD HL,T845C
SET 0,(HL)
LD HL,SCREEN
LD DE,SCREEN+1
LD BC,17FFh ;Clear screen image
LD (HL),0
LDIR
LD HL,0A000h ;Title screen bitmap
LD DE,SCREEN
LD BC,4096
LDIR
LD HL,SCREEN + 800h + 1*32 + 29
LD DE,MANDAT+64
LD C,0
CALL DRWFIX
LD HL,0FC00h ;Attributes for the last room
LD DE,ATTR ;(top third)
LD BC,256
LDIR
LD HL,09E00h ;Attributes for title screen
LD BC,512 ;(bottom two-thirds)
LDIR
LD BC,31
DI
XOR A
R8621:
IN E,(C)
OR E
DJNZ R8621 ;$-03
AND 20h
JR NZ,R862F ;$+07
LD A,1
LD (KEMP),A
R862F:
LD IY,T846E
CALL C92DC
JP NZ,L8684
XOR A
LD (EUGHGT),A
R863D:
LD A,(EUGHGT)
LD IX,TITLEMSG
DEFB 0DDh
LD L,A ;LD XL,A
LD DE,SCREEN+4096+3*32
LD C,20h
CALL PMESS
LD A,(EUGHGT)
AND 6
RRCA
RRCA
RRCA
LD E,A
LD D,82h
LD HL,SCREEN + 100h + 1*32 + 29
LD C,0
CALL DRWFIX
LD BC,100
R8664:
DJNZ R8664 ;$-00
DEC C
JR NZ,R8664 ;$-03
LD BC,0BFFEh
IN A,(C)
AND 1
CP 1
JR NZ,L8684 ;$+12
LD A,(EUGHGT)
INC A
CP 0E0h
LD (EUGHGT),A
JR NZ,R863D ;$-40
LD A,40h
LD (DEMO),A
L8684:
LD HL,SCORBUF-4
LD DE,SCORBUF-3
LD BC,9
LD (HL),30h
LDIR
NEWSHT: LD A,(SHEET)
SLA A ;*512
SLA A ;*1k
ADD A,0B0h ;+B000
LD H,A
LD L,0 ;Copy the first half-k to BK_ATTR,
LD DE,BK_ATTR
LD BC,512
LDIR ;and the second to ROOM_NAME.
LD DE,ROOM_NAME
LD BC,512
LDIR
CALL C8A75
LD HL,SCREEN+4096
LD DE,SCREEN+4097
LD BC,2047
LD (HL),0
LDIR
LD IX,ROOM_NAME
LD C,20h
LD DE,SCREEN+4096
CALL PMESS
LD IX,S_AIR
LD C,3
LD DE,SCREEN+4096+1*32
CALL PMESS
LD A,52h
R86D7:
LD H,A
LD D,A
LD L,24h
LD E,25h
LD B,A
LD A,(AIR_MAJOR)
SUB 24h
LD C,A
LD A,B
LD B,0
LD (HL),0FFh
LDIR
INC A
CP 56h
JR NZ,R86D7 ;$-17
LD IX,SCORES
LD DE,SCREEN+4096+3*32
LD C,20h
CALL PMESS
LD A,(BORDER) ;Border
LD C,0FEh
OUT (C),A
LD A,(DEMO)
OR A
JR Z,LOOP ;$+07
LD A,40h
LD (DEMO),A
;
;Main game loop
;
LOOP: LD A,(NOMEN)
LD HL,SCREEN + 4096 + 5*32
OR A
JR Z,R8730 ;$+1B
LD B,A
R8718: LD C,0
PUSH HL
PUSH BC
LD A,(B845B)
RLCA
RLCA
RLCA
AND 60h
LD E,A
LD D,82h
CALL DRWFIX
POP BC
POP HL
INC HL
INC HL
DJNZ R8718 ;$-16
R8730: LD A,(CHEAT)
CP 7
JR NZ,R873F ;$+0A
LD DE,SP_FOOT
LD C,0
CALL DRWFIX
R873F:
LD HL,BK_ATTR
LD DE,WK_ATTR
LD BC,512
LDIR
LD HL,T7000
LD DE,T6000
LD BC,4096
LDIR
CALL C8D0F
LD A,(DEMO)
OR A
CALL Z,C8ABB
LD A,(DEMO)
OR A
CALL Z,C923A
CALL C8DAA ;In JSW this is at 89ECh.
CALL C9105
CALL PAINT_ITEMS
;
; Special-case code
;
LD A,(SHEET)
CP 4 ;Eugene's Lair
CALL Z,EUGENE
LD A,(SHEET)
CP 0Dh ;Skylab Landing Bay
JP Z,SKYLAB
LD A,(SHEET)
CP 8 ;Wacky Amoebatrons and more: Vertical guardians
CALL NC,VGUARD
LD A,(SHEET)
CP 7 ;Kong Beast
CALL Z,KONG
LD A,(SHEET)
CP 0Bh ;Kong Beast
CALL Z,KONG
LD A,(SHEET)
CP 12h ;Solar Power Generator
CALL Z,SOLAR
L879F:
CALL CHK_PORTAL
L87A2:
LD HL,T6000
LD DE,SCREEN
LD BC,4096
LDIR
LD A,(B8458)
OR A
JR Z,R87C8 ;$+17
DEC A
LD (B8458),A
RLCA
RLCA
RLCA
AND 38h
LD HL,WK_ATTR
LD DE,WK_ATTR+1
LD BC,511
LD (HL),A
LDIR
R87C8:
LD HL,WK_ATTR
LD DE,ATTR
LD BC,512
LDIR
LD IX,SCORBUF
LD DE,SCREEN + 4096 + 5*32 + 26 ;AT 21,26
LD C,6
CALL PMESS
LD IX,HGHSCOR
LD DE,SCREEN + 4096 + 3*32 + 11
LD C,6
CALL PMESS
CALL AIR_DOWN ;Normal decrease of air.
JP Z,MANDEAD
LD BC,0FEFEh
IN A,(C)
LD E,A
LD B,7Fh
IN A,(C)
OR E
AND 1
JP Z,START
LD B,0FDh ;Check the A-G row for Pause.
IN A,(C)
AND 1Fh
CP 1Fh
JR Z,R8815 ;$+0C
R880B:
LD B,2 ;In a pause. Wait for a keypress in any
IN A,(C) ;other row than A-G.
AND 1Fh
CP 1Fh
JR Z,R880B ;$-08
R8815:
LD A,(AIRBORNE)
CP 0FFh
JP Z,MANDEAD
LD B,0BFh
LD HL,T845C
IN A,(C)
AND 1Fh
CP 1Fh
JR Z,R8834 ;$+0C
BIT 0,(HL)
JR NZ,R8836 ;$+0A
LD A,(HL)
XOR 3
LD (HL),A
JR R8836 ;$+04
R8834:
RES 0,(HL)
R8836:
BIT 1,(HL)
JR NZ,NONOTE4 ;$+27
LD A,(B845B)
INC A
LD (B845B),A
AND 7Eh
RRCA
LD E,A
LD D,0
LD HL,T858C
ADD HL,DE
LD A,(BORDER) ;Border
LD E,(HL)
LD BC,3
TM51: OUT (0FEh),A
;
;Source for this bit is present at X934C
;
X8854: DEC E
JR NZ,NOFLP6
LD E,(HL)
XOR 18h
NOFLP6: DJNZ TM51 ;$-08
DEC C
JR NZ,TM51 ;$-0B
NONOTE4:
LD A,(DEMO)
OR A
JR Z,NODEM1 ;$+21
DEC A
JP Z,MANDEAD
LD (DEMO),A
LD BC,0FEh ;Check for any keypress
IN A,(C)
AND 1Fh
CP 1Fh ;and if there is one, return to the opening
JP NZ,START ;screen.
LD A,(KEMP)
OR A
JR Z,NODEM1 ;$+08
IN A,(1Fh)
OR A
JP NZ,START
NODEM1: LD BC,0EFFEh ;Keys 6-9
IN A,(C)
BIT 4,A ;Check for "6"
JP NZ,CKCHEAT
LD A,(CHEAT) ;and if it's pressed, check for cheat mode
CP 7
JP NZ,CKCHEAT
LD B,0F7h ;And if it's on, get the room from keys
IN A,(C) ;1-5
CPL
AND 1Fh
CP 14h ;If it's >20, cancel
JP NC,CKCHEAT
LD (SHEET),A ;Else jump to new room
JP NEWSHT
CKCHEAT:
LD A,(CHEAT) ;If in cheat mode, don't check
CP 7
JP Z,LOOP
RLCA
LD E,A
LD D,0
LD IX,CHEATDT
ADD IX,DE
LD BC,0F7FEh ;Test keys 1-5
IN A,(C)
AND 1Fh
CP (IX+0) ;Next character in sequence?
JR Z,CKNXCHT
CP 1Fh ;No character?
JP Z,LOOP
CP (IX+-2) ;Current character in sequence?
JP Z,LOOP
XOR A ;Incorrect character
LD (CHEAT),A
JP LOOP
CKNXCHT: ;Test keys 6-9
LD B,0EFh
IN A,(C)
AND 1Fh
CP (IX+1) ;Next character
JR Z,INCCHT
CP 1Fh ;No character
JP Z,LOOP
CP (IX+-1) ;Current character
JP Z,LOOP
XOR A ;Incorrect character
LD (CHEAT),A
JP LOOP
INCCHT: LD A,(CHEAT) ;Move to next character in the code
INC A
LD (CHEAT),A
JP LOOP
;
MANDEAD:
LD A,(DEMO)
OR A
JP NZ,NXSHEET
LD A,47h
LPDEAD1:
LD HL,ATTR
LD DE,ATTR+1
LD BC,511 ;Attributes to white on black
LD (HL),A
LDIR
LD E,A
CPL
AND 7
RLCA
RLCA
RLCA
OR 7
LD D,A
LD C,E
RRC C
RRC C
RRC C
OR 10h
XOR A
TM21: OUT (0FEh),A
XOR 18h
LD B,D
TM22: DJNZ TM22
DEC C
JR NZ,TM21
LD A,E
DEC A
CP 3Fh
JR NZ,LPDEAD1
LD HL,NOMEN
LD A,(HL)
OR A
JP Z,ENDGAM
DEC (HL)
JP NEWSHT
ENDGAM: LD HL,HGHSCOR ;Compare high score
LD DE,SCORBUF ;with current score
LD B,6
LPHGH: LD A,(DE)
CP (HL)
JP C,FEET ;Current score is less
JP NZ,NEWHGH ;Current score is more
INC HL
INC DE
DJNZ LPHGH
NEWHGH: LD HL,SCORBUF ;Set high score to current
LD DE,HGHSCOR
LD BC,6
LDIR
FEET: LD HL,SCREEN ;Foot animation
LD DE,SCREEN+1
LD BC,4095
LD (HL),0
LDIR
XOR A ;Eugene's height
LD (EUGHGT),A
LD DE,MANDAT+64
LD HL,SCREEN+800h+4*32+15
LD C,0
CALL DRWFIX ;Draw Willy
LD DE,SP_PEDE
LD HL,SCREEN+800h+6*32+15
LD C,0
CALL DRWFIX ;Draw pedestal
LOOPFT: LD A,(EUGHGT)
LD C,A
LD B,83h
LD A,(BC) ;Calc foot position
OR 0Fh
LD L,A
INC BC
LD A,(BC)
SUB 20h
LD H,A
LD DE,SP_FOOT
LD C,0
CALL DRWFIX ;Draw foot
LD A,(EUGHGT)
CPL
LD E,A
XOR A
LD BC,64
TM111: OUT (0FEh),A
XOR 18h
LD B,E
TM112: DJNZ TM111 ;$-00
DEC C
JR NZ,TM112 ;$-08
LD HL,ATTR
LD DE,ATTR+1
LD BC,511
LD A,(EUGHGT)
AND 0Ch ;Flicker colours
RLCA
OR 47h
LD (HL),A
LDIR
LD A,(EUGHGT)
ADD A,4
LD (EUGHGT),A
CP 0C4h
JR NZ,LOOPFT ;$-48
LD IX,MESSG
LD C,4
LD DE,SCREEN + 6*32 + 10
CALL PMESS
LD IX,MESSO
LD C,4
LD DE,SCREEN + 6*32 + 18
CALL PMESS
LD BC,0
LD D,6
TM91: DJNZ TM91
LD A,C ;Make the "game over" message flicker
AND 7
OR 40h
LD (ATTR + 6*32 + 10),A
INC A
AND 7
OR 40h
LD (ATTR + 6*32 + 11),A
INC A
AND 7
OR 40h
LD (ATTR + 6*32 + 12),A
INC A
AND 7
OR 40h
LD (ATTR + 6*32 + 13),A
INC A
AND 7
OR 40h
LD (ATTR + 6 * 32 + 18),A
INC A
AND 7
OR 40h
LD (ATTR + 6 * 32 + 19),A
INC A
AND 7
OR 40h
LD (ATTR + 6 * 32 + 20),A
INC A
AND 7
OR 40h
LD (ATTR + 6 * 32 + 21),A
DEC C
JR NZ,TM91
DEC D
JR NZ,TM91
JP START
AIR_DOWN:
LD A,(AIR_MINOR)
SUB 4
LD (AIR_MINOR),A
CP 0FCh
JR NZ,R8A55 ;$+0F
LD A,(AIR_MAJOR)
CP 24h
RET Z
DEC A
LD (AIR_MAJOR),A
LD A,(AIR_MINOR)
R8A55:
AND 0E0h
RLCA
RLCA
RLCA
LD E,0
OR A
JR Z,R8A66 ;$+09
LD B,A
R8A60:
RRC E
SET 7,E
DJNZ R8A60 ;$-04
R8A66:
LD A,(AIR_MAJOR)
LD L,A
LD H,52h
LD B,4
R8A6E:
LD (HL),E
INC H
DJNZ R8A6E ;$-02
XOR A
INC A
RET
C8A75:
LD IX,BK_ATTR
LD A,70h
LD (L8A9B+1),A
CALL C8A8A
LD IX,T5E00 + 100h
LD A,78h
LD (L8A9B+1),A
C8A8A: LD C,0
L8A8C: LD E,C
LD A,(IX+0)
LD HL,ELEM_AIR
LD BC,72
CPIR
LD C,E
LD B,8
L8A9B: LD D,0
R8A9D: LD A,(HL)
LD (DE),A
INC HL
INC D
DJNZ R8A9D ;$-04
INC IX
INC C
JP NZ,L8A8C
LD A,(SHEET)
CP 13h
RET NZ
LD HL,0A000h ;Title page
LD DE,T7000
LD BC,2048
LDIR
RET
C8ABB:
LD A,(AIRBORNE)
CP 1
JR NZ,NOT_JUMPING ;$+50
LD A,(JUMP_DIST)
RES 0,A
SUB 8
LD HL,WILLY_Y
ADD A,(HL)
LD (HL),A
CALL C8B82
LD A,(ELEM_EARTH)
CP (HL)
JP Z,L8BA2
INC HL
CP (HL)
JP Z,L8BA2
LD A,(JUMP_DIST)
INC A
LD (JUMP_DIST),A
SUB 8
JP P,L8AEB
NEG
L8AEB:
INC A
RLCA
RLCA
RLCA
LD D,A
LD C,20h
LD A,(BORDER) ;Border
R8AF5:
OUT (0FEh),A
XOR 18h
LD B,D
R8AFA:
DJNZ R8AFA ;$-00
DEC C
JR NZ,R8AF5 ;$-08
LD A,(JUMP_DIST)
CP 12h
JP Z,L8B96
CP 10h
JR Z,NOT_JUMPING ;$+07
CP 0Dh
JP NZ,L8C83
NOT_JUMPING: ;This corresponds to JSW at 0E36h or so.
LD A,(WILLY_Y)
AND 0Fh
JR NZ,FALL_INTO ;$+3C
LD HL,(WILLY_POS)
LD DE,64
ADD HL,DE
LD A,(ELEM_CRUMBLY)
CP (HL)
CALL Z,CRUMBLE
LD A,(ELEM_FIRE1)
CP (HL)
JR Z,FALL_INTO ;$+28
LD A,(ELEM_FIRE2)
CP (HL)
JR Z,FALL_INTO ;$+22
INC HL
LD A,(ELEM_CRUMBLY)
CP (HL)
CALL Z,CRUMBLE
LD A,(ELEM_FIRE1)
CP (HL)
JR Z,FALL_INTO ;$+14
LD A,(ELEM_FIRE2)
CP (HL)
JR Z,FALL_INTO ;$+0E
LD A,(ELEM_AIR)
CP (HL)
DEC HL
JP NZ,L8BDD
CP (HL)
JP NZ,L8BDD
FALL_INTO:
LD A,(AIRBORNE)
CP 1
JP Z,L8C83
LD HL,WILLY_DIR
RES 1,(HL)
OR A
JP Z,L8B9C
INC A
LD (AIRBORNE),A
RLCA
RLCA
RLCA
RLCA
LD D,A
LD C,20h
LD A,(BORDER) ;Border
R8B70:
OUT (0FEh),A
XOR 18h
LD B,D
R8B75:
DJNZ R8B75 ;$-00
DEC C
JR NZ,R8B70 ;$-08
LD A,(WILLY_Y)
ADD A,8
LD (WILLY_Y),A
C8B82:
AND 0F0h
LD L,A
XOR A
RL L
ADC A,5Ch
LD H,A
LD A,(WILLY_POS)
AND 1Fh
OR L
LD L,A
LD (WILLY_POS),HL
RET
L8B96:
LD A,6
LD (AIRBORNE),A
RET
L8B9C:
LD A,2
LD (AIRBORNE),A
RET
L8BA2:
LD A,(WILLY_Y)
ADD A,10h
AND 0F0h
LD (WILLY_Y),A
CALL C8B82
LD A,2
LD (AIRBORNE),A
LD HL,WILLY_DIR
RES 1,(HL)
RET
CRUMBLE:
LD C,L ;eg: in Central Cavern, HL = 5D97
LD A,H ;then BC becomes 7F97.
ADD A,1Bh
OR 7
LD B,A ;BC = address of graphic for this cell.
R8BC1:
DEC B ;Move graphic down 1 row.
LD A,(BC)
INC B
LD (BC),A
DEC B
LD A,B
AND 7
JR NZ,R8BC1 ;$-08
XOR A
LD (BC),A
LD A,B
ADD A,7
LD B,A
LD A,(BC) ;Introduce a blank line at the top.
OR A
RET NZ
LD A,(ELEM_AIR)
INC H
INC H
LD (HL),A
DEC H
DEC H
RET
L8BDD:
LD A,(AIRBORNE)
CP 0Ch
JP NC,L8D06
LD E,0FFh
XOR A
LD (AIRBORNE),A
LD A,(ELEM_CONVEY)
CP (HL)
JR Z,R8BF5 ;$+06
INC HL
CP (HL)
JR NZ,R8BFB ;$+08
R8BF5:
LD A,(CONVEY_DIR)
SUB 3
LD E,A
R8BFB:
LD BC,0DFFEh
IN A,(C)
AND 1Fh
OR 20h
AND E
LD E,A
LD BC,0FBFEh
IN A,(C)
AND 1Fh
RLC A
OR 1
AND E
LD E,A
LD B,0F7h
IN A,(C)
RRCA
OR 0F7h
AND E
LD E,A
LD B,0EFh
IN A,(C)
OR 0FBh
AND E
LD E,A
LD A,(KEMP)
OR A
JR Z,R8C34 ;$+0C
LD BC,1Fh
IN A,(C)
AND 3
CPL
AND E
LD E,A
R8C34:
LD C,0
LD A,E
AND 2Ah
CP 2Ah
JR Z,R8C3F ;$+04
LD C,4
R8C3F:
LD A,E
AND 15h
CP 15h
JR Z,R8C48 ;$+04
SET 3,C
R8C48:
LD A,(WILLY_DIR)
ADD A,C
LD C,A
LD B,0
LD HL,T8408
ADD HL,BC
LD A,(HL)
LD (WILLY_DIR),A
LD BC,07EFEh
IN A,(C)
AND 1Fh
CP 1Fh
JR NZ,R8C7B ;$+1B
LD B,0EFh
IN A,(C)
AND 9
CP 9
JR NZ,R8C7B ;$+11
LD A,(KEMP)
OR A
JR Z,L8C83 ;$+13
LD BC,1Fh
IN A,(C)
BIT 4,A
JR Z,L8C83 ;$+0A
R8C7B:
XOR A
LD (JUMP_DIST),A
INC A
LD (AIRBORNE),A
L8C83:
LD A,(WILLY_DIR)
AND 2
RET Z
LD A,(WILLY_DIR)
AND 1
JP Z,L8CCA
LD A,(WILLY_FRAME)
OR A
JR Z,R8C9C ;$+07
DEC A
LD (WILLY_FRAME),A
RET
R8C9C:
LD HL,(WILLY_POS)
DEC HL
LD DE,32
ADD HL,DE
LD A,(ELEM_EARTH)
CP (HL)
RET Z
LD A,(WILLY_Y)
AND 0Fh
JR Z,R8CB9 ;$+0B
LD A,(ELEM_EARTH)
ADD HL,DE
CP (HL)
RET Z
OR A
SBC HL,DE
R8CB9:
LD A,(ELEM_EARTH)
OR A
SBC HL,DE
CP (HL)
RET Z
LD (WILLY_POS),HL
LD A,3
LD (WILLY_FRAME),A
RET
L8CCA:
LD A,(WILLY_FRAME)
CP 3
JR Z,R8CD6 ;$+07
INC A
LD (WILLY_FRAME),A
RET
R8CD6:
LD HL,(WILLY_POS)
INC HL
INC HL
LD DE,32
LD A,(ELEM_EARTH)
ADD HL,DE
CP (HL)
RET Z
LD A,(WILLY_Y)
AND 0Fh
JR Z,R8CF4 ;$+0B
LD A,(ELEM_EARTH)
ADD HL,DE
CP (HL)
RET Z
OR A
SBC HL,DE
R8CF4:
LD A,(ELEM_EARTH)
OR A
SBC HL,DE
CP (HL)
RET Z
DEC HL
LD (WILLY_POS),HL
XOR A
LD (WILLY_FRAME),A
RET
L8D05:
POP HL
L8D06:
POP HL
L8D07:
LD A,0FFh
LD (AIRBORNE),A
JP L87A2
C8D0F:
LD IY,HGUARDS
LD DE,7
R8D16:
LD A,(IY+0)
CP 0FFh
RET Z
OR A
JR Z,R8D6F ;$+52
LD A,(AIR_MINOR)
AND 4
RRCA
RRCA
RRCA
AND (IY+0)
JR NZ,R8D6F ;$+45
LD A,(IY+4)
CP 3
JR Z,R8D43 ;$+12
CP 4
JR Z,R8D5A ;$+25
JR NC,R8D3E ;$+07
INC (IY+4)
JR R8D6F ;$+33
R8D3E:
DEC (IY+4)
JR R8D6F ;$+2E
R8D43:
LD A,(IY+1)
CP (IY+6)
JR NZ,R8D51 ;$+08
LD (IY+4),7
JR R8D6F ;$+20
R8D51:
LD (IY+4),0
INC (IY+1)
JR R8D6F ;$+17
R8D5A:
LD A,(IY+1)
CP (IY+5)
JR NZ,R8D68 ;$+08
LD (IY+4),0
JR R8D6F ;$+09
R8D68:
LD (IY+4),7
DEC (IY+1)
R8D6F:
ADD IY,DE
JR R8D16 ;$-5B
SOLAR: LD HL,WK_ATTR+23
LD DE,32
R8D79:
LD A,(ELEM_WATER)
CP (HL)
RET Z
LD A,(ELEM_EARTH)
CP (HL)
RET Z
LD A,27h
CP (HL)
JR NZ,R8D98 ;$+12
EXX
CALL AIR_DOWN ;Hit by solar beam?
CALL AIR_DOWN
CALL AIR_DOWN
CALL AIR_DOWN
EXX
JR R8DA5 ;$+0F
R8D98:
LD A,(ELEM_AIR)
CP (HL)
JR Z,R8DA5 ;$+09
LD A,E
XOR 0DFh
LD E,A
LD A,D
CPL
LD D,A
R8DA5:
LD (HL),77h
ADD HL,DE
JR R8D79 ;$-2F
C8DAA:
LD IY,HGUARDS
R8DAE:
LD A,(IY+0)
CP 0FFh
RET Z
OR A
JR Z,R8DF1 ;$+3C
LD DE,31
LD L,(IY+1)
LD H,(IY+2)
AND 7Fh
LD (HL),A
INC HL
LD (HL),A
ADD HL,DE
LD (HL),A
INC HL
LD (HL),A
LD C,1
LD A,(IY+4)
RRCA
RRCA
RRCA
LD E,A
LD A,(SHEET)
CP 7
JR C,R8DE3 ;$+0C
CP 9
JR Z,R8DE3 ;$+08
CP 0Fh
JR Z,R8DE3 ;$+04
SET 7,E
R8DE3:
LD D,81h
LD L,(IY+1)
LD H,(IY+3)
CALL DRWFIX
JP NZ,L8D06
R8DF1:
LD DE,7
ADD IY,DE
JR R8DAE ;$-48
EUGENE: LD A,(PORTAL_CLOSED)
OR A
JR Z,R8E0F ;$+13
LD A,(B80DB)
OR A
JR Z,R8E0F ;$+0D
LD A,(EUGHGT)
DEC A
JR Z,R8E1C ;$+14
LD (EUGHGT),A
JR R8E24 ;$+17
R8E0F:
LD A,(EUGHGT)
INC A
CP 58h
JR Z,R8E1C ;$+07
LD (EUGHGT),A
JR R8E24 ;$+0A
R8E1C:
LD A,(B80DB)
XOR 1
LD (B80DB),A
R8E24:
LD A,(EUGHGT)
AND 7Fh
RLCA
LD E,A
LD D,83h
LD A,(DE)
OR 0Fh
LD L,A
INC DE
LD A,(DE)
LD H,A
LD DE,VGUARDS+3 ;Vertical guardian 0's position
LD C,1
CALL DRWFIX
JP NZ,L8D06
LD A,(EUGHGT)
AND 78h
RLCA
OR 7
SCF
RL A
LD L,A
LD A,0
ADC A,5Ch
LD H,A
LD A,(PORTAL_CLOSED)
OR A
LD A,7
JR NZ,R8E5F ;$+09
LD A,(AIR_MINOR)
RRCA
RRCA
AND 7
R8E5F:
C8E5F:
LD (HL),A
LD A,(ELEM_AIR)
AND 0F8h
OR (HL)
LD (HL),A
LD DE,31
INC HL
LD (HL),A
ADD HL,DE
LD (HL),A
INC HL
LD (HL),A
ADD HL,DE
LD (HL),A
INC HL
LD (HL),A
RET
SKYLAB: LD IY,VGUARDS
R8E79:
LD A,(IY+0)
CP 0FFh
JP Z,L879F
LD A,(IY+2)
CP (IY+6)
JR NC,R8E91 ;$+0A
ADD A,(IY+4)
LD (IY+2),A
JR R8EAF ;$+20
R8E91:
INC (IY+1)
LD A,(IY+1)
CP 8
JR NZ,R8EAF ;$+16
LD A,(IY+5)
LD (IY+2),A
LD A,(IY+3)
ADD A,8
AND 1Fh
LD (IY+3),A
LD (IY+1),0
R8EAF:
LD E,(IY+2)
RLC E
LD D,83h
LD A,(DE)
ADD A,(IY+3)
LD L,A
INC DE
LD A,(DE)
LD H,A
LD A,(IY+1)
RRCA
RRCA
RRCA
LD E,A
LD D,81h
LD C,1
CALL DRWFIX
JP NZ,L8D07
LD A,(IY+2)
AND 40h
RLCA
RLCA
ADD A,5Ch
LD H,A
LD A,(IY+2)
RLCA
RLCA
AND 0E0h
OR (IY+3)
LD L,A
LD A,(IY+0)
CALL C8E5F
LD DE,7
ADD IY,DE
JR R8E79 ;$-76
VGUARD: LD IY,VGUARDS
R8EF5: LD A,(IY+0)
CP 0FFh
RET Z
INC (IY+1)
RES 2,(IY+1)
LD A,(IY+2)
ADD A,(IY+4)
CP (IY+5)
JR C,R8F17 ;$+0C
CP (IY+6)
JR NC,R8F17 ;$+07
LD (IY+2),A
JR R8F1F ;$+0A
R8F17:
LD A,(IY+4)
NEG
LD (IY+4),A
R8F1F:
LD A,(IY+2)
AND 7Fh
RLCA
LD E,A
LD D,83h
LD A,(DE)
OR (IY+3)
LD L,A
INC DE
LD A,(DE)
LD H,A
LD A,(IY+1)
RRCA
RRCA
RRCA
LD E,A
LD D,81h
LD C,1
CALL DRWFIX
JP NZ,L8D06
LD A,(IY+2)
AND 40h
RLCA
RLCA
ADD A,5Ch
LD H,A
LD A,(IY+2)
RLCA
RLCA
AND 0E0h
OR (IY+3)
LD L,A
LD A,(IY+0)
CALL C8E5F
LD DE,7
ADD IY,DE
JR R8EF5 ;$-6C
PAINT_ITEMS: ;In JSW this is at 93D1h
XOR A
LD (PORTAL_CLOSED),A
LD IY,ITEMS
R8F6B:
LD A,(IY+0)
CP 0FFh
JR Z,R8FBA ;$+4A
OR A
JR Z,R8FAE ;$+3B
LD E,(IY+1)
LD D,(IY+2)
LD A,(DE)
AND 7
CP 7
JR NZ,R8F8E ;$+0E
LD HL,SCORBUF+3
CALL C90FE
LD (IY+0),0
JR R8FAE ;$+22
R8F8E:
LD A,(IY+0)
AND 0F8h
OR 3
LD B,A
LD A,(IY+0)
AND 3
ADD A,B
LD (IY+0),A
LD (DE),A
LD (PORTAL_CLOSED),A
LD D,(IY+3)
LD HL,ITEM_GRAPHIC
LD B,8
CALL C92D5
R8FAE:
INC IY
INC IY
INC IY
INC IY
INC IY
JR R8F6B ;$-4D
R8FBA:
LD A,(PORTAL_CLOSED)
OR A
RET NZ
LD HL,PORTAL_ATTR
SET 7,(HL)
RET
CHK_PORTAL:
LD HL,(PORTAL_XY)
LD A,(WILLY_POS)
CP L
JR NZ,R8FDF ;$+13
LD A,(WILLY_POS+1)
CP H
JR NZ,R8FDF ;$+0D
LD A,(PORTAL_ATTR)
BIT 7,A
JR Z,R8FDF ;$+06
POP HL
JP NXSHEET
R8FDF: LD A,(PORTAL_ATTR)
LD (HL),A
INC HL
LD (HL),A
LD DE,31
ADD HL,DE
LD (HL),A
INC HL
LD (HL),A
LD DE,PORTAL_IMAGE
LD HL,(PORTAL_XY+2)
LD C,0
DRWFIX: LD B,10h ;Draw a sprite. JSW has this at 9456h.
R8FF6: BIT 0,C
LD A,(DE)
JR Z,R8FFF ;$+06
AND (HL)
RET NZ
LD A,(DE)
OR (HL)
R8FFF:
LD (HL),A
INC L
INC DE
BIT 0,C
LD A,(DE)
JR Z,R900B ;$+06
AND (HL)
RET NZ
LD A,(DE)
OR (HL)
R900B:
LD (HL),A
DEC L
INC H
INC DE
LD A,H
AND 7
JR NZ,R9024 ;$+12
LD A,H
SUB 8
LD H,A
LD A,L
ADD A,20h
LD L,A
AND 0E0h
JR NZ,R9024 ;$+06
LD A,H
ADD A,8
LD H,A
R9024:
DJNZ R8FF6 ;$-2E
XOR A
RET
NXSHEET:
LD A,(SHEET)
INC A
CP 20
JR NZ,R9091
;
; Reached the end!
;
LD A,(DEMO)
OR A
JP NZ,L9090 ;If in demo mode, wrap.
LD A,(CHEAT)
CP 7
JR Z,L9090 ;If in cheat mode, wrap.
LD C,0
LD DE,MANDAT+96 ;Draw Willy at top of screen
LD HL,SCREEN + 2*32 + 19
CALL DRWFIX
LD DE,SP_SWFS ;SwordFish
LD HL,SCREEN+ 5*32 +19
CALL DRWFIX
LD HL,ATTR + 2*32 + 19 ;Set Willy attributes
LD DE,31
LD (HL),2Fh
INC HL
LD (HL),2Fh
ADD HL,DE
LD (HL),27h
INC HL
LD (HL),27h
ADD HL,DE
INC HL
ADD HL,DE
LD (HL),45h
INC HL
LD (HL),45h
ADD HL,DE
LD (HL),46h
INC HL
LD (HL),47h
ADD HL,DE
LD (HL),0
INC HL
LD (HL),0
LD BC,0
LD D,32h
XOR A
R907D:
OUT (0FEh),A
XOR 18h
LD E,A
LD A,C
ADD A,D
ADD A,D
ADD A,D
LD B,A
LD A,E
R9088:
DJNZ R9088 ;$-00
DEC C
JR NZ,R907D ;$-0E
DEC D
JR NZ,R907D ;$-11
L9090:
XOR A
R9091:
LD (SHEET),A
LD A,3Fh
R9096:
LD HL,ATTR
LD DE,ATTR+1
LD BC,511
LD (HL),A
LDIR
LD BC,4
R90A5:
DJNZ R90A5 ;$-00
DEC C
JR NZ,R90A5 ;$-03
DEC A
JR NZ,R9096 ;$-15
LD A,(DEMO)
OR A
JP NZ,NEWSHT
R90B4:
CALL AIR_DOWN ;Drain air and add to the bonus.
JP Z,NEWSHT
LD HL,SCORBUF+5
CALL C90FE
LD IX,SCORBUF
LD C,6
LD DE,SCREEN + 4096 + 3*32 + 26
CALL PMESS
LD C,4
LD A,(AIR_MAJOR)
CPL
AND 3Fh
RLC A
LD D,A
R90D7:
LD A,0
OUT (0FEh),A
LD B,D
R90DC:
DJNZ R90DC ;$-00
LD A,18h
OUT (0FEh),A
LD B,D
R90E3:
DJNZ R90E3 ;$-00
DEC C
JR NZ,R90D7 ;$-0F
JR R90B4 ;$-34
R90EA:
LD (HL),30h
DEC HL
LD A,L
CP 2Ah
JR NZ,C90FE ;$+0E
LD A,8
LD (B8458),A
LD A,(NOMEN)
INC A
LD (NOMEN),A
C90FE:
LD A,(HL)
CP 39h
JR Z,R90EA ;$-17
INC (HL)
RET
C9105:
LD HL,(CONVEY_POS)
LD E,L
LD D,H
LD A,(CONVEY_LEN)
LD B,A
LD A,(CONVEY_DIR)
OR A
JR NZ,R9127 ;$+15
LD A,(HL)
RLC A
RLC A
INC H
INC H
LD C,(HL)
RRC C
RRC C
R9120:
LD (DE),A
LD (HL),C
INC L
INC E
DJNZ R9120 ;$-04
RET
R9127:
LD A,(HL)
RRC A
RRC A
INC H
INC H
LD C,(HL)
RLC C
RLC C
JR R9120 ;$-13
KONG: LD HL,WK_ATTR+6
CALL C921B
LD A,(B80DB)
CP 2
RET Z
LD A,(T7000 + 506h)
CP 10h
JP Z,L91F9
LD A,(T5E00+11*32+17)
OR A
JR Z,R9176 ;$+29
LD HL,T7000 + 0F71h
R9152:
LD A,(HL)
OR A
JR NZ,R916C ;$+18
DEC H
LD A,H
CP 77h
JR NZ,R9152 ;$-08
LD A,(ELEM_AIR)
LD (T5E00+11*32+17),A
LD (T5E00+12*32+17),A
LD A,72h ;Wall has opened. Change guardian's boundary.
LD (HGUARDS+13),A
JR R9176 ;$+0C
R916C:
LD (HL),0
LD L,91h
LD A,H
XOR 7
LD H,A
LD (HL),0
R9176:
LD HL,WK_ATTR+18
CALL C921B
JR NZ,R919D ;$+21
XOR A
LD (EUGHGT),A
INC A
LD (B80DB),A
LD A,(ELEM_AIR)
LD (BK_ATTR+2*32+15),A
LD (BK_ATTR+2*32+16),A
LD HL,T7000 + 2*32 + 15
LD B,8
R9194:
LD (HL),0
INC L
LD (HL),0
DEC L
INC H
DJNZ R9194 ;$-07
R919D:
LD A,(B80DB)
OR A
JR Z,L91F9 ;$+58
LD A,(EUGHGT)
CP 64h
JR Z,R91F3 ;$+4B
ADD A,4
LD (EUGHGT),A
LD C,A
LD D,10h
LD A,(BORDER) ;Border
R91B5:
OUT (0FEh),A
XOR 18h
LD B,C
R91BA:
DJNZ R91BA ;$-00
DEC D
JR NZ,R91B5 ;$-08
LD A,C
RLCA
LD E,A
LD D,83h
LD A,(DE)
OR 0Fh
LD L,A
INC DE
LD A,(DE)
LD H,A
LD D,81h
LD A,(AIR_MINOR)
AND 20h
OR 40h
LD E,A
LD C,0
CALL DRWFIX
LD HL,SCORBUF+3
CALL C90FE
LD A,(EUGHGT)
AND 78h
LD L,A
LD H,17h
ADD HL,HL
ADD HL,HL
LD A,L
OR 0Fh
LD L,A
LD A,6
JP C8E5F
R91F3:
LD A,2
LD (B80DB),A
RET
L91F9: LD A,(AIR_MINOR)
AND 20h
LD E,A
LD D,81h
LD HL,T6000+15
LD C,1
CALL DRWFIX
JP NZ,L8D06
LD A,44h ;Kong colour: Bright green
LD (WK_ATTR+1*32+15),A
LD (WK_ATTR+1*32+16),A
LD (WK_ATTR+15),A
LD (WK_ATTR+16),A
RET
C921B:
LD A,(WILLY_POS)
INC A
AND 0FEh
CP L
RET NZ
LD A,(WILLY_POS+1)
CP H
RET NZ
LD A,(ELEM_SWITCH+6)
LD H,75h
CP (HL)
RET NZ
LD (HL),8
INC H
LD (HL),6
INC H
LD (HL),6
XOR A
OR A
RET
C923A:
LD HL,(WILLY_POS)
LD DE,31
LD C,0Fh
CALL C925F
INC HL
CALL C925F
ADD HL,DE
CALL C925F
INC HL
CALL C925F
LD A,(WILLY_Y)
LD C,A
ADD HL,DE
CALL C925F
INC HL
CALL C925F
JR R927F ;$+22
C925F:
LD A,(ELEM_AIR)
CP (HL)
JR NZ,R9270 ;$+0D
LD A,C
AND 0Fh
JR Z,R9270 ;$+08
LD A,(ELEM_AIR)
OR 7
LD (HL),A
R9270:
LD A,(ELEM_FIRE1)
CP (HL)
JP Z,L8D05
LD A,(ELEM_FIRE2)
CP (HL)
JP Z,L8D05
RET
R927F:
LD A,(WILLY_Y)
DEFB 0DDh
LD H,83h ;LD XH,83h
DEFB 0DDh
LD L,A ;LD XL,A
LD A,(WILLY_DIR)
AND 1
RRCA
LD E,A
LD A,(WILLY_FRAME)
AND 3
RRCA
RRCA
RRCA
OR E
LD E,A
LD D,82h
LD B,10h
LD A,(WILLY_POS)
AND 1Fh
LD C,A
R92A2:
LD A,(IX+0)
LD H,(IX+1)
OR C
LD L,A
LD A,(DE)
OR (HL)
LD (HL),A
INC HL
INC DE
LD A,(DE)
OR (HL)
LD (HL),A
INC IX
INC IX
INC DE
DJNZ R92A2 ;$-15
RET
PMESS: LD A,(IX+0)
CALL C92CB
INC IX
INC E
LD A,D
SUB 8
LD D,A
DEC C
JR NZ,PMESS ;$-0E
RET
C92CB:
LD H,7
LD L,A
SET 7,L
ADD HL,HL
ADD HL,HL
ADD HL,HL
LD B,8
C92D5:
LD A,(HL)
LD (DE),A
INC HL
INC D
DJNZ C92D5 ;$-04
RET
C92DC:
LD A,(IY+0)
CP 0FFh
RET Z
LD C,A
LD B,0
XOR A
LD D,(IY+1)
LD A,D
CALL C932B
LD (HL),50h
LD E,(IY+2)
LD A,E
CALL C932B
LD (HL),28h
R92F8:
OUT (0FEh),A
DEC D
JR NZ,R9302 ;$+07
LD D,(IY+1)
XOR 18h
R9302:
DEC E
JR NZ,R930A ;$+07
LD E,(IY+2)
XOR 18h
R930A:
DJNZ R92F8 ;$-12
DEC C
JR NZ,R92F8 ;$-15
CALL C9337
RET NZ
LD A,(IY+1)
CALL C932B
LD (HL),38h
LD A,(IY+2)
CALL C932B
LD (HL),38h
INC IY
INC IY
INC IY
JR C92DC ;$-4D
C932B:
SUB 8
RRCA
RRCA
RRCA
CPL
OR 0E0h
LD L,A
LD H,59h
RET
C9337:
LD A,(KEMP)
OR A
JR Z,R9342 ;$+07
IN A,(1Fh)
BIT 4,A
RET NZ
R9342:
LD BC,0BFFEh
IN A,(C)
AND 1
CP 1
RET
;
; A great tract of empty space, containing source code for the code from X8854
;on.
;
X934C: DEFS 2482
;
; DEC E
; JR NZ,NOFLP6
; LD E,(HL)
; XOR 24
; NOFLP6 DJNZ TM51
; DEC C
; JR NZ,TM51
; NONOTE4 LD A,(DEMO)
; OR A
; JR Z,NODEM1
; DEC A
; JP Z,MANDEAD
; LD (DEMO),A
; LD BC,0FEh
; IN A,(C)
; AND 31
; CP 31
; JP NZ,START
; LD A,(KEMP)
; OR A
; JR Z,NODEM1
; IN A,(31)
; OR A
; JP NZ,START
; NODEM1 LD BC,0EFFEh
; IN A,(C)
; BIT 4,A
; JP NZ,CKCHEAT
;
; [JCE] Why use JPs here? JRs would do it nicely
;
; LD A,(CHEAT)
; CP 7
; JP NZ,CKCHEAT
; LD B,0F7h
; IN A,(C)
; CPL
; AND 31
; CP 20
; JP NC,CKCHEAT
; LD (SHEET),A
; JP NEWSHT
; CKCHEAT LD A,(CHEAT)
; CP 7
; JP Z,LOOP
; RLCA
; LD E,A
; LD D,0
; LD IX,CHEATDT
; ADD IX,DE
; LD BC,0F7FEh
; IN A,(C)
; AND 31
; CP (IX+0)
; JR Z,CKNXCHT
; CP 31
; JP Z,LOOP
; CP (IX-2)
; JP Z,LOOP
; XOR A
; LD (CHEAT),A
; JP LOOP
; CKNXCHT LD B,0EFh
; IN A,(C)
; AND 31
; CP (IX+1)
; JR Z,INCCHT
; CP 31
; JP Z,LOOP
; CP (IX-1)
; JP Z,LOOP
; XOR A
; LD (CHEAT),A
; JP LOOP
; INCCHT LD A,(CHEAT)
; INC A
; LD (CHEAT),A
; JP LOOP
; MANDEAD LD A,(DEMO)
; OR A
; JP NZ,NXSHEET
; LD A,H
; LPDEAD1 LD HL,5800h
; LD DE,5801h
; LD BC,1FFFh
; LD (HL),A
; LDIR
; LD E,A
; CPL
; AND 7
; RLCA
; RLCA
; RLCA
; OR 7
; LD D,A
; LD C,E
; RRC C
; RRC C
; RRC C
; OR 16
; XOR A
; TM21 OUT (254),A
; XOR 24
; LD B,D
; TM22 DJNZ TM22
; DEC C
; JR NZ,TM21
; LD A,E
; DEC A
; CP 3Fh
; JR NZ,LPDEAD1
; LD HL,NOMEN
; LD A,(HL)
; OR A
; JP Z,ENDGAM
; DEC (HL)
; JP NEWSHT
; ENDGAM LD HL,HGHSCOR
; LD DE,SCORBUF
; LD B,6
; LPHGH LD A,(DE)
; CP (HL)
; JP C,FEET
; JP NZ,NEWHGH
; INC HL
; INC DE
; DJNZ LPHGH
; NEWHGH LD HL,SCORBUF
; LD HL,HGHSCOR
; LD BC,6
; LDIR
; FEET LD HL,4000h
; LD DE,4001h
; LD BC,0FFFh
; LD (HL),0
; LDIR
; XOR A
; LD (EUGHGT),A
; LD DE,MANDAT+64
; LD HL,488Fh
; LD C,0
; CALL DRWFIX
; LD DE,0B6E0h
; LD HL,48CFh
; LD C,0
; CALL DRWFIX
; LOOPFT LD A,(EUGHGT)
; LD C,A
; LD B,83h
; LD A,(BC)
; OR 0Fh
; LD L,A
; INC BC
; LD A,(BC)
; SUB H
; LD H,A
; LD DE,0BAE0h
; LD C,0
; CALL DRWFIX
; LD A,(EUGHGT)
; CPL
; LD E,A
; XOR A
; LD BC,40h
; TM111 OUT (254),A
; XOR 24
; LD B,E
; TM112 DJNZ TM112
; DEC C
; JR NZ,TM111
; LD HL,5800h
; LD DE,5801h
; LD BC,1FFh
; LD A,(EUGHGT)
; AND 0Ch
; RLCA
; OR 47h
; LD (HL),A
; LDIR
; LD A,(EUGHGT)
; ADD A,4
; LD (EUGHGT),A
; CP 0C4h
; JR NZ,LOOPFT
; LD IX,MESSG
; LD C,4
; LD DE,40CAh
; CALL PMESS
; LD IX,MESSO
; LD C,4
; LD DE,40D2h
; CALL PMESS
; LD BC,0
; LD D,6
; TM91 DJNZ TM91
; LD A,C
MEMTOP: DEFB 9,'A' ;The remains of "AND 7"
;
; - and at this point, the manuscript comes to an end
;
TITLEMSG:
DEFB '. . . . . .'
DEFB ' . . . . . MANIC'
DEFB ' MINER . . '
DEFB 7Fh
DEFB ' BUG-BYTE ltd. 1983'
DEFB ' . . By Matthew Smith'
DEFB ' . . . Q to P = Left'
DEFB ' & Right . . Bottom'
DEFB ' row = Jump . . A'
DEFB ' to G = Pause . .'
DEFB ' H to L = Tune On/Off'
DEFB ' . . . Guide Miner'
DEFB ' Willy through 20'
DEFB ' lethal caverns .'
DEFB ' . . . . . '
DEFB ' . .'
;
;(C) 1983,1984,1999,2000 Matthew Smith - all rights reserved
;
:0D806800000000000000000000000000000B
:02808E00FF00F1
:0E80B00000000000302C3137312C3139000037
:0380DA00FF0000A4
:0180F100FF8F
:1082000006003E007C0034003E003C0018003C00AC
:108210007E007E00F700FB003C0076006E007700D9
:1082200001800F801F000D000F800F0006000F005F
:108230001B801B801B801D800F00060006000700AE
:10824000006003E007C0034003E003C0018003C0F7
:1082500007E007E00F700FB003C0076006E007708B
:10826000001800F801F000D000F800F0006000F005
:1082700001F803FC07FE06F600F801DA030E03849A
:1082800018001F000F800B001F000F0006000F00DA
:108290001F803FC07FE06F601F005B8070C021C007
:1082A000060007C003E002C007C003C0018003C08E
:1082B00007E007E00EF00DF003C006E007600EE0F7
:1082C000018001F000F800B001F000F0006000F063
:1082D00001F801D801D801B800F00060006000E0AA
:1082E0000060007C003E002C007C003C0018003C3C
:1082F000007E007E00EF00DF003C006E007600EEA6
:108300000060006100620063006400650066006751
:108310002060206120622063206420652066206741
:108320004060406140624063406440654066406731
:108330006060606160626063606460656066606721
:108340008060806180628063806480658066806711
:10835000A060A061A062A063A064A065A066A06701
:10836000C060C061C062C063C064C065C066C067F1
:10837000E060E061E062E063E064E065E066E067E1
:10838000F3317E9CC34C8500000100010103010311
:108390000200020000010203414952303030303007
:1083A00030303030303030303030303030303048B5
:1083B0006967682053636F72652030303030303029
:1083C00020202053636F72652030303030303047CA
:1083D000616D654F766572000000000000001F1F90
:1083E0001F0F1F1E1B1F1E1F1F171F0F1F1D50803B
:1083F0008150666750565732565732ABCB322B33CB
:10840000322B3332ABCB32334032334032ABCB3210
:10841000808132808132666732565732605632AB85
:10842000C0322B30322B3032ABC032304432304489
:1084300032ABC0328889328889327273324C4D3205
:108440004C4D32ABC032263032263032ABC03230E7
:108450004432304432ABC0328889328889327273F8
:10846000324C4D324C4D32ABCB3226333226333286
:10847000ABCB32334032334032ABCB3280813280AF
:10848000813266673256573240413280AB32202B00
:1084900032202B3280AB322B33322B333280AB3253
:1084A0008081328081326667325657324041328055
:1084B00098322026322026328098322630322630DA
:1084C000320000327273327273326061324C4D325C
:1084D0004C99324C4D324C4D324C99325B5C325699
:1084E000573233CD3233343233343233CD324041EC
:1084F000326667646667327273644C4D3256573227
:1085000080CB1980001980813280CBFF8072666039
:108510005666565651605151566656568072666080
:108520005666565651605151565656568072666080
:108530005666565651605151566656568072666060
:10854000566656405666806656565656AF328783F4
:1085500032D98332DA8332DB8332D8833E0232D798
:108560008321DC83CBC621004011014001FF173677
:1085700000EDB02100A0110040010010EDB0213D40
:10858000481140820E00CD748F2100FC110058016B
:108590000001EDB021009E010002EDB0011F00F3CB
:1085A000AFED58B310FBE62020053E0132D983FD24
:1085B00021EE83CD5C92C20486AF32DC803ADC804F
:1085C000DD21809CDD6F1160500E20CD3A923ADCA7
:1085D00080E6060F0F0F5F1682213D410E00CD741D
:1085E0008F01640010FE0D20FB01FEBFED78E60157
:1085F000FE0120103ADC803CFEE032DC8020BE3EF2
:108600004032DA8321A58311A6830109003630EDBB
:10861000B03A8783CB27CB27C6B0672E0011005E08
:10862000010002EDB0110080010002EDB0CDF5892E
:1086300021005011015001FF073600EDB0DD21008F
:10864000800E20110050CD3A92DD2198830E031147
:108650002050CD3A923E5267572E241E25473ABCF1
:1086600080D6244F78060036FFEDB03CFE5620E75A
:10867000DD21AF831160500E20CD3A923A73800E07
:10868000FEED793ADA83B728053E4032DA833AD7ED
:108690008321A050B72819470E00E5C53ADB8307B0
:1086A0000707E6605F1682CD748FC1E1232310E8CF
:1086B0003ADD83FE07200811E0BA0E00CD748F2149
:1086C000005E11005C010002EDB02100701100603D
:1086D000010010EDB0CD8F8C3ADA83B7CC3B8A3AEB
:1086E000DA83B7CCBA91CD2A8DCD8590CDE38E3A81
:1086F0008783FE04CC788D3A8783FE0DCAF58D3AC8
:108700008783FE08D4718E3A8783FE07CCB5903AF2
:108710008783FE0BCCB5903A8783FE12CCF38CCDC9
:10872000458F210060110040010010EDB03AD88360
:10873000B728153D32D883070707E63821005C11BA
:10874000015C01FF0177EDB021005C1100580100D0
:1087500002EDB0DD21A98311BA500E06CD3A92DDAB
:10876000219F83116B500E06CD3A92CDBC89CA7FF2
:108770008801FEFEED785F067FED78B3E601CA4C16
:108780008506FDED78E61FFE1F280A0602ED78E655
:108790001FFE1F28F63A6B80FEFFCA7F8806BF21A6
:1087A000DC83ED78E61FFE1F280ACB4620087EEE0C
:1087B00003771802CB86CB4E20253ADB833C32DB95
:1087C00083E67E0F5F1600210C85193A73805E01E7
:1087D0000300D3FE1D20035EEE1810F60D20F33AC1
:1087E000DA83B7281F3DCA7F8832DA8301FE00EDA5
:1087F00078E61FFE1FC24C853AD983B72806DB1FD7
:10880000B7C24C8501FEEFED78CB67C228883ADD10
:1088100083FE07C2288806F7ED782FE61FFE14D2E4
:108820002888328783C311863ADD83FE07CA8E8685
:10883000075F1600DD21E083DD1901FEF7ED78E624
:108840001FDDBE002812FE1FCA8E86DDBEFECA8E48
:1088500086AF32DD83C38E8606EFED78E61FDDBE80
:10886000012812FE1FCA8E86DDBEFFCA8E86AF3279
:10887000DD83C38E863ADD833C32DD83C38E863A48
:10888000DA83B7C2A88F3E4721005811015801FF73
:108890000177EDB05F2FE607070707F607574BCBC9
:1088A00009CB09CB09F610AFD3FEEE184210FE0D2E
:1088B00020F67B3DFE3F20D021D7837EB7CAC488F7
:1088C00035C31186219F8311A98306061ABEDAE3F8
:1088D00088C2D888231310F421A983119F8301062D
:1088E00000EDB021004011014001FF0F3600EDB056
:1088F000AF32DC80114082218F480E00CD748F1181
:10890000E0B621CF480E00CD748F3ADC804F06834D
:108910000AF60F6F030AD6206711E0BA0E00CD7475
:108920008F3ADC802F5FAF014000D3FEEE1843107A
:10893000F90D20FB21005811015801FF013ADC809C
:10894000E60C07F64777EDB03ADC80C60432DC80EF
:10895000FEC420B6DD21CF830E0411CA40CD3A9269
:10896000DD21D3830E0411D240CD3A9201000016CE
:108970000610FE79E607F64032CA583CE607F64094
:1089800032CB583CE607F64032CC583CE607F6407E
:1089900032CD583CE607F64032D2583CE607F64066
:1089A00032D3583CE607F64032D4583CE607F6404E
:1089B00032D5580D20BB1520B8C34C853ABD80D6A2
:1089C0000432BD80FEFC200D3ABC80FE24C83D323E
:1089D000BC803ABD80E6E00707071E00B7280747BE
:1089E000CB0BCBFB10FA3ABC806F265206047324E3
:1089F00010FCAF3CC9DD21005E3E70321C8ACD0AFE
:108A00008ADD21005F3E78321C8A0E0059DD7E002F
:108A1000212080014800EDB14B060816007E12238C
:108A20001410FADD230CC20C8A3A8783FE13C0218E
:108A300000A0110070010008EDB0C93A6B80FE0182
:108A4000204E3A6E80CB87D6082168808677CD028B
:108A50008B3A3B80BECA228B23BECA228B3A6E80E1
:108A60003C326E80D608F26B8AED443C070707570C
:108A70000E203A7380D3FEEE184210FE0D20F63A17
:108A80006E80FE12CA168BFE102805FE0DC2038CE6
:108A90003A6880E60F203A2A6C80114000193A3279
:108AA00080BECC3A8B3A4D80BE28263A5680BE28EE
:108AB00020233A3280BECC3A8B3A4D80BE28123AFF
:108AC0005680BE280C3A2080BE2BC25D8BBEC25D94
:108AD0008B3A6B80FE01CA038C216A80CB8EB7CAA9
:108AE0001C8B3C326B8007070707570E203A7380B8
:108AF000D3FEEE184210FE0D20F63A6880C608320A
:108B00006880E6F06FAFCB15CE5C673A6C80E61FED
:108B1000B56F226C80C93E06326B80C93E02326B53
:108B200080C93A6880C610E6F0326880CD028B3E7C
:108B300002326B80216A80CB8EC94D7CC61BF60742
:108B400047050A04020578E60720F6AF0278C60753
:108B5000470AB7C03A20802424772525C93A6B807C
:108B6000FE0CD2868C1EFFAF326B803A4480BE284A
:108B70000423BE20063A6F80D6035F01FEDFED7846
:108B8000E61FF620A35F01FEFBED78E61FCB07F69C
:108B900001A35F06F7ED780FF6F7A35F06EFED7818
:108BA000F6FBA35F3AD983B7280A011F00ED78E6E8
:108BB000032FA35F0E007BE62AFE2A28020E047B09
:108BC000E615FE152802CBD93A6A80814F060021AE
:108BD0008883097E326A8001FE7EED78E61FFE1FE3
:108BE000201906EFED78E609FE09200F3AD983B780
:108BF0002811011F00ED78CB672808AF326E803C4A
:108C0000326B803A6A80E602C83A6A80E601CA4A54
:108C10008C3A6980B728053D326980C92A6C802B5F
:108C2000112000193A3B80BEC83A6880E60F280937
:108C30003A3B8019BEC8B7ED523A3B80B7ED52BE01
:108C4000C8226C803E03326980C93A6980FE0328DD
:108C5000053C326980C92A6C8023231120003A3BED
:108C60008019BEC83A6880E60F28093A3B8019BED1
:108C7000C8B7ED523A3B80B7ED52BEC82B226C808C
:108C8000AF326980C9E1E13EFF326B80C32287FDCC
:108C900021BE80110700FD7E00FEFFC8B728503AB4
:108CA000BD80E6040F0F0FFDA6002043FD7E04FEED
:108CB000032810FE0428233005FD34041831FD3547
:108CC00004182CFD7E01FDBE062006FD36040718A3
:108CD0001EFD360400FD34011815FD7E01FDBE05A4
:108CE0002006FD3604001807FD360407FD3501FD9A
:108CF0001918A321175C1120003A2980BEC83A3BFD
:108D000080BEC83E27BE2010D9CDBC89CDBC89CD40
:108D1000BC89CDBC89D9180D3A2080BE28077BEECE
:108D2000DF5F7A2F5736771918CFFD21BE80FD7E81
:108D300000FEFFC8B7283A111F00FD6E01FD660254
:108D4000E67F772377197723770E01FD7E040F0FD7
:108D50000F5F3A8783FE07380AFE092806FE0F28B0
:108D600002CBFB1681FD6E01FD6603CD748FC286BA
:108D70008C110700FD1918B63A7480B728113ADB38
:108D800080B7280B3ADC803D281232DC8018153A77
:108D9000DC803CFE58280532DC8018083ADB80EE87
:108DA0000132DB803ADC80E67F075F16831AF60F1C
:108DB0006F131A6711E0800E01CD748FC2868C3A52
:108DC000DC80E67807F60737CB176F3E00CE5C678E
:108DD0003A7480B73E0720073ABD800F0FE6077749
:108DE0003A2080E6F8B677111F00237719772377AA
:108DF00019772377C9FD21DD80FD7E00FEFFCA1FA4
:108E000087FD7E02FDBE063008FD8604FD77021850
:108E10001EFD3401FD7E01FE082014FD7E05FD7758
:108E200002FD7E03C608E61FFD7703FD360100FD47
:108E30005E02CB0316831AFD86036F131A67FD7E4D
:108E4000010F0F0F5F16810E01CD748FC2878CFD4D
:108E50007E02E6400707C65C67FD7E020707E6E084
:108E6000FDB6036FFD7E00CDDF8D110700FD1918E3
:108E700088FD21DD80FD7E00FEFFC8FD3401FDCBB5
:108E80000196FD7E02FD8604FDBE05380AFDBE0684
:108E90003005FD77021808FD7E04ED44FD7704FDE2
:108EA0007E02E67F075F16831AFDB6036F131A670B
:108EB000FD7E010F0F0F5F16810E01CD748FC286EC
:108EC0008CFD7E02E6400707C65C67FD7E02070751
:108ED000E6E0FDB6036FFD7E00CDDF8D110700FDDE
:108EE000191892AF327480FD217580FD7E00FEFF5F
:108EF0002848B72839FD5E01FD56021AE607FE072D
:108F0000200C21AC83CD7E90FD3600001820FD7E24
:108F100000E6F8F60347FD7E00E60380FD770012C9
:108F2000327480FD560321B4800608CD5592FD238E
:108F3000FD23FD23FD23FD2318B13A7480B7C02122
:108F40008F80CBFEC92AB0803A6C80BD20113A6D6B
:108F500080BC200B3A8F80CB7F2804E1C3A88F3AD6
:108F60008F80772377111F00197723771190802A3C
:108F7000B2800E000610CB411A2804A6C01AB6779C
:108F80002C13CB411A2804A6C01AB6772D24137CC3
:108F9000E60720107CD608677DC6206FE6E0200437
:108FA0007CC6086710D0AFC93A87833CFE142061A5
:108FB0003ADA83B7C210903ADD83FE0728520E00DA
:108FC000116082215340CD748F11E0B221B340CDA6
:108FD000748F215358111F00362F23362F1936272F
:108FE00023362719231936452336451936462336A5
:108FF000471936002336000100001632AFD3FEEECB
:10900000185F79828282477B10FE0D20F01520EDDB
:10901000AF3287833E3F21005811015801FF01778D
:10902000EDB001040010FE0D20FB3D20E93ADA838B
:10903000B7C21186CDBC89CA118621AE83CD7E9080
:10904000DD21A9830E06117A50CD3A920E043ABC66
:10905000802FE63FCB07573E00D3FE4210FE3E185E
:10906000D3FE4210FE0D20EF18CA36302B7DFE2AAB
:10907000200C3E0832D8833AD7833C32D7837EFE19
:109080003928E734C92A70805D543A7280473A6FB4
:1090900080B720137ECB07CB0724244ECB09CB0906
:1090A00012712C1C10FAC97ECB0FCB0F24244ECB8F
:1090B00001CB0118EB21065CCD9B913ADB80FE02CF
:1090C000C83A0675FE10CA79913A715FB728272110
:1090D000717F7EB72016257CFE7720F63A208032FD
:1090E000715F32915F3E7232CB80180A36002E914A
:1090F0007CEE0767360021125CCD9B91201FAF32BA
:10910000DC803C32DB803A2080324F5E32505E2180
:109110004F70060836002C36002D2410F73ADB80FD
:10912000B728563ADC80FE642849C60432DC804FFA
:1091300016103A7380D3FEEE184110FE1520F67912
:10914000075F16831AF60F6F131A6716813ABD80F0
:10915000E620F6405F0E00CD748F21AC83CD7E906B
:109160003ADC80E6786F261729297DF60F6F3E06D8
:10917000C3DF8D3E0232DB80C93ABD80E6205F1638
:1091800081210F600E01CD748FC2868C3E44322F38
:109190005C32305C320F5C32105CC93A6C803CE669
:1091A000FEBDC03A6D80BCC03A65802675BEC03633
:1091B00008243606243606AFB7C92A6C80111F0072
:1091C0000E0FCDDF9123CDDF9119CDDF9123CDDFC0
:1091D000913A68804F19CDDF9123CDDF9118203A65
:1091E0002080BE200B79E60F28063A2080F607770C
:1091F0003A4D80BECA858C3A5680BECA858CC93A23
:109200006880DD2683DD6F3A6A80E6010F5F3A6988
:1092100080E6030F0F0FB35F168206103A6C80E6EC
:109220001F4FDD7E00DD6601B16F1AB67723131A7A
:10923000B677DD23DD231310E9C9DD7E00CD4B9227
:10924000DD231C7AD608570D20F0C926076FCBFD09
:1092500029292906087E12231410FAC9FD7E00FE72
:10926000FFC84F0600AFFD56017ACDAB923650FDD8
:109270005E027BCDAB923628D3FE152005FD56014C
:10928000EE181D2005FD5E02EE1810EC0D20E9CD54
:10929000B792C0FD7E01CDAB923638FD7E02CDABDC
:1092A000923638FD23FD23FD2318B1D6080F0F0F8A
:1092B0002FF6E06F2659C93AD983B72805DB1FCBB3
:0C92C00067C001FEBFED78E601FE01C9A9
:109C7E0009412E20202E20202E20202E20202E2086
:109C8E00202E20202E20202E20202E20202E202080
:109C9E002E204D414E4943204D494E4552202E20F7
:109CAE002E207F204255472D42595445206C746416
:109CBE002E2031393833202E202E204279204D612E
:109CCE00747468657720536D697468202E202E2079
:109CDE002E205120746F2050203D204C656674203C
:109CEE0026205269676874202E202E20426F7474CD
:109CFE006F6D20726F77203D204A756D70202E207B
:109D0E002E204120746F2047203D205061757365D1
:109D1E00202E202E204820746F204C203D2054757C
:109D2E006E65204F6E2F4F6666202E202E202E2021
:109D3E004775696465204D696E65722057696C6C54
:109D4E0079207468726F756768203230206C657484
:109D5E0068616C2063617665726E73202E20202EF2
:109D6E0020202E20202E20202E20202E20202E209F
:029D7E00202E95
:00000001FF
0000 ;
0000 ;(C) 1983,1984,1999,2000 Matthew Smith - all rights reserved
0000 ;
0000 ;Disassembly of Manic Miner, done by John Elliott with the Dazzlestar
0000 ;disassembler under CP/M.
0000 ;
0000 ;Note: I have deleted most of the data structures (from the title screen onward)
0000 ; as the format of these areas is documented elsewhere.
0000 ;
0000 ; Compared to my JSW disassembly, this is very thinly commented indeed; I've
0000 ; only looked at bits which relate to the patch I did or which appear in
0000 ; the embedded source code.
0000 ;
0000 SCREEN: EQU 4000h
0000 ATTR: EQU 5800h
0000 WK_ATTR: EQU 5C00h
0000 BK_ATTR: EQU 5E00h
0000 T6000: EQU 6000h
0000 T7000: EQU 7000h
0000 T5E00: EQU 5E00h
0000 SP_SWFS: EQU 0B2E0h
0000 SP_PEDE: EQU 0B6E0h
0000 SP_FOOT: EQU 0BAE0h
8000 .ORG 8000h
8000 .ENGINE zxs
8000 ;
8000 ; Blank spaces in Manic Miner tend to fill up with source code. I have
8000 ; rendered these as DS directives and put the source code in comments. This
8000 ; means the code won't assemble to the same result, but it's much more
8000 ; readable.
8000 ;
8000 ; This is the source for data at T846E.
8000 ;
8000 ; [17-4-2004] Commented this section and gave it labels, based on Andrew
8000 ; Broad's room format
8000 ; <http://www.geocities.com/andrewbroad/spectrum/willy/mm_format.html>
8000 ;
8000 ROOM_NAME: DS 20h ;8000: Room name
8020 ; ... 50,171,192,50,48,68
8020 ; DB 50,48,58,50,171,192,50,136,137
8020 ELEM_AIR: DS 9 ;8020: Air
8029 ELEM_WATER: DS 9 ;8029: Water
8032 ELEM_CRUMBLY: DS 9 ;8032: Crumbling floor
803B ELEM_EARTH: DS 9 ;803B: Earth
8044 ; DB 50,136,137,50,114,115,50,76,77
8044 ELEM_CONVEY: DS 9 ;8044: Conveyor
804D ELEM_FIRE1: DS 9 ;804D: Fire (1)
8056 ELEM_FIRE2: DS 9 ;8056: Fire (2)
805F ELEM_SWITCH: DS 9
8068 00 WILLY_Y: DB 0 ;8068: Willy vertical position, pixels
8069 00 WILLY_FRAME: DB 0 ;8069: Willy's current frame
806A 00 WILLY_DIR: DB 0 ;806A: Which way does Willy face?
806B 00 AIRBORNE: DB 0 ;806B: Willy jumping?
806C 00 00 WILLY_POS: DW 0 ;806C: Willy position in attribute file
806E 00 JUMP_DIST: DB 0 ;806E: Jump distance
806F 00 CONVEY_DIR: DB 0 ;806F: Conveyor direction
8070 00 00 CONVEY_POS: DW 0 ;8070: Conveyor animation position
8072 00 CONVEY_LEN: DB 0 ;8072: Conveyor length
8073 00 BORDER: DB 0 ;8073: Border
8074 00 PORTAL_CLOSED: DB 0 ;8074: Attribute of last item drawn
8075 ITEMS: DS 25 ;8075: Up to five items to collect
808E ; 92,50,38,484
808E ; DB 50,38,4
808E FF DB 0FFh ;808E: End of item table
808F 00 PORTAL_ATTR: DB 0 ;808F: Portal attribute
8090 PORTAL_IMAGE: DS 32 ;8090: Portal image
80B0 ; 50,171,192,50,48,68'
80B0 ; DB 50,48,
80B0 00 00 00 00 PORTAL_XY: DW 0,0 ;80B0: Portal position
80B4 30 2C ITEM_GRAPHIC: DW 2C30h ;80B4: Item image
80B6 31 37 DW 3731h
80B8 31 2C DW 2C31h
80BA 31 39 DW 3931h
80BC 00 AIR_MAJOR: DB 0 ;80BC: Air supply + 32
80BD 00 AIR_MINOR: DB 0 ;80BD: Air pixel adjustment
80BE HGUARDS: DS 28 ;80BE: Horizontal guardians
80DA ; 50,136,137
80DA FF DB 0FFh ; DB 50,136,137,
80DB 00 B80DB: DB 0 ;80DB: Used when moving Eugene and Kong
80DC 00 EUGHGT: DB 0 ;80DC: Height of Eugene
80DD VGUARDS: DS 20 ;80DD: Vertical guardians
80F1 ; 114,115,50,76,77
80F1 ; B 50,76,77,50,171,203,50,38,51
80F1 FF DB 0FFh ; DB 50,38,51,50,171,203,50,51,64
80F2 ;
80F2 ; 'special' graphic and guardian graphics
80F2 ;
80F2 DS 270 ; DB 50,51,64,50,171,203,50,128,129
8200 ; DB 50,128,129,50,102,103,50,86,87
8200 ; DB 50,64,65,50,128,171,50,32,43
8200 ; DB 50,32,43,50,128,171,50,43,51
8200 ; DB 50,43,51,50,128,171,50,128,129
8200 ; DB 50,128,129,50,102
8200 06 00 3E 00 7C 00 34 00 3E 00 3C 00 18 00 3C 00 7E 00 7E MANDAT: DB 6,0,3Eh,0,7Ch,0,34h,0,3Eh,0,3Ch,0,18h,0,3Ch,0,7Eh,0,7Eh
8213 00 F7 00 FB 00 3C 00 76 00 6E 00 77 00 01 80 0F 80 1F DB 0,0F7h,0,0FBh,0,3Ch,0,76h,0,6Eh,0,77h,0,1,80h,0Fh,80h,1Fh
8225 00 0D 00 0F 80 0F 00 06 00 0F 00 1B 80 1B 80 1B 80 DB 0,0Dh,0,0Fh,80h,0Fh,0,6,0,0Fh,0,1Bh,80h,1Bh,80h,1Bh,80h
8236 1D 80 0F 00 06 00 06 00 07 00 DB 1Dh,80h,0Fh,0,6,0,6,0,7,0
8240 00 60 03 E0 07 C0 03 40 03 E0 03 C0 01 80 03 C0 07 DB 0,60h,3,0E0h,7,0C0h,3,40h,3,0E0h,3,0C0h,1,80h,3,0C0h,7
8251 E0 07 E0 0F 70 0F B0 03 C0 07 60 06 E0 07 70 DB 0E0h,7,0E0h,0Fh,70h,0Fh,0B0h,3,0C0h,7,60h,6,0E0h,7,70h
8260 00 18 00 F8 01 F0 00 D0 00 F8 00 F0 00 60 00 F0 01 DB 0,18h,0,0F8h,1,0F0h,0,0D0h,0,0F8h,0,0F0h,0,60h,0,0F0h,1
8271 F8 03 FC 07 FE 06 F6 00 F8 01 DA 03 0E 03 84 18 DB 0F8h,3,0FCh,7,0FEh,6,0F6h,0,0F8h,1,0DAh,3,0Eh,3,84h,18h
8281 00 1F 00 0F 80 0B 00 1F 00 0F 00 06 00 0F 00 1F 80 3F DB 0,1Fh,0,0Fh,80h,0Bh,0,1Fh,0,0Fh,0,6,0,0Fh,0,1Fh,80h,3Fh
8293 C0 7F E0 6F 60 1F 00 5B 80 70 C0 21 C0 06 DB 0C0h,7Fh,0E0h,6Fh,60h,1Fh,0,5Bh,80h,70h,0C0h,21h,0C0h,6
82A1 00 07 C0 03 E0 02 C0 07 C0 03 C0 01 80 03 C0 07 E0 DB 0,7,0C0h,3,0E0h,2,0C0h,7,0C0h,3,0C0h,1,80h,3,0C0h,7,0E0h
82B2 07 E0 0E F0 0D F0 03 C0 06 E0 07 60 0E E0 01 DB 7,0E0h,0Eh,0F0h,0Dh,0F0h,3,0C0h,6,0E0h,7,60h,0Eh,0E0h,1
82C1 80 01 F0 00 F8 00 B0 01 F0 00 F0 00 60 00 F0 01 F8 DB 80h,1,0F0h,0,0F8h,0,0B0h,1,0F0h,0,0F0h,0,60h,0,0F0h,1,0F8h
82D2 01 D8 01 D8 01 B8 00 F0 00 60 00 60 00 E0 00 60 00 DB 1,0D8h,1,0D8h,1,0B8h,0,0F0h,0,60h,0,60h,0,0E0h,0,60h,0
82E3 7C 00 3E 00 2C 00 7C 00 3C 00 18 00 3C 00 7E 00 7E 00 EF DB 7Ch,0,3Eh,0,2Ch,0,7Ch,0,3Ch,0,18h,0,3Ch,0,7Eh,0,7Eh,0,0EFh
82F6 00 DF 00 3C 00 6E 00 76 00 EE DB 0,0DFh,0,3Ch,0,6Eh,0,76h,0,0EEh
8300 ;
8300 ; X,Y lookup table
8300 ;
8300 00 60 00 61 00 62 00 63 DW T6000,T6000+100h,T6000+200h,T6000+300h
8308 00 64 00 65 00 66 00 67 DW T6000+400h,T6000+500h,T6000+600h,T6000+700h
8310 20 60 20 61 20 62 20 63 DW T6000+ 20h,T6000+120h,T6000+220h,T6000+320h
8318 20 64 20 65 20 66 20 67 DW T6000+420h,T6000+520h,T6000+620h,T6000+720h
8320 40 60 40 61 40 62 40 63 DW T6000+ 40h,T6000+140h,T6000+240h,T6000+340h
8328 40 64 40 65 40 66 40 67 DW T6000+440h,T6000+540h,T6000+640h,T6000+740h
8330 60 60 60 61 60 62 60 63 DW T6000+ 60h,T6000+160h,T6000+260h,T6000+360h
8338 60 64 60 65 60 66 60 67 DW T6000+460h,T6000+560h,T6000+660h,T6000+760h
8340 80 60 80 61 80 62 80 63 DW T6000+ 80h,T6000+180h,T6000+280h,T6000+380h
8348 80 64 80 65 80 66 80 67 DW T6000+480h,T6000+580h,T6000+680h,T6000+780h
8350 A0 60 A0 61 A0 62 A0 63 DW T6000+0A0h,T6000+1A0h,T6000+2A0h,T6000+3A0h
8358 A0 64 A0 65 A0 66 A0 67 DW T6000+4A0h,T6000+5A0h,T6000+6A0h,T6000+7A0h
8360 C0 60 C0 61 C0 62 C0 63 DW T6000+0C0h,T6000+1C0h,T6000+2C0h,T6000+3C0h
8368 C0 64 C0 65 C0 66 C0 67 DW T6000+4C0h,T6000+5C0h,T6000+6C0h,T6000+7C0h
8370 E0 60 E0 61 E0 62 E0 63 DW T6000+0E0h,T6000+1E0h,T6000+2E0h,T6000+3E0h
8378 E0 64 E0 65 E0 66 E0 67 DW T6000+4E0h,T6000+5E0h,T6000+6E0h,T6000+7E0h
8380 ;
8380 ; Main entry point
8380 ;
8380 F3 DI
8381 31 7E 9C LD SP,MEMTOP
8384 C3 4C 85 JP START
8387 00 SHEET: DB 0
8388 00 01 00 01 01 03 01 03 02 00 02 00 00 01 02 03 T8408: DB 0,1,0,1,1,3,1,3,2,0,2,0,0,1,2,3
8398 41 49 52 S_AIR: DB 'AIR'
839B 30 30 30 30 DB '0000'
839F 30 30 30 30 30 30 HGHSCOR: DB '000000'
83A5 30 30 30 30 DB '0000'
83A9 30 30 30 30 30 30 SCORBUF: DB '000000'
83AF 48 69 67 68 20 53 63 6F 72 65 20 30 30 30 30 30 30 SCORES: DB 'High Score 000000'
83C0 20 20 20 53 63 6F 72 65 20 30 30 30 30 30 30 DB ' Score 000000'
83CF 47 61 6D 65 MESSG: DB 'Game'
83D3 4F 76 65 72 MESSO: DB 'Over'
83D7 00 NOMEN: DB 0 ;No. of lives
83D8 00 B8458: DB 0
83D9 00 KEMP: DB 0 ;Kempston joystick flag
83DA 00 DEMO: DB 0 ;Demo mode?
83DB 00 B845B: DB 0
83DC 00 T845C: DB 0
83DD 00 CHEAT: DB 0 ;Cheat mode?
83DE 1F 1F DW 01F1Fh ;---------- ;Cheat string
83E0 CHEATDT:
83E0 1F 0F DW 0F1Fh ;----6-----
83E2 1F 1E DW 1E1Fh ;0---------
83E4 1B 1F DW 1F1Bh ;-------3--
83E6 1E 1F DW 1F1Eh ;---------1
83E8 1F 17 DW 171Fh ;---7------
83EA 1F 0F DW 0F1Fh ;----6-----
83EC 1F 1D DW 1D1Fh ;-9--------
83EE 50 80 81 50 66 67 50 56 57 32 56 57 32 AB T846E: DB 50h,80h,81h,50h,66h,67h,50h,56h,57h,32h,56h,57h,32h,0ABh
83FC CB 32 2B 33 32 2B 33 32 AB CB 32 33 40 DB 0CBh,32h,2Bh,33h,32h,2Bh,33h,32h,0ABh,0CBh,32h,33h,40h
8409 32 33 40 32 AB CB 32 80 81 32 80 81 32 66 DB 32h,33h,40h,32h,0ABh,0CBh,32h,80h,81h,32h,80h,81h,32h,66h
8417 67 32 56 57 32 60 56 32 AB C0 32 2B 30 32 DB 67h,32h,56h,57h,32h,60h,56h,32h,0ABh,0C0h,32h,2Bh,30h,32h
8425 2B 30 DB 2Bh,30h
8427 ;
8427 ; Source for this bit is at 08000h
8427 ;
8427 32 AB C0 32 30 44 32 30 44 32 AB DB 32h,0ABh,0C0h,32h,30h,44h,32h,30h,44h,32h,0ABh
8432 C0 32 88 89 32 88 89 32 72 73 32 4C 4D 32 DB 0C0h,32h,88h,89h,32h,88h,89h,32h,72h,73h,32h,4Ch,4Dh,32h
8440 4C 4D 32 AB C0 32 26 30 32 26 30 32 AB DB 4Ch,4Dh,32h,0ABh,0C0h,32h,26h,30h,32h,26h,30h,32h,0ABh
844D C0 32 30 44 32 30 44 32 AB C0 32 88 89 DB 0C0h,32h,30h,44h,32h,30h,44h,32h,0ABh,0C0h,32h,88h,89h
845A 32 88 89 32 72 73 32 4C 4D 32 4C 4D 32 AB DB 32h,88h,89h,32h,72h,73h,32h,4Ch,4Dh,32h,4Ch,4Dh,32h,0ABh
8468 CB 32 26 33 32 26 33 32 AB CB 32 33 40 DB 0CBh,32h,26h,33h,32h,26h,33h,32h,0ABh,0CBh,32h,33h,40h
8475 32 33 40 32 AB CB 32 80 81 32 80 81 32 66 DB 32h,33h,40h,32h,0ABh,0CBh,32h,80h,81h,32h,80h,81h,32h,66h
8483 67 32 56 57 32 40 41 32 80 AB 32 20 2B 32 DB 67h,32h,56h,57h,32h,40h,41h,32h,80h,0ABh,32h,20h,2Bh,32h
8491 20 2B 32 80 AB 32 2B 33 32 2B 33 32 80 AB DB 20h,2Bh,32h,80h,0ABh,32h,2Bh,33h,32h,2Bh,33h,32h,80h,0ABh
849F 32 80 81 32 80 81 32 66 67 32 56 57 32 40 DB 32h,80h,81h,32h,80h,81h,32h,66h,67h,32h,56h,57h,32h,40h
84AD 41 32 80 98 32 20 26 32 20 26 32 80 98 32 DB 41h,32h,80h,98h,32h,20h,26h,32h,20h,26h,32h,80h,98h,32h
84BB 26 30 32 26 30 32 00 00 32 72 73 32 72 73 32 DB 26h,30h,32h,26h,30h,32h,0,0,32h,72h,73h,32h,72h,73h,32h
84CA 60 61 32 4C 4D 32 4C 99 32 4C 4D 32 4C 4D DB 60h,61h,32h,4Ch,4Dh,32h,4Ch,99h,32h,4Ch,4Dh,32h,4Ch,4Dh
84D8 32 4C 99 32 5B 5C 32 56 57 32 33 CD 32 33 DB 32h,4Ch,99h,32h,5Bh,5Ch,32h,56h,57h,32h,33h,0CDh,32h,33h
84E6 34 32 33 34 32 33 CD 32 40 41 32 66 67 64 DB 34h,32h,33h,34h,32h,33h,0CDh,32h,40h,41h,32h,66h,67h,64h
84F4 66 67 32 72 73 64 4C 4D 32 56 57 32 80 CB DB 66h,67h,32h,72h,73h,64h,4Ch,4Dh,32h,56h,57h,32h,80h,0CBh
8502 19 80 00 19 80 81 32 80 CB FF DB 19h,80h,0,19h,80h,81h,32h,80h,0CBh,0FFh
850C T858C:
850C 80 72 66 60 56 66 56 56 51 60 51 51 56 66 DB 80h,72h,66h,60h,56h,66h,56h,56h,51h,60h,51h,51h,56h,66h
851A 56 56 80 72 66 60 56 66 56 56 51 60 51 51 DB 56h,56h,80h,72h,66h,60h,56h,66h,56h,56h,51h,60h,51h,51h
8528 56 56 56 56 80 72 66 60 56 66 56 56 51 60 DB 56h,56h,56h,56h,80h,72h,66h,60h,56h,66h,56h,56h,51h,60h
8536 51 51 56 66 56 56 80 72 66 60 56 66 56 40 DB 51h,51h,56h,66h,56h,56h,80h,72h,66h,60h,56h,66h,56h,40h
8544 56 66 80 66 56 56 56 56 DB 56h,66h,80h,66h,56h,56h,56h,56h
854C ;
854C ; Game restart point
854C ;
854C AF START: XOR A
854D 32 87 83 LD (SHEET),A
8550 32 D9 83 LD (KEMP),A
8553 32 DA 83 LD (DEMO),A
8556 32 DB 83 LD (B845B),A
8559 32 D8 83 LD (B8458),A
855C 3E 02 LD A,2 ;Initial lives count
855E 32 D7 83 LD (NOMEN),A
8561 21 DC 83 LD HL,T845C
8564 CB C6 SET 0,(HL)
8566 21 00 40 LD HL,SCREEN
8569 11 01 40 LD DE,SCREEN+1
856C 01 FF 17 LD BC,17FFh ;Clear screen image
856F 36 00 LD (HL),0
8571 ED B0 LDIR
8573 21 00 A0 LD HL,0A000h ;Title screen bitmap
8576 11 00 40 LD DE,SCREEN
8579 01 00 10 LD BC,4096
857C ED B0 LDIR
857E 21 3D 48 LD HL,SCREEN + 800h + 1*32 + 29
8581 11 40 82 LD DE,MANDAT+64
8584 0E 00 LD C,0
8586 CD 74 8F CALL DRWFIX
8589 21 00 FC LD HL,0FC00h ;Attributes for the last room
858C 11 00 58 LD DE,ATTR ;(top third)
858F 01 00 01 LD BC,256
8592 ED B0 LDIR
8594 21 00 9E LD HL,09E00h ;Attributes for title screen
8597 01 00 02 LD BC,512 ;(bottom two-thirds)
859A ED B0 LDIR
859C 01 1F 00 LD BC,31
859F F3 DI
85A0 AF XOR A
85A1 R8621:
85A1 ED 58 IN E,(C)
85A3 B3 OR E
85A4 10 FB DJNZ R8621 ;$-03
85A6 E6 20 AND 20h
85A8 20 05 JR NZ,R862F ;$+07
85AA 3E 01 LD A,1
85AC 32 D9 83 LD (KEMP),A
85AF R862F:
85AF FD 21 EE 83 LD IY,T846E
85B3 CD 5C 92 CALL C92DC
85B6 C2 04 86 JP NZ,L8684
85B9 AF XOR A
85BA 32 DC 80 LD (EUGHGT),A
85BD R863D:
85BD 3A DC 80 LD A,(EUGHGT)
85C0 DD 21 80 9C LD IX,TITLEMSG
85C4 DD DB 0DDh
85C5 6F LD L,A ;LD XL,A
85C6 11 60 50 LD DE,SCREEN+4096+3*32
85C9 0E 20 LD C,20h
85CB CD 3A 92 CALL PMESS
85CE 3A DC 80 LD A,(EUGHGT)
85D1 E6 06 AND 6
85D3 0F RRCA
85D4 0F RRCA
85D5 0F RRCA
85D6 5F LD E,A
85D7 16 82 LD D,82h
85D9 21 3D 41 LD HL,SCREEN + 100h + 1*32 + 29
85DC 0E 00 LD C,0
85DE CD 74 8F CALL DRWFIX
85E1 01 64 00 LD BC,100
85E4 R8664:
85E4 10 FE DJNZ R8664 ;$-00
85E6 0D DEC C
85E7 20 FB JR NZ,R8664 ;$-03
85E9 01 FE BF LD BC,0BFFEh
85EC ED 78 IN A,(C)
85EE E6 01 AND 1
85F0 FE 01 CP 1
85F2 20 10 JR NZ,L8684 ;$+12
85F4 3A DC 80 LD A,(EUGHGT)
85F7 3C INC A
85F8 FE E0 CP 0E0h
85FA 32 DC 80 LD (EUGHGT),A
85FD 20 BE JR NZ,R863D ;$-40
85FF 3E 40 LD A,40h
8601 32 DA 83 LD (DEMO),A
8604 L8684:
8604 21 A5 83 LD HL,SCORBUF-4
8607 11 A6 83 LD DE,SCORBUF-3
860A 01 09 00 LD BC,9
860D 36 30 LD (HL),30h
860F ED B0 LDIR
8611 3A 87 83 NEWSHT: LD A,(SHEET)
8614 CB 27 SLA A ;*512
8616 CB 27 SLA A ;*1k
8618 C6 B0 ADD A,0B0h ;+B000
861A 67 LD H,A
861B 2E 00 LD L,0 ;Copy the first half-k to BK_ATTR,
861D 11 00 5E LD DE,BK_ATTR
8620 01 00 02 LD BC,512
8623 ED B0 LDIR ;and the second to ROOM_NAME.
8625 11 00 80 LD DE,ROOM_NAME
8628 01 00 02 LD BC,512
862B ED B0 LDIR
862D CD F5 89 CALL C8A75
8630 21 00 50 LD HL,SCREEN+4096
8633 11 01 50 LD DE,SCREEN+4097
8636 01 FF 07 LD BC,2047
8639 36 00 LD (HL),0
863B ED B0 LDIR
863D DD 21 00 80 LD IX,ROOM_NAME
8641 0E 20 LD C,20h
8643 11 00 50 LD DE,SCREEN+4096
8646 CD 3A 92 CALL PMESS
8649 DD 21 98 83 LD IX,S_AIR
864D 0E 03 LD C,3
864F 11 20 50 LD DE,SCREEN+4096+1*32
8652 CD 3A 92 CALL PMESS
8655 3E 52 LD A,52h
8657 R86D7:
8657 67 LD H,A
8658 57 LD D,A
8659 2E 24 LD L,24h
865B 1E 25 LD E,25h
865D 47 LD B,A
865E 3A BC 80 LD A,(AIR_MAJOR)
8661 D6 24 SUB 24h
8663 4F LD C,A
8664 78 LD A,B
8665 06 00 LD B,0
8667 36 FF LD (HL),0FFh
8669 ED B0 LDIR
866B 3C INC A
866C FE 56 CP 56h
866E 20 E7 JR NZ,R86D7 ;$-17
8670 DD 21 AF 83 LD IX,SCORES
8674 11 60 50 LD DE,SCREEN+4096+3*32
8677 0E 20 LD C,20h
8679 CD 3A 92 CALL PMESS
867C 3A 73 80 LD A,(BORDER) ;Border
867F 0E FE LD C,0FEh
8681 ED 79 OUT (C),A
8683 3A DA 83 LD A,(DEMO)
8686 B7 OR A
8687 28 05 JR Z,LOOP ;$+07
8689 3E 40 LD A,40h
868B 32 DA 83 LD (DEMO),A
868E ;
868E ;Main game loop
868E ;
868E 3A D7 83 LOOP: LD A,(NOMEN)
8691 21 A0 50 LD HL,SCREEN + 4096 + 5*32
8694 B7 OR A
8695 28 19 JR Z,R8730 ;$+1B
8697 47 LD B,A
8698 0E 00 R8718: LD C,0
869A E5 PUSH HL
869B C5 PUSH BC
869C 3A DB 83 LD A,(B845B)
869F 07 RLCA
86A0 07 RLCA
86A1 07 RLCA
86A2 E6 60 AND 60h
86A4 5F LD E,A
86A5 16 82 LD D,82h
86A7 CD 74 8F CALL DRWFIX
86AA C1 POP BC
86AB E1 POP HL
86AC 23 INC HL
86AD 23 INC HL
86AE 10 E8 DJNZ R8718 ;$-16
86B0 3A DD 83 R8730: LD A,(CHEAT)
86B3 FE 07 CP 7
86B5 20 08 JR NZ,R873F ;$+0A
86B7 11 E0 BA LD DE,SP_FOOT
86BA 0E 00 LD C,0
86BC CD 74 8F CALL DRWFIX
86BF R873F:
86BF 21 00 5E LD HL,BK_ATTR
86C2 11 00 5C LD DE,WK_ATTR
86C5 01 00 02 LD BC,512
86C8 ED B0 LDIR
86CA 21 00 70 LD HL,T7000
86CD 11 00 60 LD DE,T6000
86D0 01 00 10 LD BC,4096
86D3 ED B0 LDIR
86D5 CD 8F 8C CALL C8D0F
86D8 3A DA 83 LD A,(DEMO)
86DB B7 OR A
86DC CC 3B 8A CALL Z,C8ABB
86DF 3A DA 83 LD A,(DEMO)
86E2 B7 OR A
86E3 CC BA 91 CALL Z,C923A
86E6 CD 2A 8D CALL C8DAA ;In JSW this is at 89ECh.
86E9 CD 85 90 CALL C9105
86EC CD E3 8E CALL PAINT_ITEMS
86EF ;
86EF ; Special-case code
86EF ;
86EF 3A 87 83 LD A,(SHEET)
86F2 FE 04 CP 4 ;Eugene's Lair
86F4 CC 78 8D CALL Z,EUGENE
86F7 3A 87 83 LD A,(SHEET)
86FA FE 0D CP 0Dh ;Skylab Landing Bay
86FC CA F5 8D JP Z,SKYLAB
86FF 3A 87 83 LD A,(SHEET)
8702 FE 08 CP 8 ;Wacky Amoebatrons and more: Vertical guardians
8704 D4 71 8E CALL NC,VGUARD
8707 3A 87 83 LD A,(SHEET)
870A FE 07 CP 7 ;Kong Beast
870C CC B5 90 CALL Z,KONG
870F 3A 87 83 LD A,(SHEET)
8712 FE 0B CP 0Bh ;Kong Beast
8714 CC B5 90 CALL Z,KONG
8717 3A 87 83 LD A,(SHEET)
871A FE 12 CP 12h ;Solar Power Generator
871C CC F3 8C CALL Z,SOLAR
871F L879F:
871F CD 45 8F CALL CHK_PORTAL
8722 L87A2:
8722 21 00 60 LD HL,T6000
8725 11 00 40 LD DE,SCREEN
8728 01 00 10 LD BC,4096
872B ED B0 LDIR
872D 3A D8 83 LD A,(B8458)
8730 B7 OR A
8731 28 15 JR Z,R87C8 ;$+17
8733 3D DEC A
8734 32 D8 83 LD (B8458),A
8737 07 RLCA
8738 07 RLCA
8739 07 RLCA
873A E6 38 AND 38h
873C 21 00 5C LD HL,WK_ATTR
873F 11 01 5C LD DE,WK_ATTR+1
8742 01 FF 01 LD BC,511
8745 77 LD (HL),A
8746 ED B0 LDIR
8748 R87C8:
8748 21 00 5C LD HL,WK_ATTR
874B 11 00 58 LD DE,ATTR
874E 01 00 02 LD BC,512
8751 ED B0 LDIR
8753 DD 21 A9 83 LD IX,SCORBUF
8757 11 BA 50 LD DE,SCREEN + 4096 + 5*32 + 26 ;AT 21,26
875A 0E 06 LD C,6
875C CD 3A 92 CALL PMESS
875F DD 21 9F 83 LD IX,HGHSCOR
8763 11 6B 50 LD DE,SCREEN + 4096 + 3*32 + 11
8766 0E 06 LD C,6
8768 CD 3A 92 CALL PMESS
876B CD BC 89 CALL AIR_DOWN ;Normal decrease of air.
876E CA 7F 88 JP Z,MANDEAD
8771 01 FE FE LD BC,0FEFEh
8774 ED 78 IN A,(C)
8776 5F LD E,A
8777 06 7F LD B,7Fh
8779 ED 78 IN A,(C)
877B B3 OR E
877C E6 01 AND 1
877E CA 4C 85 JP Z,START
8781 06 FD LD B,0FDh ;Check the A-G row for Pause.
8783 ED 78 IN A,(C)
8785 E6 1F AND 1Fh
8787 FE 1F CP 1Fh
8789 28 0A JR Z,R8815 ;$+0C
878B R880B:
878B 06 02 LD B,2 ;In a pause. Wait for a keypress in any
878D ED 78 IN A,(C) ;other row than A-G.
878F E6 1F AND 1Fh
8791 FE 1F CP 1Fh
8793 28 F6 JR Z,R880B ;$-08
8795 R8815:
8795 3A 6B 80 LD A,(AIRBORNE)
8798 FE FF CP 0FFh
879A CA 7F 88 JP Z,MANDEAD
879D 06 BF LD B,0BFh
879F 21 DC 83 LD HL,T845C
87A2 ED 78 IN A,(C)
87A4 E6 1F AND 1Fh
87A6 FE 1F CP 1Fh
87A8 28 0A JR Z,R8834 ;$+0C
87AA CB 46 BIT 0,(HL)
87AC 20 08 JR NZ,R8836 ;$+0A
87AE 7E LD A,(HL)
87AF EE 03 XOR 3
87B1 77 LD (HL),A
87B2 18 02 JR R8836 ;$+04
87B4 R8834:
87B4 CB 86 RES 0,(HL)
87B6 R8836:
87B6 CB 4E BIT 1,(HL)
87B8 20 25 JR NZ,NONOTE4 ;$+27
87BA 3A DB 83 LD A,(B845B)
87BD 3C INC A
87BE 32 DB 83 LD (B845B),A
87C1 E6 7E AND 7Eh
87C3 0F RRCA
87C4 5F LD E,A
87C5 16 00 LD D,0
87C7 21 0C 85 LD HL,T858C
87CA 19 ADD HL,DE
87CB 3A 73 80 LD A,(BORDER) ;Border
87CE 5E LD E,(HL)
87CF 01 03 00 LD BC,3
87D2 D3 FE TM51: OUT (0FEh),A
87D4 ;
87D4 ;Source for this bit is present at X934C
87D4 ;
87D4 1D X8854: DEC E
87D5 20 03 JR NZ,NOFLP6
87D7 5E LD E,(HL)
87D8 EE 18 XOR 18h
87DA 10 F6 NOFLP6: DJNZ TM51 ;$-08
87DC 0D DEC C
87DD 20 F3 JR NZ,TM51 ;$-0B
87DF NONOTE4:
87DF 3A DA 83 LD A,(DEMO)
87E2 B7 OR A
87E3 28 1F JR Z,NODEM1 ;$+21
87E5 3D DEC A
87E6 CA 7F 88 JP Z,MANDEAD
87E9 32 DA 83 LD (DEMO),A
87EC 01 FE 00 LD BC,0FEh ;Check for any keypress
87EF ED 78 IN A,(C)
87F1 E6 1F AND 1Fh
87F3 FE 1F CP 1Fh ;and if there is one, return to the opening
87F5 C2 4C 85 JP NZ,START ;screen.
87F8 3A D9 83 LD A,(KEMP)
87FB B7 OR A
87FC 28 06 JR Z,NODEM1 ;$+08
87FE DB 1F IN A,(1Fh)
8800 B7 OR A
8801 C2 4C 85 JP NZ,START
8804 01 FE EF NODEM1: LD BC,0EFFEh ;Keys 6-9
8807 ED 78 IN A,(C)
8809 CB 67 BIT 4,A ;Check for "6"
880B C2 28 88 JP NZ,CKCHEAT
880E 3A DD 83 LD A,(CHEAT) ;and if it's pressed, check for cheat mode
8811 FE 07 CP 7
8813 C2 28 88 JP NZ,CKCHEAT
8816 06 F7 LD B,0F7h ;And if it's on, get the room from keys
8818 ED 78 IN A,(C) ;1-5
881A 2F CPL
881B E6 1F AND 1Fh
881D FE 14 CP 14h ;If it's >20, cancel
881F D2 28 88 JP NC,CKCHEAT
8822 32 87 83 LD (SHEET),A ;Else jump to new room
8825 C3 11 86 JP NEWSHT
8828 CKCHEAT:
8828 3A DD 83 LD A,(CHEAT) ;If in cheat mode, don't check
882B FE 07 CP 7
882D CA 8E 86 JP Z,LOOP
8830 07 RLCA
8831 5F LD E,A
8832 16 00 LD D,0
8834 DD 21 E0 83 LD IX,CHEATDT
8838 DD 19 ADD IX,DE
883A 01 FE F7 LD BC,0F7FEh ;Test keys 1-5
883D ED 78 IN A,(C)
883F E6 1F AND 1Fh
8841 DD BE 00 CP (IX+0) ;Next character in sequence?
8844 28 12 JR Z,CKNXCHT
8846 FE 1F CP 1Fh ;No character?
8848 CA 8E 86 JP Z,LOOP
884B DD BE FE CP (IX+-2) ;Current character in sequence?
884E CA 8E 86 JP Z,LOOP
8851 AF XOR A ;Incorrect character
8852 32 DD 83 LD (CHEAT),A
8855 C3 8E 86 JP LOOP
8858 CKNXCHT: ;Test keys 6-9
8858 06 EF LD B,0EFh
885A ED 78 IN A,(C)
885C E6 1F AND 1Fh
885E DD BE 01 CP (IX+1) ;Next character
8861 28 12 JR Z,INCCHT
8863 FE 1F CP 1Fh ;No character
8865 CA 8E 86 JP Z,LOOP
8868 DD BE FF CP (IX+-1) ;Current character
886B CA 8E 86 JP Z,LOOP
886E AF XOR A ;Incorrect character
886F 32 DD 83 LD (CHEAT),A
8872 C3 8E 86 JP LOOP
8875 3A DD 83 INCCHT: LD A,(CHEAT) ;Move to next character in the code
8878 3C INC A
8879 32 DD 83 LD (CHEAT),A
887C C3 8E 86 JP LOOP
887F ;
887F MANDEAD:
887F 3A DA 83 LD A,(DEMO)
8882 B7 OR A
8883 C2 A8 8F JP NZ,NXSHEET
8886 3E 47 LD A,47h
8888 LPDEAD1:
8888 21 00 58 LD HL,ATTR
888B 11 01 58 LD DE,ATTR+1
888E 01 FF 01 LD BC,511 ;Attributes to white on black
8891 77 LD (HL),A
8892 ED B0 LDIR
8894 5F LD E,A
8895 2F CPL
8896 E6 07 AND 7
8898 07 RLCA
8899 07 RLCA
889A 07 RLCA
889B F6 07 OR 7
889D 57 LD D,A
889E 4B LD C,E
889F CB 09 RRC C
88A1 CB 09 RRC C
88A3 CB 09 RRC C
88A5 F6 10 OR 10h
88A7 AF XOR A
88A8 D3 FE TM21: OUT (0FEh),A
88AA EE 18 XOR 18h
88AC 42 LD B,D
88AD 10 FE TM22: DJNZ TM22
88AF 0D DEC C
88B0 20 F6 JR NZ,TM21
88B2 7B LD A,E
88B3 3D DEC A
88B4 FE 3F CP 3Fh
88B6 20 D0 JR NZ,LPDEAD1
88B8 21 D7 83 LD HL,NOMEN
88BB 7E LD A,(HL)
88BC B7 OR A
88BD CA C4 88 JP Z,ENDGAM
88C0 35 DEC (HL)
88C1 C3 11 86 JP NEWSHT
88C4 21 9F 83 ENDGAM: LD HL,HGHSCOR ;Compare high score
88C7 11 A9 83 LD DE,SCORBUF ;with current score
88CA 06 06 LD B,6
88CC 1A LPHGH: LD A,(DE)
88CD BE CP (HL)
88CE DA E3 88 JP C,FEET ;Current score is less
88D1 C2 D8 88 JP NZ,NEWHGH ;Current score is more
88D4 23 INC HL
88D5 13 INC DE
88D6 10 F4 DJNZ LPHGH
88D8 21 A9 83 NEWHGH: LD HL,SCORBUF ;Set high score to current
88DB 11 9F 83 LD DE,HGHSCOR
88DE 01 06 00 LD BC,6
88E1 ED B0 LDIR
88E3 21 00 40 FEET: LD HL,SCREEN ;Foot animation
88E6 11 01 40 LD DE,SCREEN+1
88E9 01 FF 0F LD BC,4095
88EC 36 00 LD (HL),0
88EE ED B0 LDIR
88F0 AF XOR A ;Eugene's height
88F1 32 DC 80 LD (EUGHGT),A
88F4 11 40 82 LD DE,MANDAT+64
88F7 21 8F 48 LD HL,SCREEN+800h+4*32+15
88FA 0E 00 LD C,0
88FC CD 74 8F CALL DRWFIX ;Draw Willy
88FF 11 E0 B6 LD DE,SP_PEDE
8902 21 CF 48 LD HL,SCREEN+800h+6*32+15
8905 0E 00 LD C,0
8907 CD 74 8F CALL DRWFIX ;Draw pedestal
890A 3A DC 80 LOOPFT: LD A,(EUGHGT)
890D 4F LD C,A
890E 06 83 LD B,83h
8910 0A LD A,(BC) ;Calc foot position
8911 F6 0F OR 0Fh
8913 6F LD L,A
8914 03 INC BC
8915 0A LD A,(BC)
8916 D6 20 SUB 20h
8918 67 LD H,A
8919 11 E0 BA LD DE,SP_FOOT
891C 0E 00 LD C,0
891E CD 74 8F CALL DRWFIX ;Draw foot
8921 3A DC 80 LD A,(EUGHGT)
8924 2F CPL
8925 5F LD E,A
8926 AF XOR A
8927 01 40 00 LD BC,64
892A D3 FE TM111: OUT (0FEh),A
892C EE 18 XOR 18h
892E 43 LD B,E
892F 10 F9 TM112: DJNZ TM111 ;$-00
8931 0D DEC C
8932 20 FB JR NZ,TM112 ;$-08
8934 21 00 58 LD HL,ATTR
8937 11 01 58 LD DE,ATTR+1
893A 01 FF 01 LD BC,511
893D 3A DC 80 LD A,(EUGHGT)
8940 E6 0C AND 0Ch ;Flicker colours
8942 07 RLCA
8943 F6 47 OR 47h
8945 77 LD (HL),A
8946 ED B0 LDIR
8948 3A DC 80 LD A,(EUGHGT)
894B C6 04 ADD A,4
894D 32 DC 80 LD (EUGHGT),A
8950 FE C4 CP 0C4h
8952 20 B6 JR NZ,LOOPFT ;$-48
8954 DD 21 CF 83 LD IX,MESSG
8958 0E 04 LD C,4
895A 11 CA 40 LD DE,SCREEN + 6*32 + 10
895D CD 3A 92 CALL PMESS
8960 DD 21 D3 83 LD IX,MESSO
8964 0E 04 LD C,4
8966 11 D2 40 LD DE,SCREEN + 6*32 + 18
8969 CD 3A 92 CALL PMESS
896C 01 00 00 LD BC,0
896F 16 06 LD D,6
8971 10 FE TM91: DJNZ TM91
8973 79 LD A,C ;Make the "game over" message flicker
8974 E6 07 AND 7
8976 F6 40 OR 40h
8978 32 CA 58 LD (ATTR + 6*32 + 10),A
897B 3C INC A
897C E6 07 AND 7
897E F6 40 OR 40h
8980 32 CB 58 LD (ATTR + 6*32 + 11),A
8983 3C INC A
8984 E6 07 AND 7
8986 F6 40 OR 40h
8988 32 CC 58 LD (ATTR + 6*32 + 12),A
898B 3C INC A
898C E6 07 AND 7
898E F6 40 OR 40h
8990 32 CD 58 LD (ATTR + 6*32 + 13),A
8993 3C INC A
8994 E6 07 AND 7
8996 F6 40 OR 40h
8998 32 D2 58 LD (ATTR + 6 * 32 + 18),A
899B 3C INC A
899C E6 07 AND 7
899E F6 40 OR 40h
89A0 32 D3 58 LD (ATTR + 6 * 32 + 19),A
89A3 3C INC A
89A4 E6 07 AND 7
89A6 F6 40 OR 40h
89A8 32 D4 58 LD (ATTR + 6 * 32 + 20),A
89AB 3C INC A
89AC E6 07 AND 7
89AE F6 40 OR 40h
89B0 32 D5 58 LD (ATTR + 6 * 32 + 21),A
89B3 0D DEC C
89B4 20 BB JR NZ,TM91
89B6 15 DEC D
89B7 20 B8 JR NZ,TM91
89B9 C3 4C 85 JP START
89BC AIR_DOWN:
89BC 3A BD 80 LD A,(AIR_MINOR)
89BF D6 04 SUB 4
89C1 32 BD 80 LD (AIR_MINOR),A
89C4 FE FC CP 0FCh
89C6 20 0D JR NZ,R8A55 ;$+0F
89C8 3A BC 80 LD A,(AIR_MAJOR)
89CB FE 24 CP 24h
89CD C8 RET Z
89CE 3D DEC A
89CF 32 BC 80 LD (AIR_MAJOR),A
89D2 3A BD 80 LD A,(AIR_MINOR)
89D5 R8A55:
89D5 E6 E0 AND 0E0h
89D7 07 RLCA
89D8 07 RLCA
89D9 07 RLCA
89DA 1E 00 LD E,0
89DC B7 OR A
89DD 28 07 JR Z,R8A66 ;$+09
89DF 47 LD B,A
89E0 R8A60:
89E0 CB 0B RRC E
89E2 CB FB SET 7,E
89E4 10 FA DJNZ R8A60 ;$-04
89E6 R8A66:
89E6 3A BC 80 LD A,(AIR_MAJOR)
89E9 6F LD L,A
89EA 26 52 LD H,52h
89EC 06 04 LD B,4
89EE R8A6E:
89EE 73 LD (HL),E
89EF 24 INC H
89F0 10 FC DJNZ R8A6E ;$-02
89F2 AF XOR A
89F3 3C INC A
89F4 C9 RET
89F5 C8A75:
89F5 DD 21 00 5E LD IX,BK_ATTR
89F9 3E 70 LD A,70h
89FB 32 1C 8A LD (L8A9B+1),A
89FE CD 0A 8A CALL C8A8A
8A01 DD 21 00 5F LD IX,T5E00 + 100h
8A05 3E 78 LD A,78h
8A07 32 1C 8A LD (L8A9B+1),A
8A0A 0E 00 C8A8A: LD C,0
8A0C 59 L8A8C: LD E,C
8A0D DD 7E 00 LD A,(IX+0)
8A10 21 20 80 LD HL,ELEM_AIR
8A13 01 48 00 LD BC,72
8A16 ED B1 CPIR
8A18 4B LD C,E
8A19 06 08 LD B,8
8A1B 16 00 L8A9B: LD D,0
8A1D 7E R8A9D: LD A,(HL)
8A1E 12 LD (DE),A
8A1F 23 INC HL
8A20 14 INC D
8A21 10 FA DJNZ R8A9D ;$-04
8A23 DD 23 INC IX
8A25 0C INC C
8A26 C2 0C 8A JP NZ,L8A8C
8A29 3A 87 83 LD A,(SHEET)
8A2C FE 13 CP 13h
8A2E C0 RET NZ
8A2F 21 00 A0 LD HL,0A000h ;Title page
8A32 11 00 70 LD DE,T7000
8A35 01 00 08 LD BC,2048
8A38 ED B0 LDIR
8A3A C9 RET
8A3B C8ABB:
8A3B 3A 6B 80 LD A,(AIRBORNE)
8A3E FE 01 CP 1
8A40 20 4E JR NZ,NOT_JUMPING ;$+50
8A42 3A 6E 80 LD A,(JUMP_DIST)
8A45 CB 87 RES 0,A
8A47 D6 08 SUB 8
8A49 21 68 80 LD HL,WILLY_Y
8A4C 86 ADD A,(HL)
8A4D 77 LD (HL),A
8A4E CD 02 8B CALL C8B82
8A51 3A 3B 80 LD A,(ELEM_EARTH)
8A54 BE CP (HL)
8A55 CA 22 8B JP Z,L8BA2
8A58 23 INC HL
8A59 BE CP (HL)
8A5A CA 22 8B JP Z,L8BA2
8A5D 3A 6E 80 LD A,(JUMP_DIST)
8A60 3C INC A
8A61 32 6E 80 LD (JUMP_DIST),A
8A64 D6 08 SUB 8
8A66 F2 6B 8A JP P,L8AEB
8A69 ED 44 NEG
8A6B L8AEB:
8A6B 3C INC A
8A6C 07 RLCA
8A6D 07 RLCA
8A6E 07 RLCA
8A6F 57 LD D,A
8A70 0E 20 LD C,20h
8A72 3A 73 80 LD A,(BORDER) ;Border
8A75 R8AF5:
8A75 D3 FE OUT (0FEh),A
8A77 EE 18 XOR 18h
8A79 42 LD B,D
8A7A R8AFA:
8A7A 10 FE DJNZ R8AFA ;$-00
8A7C 0D DEC C
8A7D 20 F6 JR NZ,R8AF5 ;$-08
8A7F 3A 6E 80 LD A,(JUMP_DIST)
8A82 FE 12 CP 12h
8A84 CA 16 8B JP Z,L8B96
8A87 FE 10 CP 10h
8A89 28 05 JR Z,NOT_JUMPING ;$+07
8A8B FE 0D CP 0Dh
8A8D C2 03 8C JP NZ,L8C83
8A90 NOT_JUMPING: ;This corresponds to JSW at 0E36h or so.
8A90 3A 68 80 LD A,(WILLY_Y)
8A93 E6 0F AND 0Fh
8A95 20 3A JR NZ,FALL_INTO ;$+3C
8A97 2A 6C 80 LD HL,(WILLY_POS)
8A9A 11 40 00 LD DE,64
8A9D 19 ADD HL,DE
8A9E 3A 32 80 LD A,(ELEM_CRUMBLY)
8AA1 BE CP (HL)
8AA2 CC 3A 8B CALL Z,CRUMBLE
8AA5 3A 4D 80 LD A,(ELEM_FIRE1)
8AA8 BE CP (HL)
8AA9 28 26 JR Z,FALL_INTO ;$+28
8AAB 3A 56 80 LD A,(ELEM_FIRE2)
8AAE BE CP (HL)
8AAF 28 20 JR Z,FALL_INTO ;$+22
8AB1 23 INC HL
8AB2 3A 32 80 LD A,(ELEM_CRUMBLY)
8AB5 BE CP (HL)
8AB6 CC 3A 8B CALL Z,CRUMBLE
8AB9 3A 4D 80 LD A,(ELEM_FIRE1)
8ABC BE CP (HL)
8ABD 28 12 JR Z,FALL_INTO ;$+14
8ABF 3A 56 80 LD A,(ELEM_FIRE2)
8AC2 BE CP (HL)
8AC3 28 0C JR Z,FALL_INTO ;$+0E
8AC5 3A 20 80 LD A,(ELEM_AIR)
8AC8 BE CP (HL)
8AC9 2B DEC HL
8ACA C2 5D 8B JP NZ,L8BDD
8ACD BE CP (HL)
8ACE C2 5D 8B JP NZ,L8BDD
8AD1 FALL_INTO:
8AD1 3A 6B 80 LD A,(AIRBORNE)
8AD4 FE 01 CP 1
8AD6 CA 03 8C JP Z,L8C83
8AD9 21 6A 80 LD HL,WILLY_DIR
8ADC CB 8E RES 1,(HL)
8ADE B7 OR A
8ADF CA 1C 8B JP Z,L8B9C
8AE2 3C INC A
8AE3 32 6B 80 LD (AIRBORNE),A
8AE6 07 RLCA
8AE7 07 RLCA
8AE8 07 RLCA
8AE9 07 RLCA
8AEA 57 LD D,A
8AEB 0E 20 LD C,20h
8AED 3A 73 80 LD A,(BORDER) ;Border
8AF0 R8B70:
8AF0 D3 FE OUT (0FEh),A
8AF2 EE 18 XOR 18h
8AF4 42 LD B,D
8AF5 R8B75:
8AF5 10 FE DJNZ R8B75 ;$-00
8AF7 0D DEC C
8AF8 20 F6 JR NZ,R8B70 ;$-08
8AFA 3A 68 80 LD A,(WILLY_Y)
8AFD C6 08 ADD A,8
8AFF 32 68 80 LD (WILLY_Y),A
8B02 C8B82:
8B02 E6 F0 AND 0F0h
8B04 6F LD L,A
8B05 AF XOR A
8B06 CB 15 RL L
8B08 CE 5C ADC A,5Ch
8B0A 67 LD H,A
8B0B 3A 6C 80 LD A,(WILLY_POS)
8B0E E6 1F AND 1Fh
8B10 B5 OR L
8B11 6F LD L,A
8B12 22 6C 80 LD (WILLY_POS),HL
8B15 C9 RET
8B16 L8B96:
8B16 3E 06 LD A,6
8B18 32 6B 80 LD (AIRBORNE),A
8B1B C9 RET
8B1C L8B9C:
8B1C 3E 02 LD A,2
8B1E 32 6B 80 LD (AIRBORNE),A
8B21 C9 RET
8B22 L8BA2:
8B22 3A 68 80 LD A,(WILLY_Y)
8B25 C6 10 ADD A,10h
8B27 E6 F0 AND 0F0h
8B29 32 68 80 LD (WILLY_Y),A
8B2C CD 02 8B CALL C8B82
8B2F 3E 02 LD A,2
8B31 32 6B 80 LD (AIRBORNE),A
8B34 21 6A 80 LD HL,WILLY_DIR
8B37 CB 8E RES 1,(HL)
8B39 C9 RET
8B3A CRUMBLE:
8B3A 4D LD C,L ;eg: in Central Cavern, HL = 5D97
8B3B 7C LD A,H ;then BC becomes 7F97.
8B3C C6 1B ADD A,1Bh
8B3E F6 07 OR 7
8B40 47 LD B,A ;BC = address of graphic for this cell.
8B41 R8BC1:
8B41 05 DEC B ;Move graphic down 1 row.
8B42 0A LD A,(BC)
8B43 04 INC B
8B44 02 LD (BC),A
8B45 05 DEC B
8B46 78 LD A,B
8B47 E6 07 AND 7
8B49 20 F6 JR NZ,R8BC1 ;$-08
8B4B AF XOR A
8B4C 02 LD (BC),A
8B4D 78 LD A,B
8B4E C6 07 ADD A,7
8B50 47 LD B,A
8B51 0A LD A,(BC) ;Introduce a blank line at the top.
8B52 B7 OR A
8B53 C0 RET NZ
8B54 3A 20 80 LD A,(ELEM_AIR)
8B57 24 INC H
8B58 24 INC H
8B59 77 LD (HL),A
8B5A 25 DEC H
8B5B 25 DEC H
8B5C C9 RET
8B5D L8BDD:
8B5D 3A 6B 80 LD A,(AIRBORNE)
8B60 FE 0C CP 0Ch
8B62 D2 86 8C JP NC,L8D06
8B65 1E FF LD E,0FFh
8B67 AF XOR A
8B68 32 6B 80 LD (AIRBORNE),A
8B6B 3A 44 80 LD A,(ELEM_CONVEY)
8B6E BE CP (HL)
8B6F 28 04 JR Z,R8BF5 ;$+06
8B71 23 INC HL
8B72 BE CP (HL)
8B73 20 06 JR NZ,R8BFB ;$+08
8B75 R8BF5:
8B75 3A 6F 80 LD A,(CONVEY_DIR)
8B78 D6 03 SUB 3
8B7A 5F LD E,A
8B7B R8BFB:
8B7B 01 FE DF LD BC,0DFFEh
8B7E ED 78 IN A,(C)
8B80 E6 1F AND 1Fh
8B82 F6 20 OR 20h
8B84 A3 AND E
8B85 5F LD E,A
8B86 01 FE FB LD BC,0FBFEh
8B89 ED 78 IN A,(C)
8B8B E6 1F AND 1Fh
8B8D CB 07 RLC A
8B8F F6 01 OR 1
8B91 A3 AND E
8B92 5F LD E,A
8B93 06 F7 LD B,0F7h
8B95 ED 78 IN A,(C)
8B97 0F RRCA
8B98 F6 F7 OR 0F7h
8B9A A3 AND E
8B9B 5F LD E,A
8B9C 06 EF LD B,0EFh
8B9E ED 78 IN A,(C)
8BA0 F6 FB OR 0FBh
8BA2 A3 AND E
8BA3 5F LD E,A
8BA4 3A D9 83 LD A,(KEMP)
8BA7 B7 OR A
8BA8 28 0A JR Z,R8C34 ;$+0C
8BAA 01 1F 00 LD BC,1Fh
8BAD ED 78 IN A,(C)
8BAF E6 03 AND 3
8BB1 2F CPL
8BB2 A3 AND E
8BB3 5F LD E,A
8BB4 R8C34:
8BB4 0E 00 LD C,0
8BB6 7B LD A,E
8BB7 E6 2A AND 2Ah
8BB9 FE 2A CP 2Ah
8BBB 28 02 JR Z,R8C3F ;$+04
8BBD 0E 04 LD C,4
8BBF R8C3F:
8BBF 7B LD A,E
8BC0 E6 15 AND 15h
8BC2 FE 15 CP 15h
8BC4 28 02 JR Z,R8C48 ;$+04
8BC6 CB D9 SET 3,C
8BC8 R8C48:
8BC8 3A 6A 80 LD A,(WILLY_DIR)
8BCB 81 ADD A,C
8BCC 4F LD C,A
8BCD 06 00 LD B,0
8BCF 21 88 83 LD HL,T8408
8BD2 09 ADD HL,BC
8BD3 7E LD A,(HL)
8BD4 32 6A 80 LD (WILLY_DIR),A
8BD7 01 FE 7E LD BC,07EFEh
8BDA ED 78 IN A,(C)
8BDC E6 1F AND 1Fh
8BDE FE 1F CP 1Fh
8BE0 20 19 JR NZ,R8C7B ;$+1B
8BE2 06 EF LD B,0EFh
8BE4 ED 78 IN A,(C)
8BE6 E6 09 AND 9
8BE8 FE 09 CP 9
8BEA 20 0F JR NZ,R8C7B ;$+11
8BEC 3A D9 83 LD A,(KEMP)
8BEF B7 OR A
8BF0 28 11 JR Z,L8C83 ;$+13
8BF2 01 1F 00 LD BC,1Fh
8BF5 ED 78 IN A,(C)
8BF7 CB 67 BIT 4,A
8BF9 28 08 JR Z,L8C83 ;$+0A
8BFB R8C7B:
8BFB AF XOR A
8BFC 32 6E 80 LD (JUMP_DIST),A
8BFF 3C INC A
8C00 32 6B 80 LD (AIRBORNE),A
8C03 L8C83:
8C03 3A 6A 80 LD A,(WILLY_DIR)
8C06 E6 02 AND 2
8C08 C8 RET Z
8C09 3A 6A 80 LD A,(WILLY_DIR)
8C0C E6 01 AND 1
8C0E CA 4A 8C JP Z,L8CCA
8C11 3A 69 80 LD A,(WILLY_FRAME)
8C14 B7 OR A
8C15 28 05 JR Z,R8C9C ;$+07
8C17 3D DEC A
8C18 32 69 80 LD (WILLY_FRAME),A
8C1B C9 RET
8C1C R8C9C:
8C1C 2A 6C 80 LD HL,(WILLY_POS)
8C1F 2B DEC HL
8C20 11 20 00 LD DE,32
8C23 19 ADD HL,DE
8C24 3A 3B 80 LD A,(ELEM_EARTH)
8C27 BE CP (HL)
8C28 C8 RET Z
8C29 3A 68 80 LD A,(WILLY_Y)
8C2C E6 0F AND 0Fh
8C2E 28 09 JR Z,R8CB9 ;$+0B
8C30 3A 3B 80 LD A,(ELEM_EARTH)
8C33 19 ADD HL,DE
8C34 BE CP (HL)
8C35 C8 RET Z
8C36 B7 OR A
8C37 ED 52 SBC HL,DE
8C39 R8CB9:
8C39 3A 3B 80 LD A,(ELEM_EARTH)
8C3C B7 OR A
8C3D ED 52 SBC HL,DE
8C3F BE CP (HL)
8C40 C8 RET Z
8C41 22 6C 80 LD (WILLY_POS),HL
8C44 3E 03 LD A,3
8C46 32 69 80 LD (WILLY_FRAME),A
8C49 C9 RET
8C4A L8CCA:
8C4A 3A 69 80 LD A,(WILLY_FRAME)
8C4D FE 03 CP 3
8C4F 28 05 JR Z,R8CD6 ;$+07
8C51 3C INC A
8C52 32 69 80 LD (WILLY_FRAME),A
8C55 C9 RET
8C56 R8CD6:
8C56 2A 6C 80 LD HL,(WILLY_POS)
8C59 23 INC HL
8C5A 23 INC HL
8C5B 11 20 00 LD DE,32
8C5E 3A 3B 80 LD A,(ELEM_EARTH)
8C61 19 ADD HL,DE
8C62 BE CP (HL)
8C63 C8 RET Z
8C64 3A 68 80 LD A,(WILLY_Y)
8C67 E6 0F AND 0Fh
8C69 28 09 JR Z,R8CF4 ;$+0B
8C6B 3A 3B 80 LD A,(ELEM_EARTH)
8C6E 19 ADD HL,DE
8C6F BE CP (HL)
8C70 C8 RET Z
8C71 B7 OR A
8C72 ED 52 SBC HL,DE
8C74 R8CF4:
8C74 3A 3B 80 LD A,(ELEM_EARTH)
8C77 B7 OR A
8C78 ED 52 SBC HL,DE
8C7A BE CP (HL)
8C7B C8 RET Z
8C7C 2B DEC HL
8C7D 22 6C 80 LD (WILLY_POS),HL
8C80 AF XOR A
8C81 32 69 80 LD (WILLY_FRAME),A
8C84 C9 RET
8C85 L8D05:
8C85 E1 POP HL
8C86 L8D06:
8C86 E1 POP HL
8C87 L8D07:
8C87 3E FF LD A,0FFh
8C89 32 6B 80 LD (AIRBORNE),A
8C8C C3 22 87 JP L87A2
8C8F C8D0F:
8C8F FD 21 BE 80 LD IY,HGUARDS
8C93 11 07 00 LD DE,7
8C96 R8D16:
8C96 FD 7E 00 LD A,(IY+0)
8C99 FE FF CP 0FFh
8C9B C8 RET Z
8C9C B7 OR A
8C9D 28 50 JR Z,R8D6F ;$+52
8C9F 3A BD 80 LD A,(AIR_MINOR)
8CA2 E6 04 AND 4
8CA4 0F RRCA
8CA5 0F RRCA
8CA6 0F RRCA
8CA7 FD A6 00 AND (IY+0)
8CAA 20 43 JR NZ,R8D6F ;$+45
8CAC FD 7E 04 LD A,(IY+4)
8CAF FE 03 CP 3
8CB1 28 10 JR Z,R8D43 ;$+12
8CB3 FE 04 CP 4
8CB5 28 23 JR Z,R8D5A ;$+25
8CB7 30 05 JR NC,R8D3E ;$+07
8CB9 FD 34 04 INC (IY+4)
8CBC 18 31 JR R8D6F ;$+33
8CBE R8D3E:
8CBE FD 35 04 DEC (IY+4)
8CC1 18 2C JR R8D6F ;$+2E
8CC3 R8D43:
8CC3 FD 7E 01 LD A,(IY+1)
8CC6 FD BE 06 CP (IY+6)
8CC9 20 06 JR NZ,R8D51 ;$+08
8CCB FD 36 04 07 LD (IY+4),7
8CCF 18 1E JR R8D6F ;$+20
8CD1 R8D51:
8CD1 FD 36 04 00 LD (IY+4),0
8CD5 FD 34 01 INC (IY+1)
8CD8 18 15 JR R8D6F ;$+17
8CDA R8D5A:
8CDA FD 7E 01 LD A,(IY+1)
8CDD FD BE 05 CP (IY+5)
8CE0 20 06 JR NZ,R8D68 ;$+08
8CE2 FD 36 04 00 LD (IY+4),0
8CE6 18 07 JR R8D6F ;$+09
8CE8 R8D68:
8CE8 FD 36 04 07 LD (IY+4),7
8CEC FD 35 01 DEC (IY+1)
8CEF R8D6F:
8CEF FD 19 ADD IY,DE
8CF1 18 A3 JR R8D16 ;$-5B
8CF3 21 17 5C SOLAR: LD HL,WK_ATTR+23
8CF6 11 20 00 LD DE,32
8CF9 R8D79:
8CF9 3A 29 80 LD A,(ELEM_WATER)
8CFC BE CP (HL)
8CFD C8 RET Z
8CFE 3A 3B 80 LD A,(ELEM_EARTH)
8D01 BE CP (HL)
8D02 C8 RET Z
8D03 3E 27 LD A,27h
8D05 BE CP (HL)
8D06 20 10 JR NZ,R8D98 ;$+12
8D08 D9 EXX
8D09 CD BC 89 CALL AIR_DOWN ;Hit by solar beam?
8D0C CD BC 89 CALL AIR_DOWN
8D0F CD BC 89 CALL AIR_DOWN
8D12 CD BC 89 CALL AIR_DOWN
8D15 D9 EXX
8D16 18 0D JR R8DA5 ;$+0F
8D18 R8D98:
8D18 3A 20 80 LD A,(ELEM_AIR)
8D1B BE CP (HL)
8D1C 28 07 JR Z,R8DA5 ;$+09
8D1E 7B LD A,E
8D1F EE DF XOR 0DFh
8D21 5F LD E,A
8D22 7A LD A,D
8D23 2F CPL
8D24 57 LD D,A
8D25 R8DA5:
8D25 36 77 LD (HL),77h
8D27 19 ADD HL,DE
8D28 18 CF JR R8D79 ;$-2F
8D2A C8DAA:
8D2A FD 21 BE 80 LD IY,HGUARDS
8D2E R8DAE:
8D2E FD 7E 00 LD A,(IY+0)
8D31 FE FF CP 0FFh
8D33 C8 RET Z
8D34 B7 OR A
8D35 28 3A JR Z,R8DF1 ;$+3C
8D37 11 1F 00 LD DE,31
8D3A FD 6E 01 LD L,(IY+1)
8D3D FD 66 02 LD H,(IY+2)
8D40 E6 7F AND 7Fh
8D42 77 LD (HL),A
8D43 23 INC HL
8D44 77 LD (HL),A
8D45 19 ADD HL,DE
8D46 77 LD (HL),A
8D47 23 INC HL
8D48 77 LD (HL),A
8D49 0E 01 LD C,1
8D4B FD 7E 04 LD A,(IY+4)
8D4E 0F RRCA
8D4F 0F RRCA
8D50 0F RRCA
8D51 5F LD E,A
8D52 3A 87 83 LD A,(SHEET)
8D55 FE 07 CP 7
8D57 38 0A JR C,R8DE3 ;$+0C
8D59 FE 09 CP 9
8D5B 28 06 JR Z,R8DE3 ;$+08
8D5D FE 0F CP 0Fh
8D5F 28 02 JR Z,R8DE3 ;$+04
8D61 CB FB SET 7,E
8D63 R8DE3:
8D63 16 81 LD D,81h
8D65 FD 6E 01 LD L,(IY+1)
8D68 FD 66 03 LD H,(IY+3)
8D6B CD 74 8F CALL DRWFIX
8D6E C2 86 8C JP NZ,L8D06
8D71 R8DF1:
8D71 11 07 00 LD DE,7
8D74 FD 19 ADD IY,DE
8D76 18 B6 JR R8DAE ;$-48
8D78 3A 74 80 EUGENE: LD A,(PORTAL_CLOSED)
8D7B B7 OR A
8D7C 28 11 JR Z,R8E0F ;$+13
8D7E 3A DB 80 LD A,(B80DB)
8D81 B7 OR A
8D82 28 0B JR Z,R8E0F ;$+0D
8D84 3A DC 80 LD A,(EUGHGT)
8D87 3D DEC A
8D88 28 12 JR Z,R8E1C ;$+14
8D8A 32 DC 80 LD (EUGHGT),A
8D8D 18 15 JR R8E24 ;$+17
8D8F R8E0F:
8D8F 3A DC 80 LD A,(EUGHGT)
8D92 3C INC A
8D93 FE 58 CP 58h
8D95 28 05 JR Z,R8E1C ;$+07
8D97 32 DC 80 LD (EUGHGT),A
8D9A 18 08 JR R8E24 ;$+0A
8D9C R8E1C:
8D9C 3A DB 80 LD A,(B80DB)
8D9F EE 01 XOR 1
8DA1 32 DB 80 LD (B80DB),A
8DA4 R8E24:
8DA4 3A DC 80 LD A,(EUGHGT)
8DA7 E6 7F AND 7Fh
8DA9 07 RLCA
8DAA 5F LD E,A
8DAB 16 83 LD D,83h
8DAD 1A LD A,(DE)
8DAE F6 0F OR 0Fh
8DB0 6F LD L,A
8DB1 13 INC DE
8DB2 1A LD A,(DE)
8DB3 67 LD H,A
8DB4 11 E0 80 LD DE,VGUARDS+3 ;Vertical guardian 0's position
8DB7 0E 01 LD C,1
8DB9 CD 74 8F CALL DRWFIX
8DBC C2 86 8C JP NZ,L8D06
8DBF 3A DC 80 LD A,(EUGHGT)
8DC2 E6 78 AND 78h
8DC4 07 RLCA
8DC5 F6 07 OR 7
8DC7 37 SCF
8DC8 CB 17 RL A
8DCA 6F LD L,A
8DCB 3E 00 LD A,0
8DCD CE 5C ADC A,5Ch
8DCF 67 LD H,A
8DD0 3A 74 80 LD A,(PORTAL_CLOSED)
8DD3 B7 OR A
8DD4 3E 07 LD A,7
8DD6 20 07 JR NZ,R8E5F ;$+09
8DD8 3A BD 80 LD A,(AIR_MINOR)
8DDB 0F RRCA
8DDC 0F RRCA
8DDD E6 07 AND 7
8DDF R8E5F:
8DDF C8E5F:
8DDF 77 LD (HL),A
8DE0 3A 20 80 LD A,(ELEM_AIR)
8DE3 E6 F8 AND 0F8h
8DE5 B6 OR (HL)
8DE6 77 LD (HL),A
8DE7 11 1F 00 LD DE,31
8DEA 23 INC HL
8DEB 77 LD (HL),A
8DEC 19 ADD HL,DE
8DED 77 LD (HL),A
8DEE 23 INC HL
8DEF 77 LD (HL),A
8DF0 19 ADD HL,DE
8DF1 77 LD (HL),A
8DF2 23 INC HL
8DF3 77 LD (HL),A
8DF4 C9 RET
8DF5 FD 21 DD 80 SKYLAB: LD IY,VGUARDS
8DF9 R8E79:
8DF9 FD 7E 00 LD A,(IY+0)
8DFC FE FF CP 0FFh
8DFE CA 1F 87 JP Z,L879F
8E01 FD 7E 02 LD A,(IY+2)
8E04 FD BE 06 CP (IY+6)
8E07 30 08 JR NC,R8E91 ;$+0A
8E09 FD 86 04 ADD A,(IY+4)
8E0C FD 77 02 LD (IY+2),A
8E0F 18 1E JR R8EAF ;$+20
8E11 R8E91:
8E11 FD 34 01 INC (IY+1)
8E14 FD 7E 01 LD A,(IY+1)
8E17 FE 08 CP 8
8E19 20 14 JR NZ,R8EAF ;$+16
8E1B FD 7E 05 LD A,(IY+5)
8E1E FD 77 02 LD (IY+2),A
8E21 FD 7E 03 LD A,(IY+3)
8E24 C6 08 ADD A,8
8E26 E6 1F AND 1Fh
8E28 FD 77 03 LD (IY+3),A
8E2B FD 36 01 00 LD (IY+1),0
8E2F R8EAF:
8E2F FD 5E 02 LD E,(IY+2)
8E32 CB 03 RLC E
8E34 16 83 LD D,83h
8E36 1A LD A,(DE)
8E37 FD 86 03 ADD A,(IY+3)
8E3A 6F LD L,A
8E3B 13 INC DE
8E3C 1A LD A,(DE)
8E3D 67 LD H,A
8E3E FD 7E 01 LD A,(IY+1)
8E41 0F RRCA
8E42 0F RRCA
8E43 0F RRCA
8E44 5F LD E,A
8E45 16 81 LD D,81h
8E47 0E 01 LD C,1
8E49 CD 74 8F CALL DRWFIX
8E4C C2 87 8C JP NZ,L8D07
8E4F FD 7E 02 LD A,(IY+2)
8E52 E6 40 AND 40h
8E54 07 RLCA
8E55 07 RLCA
8E56 C6 5C ADD A,5Ch
8E58 67 LD H,A
8E59 FD 7E 02 LD A,(IY+2)
8E5C 07 RLCA
8E5D 07 RLCA
8E5E E6 E0 AND 0E0h
8E60 FD B6 03 OR (IY+3)
8E63 6F LD L,A
8E64 FD 7E 00 LD A,(IY+0)
8E67 CD DF 8D CALL C8E5F
8E6A 11 07 00 LD DE,7
8E6D FD 19 ADD IY,DE
8E6F 18 88 JR R8E79 ;$-76
8E71 FD 21 DD 80 VGUARD: LD IY,VGUARDS
8E75 FD 7E 00 R8EF5: LD A,(IY+0)
8E78 FE FF CP 0FFh
8E7A C8 RET Z
8E7B FD 34 01 INC (IY+1)
8E7E FD CB 01 96 RES 2,(IY+1)
8E82 FD 7E 02 LD A,(IY+2)
8E85 FD 86 04 ADD A,(IY+4)
8E88 FD BE 05 CP (IY+5)
8E8B 38 0A JR C,R8F17 ;$+0C
8E8D FD BE 06 CP (IY+6)
8E90 30 05 JR NC,R8F17 ;$+07
8E92 FD 77 02 LD (IY+2),A
8E95 18 08 JR R8F1F ;$+0A
8E97 R8F17:
8E97 FD 7E 04 LD A,(IY+4)
8E9A ED 44 NEG
8E9C FD 77 04 LD (IY+4),A
8E9F R8F1F:
8E9F FD 7E 02 LD A,(IY+2)
8EA2 E6 7F AND 7Fh
8EA4 07 RLCA
8EA5 5F LD E,A
8EA6 16 83 LD D,83h
8EA8 1A LD A,(DE)
8EA9 FD B6 03 OR (IY+3)
8EAC 6F LD L,A
8EAD 13 INC DE
8EAE 1A LD A,(DE)
8EAF 67 LD H,A
8EB0 FD 7E 01 LD A,(IY+1)
8EB3 0F RRCA
8EB4 0F RRCA
8EB5 0F RRCA
8EB6 5F LD E,A
8EB7 16 81 LD D,81h
8EB9 0E 01 LD C,1
8EBB CD 74 8F CALL DRWFIX
8EBE C2 86 8C JP NZ,L8D06
8EC1 FD 7E 02 LD A,(IY+2)
8EC4 E6 40 AND 40h
8EC6 07 RLCA
8EC7 07 RLCA
8EC8 C6 5C ADD A,5Ch
8ECA 67 LD H,A
8ECB FD 7E 02 LD A,(IY+2)
8ECE 07 RLCA
8ECF 07 RLCA
8ED0 E6 E0 AND 0E0h
8ED2 FD B6 03 OR (IY+3)
8ED5 6F LD L,A
8ED6 FD 7E 00 LD A,(IY+0)
8ED9 CD DF 8D CALL C8E5F
8EDC 11 07 00 LD DE,7
8EDF FD 19 ADD IY,DE
8EE1 18 92 JR R8EF5 ;$-6C
8EE3 PAINT_ITEMS: ;In JSW this is at 93D1h
8EE3 AF XOR A
8EE4 32 74 80 LD (PORTAL_CLOSED),A
8EE7 FD 21 75 80 LD IY,ITEMS
8EEB R8F6B:
8EEB FD 7E 00 LD A,(IY+0)
8EEE FE FF CP 0FFh
8EF0 28 48 JR Z,R8FBA ;$+4A
8EF2 B7 OR A
8EF3 28 39 JR Z,R8FAE ;$+3B
8EF5 FD 5E 01 LD E,(IY+1)
8EF8 FD 56 02 LD D,(IY+2)
8EFB 1A LD A,(DE)
8EFC E6 07 AND 7
8EFE FE 07 CP 7
8F00 20 0C JR NZ,R8F8E ;$+0E
8F02 21 AC 83 LD HL,SCORBUF+3
8F05 CD 7E 90 CALL C90FE
8F08 FD 36 00 00 LD (IY+0),0
8F0C 18 20 JR R8FAE ;$+22
8F0E R8F8E:
8F0E FD 7E 00 LD A,(IY+0)
8F11 E6 F8 AND 0F8h
8F13 F6 03 OR 3
8F15 47 LD B,A
8F16 FD 7E 00 LD A,(IY+0)
8F19 E6 03 AND 3
8F1B 80 ADD A,B
8F1C FD 77 00 LD (IY+0),A
8F1F 12 LD (DE),A
8F20 32 74 80 LD (PORTAL_CLOSED),A
8F23 FD 56 03 LD D,(IY+3)
8F26 21 B4 80 LD HL,ITEM_GRAPHIC
8F29 06 08 LD B,8
8F2B CD 55 92 CALL C92D5
8F2E R8FAE:
8F2E FD 23 INC IY
8F30 FD 23 INC IY
8F32 FD 23 INC IY
8F34 FD 23 INC IY
8F36 FD 23 INC IY
8F38 18 B1 JR R8F6B ;$-4D
8F3A R8FBA:
8F3A 3A 74 80 LD A,(PORTAL_CLOSED)
8F3D B7 OR A
8F3E C0 RET NZ
8F3F 21 8F 80 LD HL,PORTAL_ATTR
8F42 CB FE SET 7,(HL)
8F44 C9 RET
8F45 CHK_PORTAL:
8F45 2A B0 80 LD HL,(PORTAL_XY)
8F48 3A 6C 80 LD A,(WILLY_POS)
8F4B BD CP L
8F4C 20 11 JR NZ,R8FDF ;$+13
8F4E 3A 6D 80 LD A,(WILLY_POS+1)
8F51 BC CP H
8F52 20 0B JR NZ,R8FDF ;$+0D
8F54 3A 8F 80 LD A,(PORTAL_ATTR)
8F57 CB 7F BIT 7,A
8F59 28 04 JR Z,R8FDF ;$+06
8F5B E1 POP HL
8F5C C3 A8 8F JP NXSHEET
8F5F 3A 8F 80 R8FDF: LD A,(PORTAL_ATTR)
8F62 77 LD (HL),A
8F63 23 INC HL
8F64 77 LD (HL),A
8F65 11 1F 00 LD DE,31
8F68 19 ADD HL,DE
8F69 77 LD (HL),A
8F6A 23 INC HL
8F6B 77 LD (HL),A
8F6C 11 90 80 LD DE,PORTAL_IMAGE
8F6F 2A B2 80 LD HL,(PORTAL_XY+2)
8F72 0E 00 LD C,0
8F74 06 10 DRWFIX: LD B,10h ;Draw a sprite. JSW has this at 9456h.
8F76 CB 41 R8FF6: BIT 0,C
8F78 1A LD A,(DE)
8F79 28 04 JR Z,R8FFF ;$+06
8F7B A6 AND (HL)
8F7C C0 RET NZ
8F7D 1A LD A,(DE)
8F7E B6 OR (HL)
8F7F R8FFF:
8F7F 77 LD (HL),A
8F80 2C INC L
8F81 13 INC DE
8F82 CB 41 BIT 0,C
8F84 1A LD A,(DE)
8F85 28 04 JR Z,R900B ;$+06
8F87 A6 AND (HL)
8F88 C0 RET NZ
8F89 1A LD A,(DE)
8F8A B6 OR (HL)
8F8B R900B:
8F8B 77 LD (HL),A
8F8C 2D DEC L
8F8D 24 INC H
8F8E 13 INC DE
8F8F 7C LD A,H
8F90 E6 07 AND 7
8F92 20 10 JR NZ,R9024 ;$+12
8F94 7C LD A,H
8F95 D6 08 SUB 8
8F97 67 LD H,A
8F98 7D LD A,L
8F99 C6 20 ADD A,20h
8F9B 6F LD L,A
8F9C E6 E0 AND 0E0h
8F9E 20 04 JR NZ,R9024 ;$+06
8FA0 7C LD A,H
8FA1 C6 08 ADD A,8
8FA3 67 LD H,A
8FA4 R9024:
8FA4 10 D0 DJNZ R8FF6 ;$-2E
8FA6 AF XOR A
8FA7 C9 RET
8FA8 NXSHEET:
8FA8 3A 87 83 LD A,(SHEET)
8FAB 3C INC A
8FAC FE 14 CP 20
8FAE 20 61 JR NZ,R9091
8FB0 ;
8FB0 ; Reached the end!
8FB0 ;
8FB0 3A DA 83 LD A,(DEMO)
8FB3 B7 OR A
8FB4 C2 10 90 JP NZ,L9090 ;If in demo mode, wrap.
8FB7 3A DD 83 LD A,(CHEAT)
8FBA FE 07 CP 7
8FBC 28 52 JR Z,L9090 ;If in cheat mode, wrap.
8FBE 0E 00 LD C,0
8FC0 11 60 82 LD DE,MANDAT+96 ;Draw Willy at top of screen
8FC3 21 53 40 LD HL,SCREEN + 2*32 + 19
8FC6 CD 74 8F CALL DRWFIX
8FC9 11 E0 B2 LD DE,SP_SWFS ;SwordFish
8FCC 21 B3 40 LD HL,SCREEN+ 5*32 +19
8FCF CD 74 8F CALL DRWFIX
8FD2 21 53 58 LD HL,ATTR + 2*32 + 19 ;Set Willy attributes
8FD5 11 1F 00 LD DE,31
8FD8 36 2F LD (HL),2Fh
8FDA 23 INC HL
8FDB 36 2F LD (HL),2Fh
8FDD 19 ADD HL,DE
8FDE 36 27 LD (HL),27h
8FE0 23 INC HL
8FE1 36 27 LD (HL),27h
8FE3 19 ADD HL,DE
8FE4 23 INC HL
8FE5 19 ADD HL,DE
8FE6 36 45 LD (HL),45h
8FE8 23 INC HL
8FE9 36 45 LD (HL),45h
8FEB 19 ADD HL,DE
8FEC 36 46 LD (HL),46h
8FEE 23 INC HL
8FEF 36 47 LD (HL),47h
8FF1 19 ADD HL,DE
8FF2 36 00 LD (HL),0
8FF4 23 INC HL
8FF5 36 00 LD (HL),0
8FF7 01 00 00 LD BC,0
8FFA 16 32 LD D,32h
8FFC AF XOR A
8FFD R907D:
8FFD D3 FE OUT (0FEh),A
8FFF EE 18 XOR 18h
9001 5F LD E,A
9002 79 LD A,C
9003 82 ADD A,D
9004 82 ADD A,D
9005 82 ADD A,D
9006 47 LD B,A
9007 7B LD A,E
9008 R9088:
9008 10 FE DJNZ R9088 ;$-00
900A 0D DEC C
900B 20 F0 JR NZ,R907D ;$-0E
900D 15 DEC D
900E 20 ED JR NZ,R907D ;$-11
9010 L9090:
9010 AF XOR A
9011 R9091:
9011 32 87 83 LD (SHEET),A
9014 3E 3F LD A,3Fh
9016 R9096:
9016 21 00 58 LD HL,ATTR
9019 11 01 58 LD DE,ATTR+1
901C 01 FF 01 LD BC,511
901F 77 LD (HL),A
9020 ED B0 LDIR
9022 01 04 00 LD BC,4
9025 R90A5:
9025 10 FE DJNZ R90A5 ;$-00
9027 0D DEC C
9028 20 FB JR NZ,R90A5 ;$-03
902A 3D DEC A
902B 20 E9 JR NZ,R9096 ;$-15
902D 3A DA 83 LD A,(DEMO)
9030 B7 OR A
9031 C2 11 86 JP NZ,NEWSHT
9034 R90B4:
9034 CD BC 89 CALL AIR_DOWN ;Drain air and add to the bonus.
9037 CA 11 86 JP Z,NEWSHT
903A 21 AE 83 LD HL,SCORBUF+5
903D CD 7E 90 CALL C90FE
9040 DD 21 A9 83 LD IX,SCORBUF
9044 0E 06 LD C,6
9046 11 7A 50 LD DE,SCREEN + 4096 + 3*32 + 26
9049 CD 3A 92 CALL PMESS
904C 0E 04 LD C,4
904E 3A BC 80 LD A,(AIR_MAJOR)
9051 2F CPL
9052 E6 3F AND 3Fh
9054 CB 07 RLC A
9056 57 LD D,A
9057 R90D7:
9057 3E 00 LD A,0
9059 D3 FE OUT (0FEh),A
905B 42 LD B,D
905C R90DC:
905C 10 FE DJNZ R90DC ;$-00
905E 3E 18 LD A,18h
9060 D3 FE OUT (0FEh),A
9062 42 LD B,D
9063 R90E3:
9063 10 FE DJNZ R90E3 ;$-00
9065 0D DEC C
9066 20 EF JR NZ,R90D7 ;$-0F
9068 18 CA JR R90B4 ;$-34
906A R90EA:
906A 36 30 LD (HL),30h
906C 2B DEC HL
906D 7D LD A,L
906E FE 2A CP 2Ah
9070 20 0C JR NZ,C90FE ;$+0E
9072 3E 08 LD A,8
9074 32 D8 83 LD (B8458),A
9077 3A D7 83 LD A,(NOMEN)
907A 3C INC A
907B 32 D7 83 LD (NOMEN),A
907E C90FE:
907E 7E LD A,(HL)
907F FE 39 CP 39h
9081 28 E7 JR Z,R90EA ;$-17
9083 34 INC (HL)
9084 C9 RET
9085 C9105:
9085 2A 70 80 LD HL,(CONVEY_POS)
9088 5D LD E,L
9089 54 LD D,H
908A 3A 72 80 LD A,(CONVEY_LEN)
908D 47 LD B,A
908E 3A 6F 80 LD A,(CONVEY_DIR)
9091 B7 OR A
9092 20 13 JR NZ,R9127 ;$+15
9094 7E LD A,(HL)
9095 CB 07 RLC A
9097 CB 07 RLC A
9099 24 INC H
909A 24 INC H
909B 4E LD C,(HL)
909C CB 09 RRC C
909E CB 09 RRC C
90A0 R9120:
90A0 12 LD (DE),A
90A1 71 LD (HL),C
90A2 2C INC L
90A3 1C INC E
90A4 10 FA DJNZ R9120 ;$-04
90A6 C9 RET
90A7 R9127:
90A7 7E LD A,(HL)
90A8 CB 0F RRC A
90AA CB 0F RRC A
90AC 24 INC H
90AD 24 INC H
90AE 4E LD C,(HL)
90AF CB 01 RLC C
90B1 CB 01 RLC C
90B3 18 EB JR R9120 ;$-13
90B5 21 06 5C KONG: LD HL,WK_ATTR+6
90B8 CD 9B 91 CALL C921B
90BB 3A DB 80 LD A,(B80DB)
90BE FE 02 CP 2
90C0 C8 RET Z
90C1 3A 06 75 LD A,(T7000 + 506h)
90C4 FE 10 CP 10h
90C6 CA 79 91 JP Z,L91F9
90C9 3A 71 5F LD A,(T5E00+11*32+17)
90CC B7 OR A
90CD 28 27 JR Z,R9176 ;$+29
90CF 21 71 7F LD HL,T7000 + 0F71h
90D2 R9152:
90D2 7E LD A,(HL)
90D3 B7 OR A
90D4 20 16 JR NZ,R916C ;$+18
90D6 25 DEC H
90D7 7C LD A,H
90D8 FE 77 CP 77h
90DA 20 F6 JR NZ,R9152 ;$-08
90DC 3A 20 80 LD A,(ELEM_AIR)
90DF 32 71 5F LD (T5E00+11*32+17),A
90E2 32 91 5F LD (T5E00+12*32+17),A
90E5 3E 72 LD A,72h ;Wall has opened. Change guardian's boundary.
90E7 32 CB 80 LD (HGUARDS+13),A
90EA 18 0A JR R9176 ;$+0C
90EC R916C:
90EC 36 00 LD (HL),0
90EE 2E 91 LD L,91h
90F0 7C LD A,H
90F1 EE 07 XOR 7
90F3 67 LD H,A
90F4 36 00 LD (HL),0
90F6 R9176:
90F6 21 12 5C LD HL,WK_ATTR+18
90F9 CD 9B 91 CALL C921B
90FC 20 1F JR NZ,R919D ;$+21
90FE AF XOR A
90FF 32 DC 80 LD (EUGHGT),A
9102 3C INC A
9103 32 DB 80 LD (B80DB),A
9106 3A 20 80 LD A,(ELEM_AIR)
9109 32 4F 5E LD (BK_ATTR+2*32+15),A
910C 32 50 5E LD (BK_ATTR+2*32+16),A
910F 21 4F 70 LD HL,T7000 + 2*32 + 15
9112 06 08 LD B,8
9114 R9194:
9114 36 00 LD (HL),0
9116 2C INC L
9117 36 00 LD (HL),0
9119 2D DEC L
911A 24 INC H
911B 10 F7 DJNZ R9194 ;$-07
911D R919D:
911D 3A DB 80 LD A,(B80DB)
9120 B7 OR A
9121 28 56 JR Z,L91F9 ;$+58
9123 3A DC 80 LD A,(EUGHGT)
9126 FE 64 CP 64h
9128 28 49 JR Z,R91F3 ;$+4B
912A C6 04 ADD A,4
912C 32 DC 80 LD (EUGHGT),A
912F 4F LD C,A
9130 16 10 LD D,10h
9132 3A 73 80 LD A,(BORDER) ;Border
9135 R91B5:
9135 D3 FE OUT (0FEh),A
9137 EE 18 XOR 18h
9139 41 LD B,C
913A R91BA:
913A 10 FE DJNZ R91BA ;$-00
913C 15 DEC D
913D 20 F6 JR NZ,R91B5 ;$-08
913F 79 LD A,C
9140 07 RLCA
9141 5F LD E,A
9142 16 83 LD D,83h
9144 1A LD A,(DE)
9145 F6 0F OR 0Fh
9147 6F LD L,A
9148 13 INC DE
9149 1A LD A,(DE)
914A 67 LD H,A
914B 16 81 LD D,81h
914D 3A BD 80 LD A,(AIR_MINOR)
9150 E6 20 AND 20h
9152 F6 40 OR 40h
9154 5F LD E,A
9155 0E 00 LD C,0
9157 CD 74 8F CALL DRWFIX
915A 21 AC 83 LD HL,SCORBUF+3
915D CD 7E 90 CALL C90FE
9160 3A DC 80 LD A,(EUGHGT)
9163 E6 78 AND 78h
9165 6F LD L,A
9166 26 17 LD H,17h
9168 29 ADD HL,HL
9169 29 ADD HL,HL
916A 7D LD A,L
916B F6 0F OR 0Fh
916D 6F LD L,A
916E 3E 06 LD A,6
9170 C3 DF 8D JP C8E5F
9173 R91F3:
9173 3E 02 LD A,2
9175 32 DB 80 LD (B80DB),A
9178 C9 RET
9179 3A BD 80 L91F9: LD A,(AIR_MINOR)
917C E6 20 AND 20h
917E 5F LD E,A
917F 16 81 LD D,81h
9181 21 0F 60 LD HL,T6000+15
9184 0E 01 LD C,1
9186 CD 74 8F CALL DRWFIX
9189 C2 86 8C JP NZ,L8D06
918C 3E 44 LD A,44h ;Kong colour: Bright green
918E 32 2F 5C LD (WK_ATTR+1*32+15),A
9191 32 30 5C LD (WK_ATTR+1*32+16),A
9194 32 0F 5C LD (WK_ATTR+15),A
9197 32 10 5C LD (WK_ATTR+16),A
919A C9 RET
919B C921B:
919B 3A 6C 80 LD A,(WILLY_POS)
919E 3C INC A
919F E6 FE AND 0FEh
91A1 BD CP L
91A2 C0 RET NZ
91A3 3A 6D 80 LD A,(WILLY_POS+1)
91A6 BC CP H
91A7 C0 RET NZ
91A8 3A 65 80 LD A,(ELEM_SWITCH+6)
91AB 26 75 LD H,75h
91AD BE CP (HL)
91AE C0 RET NZ
91AF 36 08 LD (HL),8
91B1 24 INC H
91B2 36 06 LD (HL),6
91B4 24 INC H
91B5 36 06 LD (HL),6
91B7 AF XOR A
91B8 B7 OR A
91B9 C9 RET
91BA C923A:
91BA 2A 6C 80 LD HL,(WILLY_POS)
91BD 11 1F 00 LD DE,31
91C0 0E 0F LD C,0Fh
91C2 CD DF 91 CALL C925F
91C5 23 INC HL
91C6 CD DF 91 CALL C925F
91C9 19 ADD HL,DE
91CA CD DF 91 CALL C925F
91CD 23 INC HL
91CE CD DF 91 CALL C925F
91D1 3A 68 80 LD A,(WILLY_Y)
91D4 4F LD C,A
91D5 19 ADD HL,DE
91D6 CD DF 91 CALL C925F
91D9 23 INC HL
91DA CD DF 91 CALL C925F
91DD 18 20 JR R927F ;$+22
91DF C925F:
91DF 3A 20 80 LD A,(ELEM_AIR)
91E2 BE CP (HL)
91E3 20 0B JR NZ,R9270 ;$+0D
91E5 79 LD A,C
91E6 E6 0F AND 0Fh
91E8 28 06 JR Z,R9270 ;$+08
91EA 3A 20 80 LD A,(ELEM_AIR)
91ED F6 07 OR 7
91EF 77 LD (HL),A
91F0 R9270:
91F0 3A 4D 80 LD A,(ELEM_FIRE1)
91F3 BE CP (HL)
91F4 CA 85 8C JP Z,L8D05
91F7 3A 56 80 LD A,(ELEM_FIRE2)
91FA BE CP (HL)
91FB CA 85 8C JP Z,L8D05
91FE C9 RET
91FF R927F:
91FF 3A 68 80 LD A,(WILLY_Y)
9202 DD DB 0DDh
9203 26 83 LD H,83h ;LD XH,83h
9205 DD DB 0DDh
9206 6F LD L,A ;LD XL,A
9207 3A 6A 80 LD A,(WILLY_DIR)
920A E6 01 AND 1
920C 0F RRCA
920D 5F LD E,A
920E 3A 69 80 LD A,(WILLY_FRAME)
9211 E6 03 AND 3
9213 0F RRCA
9214 0F RRCA
9215 0F RRCA
9216 B3 OR E
9217 5F LD E,A
9218 16 82 LD D,82h
921A 06 10 LD B,10h
921C 3A 6C 80 LD A,(WILLY_POS)
921F E6 1F AND 1Fh
9221 4F LD C,A
9222 R92A2:
9222 DD 7E 00 LD A,(IX+0)
9225 DD 66 01 LD H,(IX+1)
9228 B1 OR C
9229 6F LD L,A
922A 1A LD A,(DE)
922B B6 OR (HL)
922C 77 LD (HL),A
922D 23 INC HL
922E 13 INC DE
922F 1A LD A,(DE)
9230 B6 OR (HL)
9231 77 LD (HL),A
9232 DD 23 INC IX
9234 DD 23 INC IX
9236 13 INC DE
9237 10 E9 DJNZ R92A2 ;$-15
9239 C9 RET
923A DD 7E 00 PMESS: LD A,(IX+0)
923D CD 4B 92 CALL C92CB
9240 DD 23 INC IX
9242 1C INC E
9243 7A LD A,D
9244 D6 08 SUB 8
9246 57 LD D,A
9247 0D DEC C
9248 20 F0 JR NZ,PMESS ;$-0E
924A C9 RET
924B C92CB:
924B 26 07 LD H,7
924D 6F LD L,A
924E CB FD SET 7,L
9250 29 ADD HL,HL
9251 29 ADD HL,HL
9252 29 ADD HL,HL
9253 06 08 LD B,8
9255 C92D5:
9255 7E LD A,(HL)
9256 12 LD (DE),A
9257 23 INC HL
9258 14 INC D
9259 10 FA DJNZ C92D5 ;$-04
925B C9 RET
925C C92DC:
925C FD 7E 00 LD A,(IY+0)
925F FE FF CP 0FFh
9261 C8 RET Z
9262 4F LD C,A
9263 06 00 LD B,0
9265 AF XOR A
9266 FD 56 01 LD D,(IY+1)
9269 7A LD A,D
926A CD AB 92 CALL C932B
926D 36 50 LD (HL),50h
926F FD 5E 02 LD E,(IY+2)
9272 7B LD A,E
9273 CD AB 92 CALL C932B
9276 36 28 LD (HL),28h
9278 R92F8:
9278 D3 FE OUT (0FEh),A
927A 15 DEC D
927B 20 05 JR NZ,R9302 ;$+07
927D FD 56 01 LD D,(IY+1)
9280 EE 18 XOR 18h
9282 R9302:
9282 1D DEC E
9283 20 05 JR NZ,R930A ;$+07
9285 FD 5E 02 LD E,(IY+2)
9288 EE 18 XOR 18h
928A R930A:
928A 10 EC DJNZ R92F8 ;$-12
928C 0D DEC C
928D 20 E9 JR NZ,R92F8 ;$-15
928F CD B7 92 CALL C9337
9292 C0 RET NZ
9293 FD 7E 01 LD A,(IY+1)
9296 CD AB 92 CALL C932B
9299 36 38 LD (HL),38h
929B FD 7E 02 LD A,(IY+2)
929E CD AB 92 CALL C932B
92A1 36 38 LD (HL),38h
92A3 FD 23 INC IY
92A5 FD 23 INC IY
92A7 FD 23 INC IY
92A9 18 B1 JR C92DC ;$-4D
92AB C932B:
92AB D6 08 SUB 8
92AD 0F RRCA
92AE 0F RRCA
92AF 0F RRCA
92B0 2F CPL
92B1 F6 E0 OR 0E0h
92B3 6F LD L,A
92B4 26 59 LD H,59h
92B6 C9 RET
92B7 C9337:
92B7 3A D9 83 LD A,(KEMP)
92BA B7 OR A
92BB 28 05 JR Z,R9342 ;$+07
92BD DB 1F IN A,(1Fh)
92BF CB 67 BIT 4,A
92C1 C0 RET NZ
92C2 R9342:
92C2 01 FE BF LD BC,0BFFEh
92C5 ED 78 IN A,(C)
92C7 E6 01 AND 1
92C9 FE 01 CP 1
92CB C9 RET
92CC ;
92CC ; A great tract of empty space, containing source code for the code from X8854
92CC ;on.
92CC ;
92CC X934C: DS 2482
9C7E ;
9C7E ; DEC E
9C7E ; JR NZ,NOFLP6
9C7E ; LD E,(HL)
9C7E ; XOR 24
9C7E ; NOFLP6 DJNZ TM51
9C7E ; DEC C
9C7E ; JR NZ,TM51
9C7E ; NONOTE4 LD A,(DEMO)
9C7E ; OR A
9C7E ; JR Z,NODEM1
9C7E ; DEC A
9C7E ; JP Z,MANDEAD
9C7E ; LD (DEMO),A
9C7E ; LD BC,0FEh
9C7E ; IN A,(C)
9C7E ; AND 31
9C7E ; CP 31
9C7E ; JP NZ,START
9C7E ; LD A,(KEMP)
9C7E ; OR A
9C7E ; JR Z,NODEM1
9C7E ; IN A,(31)
9C7E ; OR A
9C7E ; JP NZ,START
9C7E ; NODEM1 LD BC,0EFFEh
9C7E ; IN A,(C)
9C7E ; BIT 4,A
9C7E ; JP NZ,CKCHEAT
9C7E ;
9C7E ; [JCE] Why use JPs here? JRs would do it nicely
9C7E ;
9C7E ; LD A,(CHEAT)
9C7E ; CP 7
9C7E ; JP NZ,CKCHEAT
9C7E ; LD B,0F7h
9C7E ; IN A,(C)
9C7E ; CPL
9C7E ; AND 31
9C7E ; CP 20
9C7E ; JP NC,CKCHEAT
9C7E ; LD (SHEET),A
9C7E ; JP NEWSHT
9C7E ; CKCHEAT LD A,(CHEAT)
9C7E ; CP 7
9C7E ; JP Z,LOOP
9C7E ; RLCA
9C7E ; LD E,A
9C7E ; LD D,0
9C7E ; LD IX,CHEATDT
9C7E ; ADD IX,DE
9C7E ; LD BC,0F7FEh
9C7E ; IN A,(C)
9C7E ; AND 31
9C7E ; CP (IX+0)
9C7E ; JR Z,CKNXCHT
9C7E ; CP 31
9C7E ; JP Z,LOOP
9C7E ; CP (IX-2)
9C7E ; JP Z,LOOP
9C7E ; XOR A
9C7E ; LD (CHEAT),A
9C7E ; JP LOOP
9C7E ; CKNXCHT LD B,0EFh
9C7E ; IN A,(C)
9C7E ; AND 31
9C7E ; CP (IX+1)
9C7E ; JR Z,INCCHT
9C7E ; CP 31
9C7E ; JP Z,LOOP
9C7E ; CP (IX-1)
9C7E ; JP Z,LOOP
9C7E ; XOR A
9C7E ; LD (CHEAT),A
9C7E ; JP LOOP
9C7E ; INCCHT LD A,(CHEAT)
9C7E ; INC A
9C7E ; LD (CHEAT),A
9C7E ; JP LOOP
9C7E ; MANDEAD LD A,(DEMO)
9C7E ; OR A
9C7E ; JP NZ,NXSHEET
9C7E ; LD A,H
9C7E ; LPDEAD1 LD HL,5800h
9C7E ; LD DE,5801h
9C7E ; LD BC,1FFFh
9C7E ; LD (HL),A
9C7E ; LDIR
9C7E ; LD E,A
9C7E ; CPL
9C7E ; AND 7
9C7E ; RLCA
9C7E ; RLCA
9C7E ; RLCA
9C7E ; OR 7
9C7E ; LD D,A
9C7E ; LD C,E
9C7E ; RRC C
9C7E ; RRC C
9C7E ; RRC C
9C7E ; OR 16
9C7E ; XOR A
9C7E ; TM21 OUT (254),A
9C7E ; XOR 24
9C7E ; LD B,D
9C7E ; TM22 DJNZ TM22
9C7E ; DEC C
9C7E ; JR NZ,TM21
9C7E ; LD A,E
9C7E ; DEC A
9C7E ; CP 3Fh
9C7E ; JR NZ,LPDEAD1
9C7E ; LD HL,NOMEN
9C7E ; LD A,(HL)
9C7E ; OR A
9C7E ; JP Z,ENDGAM
9C7E ; DEC (HL)
9C7E ; JP NEWSHT
9C7E ; ENDGAM LD HL,HGHSCOR
9C7E ; LD DE,SCORBUF
9C7E ; LD B,6
9C7E ; LPHGH LD A,(DE)
9C7E ; CP (HL)
9C7E ; JP C,FEET
9C7E ; JP NZ,NEWHGH
9C7E ; INC HL
9C7E ; INC DE
9C7E ; DJNZ LPHGH
9C7E ; NEWHGH LD HL,SCORBUF
9C7E ; LD HL,HGHSCOR
9C7E ; LD BC,6
9C7E ; LDIR
9C7E ; FEET LD HL,4000h
9C7E ; LD DE,4001h
9C7E ; LD BC,0FFFh
9C7E ; LD (HL),0
9C7E ; LDIR
9C7E ; XOR A
9C7E ; LD (EUGHGT),A
9C7E ; LD DE,MANDAT+64
9C7E ; LD HL,488Fh
9C7E ; LD C,0
9C7E ; CALL DRWFIX
9C7E ; LD DE,0B6E0h
9C7E ; LD HL,48CFh
9C7E ; LD C,0
9C7E ; CALL DRWFIX
9C7E ; LOOPFT LD A,(EUGHGT)
9C7E ; LD C,A
9C7E ; LD B,83h
9C7E ; LD A,(BC)
9C7E ; OR 0Fh
9C7E ; LD L,A
9C7E ; INC BC
9C7E ; LD A,(BC)
9C7E ; SUB H
9C7E ; LD H,A
9C7E ; LD DE,0BAE0h
9C7E ; LD C,0
9C7E ; CALL DRWFIX
9C7E ; LD A,(EUGHGT)
9C7E ; CPL
9C7E ; LD E,A
9C7E ; XOR A
9C7E ; LD BC,40h
9C7E ; TM111 OUT (254),A
9C7E ; XOR 24
9C7E ; LD B,E
9C7E ; TM112 DJNZ TM112
9C7E ; DEC C
9C7E ; JR NZ,TM111
9C7E ; LD HL,5800h
9C7E ; LD DE,5801h
9C7E ; LD BC,1FFh
9C7E ; LD A,(EUGHGT)
9C7E ; AND 0Ch
9C7E ; RLCA
9C7E ; OR 47h
9C7E ; LD (HL),A
9C7E ; LDIR
9C7E ; LD A,(EUGHGT)
9C7E ; ADD A,4
9C7E ; LD (EUGHGT),A
9C7E ; CP 0C4h
9C7E ; JR NZ,LOOPFT
9C7E ; LD IX,MESSG
9C7E ; LD C,4
9C7E ; LD DE,40CAh
9C7E ; CALL PMESS
9C7E ; LD IX,MESSO
9C7E ; LD C,4
9C7E ; LD DE,40D2h
9C7E ; CALL PMESS
9C7E ; LD BC,0
9C7E ; LD D,6
9C7E ; TM91 DJNZ TM91
9C7E ; LD A,C
9C7E 09 41 MEMTOP: DB 9,'A' ;The remains of "AND 7"
9C80 ;
9C80 ; - and at this point, the manuscript comes to an end
9C80 ;
9C80 TITLEMSG:
9C80 2E 20 20 2E 20 20 2E 20 20 2E 20 20 2E 20 20 2E DB '. . . . . .'
9C90 20 20 2E 20 20 2E 20 20 2E 20 20 2E 20 20 2E 20 4D 41 4E 49 43 DB ' . . . . . MANIC'
9CA5 20 4D 49 4E 45 52 20 2E 20 2E 20 DB ' MINER . . '
9CB0 7F DB 7Fh
9CB1 20 42 55 47 2D 42 59 54 45 20 6C 74 64 2E 20 31 39 38 33 DB ' BUG-BYTE ltd. 1983'
9CC4 20 2E 20 2E 20 42 79 20 4D 61 74 74 68 65 77 20 53 6D 69 74 68 DB ' . . By Matthew Smith'
9CD9 20 2E 20 2E 20 2E 20 51 20 74 6F 20 50 20 3D 20 4C 65 66 74 DB ' . . . Q to P = Left'
9CED 20 26 20 52 69 67 68 74 20 2E 20 2E 20 42 6F 74 74 6F 6D DB ' & Right . . Bottom'
9D00 20 72 6F 77 20 3D 20 4A 75 6D 70 20 2E 20 2E 20 41 DB ' row = Jump . . A'
9D11 20 74 6F 20 47 20 3D 20 50 61 75 73 65 20 2E 20 2E DB ' to G = Pause . .'
9D22 20 48 20 74 6F 20 4C 20 3D 20 54 75 6E 65 20 4F 6E 2F 4F 66 66 DB ' H to L = Tune On/Off'
9D37 20 2E 20 2E 20 2E 20 47 75 69 64 65 20 4D 69 6E 65 72 DB ' . . . Guide Miner'
9D49 20 57 69 6C 6C 79 20 74 68 72 6F 75 67 68 20 32 30 DB ' Willy through 20'
9D5A 20 6C 65 74 68 61 6C 20 63 61 76 65 72 6E 73 20 2E DB ' lethal caverns .'
9D6B 20 20 2E 20 20 2E 20 20 2E 20 20 2E 20 20 2E 20 DB ' . . . . . '
9D7B 20 2E 20 20 2E DB ' . .'
9D80 ;
9D80 ;(C) 1983,1984,1999,2000 Matthew Smith - all rights reserved
9D80 ;
_PC 9D80
SCREEN 4000
ATTR 5800
WK_ATTR 5C00
BK_ATTR 5E00
T6000 6000
T7000 7000
T5E00 5E00
SP_SWFS B2E0
SP_PEDE B6E0
SP_FOOT BAE0
ROOM_NAME 8000
ELEM_AIR 8020
ELEM_WATER 8029
ELEM_CRUMBLY8032
ELEM_EARTH 803B
ELEM_CONVEY 8044
ELEM_FIRE1 804D
ELEM_FIRE2 8056
ELEM_SWITCH 805F
WILLY_Y 8068
WILLY_FRAME 8069
WILLY_DIR 806A
AIRBORNE 806B
WILLY_POS 806C
JUMP_DIST 806E
CONVEY_DIR 806F
CONVEY_POS 8070
CONVEY_LEN 8072
BORDER 8073
PORTAL_CLOSED8074
ITEMS 8075
PORTAL_ATTR 808F
PORTAL_IMAGE8090
PORTAL_XY 80B0
ITEM_GRAPHIC80B4
AIR_MAJOR 80BC
AIR_MINOR 80BD
HGUARDS 80BE
B80DB 80DB
EUGHGT 80DC
VGUARDS 80DD
MANDAT 8200
SHEET 8387
T8408 8388
S_AIR 8398
HGHSCOR 839F
SCORBUF 83A9
SCORES 83AF
MESSG 83CF
MESSO 83D3
NOMEN 83D7
B8458 83D8
KEMP 83D9
DEMO 83DA
B845B 83DB
T845C 83DC
CHEAT 83DD
CHEATDT 83E0
T846E 83EE
T858C 850C
START 854C
R8621 85A1
R862F 85AF
R863D 85BD
R8664 85E4
L8684 8604
NEWSHT 8611
R86D7 8657
LOOP 868E
R8718 8698
R8730 86B0
R873F 86BF
L879F 871F
L87A2 8722
R87C8 8748
R880B 878B
R8815 8795
R8834 87B4
R8836 87B6
TM51 87D2
X8854 87D4
NOFLP6 87DA
NONOTE4 87DF
NODEM1 8804
CKCHEAT 8828
CKNXCHT 8858
INCCHT 8875
MANDEAD 887F
LPDEAD1 8888
TM21 88A8
TM22 88AD
ENDGAM 88C4
LPHGH 88CC
NEWHGH 88D8
FEET 88E3
LOOPFT 890A
TM111 892A
TM112 892F
TM91 8971
AIR_DOWN 89BC
R8A55 89D5
R8A60 89E0
R8A66 89E6
R8A6E 89EE
C8A75 89F5
C8A8A 8A0A
L8A8C 8A0C
L8A9B 8A1B
R8A9D 8A1D
C8ABB 8A3B
L8AEB 8A6B
R8AF5 8A75
R8AFA 8A7A
NOT_JUMPING 8A90
FALL_INTO 8AD1
R8B70 8AF0
R8B75 8AF5
C8B82 8B02
L8B96 8B16
L8B9C 8B1C
L8BA2 8B22
CRUMBLE 8B3A
R8BC1 8B41
L8BDD 8B5D
R8BF5 8B75
R8BFB 8B7B
R8C34 8BB4
R8C3F 8BBF
R8C48 8BC8
R8C7B 8BFB
L8C83 8C03
R8C9C 8C1C
R8CB9 8C39
L8CCA 8C4A
R8CD6 8C56
R8CF4 8C74
L8D05 8C85
L8D06 8C86
L8D07 8C87
C8D0F 8C8F
R8D16 8C96
R8D3E 8CBE
R8D43 8CC3
R8D51 8CD1
R8D5A 8CDA
R8D68 8CE8
R8D6F 8CEF
SOLAR 8CF3
R8D79 8CF9
R8D98 8D18
R8DA5 8D25
C8DAA 8D2A
R8DAE 8D2E
R8DE3 8D63
R8DF1 8D71
EUGENE 8D78
R8E0F 8D8F
R8E1C 8D9C
R8E24 8DA4
R8E5F 8DDF
C8E5F 8DDF
SKYLAB 8DF5
R8E79 8DF9
R8E91 8E11
R8EAF 8E2F
VGUARD 8E71
R8EF5 8E75
R8F17 8E97
R8F1F 8E9F
PAINT_ITEMS 8EE3
R8F6B 8EEB
R8F8E 8F0E
R8FAE 8F2E
R8FBA 8F3A
CHK_PORTAL 8F45
R8FDF 8F5F
DRWFIX 8F74
R8FF6 8F76
R8FFF 8F7F
R900B 8F8B
R9024 8FA4
NXSHEET 8FA8
R907D 8FFD
R9088 9008
L9090 9010
R9091 9011
R9096 9016
R90A5 9025
R90B4 9034
R90D7 9057
R90DC 905C
R90E3 9063
R90EA 906A
C90FE 907E
C9105 9085
R9120 90A0
R9127 90A7
KONG 90B5
R9152 90D2
R916C 90EC
R9176 90F6
R9194 9114
R919D 911D
R91B5 9135
R91BA 913A
R91F3 9173
L91F9 9179
C921B 919B
C923A 91BA
C925F 91DF
R9270 91F0
R927F 91FF
R92A2 9222
PMESS 923A
C92CB 924B
C92D5 9255
C92DC 925C
R92F8 9278
R9302 9282
R930A 928A
C932B 92AB
C9337 92B7
R9342 92C2
X934C 92CC
MEMTOP 9C7E
TITLEMSG 9C80
.engine mac6502
ACIA = $A000
ACIACONTROL = ACIA+0
ACIASTATUS = ACIA+0
ACIADATA = ACIA+1
.ORG $FFFC
DW reset
DW reset
.org $f000
RESET:
; Nastavíme si ukazatel zásobníku
LDX #$FF
TXS
; Nastavení řídicího registru ACIA
LDA #$15
STA ACIAControl
; Začínáme vypisovat znaky, Y je ukazatel
LDY #0
LOOP:
LDA Message,Y ; Načti znak ze zprávy na pozici Y
BEQ key ; Jestli je to 0, tak hop!
JSR SEROUT ; Jinak zavolej podprogram pro vyslání znaku
INY ; Y++ - abychom adresovali další bajt
BNE LOOP ; a jestli toho ještě nebylo dost, tak hop na začátek
KEY: LDA ACIAStatus ; Přišel nějaký znak?
AND #1 ; Bit 0 nám to řekne
BEQ KEY ; Nepřišel? Tak to zkusíme znovu, dokud nějaký nepřijde
LDA ACIAData
SEC
ADC #0
JSR serout
JMP KEY ; TO JE KONEC!!! :(
Message:
DB $0C,"My hovercraft is full of eels!",$0D,$0A,$00
; podprogram pro vyslání hodnoty z registru A
; přes sériový obvod 6850 na terminál
SEROUT: PHA ; Uschováme hodnotu, protože registr A potřebujeme
SO_WAIT: LDA ACIAStatus ; Je volno?
AND #2 ; Bit 1 nám to řekne
BEQ SO_WAIT ; Není? Tak to zkusíme znovu, dokud nebude
PLA ; Už je, takže si vrátíme zpět hodnotu z registru A
STA ACIAData ; a pošleme ji do 6850
RTS ; už není co na práci, tak se můžeme vrátit
:04FFFC0000F000F021
:10F00000A2FF9AA9158D00A0A000B928F0F0062053
:10F010004AF0C8D0F5AD00A02901F0F9AD01A03843
:10F020006900204AF04C15F00C4D7920686F766528
:10F030007263726166742069732066756C6C206FF0
:10F04000662065656C73210D0A0048AD00A0290299
:07F05000F0F9688D01A060DA
:00000001FF
0000 .ENGINE mac6502
0000 ACIA: = $A000
0000 ACIACONTROL: = ACIA+0
0000 ACIASTATUS: = ACIA+0
0000 ACIADATA: = ACIA+1
FFFC .ORG $FFFC
FFFC 00 F0 DW reset
FFFE 00 F0 DW reset
F000 .ORG $f000
F000 RESET:
F000 ; Nastavíme si ukazatel zásobníku
F000 A2 FF LDX #$FF
F002 9A TXS
F003 ; Nastavení řídicího registru ACIA
F003 A9 15 LDA #$15
F005 8D 00 A0 STA ACIAControl
F008 ; Začínáme vypisovat znaky, Y je ukazatel
F008 A0 00 LDY #0
F00A LOOP:
F00A B9 28 F0 LDA Message,Y ; Načti znak ze zprávy na pozici Y
F00D F0 06 BEQ key ; Jestli je to 0, tak hop!
F00F 20 4A F0 JSR SEROUT ; Jinak zavolej podprogram pro vyslání znaku
F012 C8 INY ; Y++ - abychom adresovali další bajt
F013 D0 F5 BNE LOOP ; a jestli toho ještě nebylo dost, tak hop na začátek
F015 AD 00 A0 KEY: LDA ACIAStatus ; Přišel nějaký znak?
F018 29 01 AND #1 ; Bit 0 nám to řekne
F01A F0 F9 BEQ KEY ; Nepřišel? Tak to zkusíme znovu, dokud nějaký nepřijde
F01C AD 01 A0 LDA ACIAData
F01F 38 SEC
F020 69 00 ADC #0
F022 20 4A F0 JSR serout
F025 4C 15 F0 JMP KEY ; TO JE KONEC!!! :(
F028 MESSAGE:
F028 0C 4D 79 20 68 6F 76 65 72 63 72 61 66 74 20 69 73 20 66 75 6C 6C 20 6F 66 20 65 65 6C 73 21 0D 0A 00 DB $0C,"My hovercraft is full of eels!",$0D,$0A,$00
F04A ; podprogram pro vyslání hodnoty z registru A
F04A ; přes sériový obvod 6850 na terminál
F04A 48 SEROUT: PHA ; Uschováme hodnotu, protože registr A potřebujeme
F04B AD 00 A0 SO_WAIT: LDA ACIAStatus ; Je volno?
F04E 29 02 AND #2 ; Bit 1 nám to řekne
F050 F0 F9 BEQ SO_WAIT ; Není? Tak to zkusíme znovu, dokud nebude
F052 68 PLA ; Už je, takže si vrátíme zpět hodnotu z registru A
F053 8D 01 A0 STA ACIAData ; a pošleme ji do 6850
F056 60 RTS ; už není co na práci, tak se můžeme vrátit
_PC F056
ACIA A000
ACIACONTROL A000
ACIASTATUS A000
ACIADATA A001
RESET F000
LOOP F00A
KEY F015
MESSAGE F028
SEROUT F04A
SO_WAIT F04B
; PMD monitor
MAIN .equ 8016H ; základní smyčka monitoru
; Program hledá v tabulce příkazů příkaz, jehož znění je v paměti na adrese,
; která je uložena v ukazateli na adrese (C072H). Po vyhledání správného pří-
; kazu předá řízení na adresu, která je v tabulce příkazů uvedena. Nenajde-li
; příkaz, vrací se přes PRTEXT s hláškou "** NO COMMAND **".
; vstup: (C070H) - adresa začátku tabulky příkazů
HEX .equ 80E0H ;- převod ASCII na číslo
; Převod ASCII znaku na číslo 00H-0FH v registru A.
; vstup: znak ASCII v A
; výstup: A - číslo 00H-0FH
; CY=1 při chybě
; používá: PSW
PAIRIN .equ 80F7H ;- převod 2 krát ASCII na číslo
; Převod 2 HEX znaků z bufferu na binární v registru A (00H-FFH)
; vstup: HL - adresa do bufferu
; výstup: A - výsledek (číslo 00H-FFH)
; HL - zvýšeno o 1 (na 2. HEX znak)
; CY=1 při chybě
; používá: B, HL, PSW
ADRIN .equ 8109H ; - převod 4 krát ASCII na číslo
; Převod 4 HEX znaků z bufferu na 16-ti bitové binární číslo v DE (0000H-FFFFH)
; vstup: HL - adresa do bufferu
; výstup: DE - výsledek (číslo 0000H-FFFFH)
; HL - zvýšeno o 4 (za poslední HEX znak)
; CY=1 při chybě
; používá: B, DE, HL, PSW
TRADR .equ 8115H; - převod 4 znaků na binární číslo + příprava hlášky
; vstup: (C072H) dialogový řádek
; výstup: DE - výsledek (číslo 0000H-FFFFH)
; HL - ukazuje za poslední HEX znak
; ukazatel (C074H) nastaven na "** ERROR IN ADDRES **"
; používá: B, DE, HL, PSW
PREVO1 .equ 8125H; - výpis bytu z A jako HEX
; Převod a HEX výpis bytu z A (dvěma ASCII znaky)
; vstup: A - binární hodnota
; výstup: 2 znaky na obrazovce
; používá: B, PSW
PREVO2 .equ 813BH; - převod A na HEX do bufferu
; Převod binární hodnoty z A na dva znaky do bufferu
; vstup: A - binární hodnota
; HL - adresa do bufferu
; výstup: HL - zvětšeno o 1 (na 2. znak v bufferu)
; používá: B, HL, PSW
BINHEX .equ 814FH; - převod A na 1 HEX znak
; Převod binární hodnoty (dolní půlbyte) na HEX znak
; vstup: A - binární hodnota 00H-0FH (nekontroluje!)
; výstup: A - ASCII znak "0" až "F"
; používá: PSW
CMDSUB .equ 8159H; - příkaz SUB
; Ukládá do paměti data a znaky napsané v ASCII v editačním bufferu na adresu,
; která je udána prvními čtyřmi znaky, na které ukazuje ukazatel (C072H). Ře-
; tězec znaků musí být oddělený apostrofem. Program končí tím, že v editačním
; řádku zobrazí "SUB" a následující ukládací adresu.
; vstup: (C072H) - ukazatel do bufferu
; používá: vše
CMDJUM .equ 81C5H; - příkaz JUMP
; Vyšle do dialogového řádku "** EXECUTIVE **" a předá řízení na adresu, která
; je uložena v ASCII znacích v bufferu, do kterého ukazuje (C072H).
; vstup: (C072H) - adresa skoku v ASCII znacích
; používá: vše
CMDMEM .equ 81DFH; - příkaz MEM
; Do dialogového řádku se vypíše stav 16 bytů od adresy uvedené v ASCII zna-
; cích, na které ukazuje ukazatel (C072H) nebo v DE - potom je třeba volat
; adresu 81E5H.
; vstup: (C072H) - adresa odkud vypisovat zapsaná v ASCII
; nebo DE - adresa odkud vypisovat (v případě volání 81E5H)
; používá: vše
CMDDUM .equ 8200H; - příkaz DUMP
; Vypisuje na obrazovku stav bytů paměti od adresy napsané v ASCII (C072H) ne-
; bo binárně v HL - potom volat adresu 8209H.
; vstup: (C072H) - adresa, odkud vypisovat zapsaná v ASCII
; nebo HL - adresa, odkud vypisovat (v případě volání 8209H)
; používá: vše
VYMAZ .equ 8276H; - nulování oblasti klíčů 7000H-7EFFH
; Program nekompromisně nuluje paměť v již zmíněném rozsahu.
; používá: HL, PSW
L8283 .equ 8283H; - test, zda je v seznamu ještě 80 bytů volných
; Program slouží pro ukládání klíčů. V paměti musí být vynulováno 80 bytů pro
; uložení klíče. Jinak vypisuje "** MEMORY OVERFLOW **".
; používá: vše
CLDINY .equ 82A3H; - inicializace při studeném startu monitoru
; Program nastavuje zápisník, maže obrazovku a nastavuje USART.
; používá: vše
TABPR .equ 8300H; - tabulka příkazů monitoru
; V této tabulce jsou ASCII znaky napsány příkazy s mezerou a dvěma byty ur-
; čujícími adresu příslušného příkazu. POZOR! První byte znamená vyšších
; 8 bytů adresy a druhý nižších 8. Tabulka končí za poslední adresou bytem
; o hodnotě FFH. Ukazatel na tuto tabulku je v (C070H).
TABKBD .equ 8400H; - tabulka kódů klávesnice
; Tato tabulka obsahuje kódy, které přiřadí program KEYBD stisknuté klávese.
; První byte označuje řádek a stisknuté tlačítko SHIFT, dalších 15 bytů jsou
; kódy kláves v příslušném pořadí. Každý řádek má tedy 16 bytů. Tabulka končí
; prázdným bytem.
KEYBD .equ 84A1H; - vstup znaku z klávesnice
; Program přiřazuje stisknuté klávese kód, který má uložený v tabulce 8400H a
; končí teprve po uvolnění stisknuté klávesy.
; vstup: stisknutá klávesa
; výstup: A a (C134H) - kód znaku
; používá: PSW
BREAD .equ 84F3H; - přečtení obsahu bytu z obrazovky
; vstup: (C17AH) - adresa bytu
; výstup: A - byte bez barevných atributů
; používá: HL, PSW
PRTOUT .equ 8500H; - výstup znaku na obrazovku
; Program se snaží zobrazit všechny znaky kromě 0AH, který ignoruje, na 1CH
; smaže kompletně celou obrazovku (ale zápisník nechá) a znak 0DH odřádkuje a
; nastaví kurzor na začátek řádku (FB00H). Ignoruje mód kreslení bodu!!!
; vstup: A - kód znaku
; (C03EH) - kurzor - adresa ve V-RAM
; (C03CH) - ukazatel tabulky znaků
; (C03AH) - barevné atributy
; výstup: obrazovka
; používá: PSW
ECHO .equ 8584H; - zobrazení ASCII znaku
; vstup: HL - kurzor
; A - kód znaku
; (C03CH) - ukazatel tabulky znaků
; (C03AH) - barevné atributy
; výstup: obrazovka
; používá: BC, PSW
L85E6 .equ 85E6H; - test bodu (souřádnice 0, 0 je vlevo nahoře)
; vstup: (C170H) - souřadnice X
; (C172H) - souřadnice Y
; výstup: A=0/1 - bod nesvítí / svítí
; používá: PSW
TABZN .equ 8600H; - tabulka pro generování znaků
; Tabulka pro generování znaků se skladá z 64 8-bitových slov. Každé toto
; slovo patří jednomu ASCII znaku. Ukazatel na tuto tabulku snížený o 0100H
; se ukládá na adresu (C03CH).
EDIT .equ 8800H; - zpracování znaků při vstupu dialogového řádku
; vstup: (C134H) - znak z klávesnice
; (C130H) - nejnižší řídící znak
; (C131H) - nejvyšší řídící znak
; (C132H) - adresa tabulky řídících znaků
; výstup: rutina dle řídícího znaku nebo při tisknutelném znaku zpracování
; v dialogovém řádku
; používá: vše
CTRDIL .equ 884AH; - řídící znak 86H |<-- posunutí řádku doleva
; používá: vše
ZOBRED .equ 8855H; - echování dialogového řádku na displeji (48 znaků)
; používá: vše
ZOBRBU .equ 8858H; - zobrazí 48 znaků umístěných v paměti od adresy v HL
; používá: DE, HL, PSW
CUROFF .equ 887FH; - smazání kurzoru v dialogovém řádku na TV
; výstup: HL - adresa kurzoru na TV
; používá: DE, HL, PSW
RIGHT .equ 888CH; - posun kurzoru doprava
; používá: DE, HL, PSW
CURON .equ 8890H; - zobrazení kurzoru na TV
; vstup: HL - adresa kurzoru na TV
; výstup: HL - pozice kurzoru v bufferu
; používá: D, HL, PSW
LEFT .equ 889CH; - posun kurzoru doleva
; používá: vše
PIIP .equ 88A3H; - standardní zapípání
; používá: DE, HL, PSW
BELL .equ 88A6H; - zapípání podle tabulky
; Tabulka se skládá z dvojic bytů. 1 byte označuje výšku tónu a může nabývat
; hodnoty 0, 1, 2 a 3. 2. byte je délka tónu.
; tón 0 - nic
; tón 1 - nižší tón
; tón 2 - vyšší tón
; tón 3 - oba tóny
; Konec tabulky je označen hodnotou FFH.
; vstup: HL - adresa tabulky
; výstup: pípnutí
; HL - konec tabulky
; používá: DE, HL, PSW
DELAY .equ 88B5H; - čekací smyčka - dekrementace DE na nulu
; Nejmenší zdržení je při předvolbě DE=0101H, největší zdržení je při před-
; volbě DE=0000H (=FFFFH+1).
; vstup: DE - délka čekání
; používá: DE (nuluje), PSW
TABBEP .equ 88BEH; - tabulka pro PIIP
CTRCEL .equ 88C3H; - řídící znak 82H (SHIFT + CLR) výmaz do konce řádku
; používá: vše
CTRHOM .equ 88D2H; - řídící znak 84H (<^- Šipka doleva nahoru) kurzor na začátek řádku
; používá: vše
CTRCLR .equ 88E8H; - řídící znak 8DH (CLR) vymaže dialogový řádek
; používá: vše
LENEDI .equ 88EEH; - určení délky textu v editačním bufferu
; výstup: (C13CH) - délka dialogového řádku
; používá: DE, HL, PSW
TABBEL .equ 8920H; - tabulka pro akustické návěští
COPMSG .equ 892DH; - kopírování textu hlášky do výstupního bufferu
; vstup: (C13AH) - adresa výstupního bufferu
; (C074H) - adresa platné hlášky
; používá: vše
COPWRK .equ 8937H; - přesun úseku paměti ukončeného 0DH (CR)
; vstup: HL - adresa co přesouvat
; DE - adresa kam přesouvat
; výstup: (C13CH), HL - délka přesunutého úseku
; používá: C, DE, HL, PSW
OUTMSG .equ 894AH; - zobrazení hlášky
; Program končí vstupem znaku, to znamená, že se zastaví a čeká na znak z klá-
; vesnice. Teprve pak se ukončí.
; používá: vše
CTRCUR .equ 896CH; - řídící znak 85H --> kurzor o pozici doprava
; používá: vše
CTRCUL .equ 897DH; - řídící znak 83H <-- kurzor o pozici doleva
; používá: vše
CTRDIR .equ 898CH; - řídící znak 88H -->| řádek o pozici doprava
; používá: vše
CTRPTL .equ 8996H; - řídící znak 8BH PTL zapnutí / vypnutí opisu
; používá: vše
CTRCD .equ 899EH; - řídící znak 8AH C-D přivolání textu hlášky
; používá: vše
CTRDEL .equ 89A5H; - řídící znak 81H DEL vymaže znak nad kurzorem
; používá: vše
CTRINS .equ 89C6H; - řídící znak 80H INS vložení mezery
; používá: vše
CTREND .equ 89EEH; - řídící znak 87H END kurzor na konec řádku
; používá: vše
WRKINY .equ 8A47H; - inicializace zápisníkových oblastí ve V-RAM
; Program inicializuje oblasti C030H, CO70H, C130H jako při studeném startu.
; používá: vše
CLDCLS .equ 8A62H; - část inicializace při studeném startu
; Vymaže obrazovku, zapípá, zobrazí hlášku v dial. řádku a nastaví prompt znak
; do editačního bufferu.
; používá: vše
PRTEXT .equ 8A89H; - výpis textu připravené hlášky
; vstup: (C074H) - adresa hlášky
; používá: vše
TABCTR .equ 8AEDH; - tabulka adres příkazů při vstupu řádku
; 1. byte ... řídící znak
; 2. a 3. byte ... adresa rutiny
CTRKEY .equ 8B40H ;- řídící znaky D0H-FFH klíče
; používá: vše
SAVKEY .equ 8B76H ;- uložení klíče
; používá: vše
CTRRCL .equ 8B87H ;- řídící znak A0H RCL - přivolání předešlého řádku
; používá: vše
CTRWRK .equ 8B8DH ;- řídící znak A2H WRK - zápis textu do klíče
; používá: vše
LINECH .equ 8BDAH ;- opis příkazu na oprazovku při zapnutém PTL
; používá: vše
ENTER .equ 8BEEH ;- vstup dialogového řádku
; Tato rutina si nastavuje svůj vlastní ukazatel zásobníku (7FFFH) a po výstu-
; pu jej obnovuje na původní. Výstup z této rutiny je obsah dialogového řádku
; umístěný od adresy, která je uvedena v (C074H) a končí znakem CR (0DH).
; V zápisníku na adrese (C13CH) je délka tohoto řádku.
; vstup: (C078H) - adresa, kam dial. řádek uložit
; výstup: (C13CH) - délka dial. řádku
; používá: vše
TRANSF .equ 8C00H ;- natažení bloku paměti z ROM modulu
; volání: CALL TRANSF
; DW - adresa v ROM modulu
; DW - délka přenášeného úseku + FFH
; DW - adresa, kam uložit do RAM
; používá: BC, DE, PSW
MONIT .equ 8C40H ;- vstup do monitoru s výpisem "OS READY" a písknutím
; Nastavuje zásobník na 7FFFH, prompt znak na "?", pískne, vypíše "OS READY" a
; udělá teplý start (8016H). Jinak nedělá nic.
; používá: vše
CMDJOB .equ 8C54H ;- příkaz JOB
; používá: vše
CMDBAS .equ 8C60H ;- příkaz BASIC G
; používá: vše
STOP .equ 8C74H ;- test stisknutí klávesy STOP
; výstup: A=03H, Z=1 (nastaven) ... STOP je stisknuto
; A=40H, Z=0 (vynulován) ... STOP není stisknuto
; používá: PSW
POINT .equ 8C7DH ;- vykreslení bodu na obrazovce
; Tento program vypočítá ze souřadnic adresu bytu ve V-RAM a příslušný bit
; v tomto bytu. Přidá barevné atributy a bod vykreslí podle módu kreslení.
; vstup: XOLD (C170H) - souřadnice X
; YOLD (C172H) - souřadnice Y
; (C1FAH) - mód kreslení bodu
; (C03AH) - barevný atribut výstupu
; používá: vše
INPOL .equ 8CD0H ;- interpolátor
; Interpolátor spojuje dva zadané body nejkratší cestou podle módu kreslení a
; barevného atributu. Využívá program POINT a pracuje tak dlouho, dokud nejsou
; souřadnice výchozího bodu stejné jako souřadnice koncového bodu.
; vstup: XOLD (C170H) - souřadnice X výchozího bodu
; YOLD (C172H) - souřadnice Y výchozího bodu
; XNEW (C173H) - souřadnice X koncového bodu
; YNEW (C174H) - souřadnice Y koncového bodu
; (C1FAH) - mód kreslení bodu
; (C03AH) - barevný atribut výstupu
; používá: vše
MGOBLK .equ 8D6CH ;- výstup bloku z paměti na USART
; Program posílá postupně obsah paměti na USART a provádí kontrolní součet. Po
; odvysílání následuje 1 byte - kontrolní součet a konec.
; vstup: HL - začátek bloku
; DE - délka bloku - 1
; používá: B, DE, HL, PSW
WAIMGO .equ 8DB1H ;- čekání na volný vysílač USARTu
; Z tohoto programu se vystoupí, až když je vysílač uvolněn a připraven
; k přijmutí dalšího znaku.
; používá: PSW
INIMGF .equ 8DB9H ;- inicializace USARTu pro výstup na magnetofon
; Nastaví asynchronní režim pro 8 bitů, 2 stop bity, bez parity, f=1x.
; používá: A
MGIBL1 .equ 8DC2H ;- vstup bloku dat z USARTu a kontrola součtu
; Nebo MGIBLK 8DC4H - C=00/XX ... jen kontrola / i do paměti
; Program přenese blok dat do paměti. Pokud chceme kontrolovat součet, vynulu-
; jeme reg. C a program voláme od adresy 8DC4H (MGIBLK).
; vstup: HL - ukládací adresa pro čtená data
; DE - délka - 1 (požadovaný počet bytů - 1)
; výstup: příznak Z=0/1 ... chyba kontrolního součtu / OK
; používá: vše
MGIREC .equ 8DE2H ;- vyhledání synchronizace a načtení hlavičky
; Pokud program najde hlavičku souboru, tak ji přečte a uloží od adr. C1B2H.
; POZOR! Při stisknutí klávesy STOP se vrací na adresu v zásobníku o úroveň
; výše!!!
; výstup: (C1B2H) - číslo souboru
; (C1B3H) - typ souboru
; (C1B4H, C1B5H) - počáteční adresa
; (C1B6H, C1B7H) - délka - 1
; (C1B8H-C1BFH) - 8 znaků jméno souboru (domezerovat!)
; používá: vše
WAIMGI .equ 8E0EH ;- čekání na přijatý znak z USARTu
; Z tohoto podprogramu se vystoupí, jakmile je v USARTu připraven znak k pře-
; vzetí.
; používá: PSW
MGLD .equ 8E19H ;- výkonná část příkazu MGLD a MGEND
; Načte hlavičku, zobrazí ji v dial. řádku, zkontroluje číslo souboru, pokud
; je typ souboru (C1B1H) nulový a číslo souboru souhlasí, dělá se jen kontrola.
; Pokud nesouhlasí číslo souboru (C1B0H) nebo typ souboru, pískne a hledá dal-
; ší hlavičku.
; vstup: (C1B0H) - požadované číslo souboru
; (C1B1H) - požadovaný typ souboru (pokud je 00H, povádí se MGEND)
; používá: vše
BINBCD .equ 8E73H ;- převod A registru z binárního na BCD tvar
; vstup: A - binární hodnota
; výstup: A - BCD číslo
; používá: B, H, PSW
L8E7F .equ 8E7FH ;- převod ze vstupu BCD na binární číslo s kontrolou rozsahu 00-63
; Pokud máme číslo BCD v reg. A, voláme L8E91 (8E91H) nebo bez kontroly rozsa-
; hu 00-63 voláme BCDBIN (8E95H). V těchto případech používá BC a PSW.
; vstup: dva znaky v bufferu (ukazatel (C072H))
; výstup: ukazatel chybové hlášky nastaven na "** FILE ERROR **", ukazatel do
; bufferu nastaven o 3 znaky dále než byl, od adr. C0F0H se zapíše
; toto: NOP
; JMP L8DE1 (RET)
; CY=1 při chybě
; používá: BC, HL, PSW
BCDBIN .equ 8E95H ;- převod A registru z BCD na binárního tvar
; vstup: A - BCD číslo
; výstup: A - binární číslo
; používá: B, H, PSW
CMDMGI .equ 8EA9H ;- příkaz MGLD
; vstup: dva znaky - číslo souboru - v bufferu, na který ukazuje (C072H)
; používá: vše
MGSV .equ 8ECAH ;- výkonný blok příkazu MGSV
; vstup: číslo souboru, poč. adresa, konc. adresa, jméno - to vše v bufferu
; (ukazatel C072H), prompt znak na (C136H)
; používá: vše
CMDMGO .equ 8F47H ;- příkaz MGSV
; Udělá MGSV, vypíše "** MG STOP! **" a zapípá
; používá: vše
CMDMGE .equ 8F53H ;- příkaz MGEND
; používá: vše
MGOREC .equ 8F60H ;- zápis synchronizace a hlavičky dat
; Po nahrání hlavičky a po časové prodlevě se skočí do podprogramu přes adresu
; C0F0H. V tomto místě se tedy může modifikovat.
; vstup: (C1B2H) - číslo souboru
; (C1B3H) - typ souboru
; (C1B4H, C1B5H) - počáteční adresa bloku dat
; (C1B6H, C1B7H) - délka bloku dat
; (C1B8H-C1BFH) - jméno souboru (8 znaků ASCII)
; používá: vše
L8F7E .equ 8F7EH ;- inicializace zápisníkové oblasti C0F0H
; Tento program nuluje příznak CY a od adr. C0F0H zapíše toto:
; NOP
; JMP L8DE1 (RET)
; používá: vše
BSDSAV .equ 8F95H ;- podpora MGF operací v Basicu
; používá: vše
BS1BYT .equ 8FCFH ;- výstup bytu z paměti na MGF s úpravou kontr. součtu
; vstup: HL - adresa na odesílaný byte (odesílá se reg. M)
; B - dosavadní kotrolní součet
; výstup: HL - zvýšeno o 1 (na další byte)
; B - upravený kontrolní součet
; používá: B, HL, PSW
BSCBLK .equ 8FD9H ;- vstup bloku dat do paměti s úpravou kontr. součtu
; vstup: HL - adresa, kam blok uložit
; B - dosavadní kotrolní součet
; C - požadovaná délka bloku
; výstup: HL - zvýšeno na následující adresu
; B - upravený kontrolní součet
; C - vynulováno
; používá: BC, HL, PSW
L8FE7 .equ 8FE7H ;- nulovat zvuk a poslat nový
; Zruší oba tóny a skočí do BELL. Nutno proto v HL připravit adr. tab. tónů.
; používá: DE, HL, PSW
L8FF0 .equ 8FF0H ;- inicializace grafiky
; Program přepne inverzi bodu, nuluje barevné atributy a nastaví standardní
; tabulku znaků (8600H).
; používá: HL, PSW
0000 ; PMD monitor
0000 MAIN: EQU 8016H
0000 ; Program hledá v tabulce příkazů příkaz, jehož znění je v paměti na adrese,
0000 ; která je uložena v ukazateli na adrese (C072H). Po vyhledání správného pří-
0000 ; kazu předá řízení na adresu, která je v tabulce příkazů uvedena. Nenajde-li
0000 ; příkaz, vrací se přes PRTEXT s hláškou "** NO COMMAND **".
0000 ; vstup: (C070H) - adresa začátku tabulky příkazů
0000 HEX: EQU 80E0H
0000 ; Převod ASCII znaku na číslo 00H-0FH v registru A.
0000 ; vstup: znak ASCII v A
0000 ; výstup: A - číslo 00H-0FH
0000 ; CY=1 při chybě
0000 ; používá: PSW
0000 PAIRIN: EQU 80F7H
0000 ; Převod 2 HEX znaků z bufferu na binární v registru A (00H-FFH)
0000 ; vstup: HL - adresa do bufferu
0000 ; výstup: A - výsledek (číslo 00H-FFH)
0000 ; HL - zvýšeno o 1 (na 2. HEX znak)
0000 ; CY=1 při chybě
0000 ; používá: B, HL, PSW
0000 ADRIN: EQU 8109H
0000 ; Převod 4 HEX znaků z bufferu na 16-ti bitové binární číslo v DE (0000H-FFFFH)
0000 ; vstup: HL - adresa do bufferu
0000 ; výstup: DE - výsledek (číslo 0000H-FFFFH)
0000 ; HL - zvýšeno o 4 (za poslední HEX znak)
0000 ; CY=1 při chybě
0000 ; používá: B, DE, HL, PSW
0000 TRADR: EQU 8115H
0000 ; vstup: (C072H) dialogový řádek
0000 ; výstup: DE - výsledek (číslo 0000H-FFFFH)
0000 ; HL - ukazuje za poslední HEX znak
0000 ; ukazatel (C074H) nastaven na "** ERROR IN ADDRES **"
0000 ; používá: B, DE, HL, PSW
0000 PREVO1: EQU 8125H
0000 ; Převod a HEX výpis bytu z A (dvěma ASCII znaky)
0000 ; vstup: A - binární hodnota
0000 ; výstup: 2 znaky na obrazovce
0000 ; používá: B, PSW
0000 PREVO2: EQU 813BH
0000 ; Převod binární hodnoty z A na dva znaky do bufferu
0000 ; vstup: A - binární hodnota
0000 ; HL - adresa do bufferu
0000 ; výstup: HL - zvětšeno o 1 (na 2. znak v bufferu)
0000 ; používá: B, HL, PSW
0000 BINHEX: EQU 814FH
0000 ; Převod binární hodnoty (dolní půlbyte) na HEX znak
0000 ; vstup: A - binární hodnota 00H-0FH (nekontroluje!)
0000 ; výstup: A - ASCII znak "0" až "F"
0000 ; používá: PSW
0000 CMDSUB: EQU 8159H
0000 ; Ukládá do paměti data a znaky napsané v ASCII v editačním bufferu na adresu,
0000 ; která je udána prvními čtyřmi znaky, na které ukazuje ukazatel (C072H). Ře-
0000 ; tězec znaků musí být oddělený apostrofem. Program končí tím, že v editačním
0000 ; řádku zobrazí "SUB" a následující ukládací adresu.
0000 ; vstup: (C072H) - ukazatel do bufferu
0000 ; používá: vše
0000 CMDJUM: EQU 81C5H
0000 ; Vyšle do dialogového řádku "** EXECUTIVE **" a předá řízení na adresu, která
0000 ; je uložena v ASCII znacích v bufferu, do kterého ukazuje (C072H).
0000 ; vstup: (C072H) - adresa skoku v ASCII znacích
0000 ; používá: vše
0000 CMDMEM: EQU 81DFH
0000 ; Do dialogového řádku se vypíše stav 16 bytů od adresy uvedené v ASCII zna-
0000 ; cích, na které ukazuje ukazatel (C072H) nebo v DE - potom je třeba volat
0000 ; adresu 81E5H.
0000 ; vstup: (C072H) - adresa odkud vypisovat zapsaná v ASCII
0000 ; nebo DE - adresa odkud vypisovat (v případě volání 81E5H)
0000 ; používá: vše
0000 CMDDUM: EQU 8200H
0000 ; Vypisuje na obrazovku stav bytů paměti od adresy napsané v ASCII (C072H) ne-
0000 ; bo binárně v HL - potom volat adresu 8209H.
0000 ; vstup: (C072H) - adresa, odkud vypisovat zapsaná v ASCII
0000 ; nebo HL - adresa, odkud vypisovat (v případě volání 8209H)
0000 ; používá: vše
0000 VYMAZ: EQU 8276H
0000 ; Program nekompromisně nuluje paměť v již zmíněném rozsahu.
0000 ; používá: HL, PSW
0000 L8283: EQU 8283H
0000 ; Program slouží pro ukládání klíčů. V paměti musí být vynulováno 80 bytů pro
0000 ; uložení klíče. Jinak vypisuje "** MEMORY OVERFLOW **".
0000 ; používá: vše
0000 CLDINY: EQU 82A3H
0000 ; Program nastavuje zápisník, maže obrazovku a nastavuje USART.
0000 ; používá: vše
0000 TABPR: EQU 8300H
0000 ; V této tabulce jsou ASCII znaky napsány příkazy s mezerou a dvěma byty ur-
0000 ; čujícími adresu příslušného příkazu. POZOR! První byte znamená vyšších
0000 ; 8 bytů adresy a druhý nižších 8. Tabulka končí za poslední adresou bytem
0000 ; o hodnotě FFH. Ukazatel na tuto tabulku je v (C070H).
0000 TABKBD: EQU 8400H
0000 ; Tato tabulka obsahuje kódy, které přiřadí program KEYBD stisknuté klávese.
0000 ; První byte označuje řádek a stisknuté tlačítko SHIFT, dalších 15 bytů jsou
0000 ; kódy kláves v příslušném pořadí. Každý řádek má tedy 16 bytů. Tabulka končí
0000 ; prázdným bytem.
0000 KEYBD: EQU 84A1H
0000 ; Program přiřazuje stisknuté klávese kód, který má uložený v tabulce 8400H a
0000 ; končí teprve po uvolnění stisknuté klávesy.
0000 ; vstup: stisknutá klávesa
0000 ; výstup: A a (C134H) - kód znaku
0000 ; používá: PSW
0000 BREAD: EQU 84F3H
0000 ; vstup: (C17AH) - adresa bytu
0000 ; výstup: A - byte bez barevných atributů
0000 ; používá: HL, PSW
0000 PRTOUT: EQU 8500H
0000 ; Program se snaží zobrazit všechny znaky kromě 0AH, který ignoruje, na 1CH
0000 ; smaže kompletně celou obrazovku (ale zápisník nechá) a znak 0DH odřádkuje a
0000 ; nastaví kurzor na začátek řádku (FB00H). Ignoruje mód kreslení bodu!!!
0000 ; vstup: A - kód znaku
0000 ; (C03EH) - kurzor - adresa ve V-RAM
0000 ; (C03CH) - ukazatel tabulky znaků
0000 ; (C03AH) - barevné atributy
0000 ; výstup: obrazovka
0000 ; používá: PSW
0000 ECHO: EQU 8584H
0000 ; vstup: HL - kurzor
0000 ; A - kód znaku
0000 ; (C03CH) - ukazatel tabulky znaků
0000 ; (C03AH) - barevné atributy
0000 ; výstup: obrazovka
0000 ; používá: BC, PSW
0000 L85E6: EQU 85E6H
0000 ; vstup: (C170H) - souřadnice X
0000 ; (C172H) - souřadnice Y
0000 ; výstup: A=0/1 - bod nesvítí / svítí
0000 ; používá: PSW
0000 TABZN: EQU 8600H
0000 ; Tabulka pro generování znaků se skladá z 64 8-bitových slov. Každé toto
0000 ; slovo patří jednomu ASCII znaku. Ukazatel na tuto tabulku snížený o 0100H
0000 ; se ukládá na adresu (C03CH).
0000 EDIT: EQU 8800H
0000 ; vstup: (C134H) - znak z klávesnice
0000 ; (C130H) - nejnižší řídící znak
0000 ; (C131H) - nejvyšší řídící znak
0000 ; (C132H) - adresa tabulky řídících znaků
0000 ; výstup: rutina dle řídícího znaku nebo při tisknutelném znaku zpracování
0000 ; v dialogovém řádku
0000 ; používá: vše
0000 CTRDIL: EQU 884AH
0000 ; používá: vše
0000 ZOBRED: EQU 8855H
0000 ; používá: vše
0000 ZOBRBU: EQU 8858H
0000 ; používá: DE, HL, PSW
0000 CUROFF: EQU 887FH
0000 ; výstup: HL - adresa kurzoru na TV
0000 ; používá: DE, HL, PSW
0000 RIGHT: EQU 888CH
0000 ; používá: DE, HL, PSW
0000 CURON: EQU 8890H
0000 ; vstup: HL - adresa kurzoru na TV
0000 ; výstup: HL - pozice kurzoru v bufferu
0000 ; používá: D, HL, PSW
0000 LEFT: EQU 889CH
0000 ; používá: vše
0000 PIIP: EQU 88A3H
0000 ; používá: DE, HL, PSW
0000 BELL: EQU 88A6H
0000 ; Tabulka se skládá z dvojic bytů. 1 byte označuje výšku tónu a může nabývat
0000 ; hodnoty 0, 1, 2 a 3. 2. byte je délka tónu.
0000 ; tón 0 - nic
0000 ; tón 1 - nižší tón
0000 ; tón 2 - vyšší tón
0000 ; tón 3 - oba tóny
0000 ; Konec tabulky je označen hodnotou FFH.
0000 ; vstup: HL - adresa tabulky
0000 ; výstup: pípnutí
0000 ; HL - konec tabulky
0000 ; používá: DE, HL, PSW
0000 DELAY: EQU 88B5H
0000 ; Nejmenší zdržení je při předvolbě DE=0101H, největší zdržení je při před-
0000 ; volbě DE=0000H (=FFFFH+1).
0000 ; vstup: DE - délka čekání
0000 ; používá: DE (nuluje), PSW
0000 TABBEP: EQU 88BEH
0000 CTRCEL: EQU 88C3H
0000 ; používá: vše
0000 CTRHOM: EQU 88D2H
0000 ; používá: vše
0000 CTRCLR: EQU 88E8H
0000 ; používá: vše
0000 LENEDI: EQU 88EEH
0000 ; výstup: (C13CH) - délka dialogového řádku
0000 ; používá: DE, HL, PSW
0000 TABBEL: EQU 8920H
0000 COPMSG: EQU 892DH
0000 ; vstup: (C13AH) - adresa výstupního bufferu
0000 ; (C074H) - adresa platné hlášky
0000 ; používá: vše
0000 COPWRK: EQU 8937H
0000 ; vstup: HL - adresa co přesouvat
0000 ; DE - adresa kam přesouvat
0000 ; výstup: (C13CH), HL - délka přesunutého úseku
0000 ; používá: C, DE, HL, PSW
0000 OUTMSG: EQU 894AH
0000 ; Program končí vstupem znaku, to znamená, že se zastaví a čeká na znak z klá-
0000 ; vesnice. Teprve pak se ukončí.
0000 ; používá: vše
0000 CTRCUR: EQU 896CH
0000 ; používá: vše
0000 CTRCUL: EQU 897DH
0000 ; používá: vše
0000 CTRDIR: EQU 898CH
0000 ; používá: vše
0000 CTRPTL: EQU 8996H
0000 ; používá: vše
0000 CTRCD: EQU 899EH
0000 ; používá: vše
0000 CTRDEL: EQU 89A5H
0000 ; používá: vše
0000 CTRINS: EQU 89C6H
0000 ; používá: vše
0000 CTREND: EQU 89EEH
0000 ; používá: vše
0000 WRKINY: EQU 8A47H
0000 ; Program inicializuje oblasti C030H, CO70H, C130H jako při studeném startu.
0000 ; používá: vše
0000 CLDCLS: EQU 8A62H
0000 ; Vymaže obrazovku, zapípá, zobrazí hlášku v dial. řádku a nastaví prompt znak
0000 ; do editačního bufferu.
0000 ; používá: vše
0000 PRTEXT: EQU 8A89H
0000 ; vstup: (C074H) - adresa hlášky
0000 ; používá: vše
0000 TABCTR: EQU 8AEDH
0000 ; 1. byte ... řídící znak
0000 ; 2. a 3. byte ... adresa rutiny
0000 CTRKEY: EQU 8B40H
0000 ; používá: vše
0000 SAVKEY: EQU 8B76H
0000 ; používá: vše
0000 CTRRCL: EQU 8B87H
0000 ; používá: vše
0000 CTRWRK: EQU 8B8DH
0000 ; používá: vše
0000 LINECH: EQU 8BDAH
0000 ; používá: vše
0000 ENTER: EQU 8BEEH
0000 ; Tato rutina si nastavuje svůj vlastní ukazatel zásobníku (7FFFH) a po výstu-
0000 ; pu jej obnovuje na původní. Výstup z této rutiny je obsah dialogového řádku
0000 ; umístěný od adresy, která je uvedena v (C074H) a končí znakem CR (0DH).
0000 ; V zápisníku na adrese (C13CH) je délka tohoto řádku.
0000 ; vstup: (C078H) - adresa, kam dial. řádek uložit
0000 ; výstup: (C13CH) - délka dial. řádku
0000 ; používá: vše
0000 TRANSF: EQU 8C00H
0000 ; volání: CALL TRANSF
0000 ; DW - adresa v ROM modulu
0000 ; DW - délka přenášeného úseku + FFH
0000 ; DW - adresa, kam uložit do RAM
0000 ; používá: BC, DE, PSW
0000 MONIT: EQU 8C40H
0000 ; Nastavuje zásobník na 7FFFH, prompt znak na "?", pískne, vypíše "OS READY" a
0000 ; udělá teplý start (8016H). Jinak nedělá nic.
0000 ; používá: vše
0000 CMDJOB: EQU 8C54H
0000 ; používá: vše
0000 CMDBAS: EQU 8C60H
0000 ; používá: vše
0000 STOP: EQU 8C74H
0000 ; výstup: A=03H, Z=1 (nastaven) ... STOP je stisknuto
0000 ; A=40H, Z=0 (vynulován) ... STOP není stisknuto
0000 ; používá: PSW
0000 POINT: EQU 8C7DH
0000 ; Tento program vypočítá ze souřadnic adresu bytu ve V-RAM a příslušný bit
0000 ; v tomto bytu. Přidá barevné atributy a bod vykreslí podle módu kreslení.
0000 ; vstup: XOLD (C170H) - souřadnice X
0000 ; YOLD (C172H) - souřadnice Y
0000 ; (C1FAH) - mód kreslení bodu
0000 ; (C03AH) - barevný atribut výstupu
0000 ; používá: vše
0000 INPOL: EQU 8CD0H
0000 ; Interpolátor spojuje dva zadané body nejkratší cestou podle módu kreslení a
0000 ; barevného atributu. Využívá program POINT a pracuje tak dlouho, dokud nejsou
0000 ; souřadnice výchozího bodu stejné jako souřadnice koncového bodu.
0000 ; vstup: XOLD (C170H) - souřadnice X výchozího bodu
0000 ; YOLD (C172H) - souřadnice Y výchozího bodu
0000 ; XNEW (C173H) - souřadnice X koncového bodu
0000 ; YNEW (C174H) - souřadnice Y koncového bodu
0000 ; (C1FAH) - mód kreslení bodu
0000 ; (C03AH) - barevný atribut výstupu
0000 ; používá: vše
0000 MGOBLK: EQU 8D6CH
0000 ; Program posílá postupně obsah paměti na USART a provádí kontrolní součet. Po
0000 ; odvysílání následuje 1 byte - kontrolní součet a konec.
0000 ; vstup: HL - začátek bloku
0000 ; DE - délka bloku - 1
0000 ; používá: B, DE, HL, PSW
0000 WAIMGO: EQU 8DB1H
0000 ; Z tohoto programu se vystoupí, až když je vysílač uvolněn a připraven
0000 ; k přijmutí dalšího znaku.
0000 ; používá: PSW
0000 INIMGF: EQU 8DB9H
0000 ; Nastaví asynchronní režim pro 8 bitů, 2 stop bity, bez parity, f=1x.
0000 ; používá: A
0000 MGIBL1: EQU 8DC2H
0000 ; Nebo MGIBLK 8DC4H - C=00/XX ... jen kontrola / i do paměti
0000 ; Program přenese blok dat do paměti. Pokud chceme kontrolovat součet, vynulu-
0000 ; jeme reg. C a program voláme od adresy 8DC4H (MGIBLK).
0000 ; vstup: HL - ukládací adresa pro čtená data
0000 ; DE - délka - 1 (požadovaný počet bytů - 1)
0000 ; výstup: příznak Z=0/1 ... chyba kontrolního součtu / OK
0000 ; používá: vše
0000 MGIREC: EQU 8DE2H
0000 ; Pokud program najde hlavičku souboru, tak ji přečte a uloží od adr. C1B2H.
0000 ; POZOR! Při stisknutí klávesy STOP se vrací na adresu v zásobníku o úroveň
0000 ; výše!!!
0000 ; výstup: (C1B2H) - číslo souboru
0000 ; (C1B3H) - typ souboru
0000 ; (C1B4H, C1B5H) - počáteční adresa
0000 ; (C1B6H, C1B7H) - délka - 1
0000 ; (C1B8H-C1BFH) - 8 znaků jméno souboru (domezerovat!)
0000 ; používá: vše
0000 WAIMGI: EQU 8E0EH
0000 ; Z tohoto podprogramu se vystoupí, jakmile je v USARTu připraven znak k pře-
0000 ; vzetí.
0000 ; používá: PSW
0000 MGLD: EQU 8E19H
0000 ; Načte hlavičku, zobrazí ji v dial. řádku, zkontroluje číslo souboru, pokud
0000 ; je typ souboru (C1B1H) nulový a číslo souboru souhlasí, dělá se jen kontrola.
0000 ; Pokud nesouhlasí číslo souboru (C1B0H) nebo typ souboru, pískne a hledá dal-
0000 ; ší hlavičku.
0000 ; vstup: (C1B0H) - požadované číslo souboru
0000 ; (C1B1H) - požadovaný typ souboru (pokud je 00H, povádí se MGEND)
0000 ; používá: vše
0000 BINBCD: EQU 8E73H
0000 ; vstup: A - binární hodnota
0000 ; výstup: A - BCD číslo
0000 ; používá: B, H, PSW
0000 L8E7F: EQU 8E7FH
0000 ; Pokud máme číslo BCD v reg. A, voláme L8E91 (8E91H) nebo bez kontroly rozsa-
0000 ; hu 00-63 voláme BCDBIN (8E95H). V těchto případech používá BC a PSW.
0000 ; vstup: dva znaky v bufferu (ukazatel (C072H))
0000 ; výstup: ukazatel chybové hlášky nastaven na "** FILE ERROR **", ukazatel do
0000 ; bufferu nastaven o 3 znaky dále než byl, od adr. C0F0H se zapíše
0000 ; toto: NOP
0000 ; JMP L8DE1 (RET)
0000 ; CY=1 při chybě
0000 ; používá: BC, HL, PSW
0000 BCDBIN: EQU 8E95H
0000 ; vstup: A - BCD číslo
0000 ; výstup: A - binární číslo
0000 ; používá: B, H, PSW
0000 CMDMGI: EQU 8EA9H
0000 ; vstup: dva znaky - číslo souboru - v bufferu, na který ukazuje (C072H)
0000 ; používá: vše
0000 MGSV: EQU 8ECAH
0000 ; vstup: číslo souboru, poč. adresa, konc. adresa, jméno - to vše v bufferu
0000 ; (ukazatel C072H), prompt znak na (C136H)
0000 ; používá: vše
0000 CMDMGO: EQU 8F47H
0000 ; Udělá MGSV, vypíše "** MG STOP! **" a zapípá
0000 ; používá: vše
0000 CMDMGE: EQU 8F53H
0000 ; používá: vše
0000 MGOREC: EQU 8F60H
0000 ; Po nahrání hlavičky a po časové prodlevě se skočí do podprogramu přes adresu
0000 ; C0F0H. V tomto místě se tedy může modifikovat.
0000 ; vstup: (C1B2H) - číslo souboru
0000 ; (C1B3H) - typ souboru
0000 ; (C1B4H, C1B5H) - počáteční adresa bloku dat
0000 ; (C1B6H, C1B7H) - délka bloku dat
0000 ; (C1B8H-C1BFH) - jméno souboru (8 znaků ASCII)
0000 ; používá: vše
0000 L8F7E: EQU 8F7EH
0000 ; Tento program nuluje příznak CY a od adr. C0F0H zapíše toto:
0000 ; NOP
0000 ; JMP L8DE1 (RET)
0000 ; používá: vše
0000 BSDSAV: EQU 8F95H
0000 ; používá: vše
0000 BS1BYT: EQU 8FCFH
0000 ; vstup: HL - adresa na odesílaný byte (odesílá se reg. M)
0000 ; B - dosavadní kotrolní součet
0000 ; výstup: HL - zvýšeno o 1 (na další byte)
0000 ; B - upravený kontrolní součet
0000 ; používá: B, HL, PSW
0000 BSCBLK: EQU 8FD9H
0000 ; vstup: HL - adresa, kam blok uložit
0000 ; B - dosavadní kotrolní součet
0000 ; C - požadovaná délka bloku
0000 ; výstup: HL - zvýšeno na následující adresu
0000 ; B - upravený kontrolní součet
0000 ; C - vynulováno
0000 ; používá: BC, HL, PSW
0000 L8FE7: EQU 8FE7H
0000 ; Zruší oba tóny a skočí do BELL. Nutno proto v HL připravit adr. tab. tónů.
0000 ; používá: DE, HL, PSW
0000 L8FF0: EQU 8FF0H
0000 ; Program přepne inverzi bodu, nuluje barevné atributy a nastaví standardní
0000 ; tabulku znaků (8600H).
0000 ; používá: HL, PSW
_PC 0000
MAIN 8016
HEX 80E0
PAIRIN 80F7
ADRIN 8109
TRADR 8115
PREVO1 8125
PREVO2 813B
BINHEX 814F
CMDSUB 8159
CMDJUM 81C5
CMDMEM 81DF
CMDDUM 8200
VYMAZ 8276
L8283 8283
CLDINY 82A3
TABPR 8300
TABKBD 8400
KEYBD 84A1
BREAD 84F3
PRTOUT 8500
ECHO 8584
L85E6 85E6
TABZN 8600
EDIT 8800
CTRDIL 884A
ZOBRED 8855
ZOBRBU 8858
CUROFF 887F
RIGHT 888C
CURON 8890
LEFT 889C
PIIP 88A3
BELL 88A6
DELAY 88B5
TABBEP 88BE
CTRCEL 88C3
CTRHOM 88D2
CTRCLR 88E8
LENEDI 88EE
TABBEL 8920
COPMSG 892D
COPWRK 8937
OUTMSG 894A
CTRCUR 896C
CTRCUL 897D
CTRDIR 898C
CTRPTL 8996
CTRCD 899E
CTRDEL 89A5
CTRINS 89C6
CTREND 89EE
WRKINY 8A47
CLDCLS 8A62
PRTEXT 8A89
TABCTR 8AED
CTRKEY 8B40
SAVKEY 8B76
CTRRCL 8B87
CTRWRK 8B8D
LINECH 8BDA
ENTER 8BEE
TRANSF 8C00
MONIT 8C40
CMDJOB 8C54
CMDBAS 8C60
STOP 8C74
POINT 8C7D
INPOL 8CD0
MGOBLK 8D6C
WAIMGO 8DB1
INIMGF 8DB9
MGIBL1 8DC2
MGIREC 8DE2
WAIMGI 8E0E
MGLD 8E19
BINBCD 8E73
L8E7F 8E7F
BCDBIN 8E95
CMDMGI 8EA9
MGSV 8ECA
CMDMGO 8F47
CMDMGE 8F53
MGOREC 8F60
L8F7E 8F7E
BSDSAV 8F95
BS1BYT 8FCF
BSCBLK 8FD9
L8FE7 8FE7
L8FF0 8FF0
;
; Zdrojovy kod obsluzneho monitoru pocitace PMI-80
;*************************************************
;* (c) www.nostalcomp.cz 2010 *
;*************************************************
;
; Disassembled by:
; DASMx object code disassembler
; (c) Copyright 1996-1999 Conquest Consultants
; Version 1.30 (Oct 6 1999)
;
; File: pmi80.rom, Size: 1024 bytes, Checksum: 82C9, CRC-32: B93F4407
; Soubor PMI-80.ROM byl porovnan s obsahem ROM originalniho PMI a je identicky!
;
; Date: Tue Apr 06 20:17:03 2010
;
; CPU: Intel 8080 (MCS-80/85 family)
;
; Poznamka: RST 7 = FFh a je to nevyuzita (nenaprogramovana) pametova bunka
;
; Zaneseny tez upravy pro monitory PMI-80r, PMI-85 a PMI Z-80 (PMI-880)
;
STACK equ 0x1fd9
INT_VECTOR equ 0x1fe6
VIDEO_POINTER equ 0x1ffc
VIDEORAM equ 0x1fef
IN_DATA equ 0x1ffa
IN_ADR equ 0x1ff8
org 00000H
START: ; 0000h - RESET
mvi a,08AH ; nastaveni sluzebniho 8255A.
out 0FBH ; CW 8Ah => rezim 0, PA out, PB inp, PC0-3 out, PC4-7 inp
nop ; lze vlozit DI (adresa 0004h = F3h) pro vsechny verze
jmp L002E
ENTRY: ; 0008h - BREAK STOP
shld 0X1FDF
pop h
shld 0X1FE2
lxi h,0000h
dad sp
shld 0X1FE4
lxi h,0X1FDD
sphl
push b
push d
push psw
pop h
shld 0x1FDD
lhld 0x1FEC
lda 0x1FEE
mov m,a
lxi h,TEXT_BR_STOP
jmp L0040
L002E:
lxi h,STACK
shld 0x1FE4
jmp L003D ;PMI Z-80 upravit skok na L_IM na adresu 003Bh:
;na adresu 0035h staci dat misto 3Dh hodnotu 3Bh
rst 7
INTERRUPT:
jmp INT_VECTOR ; 0038h - pevna adresa preruseni (typu RST7)
; nasleduji 2 volne byty, ktere lze vyuzit pro vlozeni instrukce IM1 pro Z-80:
rst 7 ;003Bh = EDh (label L_IM: IM1 (režim přerušení jako u 8080, 2 byte)
rst 7 ;003Ch = 56h (IM1 je dvoubajtova!)
L003D:
lxi h,TEXT_PMI_80
L0040:
lxi sp,STACK
L0043:
shld VIDEO_POINTER
call OUTKE
lxi h,VIDEORAM
shld VIDEO_POINTER
L004F:
mvi a,01DH
call CLEAR
call OUTKE
lxi h,TABPRIKAZY
mvi b,006H
L005C:
cmp m
inx h
jz L006D
inx h
inx h
dcr b
jnz L005C
L0067:
lxi h,TEXT_ERROR
jmp L0040
L006D:
mov c,m
inx h
mov h,m
mov l,c
pchl
; PCHL - obsah HL do PC = skok na adresu, ktery byla v HL (indexovy skok).
; - adresy v HL jsou adresami exekutiv (rutin) jednotlivych prikazu.
;
; Konec hlavni programove smycky.
; Nasleduji jednotlive vykonne exekutivy prikazu a podprogramy
PRIKAZ_MEM: ; MEM
mvi a,016H
call CLEAR
call MODAD
L007A:
mov a,m
sta IN_DATA
mvi a,018H
stax b
call MODDA
lhld IN_ADR
lda IN_DATA
mov m,a
inx h
shld IN_ADR
call OUTAD
jmp L007A
TEXT_MG_RUN:
db 01EH, 016H, 020H, 019H, 019H, 012H, 015H, 01BH, 01EH
TEXT_MG_STOP:
db 01EH, 016H, 020H, 019H, 005H, 010H, 011H, 013H, 01EH
rst 7
rst 7
rst 7
rst 7
CLEAR:
lxi d,ENTRY
L00AE:
lhld VIDEO_POINTER
dad d
mvi m,019H
dcr e
jnz L00AE
dcx h
mov m,a
ret
;
OUTAD:
lxi b,01FF1H
lhld IN_ADR
mov a,h
call L00C6
L00C5:
mov a,l
L00C6:
push d
mov d,a
rrc
rrc
rrc
rrc
ani 00FH
stax b
inx b
mov a,d
ani 00FH
stax b
inx b
pop d
ret
;
MODAD:
call OUTAD
call OUTKE
rz
jnc L0197
lhld IN_ADR
ani 00FH
dad h
dad h
dad h
dad h
add l
mov l,a
shld IN_ADR
jmp MODAD
;
OUTDA:
lxi b,0x1FF6
lhld IN_DATA
jmp L00C5
;
MODDA:
call OUTDA
call OUTKE
rz
jnc L019D
nop
nop
nop
ani 00FH
dad h
dad h
dad h
dad h
add l
mov l,a
shld IN_DATA
jmp MODDA
;
OUTKE:
call DISP ;volej DISP
jnc OUTKE ;bylo neco zmacknuto? Kdyz ne, volej DISP
rrc ;odrotuj vpravo (z DISPu jde hodnota odrotovana vlevo,
;takze RRC ji jen restauruje)
mov c,a ;ulozime se kod klavesy
L011E:
call DISP ;volej DISP
jc L011E ;byly klavesy uvolneny? Kdyz ne, volej DISP
call DISP ;jeste jednou zavolej DISP (proc?)
mov a,c ;natahni hodnotu kodu klavesy z C
cpi 090H ;a porovnej ji s kodem klavesy = (90h)
ret ;RETURN??? Nemelo by zde byt nejake dalsi vyhodnoceni?
;Nebo jde jen o nastaveni priznaku?
; pravdepodobne jiz nepouzivany usek s vyhodnocenim (nevedou sem zadne skoky)
db 008H
dad b
dcr c
dcx b
ldax b
inx d
inr d
mvi c,00CH
rrc
dcr b
ldax d
dcr c
dcx b
ldax b
cpo 0xD9DF
in 0DDH
rst 7
; konec asi jiz nepouzivane casti kodu
DISP: ;tento podprogram byl okomentovan jiz v puvodni dokumentaci v AR 11/1984
; ale v tomto AR je spatna tabulka TABKEY. Spravne je to zde.
push h
push b
push d
lxi d,0000h ;nul D,E
mov b,d ;nul B
mov a,d ;nul A
sta 0x1FFE ;inic STATUS
LOOP1:
mvi a,07FH ;blok segmenty
out 0F8H ;port segment
nop
mov a,e
cma
out 0FAH ;nastav digit
nop
lhld VIDEO_POINTER ;nastav ukazatel vypisu
dad d ;pripocitej digit
mov c,m ;vloz zobrazovana data
lxi h,TPREV ;nastav tabulku prevodu znaku
dad b
mov a,m ;segment data
out 0F8H ;port segment
nop
lda 0x1FFE ;lda STATUS
ora a
jnz NOKEY ;KEY?
mvi c,009H ;ANO
lxi h,0019AH ;lxi h, TABKEY-9 nastav tabulku prevodu klaves
in 0FAH ;vstup KEY kod
nop
ani 070H ;maska
rlc
rlc
jnc PRVA ;ANO, první rada
rlc ;NE
jnc DRUHA ;ANO, druhá rada
rlc ;NE
jc NOKEY ;C!=1, zadna rada
dad b ;pripocitej radu
DRUHA:
dad b ;pripocitej radu
PRVA:
dad b ;pripocitej radu
dad d ;pripocitej KEY
mov a,m ;vyber kod KEY
sta 0x1FFE ;vloz do STATUS
NOKEY:
inr e ;dalsi digit
mvi a,00AH
cmp e
jnz LOOP1 ;posledni digit?
lda 0x1FFE ;lda STATUS ANO, posledni
rlc ;nastav carry
pop d
pop b
pop h
ret
;
L0197:
lxi h,TEXT_ERR_ADRES
jmp L0040
;
L019D:
lxi h,TEXT_ERR_DATA
jmp L0040
; tabulka klaves.
; 80h-8Fh = klavesy 0-F, 9xh = ridici klavesy, FFh = neosazeno
TABKEY:
db 080H, 084H, 088H, 091H, 08DH, 08CH, 089H, 085H, 081H ;3. radek matice tl.
db 082H, 086H, 08AH, 09AH, 08FH, 08EH, 08BH, 087H, 083H ;2. radek matice tl.
db 0FFH, 094H, 093H, 0FFH, 097H, 092H, 0FFH, 0FFH, 090H ;1. radek matice tl.
; tabulka pro prevod kodu znaku na sedmisegmentove vyjadreni
; pozor, je to invertovane!
TPREV:
db 040H ;znak 0
db 079H ;znak 1, atd. dle tabulky znaku:
db 024H, 030H, 019H, 012H, 002H, 078H, 000H, 018H, 008H, 003H, 046H, 021H
db 006H, 00EH, 007H, 023H, 02FH, 00CH, 047H, 063H, 048H, 071H, 037H, 07FH
db 009H, 02BH, 00BH, 02CH, 05DH, 03FH, 042H, 061H
db 07BH ;znak c. 22 (carka), posledni v tabulce znaku
db 011H ;v tabulce znaku v manualu neni
rst 7 ; volny prostor (lze vyuzit pro upravy)
rst 7
rst 7
rst 7
rst 7
TEXT_PMI_80: ;zacina na adrese 01E7h
db 01EH, 013H, 016H, 001H, 019H, 01FH, 008H, 000H, 01EH
;TEXT_PMI_80r:
; db 01EH, 013H, 016H, 001H, 01FH, 008H, 000H, 012H 01EH
; text pro repliku PMI-80r od 01E7h
;TEXT_PMI_85:
; db 01EH, 013H, 016H, 001H, 019H, 01FH, 008H, 005H, 01EH
; na 01EEh dat hodnotu 05h
;TEXT_PMI Z-80
; db 013H, 016H, 001H, 019H, 019H, 002H, 01FH, 008H, 000H
; alternativni text pro Z-80 (od 01E7h)
;TEXT_PMI_880:
; db 01EH, 013H, 016H, 001H, 019H, 008H, 008H, 000H, 01EH
; alternativni text pro U880D
; na 01EC dat hodnotu 08h
TEXT_ERR_ADRES:
db 00EH, 012H, 012H, 018H, 00AH, 00DH, 012H, 00EH, 005H
TEXT_ERR_DATA:
db 00EH, 012H, 012H, 018H, 019H, 00DH, 00AH, 010H, 00AH
TEXT_ERROR:
db 01EH, 019H, 00EH, 012H, 012H, 011H, 012H, 019H, 01EH
TABPRIKAZY: ;kod prikazu (klavesy) + adresa obsluzneho programu (low, high)
db 092H, 072H, 000H ; MEM
db 091H, 029H, 002H ; EX
db 097H, 05AH, 002H ; BR
db 09AH, 07EH, 002H ; R
db 094H, 04CH, 003H ; SAVE
db 093H, 08CH, 003H ; LOAD
db 0FFH, 0FFH, 0FFH ; Zde mely byt asi Rst 7 (nevyuzite misto)
TEXT_BR_STOP:
db 01EH, 00BH, 012H, 01FH, 005H, 010H, 011H, 013H, 01EH
PRIKAZ_EX: ; EX
mvi a,020H
call CLEAR
lhld 0x1FE2
shld IN_ADR
call MODAD
lhld IN_ADR
shld 0x1FE2
mvi a,006H
out 0F8H
nop
mvi a,00FH
out 0FAH
nop
lxi h,STACK
sphl
pop d
pop b
pop psw
lhld 0x1FE4
sphl
lhld 0x1FE2
push h
lhld 0x1FDF
ret
;
PRIKAZ_BR: ; BR
mvi a,00BH
call CLEAR
lhld 0x1FEC
shld IN_ADR
call MODAD
lhld IN_ADR
shld 0x1FEC
mov a,m
sta 0x1FEE
mvi m,0CFH
lhld 0x1FE2
dcx h
shld 0x1FE2
jmp PRIKAZ_EX
;
PRIKAZ_R: ; R
mvi a,012H
call CLEAR
call OUTKE
jnc L0067
ani 00FH
lxi b,00006H
L028E:
lxi h,0012AH
dcx b
dad b
inr c
dcr c
jz L004F
cmp m
jnz L028E
L029C:
lxi h,0012FH
call L02CD
mov e,l
lxi h,00134H
call L02CD
mov h,e
shld 0x1FF6
push b
call L02CA
push h
mov c,m
inx h
mov h,m
mov l,c
shld IN_ADR
call MODAD
pop d
mov a,l
stax d
inx d
mov a,h
stax d
pop b
dcr c
jnz L029C
jmp L004F
L02CA:
lxi h,00139H
L02CD:
mvi b,000H
dad b
mov l,m
mvi h,01FH
ret
;
TOUT:
mvi b,009H
L02D6:
mvi a,0C7H
call L02EE
mov a,c
rar
mov c,a
mvi a,08FH
rar
call L02EE
mvi a,047H
call L02EE
dcr b
jnz L02D6
ret
;
L02EE:
mvi d,020H
L02F0:
out 0F8H
mvi e,004H
L02F4:
dcr e
jnz L02F4
xri 040H
dcr d
jnz L02F0
ret
;
rst 7
TIN:
mvi b,008H
mvi d,000H
L0304:
call L0342
jc L0304
call L0342
jc L0304
L0310:
call L0342
jnc L0310
call L0342
jnc L0310
L031C:
dcr d
call L0342
jc L031C
call L0342
jc L031C
L0329:
inr d
call L0342
jnc L0329
call L0342
jnc L0329
mov a,d
ral
mov a,c
rar
mov c,a
mvi d,000H
dcr b
jnz L031C
ret
;
L0342:
mvi e,002H
L0344:
dcr e
jnz L0344
in 0FAH
ral
ret
;
PRIKAZ_SAVE:
mvi a,005H
call CLEAR
call MODAD
call MODDA
lxi h,TEXT_MG_RUN
shld VIDEO_POINTER
call OUTKE
mvi a,023H
out 0F8H
mvi a,00FH
out 0FAH
mvi d,0F0H
mvi a,0C7H
call L02F0
lda IN_DATA
mov c,a
call TOUT
mvi a,010H
call CLEAR
lhld IN_ADR
L037E:
mov c,m
call TOUT
inr l
jnz L037E
L0386:
lxi h,TEXT_MG_STOP
jmp L0043
;
PRIKAZ_LOAD:
mvi a,014H
call CLEAR
call MODAD
call MODDA
lxi h,TEXT_MG_RUN
L039A:
shld VIDEO_POINTER
call OUTKE
L03A0:
lhld IN_ADR
mvi a,007H
out 0F8H
mvi a,00FH
out 0FAH
L03AB:
mvi d,0A0H
L03AD:
call L0342
jc L03AB
dcr d
jnz L03AD
call TIN
lda IN_DATA
cmp c
jnz L03CC
L03C1:
call TIN
mov m,c
inr l
jnz L03C1
jmp L0386
;
L03CC:
jc L03E7
mvi a,00FH
call CLEAR
mov a,c
lxi b,0x1FF6
call L00C6
lxi h,VIDEORAM
shld VIDEO_POINTER
call OUTKE
jmp L03A0
;
L03E7:
lxi h,TEXT_MG_SPAT
jmp L039A
TEXT_MG_SPAT:
db 01EH, 016H, 020H, 019H, 005H, 013H, 00AH, 010H, 01EH
rst 7 ; volny prostor na konci PROM (lze vyuzit pro upravy)
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7
rst 7 ;03FFh konec 1KB PROM
; Poznamka: port PB sluzebni 8255A lze nastavit
; pouze na jednoduchy vstup/vystup v rezimu 0
;
; vstup: mvi a,08Ah
; out 0FBh
;
; vystup: mvi a,088h
; out 0FBh
;
; jina nastaveni tohoto obvodu nejsou mozna!
; Pridavny 8255A lze nastavit dle libosti.
;
;***************************** www.nostalcomp.cz *****************************
:100000003E8AD3FB00C32E0022DF1FE122E21F2124
:1000100000003922E41F21DD1FF9C5D5F5E122DDFD
:100020001F2AEC1F3AEE1F77212002C3400021D97E
:100030001F22E41FC33D00FFC3E61FFFFF21E701AE
:1000400031D91F22FC1FCD160121EF1F22FC1F3EBC
:100050001DCDAB00CD1601210B020606BE23CA6DD5
:1000600000232305C25C00210202C340004E236628
:1000700069E93E16CDAB00CDD7007E32FA1F3E189F
:1000800002CDFB002AF81F3AFA1F772322F81FCD72
:10009000BB00C37A001E1620191912151B1E1E164E
:1000A0002019051011131EFFFFFFFF1108002AFC85
:1000B0001F1936191DC2AE002B77C901F11F2AF88E
:1000C0001F7CCDC6007DD5570F0F0F0FE60F020323
:1000D0007AE60F0203D1C9CDBB00CD1601C8D29775
:1000E000012AF81FE60F29292929856F22F81FC345
:1000F000D70001F61F2AFA1FC3C500CDF200CD16A6
:1001000001C8D29D01000000E60F29292929856F29
:1001100022FA1FC3FB00CD4001D216010F4FCD4084
:1001200001DA1E01CD400179FE90C908090D0B0AC4
:1001300013140E0C0F051A0D0B0AE4DFD9DBDDFFDB
:10014000E5C5D5110000427A32FE1F3E7FD3F8008C
:100150007B2FD3FA002AFC1F194E21BE01097ED342
:10016000F8003AFE1FB7C288010E09219A01DBFA96
:1001700000E6700707D2820107D2810107DA880101
:10018000090909197E32FE1F1C3E0ABBC24B013A07
:10019000FE1F07D1C1E1C921F001C3400021F901CF
:1001A000C34000808488918D8C89858182868A9A5B
:1001B0008F8E8B8783FF9493FF9792FFFF904079F8
:1001C000243019120278001808034621060E07236E
:1001D0002F0C47634871377F092B0B2C5D3F426121
:1001E0007B11FFFFFFFFFF1E131601191F08001EE2
:1001F0000E1212180A0D120E050E121218190D0AFF
:10020000100A1E190E12121112191E927200912953
:1002100002975A029A7E02944C03938C03FFFFFFCD
:100220001E0B121F051011131E3E20CDAB002AE23B
:100230001F22F81FCDD7002AF81F22E21F3E06D347
:10024000F8003E0FD3FA0021D91FF9D1C1F12AE4F9
:100250001FF92AE21FE52ADF1FC93E0BCDAB002A9A
:10026000EC1F22F81FCDD7002AF81F22EC1F7E3288
:10027000EE1F36CF2AE21F2B22E21FC329023E12B5
:10028000CDAB00CD1601D26700E60F010600212A92
:10029000010B090C0DCA4F00BEC28E02212F01CDE9
:1002A000CD025D213401CDCD026322F61FC5CDCA3A
:1002B00002E54E23666922F81FCDD700D17D1213C7
:1002C0007C12C10DC29C02C34F00213901060009F6
:1002D0006E261FC906093EC7CDEE02791F4F3E8F1D
:1002E0001FCDEE023E47CDEE0205C2D602C9162052
:1002F000D3F81E041DC2F402EE4015C2F002C9FF7D
:1003000006081600CD4203DA0403CD4203DA0403E3
:10031000CD4203D21003CD4203D2100315CD4203C8
:10032000DA1C03CD4203DA1C0314CD4203D22903A5
:10033000CD4203D229037A17791F4F160005C21C3C
:1003400003C91E021DC24403DBFA17C93E05CDAB2B
:1003500000CDD700CDFB0021950022FC1FCD16015A
:100360003E23D3F83E0FD3FA16F03EC7CDF0023A43
:10037000FA1F4FCDD4023E10CDAB002AF81F4ECD50
:10038000D4022CC27E03219E00C343003E14CDAB99
:1003900000CDD700CDFB0021950022FC1FCD16011A
:1003A0002AF81F3E07D3F83E0FD3FA16A0CD42031A
:1003B000DAAB0315C2AD03CD00033AFA1FB9C2CCC4
:1003C00003CD0003712CC2C103C38603DAE7033EE9
:1003D0000FCDAB007901F61FCDC60021EF1F22FC27
:1003E0001FCD1601C3A00321ED03C39A031E1620DF
:1003F0001905130A101EFFFFFFFFFFFFFFFFFFFF9E
:00000001FF
0000 ;
0000 ; Zdrojovy kod obsluzneho monitoru pocitace PMI-80
0000 ;*************************************************
0000 ;* (c) www.nostalcomp.cz 2010 *
0000 ;*************************************************
0000 ;
0000 ; Disassembled by:
0000 ; DASMx object code disassembler
0000 ; (c) Copyright 1996-1999 Conquest Consultants
0000 ; Version 1.30 (Oct 6 1999)
0000 ;
0000 ; File: pmi80.rom, Size: 1024 bytes, Checksum: 82C9, CRC-32: B93F4407
0000 ; Soubor PMI-80.ROM byl porovnan s obsahem ROM originalniho PMI a je identicky!
0000 ;
0000 ; Date: Tue Apr 06 20:17:03 2010
0000 ;
0000 ; CPU: Intel 8080 (MCS-80/85 family)
0000 ;
0000 ; Poznamka: RST 7 = FFh a je to nevyuzita (nenaprogramovana) pametova bunka
0000 ;
0000 ; Zaneseny tez upravy pro monitory PMI-80r, PMI-85 a PMI Z-80 (PMI-880)
0000 ;
0000 STACK: EQU 0x1fd9
0000 INT_VECTOR: EQU 0x1fe6
0000 VIDEO_POINTER: EQU 0x1ffc
0000 VIDEORAM: EQU 0x1fef
0000 IN_DATA: EQU 0x1ffa
0000 IN_ADR: EQU 0x1ff8
0000 .ORG 00000H
0000 START: ; 0000h - RESET
0000 3E 8A MVI a,08AH ; nastaveni sluzebniho 8255A.
0002 D3 FB OUT 0FBH ; CW 8Ah => rezim 0, PA out, PB inp, PC0-3 out, PC4-7 inp
0004 00 NOP ; lze vlozit DI (adresa 0004h = F3h) pro vsechny verze
0005 C3 2E 00 JMP L002E
0008 ENTRY: ; 0008h - BREAK STOP
0008 22 DF 1F SHLD 0X1FDF
000B E1 POP h
000C 22 E2 1F SHLD 0X1FE2
000F 21 00 00 LXI h,0000h
0012 39 DAD sp
0013 22 E4 1F SHLD 0X1FE4
0016 21 DD 1F LXI h,0X1FDD
0019 F9 SPHL
001A C5 PUSH b
001B D5 PUSH d
001C F5 PUSH psw
001D E1 POP h
001E 22 DD 1F SHLD 0x1FDD
0021 2A EC 1F LHLD 0x1FEC
0024 3A EE 1F LDA 0x1FEE
0027 77 MOV m,a
0028 21 20 02 LXI h,TEXT_BR_STOP
002B C3 40 00 JMP L0040
002E L002E:
002E 21 D9 1F LXI h,STACK
0031 22 E4 1F SHLD 0x1FE4
0034 C3 3D 00 JMP L003D ;PMI Z-80 upravit skok na L_IM na adresu 003Bh:
0037 ;na adresu 0035h staci dat misto 3Dh hodnotu 3Bh
0037 FF RST 7
0038 INTERRUPT:
0038 C3 E6 1F JMP INT_VECTOR ; 0038h - pevna adresa preruseni (typu RST7)
003B ; nasleduji 2 volne byty, ktere lze vyuzit pro vlozeni instrukce IM1 pro Z-80:
003B FF RST 7 ;003Bh = EDh (label L_IM: IM1 (režim přerušení jako u 8080, 2 byte)
003C FF RST 7 ;003Ch = 56h (IM1 je dvoubajtova!)
003D L003D:
003D 21 E7 01 LXI h,TEXT_PMI_80
0040 L0040:
0040 31 D9 1F LXI sp,STACK
0043 L0043:
0043 22 FC 1F SHLD VIDEO_POINTER
0046 CD 16 01 CALL OUTKE
0049 21 EF 1F LXI h,VIDEORAM
004C 22 FC 1F SHLD VIDEO_POINTER
004F L004F:
004F 3E 1D MVI a,01DH
0051 CD AB 00 CALL CLEAR
0054 CD 16 01 CALL OUTKE
0057 21 0B 02 LXI h,TABPRIKAZY
005A 06 06 MVI b,006H
005C L005C:
005C BE CMP m
005D 23 INX h
005E CA 6D 00 JZ L006D
0061 23 INX h
0062 23 INX h
0063 05 DCR b
0064 C2 5C 00 JNZ L005C
0067 L0067:
0067 21 02 02 LXI h,TEXT_ERROR
006A C3 40 00 JMP L0040
006D L006D:
006D 4E MOV c,m
006E 23 INX h
006F 66 MOV h,m
0070 69 MOV l,c
0071 E9 PCHL
0072 ; PCHL - obsah HL do PC = skok na adresu, ktery byla v HL (indexovy skok).
0072 ; - adresy v HL jsou adresami exekutiv (rutin) jednotlivych prikazu.
0072 ;
0072 ; Konec hlavni programove smycky.
0072 ; Nasleduji jednotlive vykonne exekutivy prikazu a podprogramy
0072 PRIKAZ_MEM: ; MEM
0072 3E 16 MVI a,016H
0074 CD AB 00 CALL CLEAR
0077 CD D7 00 CALL MODAD
007A L007A:
007A 7E MOV a,m
007B 32 FA 1F STA IN_DATA
007E 3E 18 MVI a,018H
0080 02 STAX b
0081 CD FB 00 CALL MODDA
0084 2A F8 1F LHLD IN_ADR
0087 3A FA 1F LDA IN_DATA
008A 77 MOV m,a
008B 23 INX h
008C 22 F8 1F SHLD IN_ADR
008F CD BB 00 CALL OUTAD
0092 C3 7A 00 JMP L007A
0095 TEXT_MG_RUN:
0095 1E 16 20 19 19 12 15 1B 1E DB 01EH,016H,020H,019H,019H,012H,015H,01BH,01EH
009E TEXT_MG_STOP:
009E 1E 16 20 19 05 10 11 13 1E DB 01EH,016H,020H,019H,005H,010H,011H,013H,01EH
00A7 FF RST 7
00A8 FF RST 7
00A9 FF RST 7
00AA FF RST 7
00AB CLEAR:
00AB 11 08 00 LXI d,ENTRY
00AE L00AE:
00AE 2A FC 1F LHLD VIDEO_POINTER
00B1 19 DAD d
00B2 36 19 MVI m,019H
00B4 1D DCR e
00B5 C2 AE 00 JNZ L00AE
00B8 2B DCX h
00B9 77 MOV m,a
00BA C9 RET
00BB ;
00BB OUTAD:
00BB 01 F1 1F LXI b,01FF1H
00BE 2A F8 1F LHLD IN_ADR
00C1 7C MOV a,h
00C2 CD C6 00 CALL L00C6
00C5 L00C5:
00C5 7D MOV a,l
00C6 L00C6:
00C6 D5 PUSH d
00C7 57 MOV d,a
00C8 0F RRC
00C9 0F RRC
00CA 0F RRC
00CB 0F RRC
00CC E6 0F ANI 00FH
00CE 02 STAX b
00CF 03 INX b
00D0 7A MOV a,d
00D1 E6 0F ANI 00FH
00D3 02 STAX b
00D4 03 INX b
00D5 D1 POP d
00D6 C9 RET
00D7 ;
00D7 MODAD:
00D7 CD BB 00 CALL OUTAD
00DA CD 16 01 CALL OUTKE
00DD C8 RZ
00DE D2 97 01 JNC L0197
00E1 2A F8 1F LHLD IN_ADR
00E4 E6 0F ANI 00FH
00E6 29 DAD h
00E7 29 DAD h
00E8 29 DAD h
00E9 29 DAD h
00EA 85 ADD l
00EB 6F MOV l,a
00EC 22 F8 1F SHLD IN_ADR
00EF C3 D7 00 JMP MODAD
00F2 ;
00F2 OUTDA:
00F2 01 F6 1F LXI b,0x1FF6
00F5 2A FA 1F LHLD IN_DATA
00F8 C3 C5 00 JMP L00C5
00FB ;
00FB MODDA:
00FB CD F2 00 CALL OUTDA
00FE CD 16 01 CALL OUTKE
0101 C8 RZ
0102 D2 9D 01 JNC L019D
0105 00 NOP
0106 00 NOP
0107 00 NOP
0108 E6 0F ANI 00FH
010A 29 DAD h
010B 29 DAD h
010C 29 DAD h
010D 29 DAD h
010E 85 ADD l
010F 6F MOV l,a
0110 22 FA 1F SHLD IN_DATA
0113 C3 FB 00 JMP MODDA
0116 ;
0116 OUTKE:
0116 CD 40 01 CALL DISP ;volej DISP
0119 D2 16 01 JNC OUTKE ;bylo neco zmacknuto? Kdyz ne, volej DISP
011C 0F RRC ;odrotuj vpravo (z DISPu jde hodnota odrotovana vlevo,
011D ;takze RRC ji jen restauruje)
011D 4F MOV c,a ;ulozime se kod klavesy
011E L011E:
011E CD 40 01 CALL DISP ;volej DISP
0121 DA 1E 01 JC L011E ;byly klavesy uvolneny? Kdyz ne, volej DISP
0124 CD 40 01 CALL DISP ;jeste jednou zavolej DISP (proc?)
0127 79 MOV a,c ;natahni hodnotu kodu klavesy z C
0128 FE 90 CPI 090H ;a porovnej ji s kodem klavesy = (90h)
012A C9 RET ;RETURN??? Nemelo by zde byt nejake dalsi vyhodnoceni?
012B ;Nebo jde jen o nastaveni priznaku?
012B ; pravdepodobne jiz nepouzivany usek s vyhodnocenim (nevedou sem zadne skoky)
012B 08 DB 008H
012C 09 DAD b
012D 0D DCR c
012E 0B DCX b
012F 0A LDAX b
0130 13 INX d
0131 14 INR d
0132 0E 0C MVI c,00CH
0134 0F RRC
0135 05 DCR b
0136 1A LDAX d
0137 0D DCR c
0138 0B DCX b
0139 0A LDAX b
013A E4 DF D9 CPO 0xD9DF
013D DB DD IN 0DDH
013F FF RST 7
0140 ; konec asi jiz nepouzivane casti kodu
0140 DISP: ;tento podprogram byl okomentovan jiz v puvodni dokumentaci v AR 11/1984
0140 ; ale v tomto AR je spatna tabulka TABKEY. Spravne je to zde.
0140 E5 PUSH h
0141 C5 PUSH b
0142 D5 PUSH d
0143 11 00 00 LXI d,0000h ;nul D,E
0146 42 MOV b,d ;nul B
0147 7A MOV a,d ;nul A
0148 32 FE 1F STA 0x1FFE ;inic STATUS
014B LOOP1:
014B 3E 7F MVI a,07FH ;blok segmenty
014D D3 F8 OUT 0F8H ;port segment
014F 00 NOP
0150 7B MOV a,e
0151 2F CMA
0152 D3 FA OUT 0FAH ;nastav digit
0154 00 NOP
0155 2A FC 1F LHLD VIDEO_POINTER ;nastav ukazatel vypisu
0158 19 DAD d ;pripocitej digit
0159 4E MOV c,m ;vloz zobrazovana data
015A 21 BE 01 LXI h,TPREV ;nastav tabulku prevodu znaku
015D 09 DAD b
015E 7E MOV a,m ;segment data
015F D3 F8 OUT 0F8H ;port segment
0161 00 NOP
0162 3A FE 1F LDA 0x1FFE ;lda STATUS
0165 B7 ORA a
0166 C2 88 01 JNZ NOKEY ;KEY?
0169 0E 09 MVI c,009H ;ANO
016B 21 9A 01 LXI h,0019AH ;lxi h, TABKEY-9 nastav tabulku prevodu klaves
016E DB FA IN 0FAH ;vstup KEY kod
0170 00 NOP
0171 E6 70 ANI 070H ;maska
0173 07 RLC
0174 07 RLC
0175 D2 82 01 JNC PRVA ;ANO, první rada
0178 07 RLC ;NE
0179 D2 81 01 JNC DRUHA ;ANO, druhá rada
017C 07 RLC ;NE
017D DA 88 01 JC NOKEY ;C!=1, zadna rada
0180 09 DAD b ;pripocitej radu
0181 DRUHA:
0181 09 DAD b ;pripocitej radu
0182 PRVA:
0182 09 DAD b ;pripocitej radu
0183 19 DAD d ;pripocitej KEY
0184 7E MOV a,m ;vyber kod KEY
0185 32 FE 1F STA 0x1FFE ;vloz do STATUS
0188 NOKEY:
0188 1C INR e ;dalsi digit
0189 3E 0A MVI a,00AH
018B BB CMP e
018C C2 4B 01 JNZ LOOP1 ;posledni digit?
018F 3A FE 1F LDA 0x1FFE ;lda STATUS ANO, posledni
0192 07 RLC ;nastav carry
0193 D1 POP d
0194 C1 POP b
0195 E1 POP h
0196 C9 RET
0197 ;
0197 L0197:
0197 21 F0 01 LXI h,TEXT_ERR_ADRES
019A C3 40 00 JMP L0040
019D ;
019D L019D:
019D 21 F9 01 LXI h,TEXT_ERR_DATA
01A0 C3 40 00 JMP L0040
01A3 ; tabulka klaves.
01A3 ; 80h-8Fh = klavesy 0-F, 9xh = ridici klavesy, FFh = neosazeno
01A3 TABKEY:
01A3 80 84 88 91 8D 8C 89 85 81 DB 080H,084H,088H,091H,08DH,08CH,089H,085H,081H ;3. radek matice tl.
01AC 82 86 8A 9A 8F 8E 8B 87 83 DB 082H,086H,08AH,09AH,08FH,08EH,08BH,087H,083H ;2. radek matice tl.
01B5 FF 94 93 FF 97 92 FF FF 90 DB 0FFH,094H,093H,0FFH,097H,092H,0FFH,0FFH,090H ;1. radek matice tl.
01BE ; tabulka pro prevod kodu znaku na sedmisegmentove vyjadreni
01BE ; pozor, je to invertovane!
01BE TPREV:
01BE 40 DB 040H ;znak 0
01BF 79 DB 079H ;znak 1, atd. dle tabulky znaku:
01C0 24 30 19 12 02 78 00 18 08 03 46 21 DB 024H,030H,019H,012H,002H,078H,000H,018H,008H,003H,046H,021H
01CC 06 0E 07 23 2F 0C 47 63 48 71 37 7F DB 006H,00EH,007H,023H,02FH,00CH,047H,063H,048H,071H,037H,07FH
01D8 09 2B 0B 2C 5D 3F 42 61 DB 009H,02BH,00BH,02CH,05DH,03FH,042H,061H
01E0 7B DB 07BH ;znak c. 22 (carka), posledni v tabulce znaku
01E1 11 DB 011H ;v tabulce znaku v manualu neni
01E2 FF RST 7 ; volny prostor (lze vyuzit pro upravy)
01E3 FF RST 7
01E4 FF RST 7
01E5 FF RST 7
01E6 FF RST 7
01E7 TEXT_PMI_80: ;zacina na adrese 01E7h
01E7 1E 13 16 01 19 1F 08 00 1E DB 01EH,013H,016H,001H,019H,01FH,008H,000H,01EH
01F0 ;TEXT_PMI_80r:
01F0 ; db 01EH, 013H, 016H, 001H, 01FH, 008H, 000H, 012H 01EH
01F0 ; text pro repliku PMI-80r od 01E7h
01F0 ;TEXT_PMI_85:
01F0 ; db 01EH, 013H, 016H, 001H, 019H, 01FH, 008H, 005H, 01EH
01F0 ; na 01EEh dat hodnotu 05h
01F0 ;TEXT_PMI Z-80
01F0 ; db 013H, 016H, 001H, 019H, 019H, 002H, 01FH, 008H, 000H
01F0 ; alternativni text pro Z-80 (od 01E7h)
01F0 ;TEXT_PMI_880:
01F0 ; db 01EH, 013H, 016H, 001H, 019H, 008H, 008H, 000H, 01EH
01F0 ; alternativni text pro U880D
01F0 ; na 01EC dat hodnotu 08h
01F0 TEXT_ERR_ADRES:
01F0 0E 12 12 18 0A 0D 12 0E 05 DB 00EH,012H,012H,018H,00AH,00DH,012H,00EH,005H
01F9 TEXT_ERR_DATA:
01F9 0E 12 12 18 19 0D 0A 10 0A DB 00EH,012H,012H,018H,019H,00DH,00AH,010H,00AH
0202 TEXT_ERROR:
0202 1E 19 0E 12 12 11 12 19 1E DB 01EH,019H,00EH,012H,012H,011H,012H,019H,01EH
020B TABPRIKAZY: ;kod prikazu (klavesy) + adresa obsluzneho programu (low, high)
020B 92 72 00 DB 092H,072H,000H ; MEM
020E 91 29 02 DB 091H,029H,002H ; EX
0211 97 5A 02 DB 097H,05AH,002H ; BR
0214 9A 7E 02 DB 09AH,07EH,002H ; R
0217 94 4C 03 DB 094H,04CH,003H ; SAVE
021A 93 8C 03 DB 093H,08CH,003H ; LOAD
021D FF FF FF DB 0FFH,0FFH,0FFH ; Zde mely byt asi Rst 7 (nevyuzite misto)
0220 TEXT_BR_STOP:
0220 1E 0B 12 1F 05 10 11 13 1E DB 01EH,00BH,012H,01FH,005H,010H,011H,013H,01EH
0229 PRIKAZ_EX: ; EX
0229 3E 20 MVI a,020H
022B CD AB 00 CALL CLEAR
022E 2A E2 1F LHLD 0x1FE2
0231 22 F8 1F SHLD IN_ADR
0234 CD D7 00 CALL MODAD
0237 2A F8 1F LHLD IN_ADR
023A 22 E2 1F SHLD 0x1FE2
023D 3E 06 MVI a,006H
023F D3 F8 OUT 0F8H
0241 00 NOP
0242 3E 0F MVI a,00FH
0244 D3 FA OUT 0FAH
0246 00 NOP
0247 21 D9 1F LXI h,STACK
024A F9 SPHL
024B D1 POP d
024C C1 POP b
024D F1 POP psw
024E 2A E4 1F LHLD 0x1FE4
0251 F9 SPHL
0252 2A E2 1F LHLD 0x1FE2
0255 E5 PUSH h
0256 2A DF 1F LHLD 0x1FDF
0259 C9 RET
025A ;
025A PRIKAZ_BR: ; BR
025A 3E 0B MVI a,00BH
025C CD AB 00 CALL CLEAR
025F 2A EC 1F LHLD 0x1FEC
0262 22 F8 1F SHLD IN_ADR
0265 CD D7 00 CALL MODAD
0268 2A F8 1F LHLD IN_ADR
026B 22 EC 1F SHLD 0x1FEC
026E 7E MOV a,m
026F 32 EE 1F STA 0x1FEE
0272 36 CF MVI m,0CFH
0274 2A E2 1F LHLD 0x1FE2
0277 2B DCX h
0278 22 E2 1F SHLD 0x1FE2
027B C3 29 02 JMP PRIKAZ_EX
027E ;
027E PRIKAZ_R: ; R
027E 3E 12 MVI a,012H
0280 CD AB 00 CALL CLEAR
0283 CD 16 01 CALL OUTKE
0286 D2 67 00 JNC L0067
0289 E6 0F ANI 00FH
028B 01 06 00 LXI b,00006H
028E L028E:
028E 21 2A 01 LXI h,0012AH
0291 0B DCX b
0292 09 DAD b
0293 0C INR c
0294 0D DCR c
0295 CA 4F 00 JZ L004F
0298 BE CMP m
0299 C2 8E 02 JNZ L028E
029C L029C:
029C 21 2F 01 LXI h,0012FH
029F CD CD 02 CALL L02CD
02A2 5D MOV e,l
02A3 21 34 01 LXI h,00134H
02A6 CD CD 02 CALL L02CD
02A9 63 MOV h,e
02AA 22 F6 1F SHLD 0x1FF6
02AD C5 PUSH b
02AE CD CA 02 CALL L02CA
02B1 E5 PUSH h
02B2 4E MOV c,m
02B3 23 INX h
02B4 66 MOV h,m
02B5 69 MOV l,c
02B6 22 F8 1F SHLD IN_ADR
02B9 CD D7 00 CALL MODAD
02BC D1 POP d
02BD 7D MOV a,l
02BE 12 STAX d
02BF 13 INX d
02C0 7C MOV a,h
02C1 12 STAX d
02C2 C1 POP b
02C3 0D DCR c
02C4 C2 9C 02 JNZ L029C
02C7 C3 4F 00 JMP L004F
02CA L02CA:
02CA 21 39 01 LXI h,00139H
02CD L02CD:
02CD 06 00 MVI b,000H
02CF 09 DAD b
02D0 6E MOV l,m
02D1 26 1F MVI h,01FH
02D3 C9 RET
02D4 ;
02D4 TOUT:
02D4 06 09 MVI b,009H
02D6 L02D6:
02D6 3E C7 MVI a,0C7H
02D8 CD EE 02 CALL L02EE
02DB 79 MOV a,c
02DC 1F RAR
02DD 4F MOV c,a
02DE 3E 8F MVI a,08FH
02E0 1F RAR
02E1 CD EE 02 CALL L02EE
02E4 3E 47 MVI a,047H
02E6 CD EE 02 CALL L02EE
02E9 05 DCR b
02EA C2 D6 02 JNZ L02D6
02ED C9 RET
02EE ;
02EE L02EE:
02EE 16 20 MVI d,020H
02F0 L02F0:
02F0 D3 F8 OUT 0F8H
02F2 1E 04 MVI e,004H
02F4 L02F4:
02F4 1D DCR e
02F5 C2 F4 02 JNZ L02F4
02F8 EE 40 XRI 040H
02FA 15 DCR d
02FB C2 F0 02 JNZ L02F0
02FE C9 RET
02FF ;
02FF FF RST 7
0300 TIN:
0300 06 08 MVI b,008H
0302 16 00 MVI d,000H
0304 L0304:
0304 CD 42 03 CALL L0342
0307 DA 04 03 JC L0304
030A CD 42 03 CALL L0342
030D DA 04 03 JC L0304
0310 L0310:
0310 CD 42 03 CALL L0342
0313 D2 10 03 JNC L0310
0316 CD 42 03 CALL L0342
0319 D2 10 03 JNC L0310
031C L031C:
031C 15 DCR d
031D CD 42 03 CALL L0342
0320 DA 1C 03 JC L031C
0323 CD 42 03 CALL L0342
0326 DA 1C 03 JC L031C
0329 L0329:
0329 14 INR d
032A CD 42 03 CALL L0342
032D D2 29 03 JNC L0329
0330 CD 42 03 CALL L0342
0333 D2 29 03 JNC L0329
0336 7A MOV a,d
0337 17 RAL
0338 79 MOV a,c
0339 1F RAR
033A 4F MOV c,a
033B 16 00 MVI d,000H
033D 05 DCR b
033E C2 1C 03 JNZ L031C
0341 C9 RET
0342 ;
0342 L0342:
0342 1E 02 MVI e,002H
0344 L0344:
0344 1D DCR e
0345 C2 44 03 JNZ L0344
0348 DB FA IN 0FAH
034A 17 RAL
034B C9 RET
034C ;
034C PRIKAZ_SAVE:
034C 3E 05 MVI a,005H
034E CD AB 00 CALL CLEAR
0351 CD D7 00 CALL MODAD
0354 CD FB 00 CALL MODDA
0357 21 95 00 LXI h,TEXT_MG_RUN
035A 22 FC 1F SHLD VIDEO_POINTER
035D CD 16 01 CALL OUTKE
0360 3E 23 MVI a,023H
0362 D3 F8 OUT 0F8H
0364 3E 0F MVI a,00FH
0366 D3 FA OUT 0FAH
0368 16 F0 MVI d,0F0H
036A 3E C7 MVI a,0C7H
036C CD F0 02 CALL L02F0
036F 3A FA 1F LDA IN_DATA
0372 4F MOV c,a
0373 CD D4 02 CALL TOUT
0376 3E 10 MVI a,010H
0378 CD AB 00 CALL CLEAR
037B 2A F8 1F LHLD IN_ADR
037E L037E:
037E 4E MOV c,m
037F CD D4 02 CALL TOUT
0382 2C INR l
0383 C2 7E 03 JNZ L037E
0386 L0386:
0386 21 9E 00 LXI h,TEXT_MG_STOP
0389 C3 43 00 JMP L0043
038C ;
038C PRIKAZ_LOAD:
038C 3E 14 MVI a,014H
038E CD AB 00 CALL CLEAR
0391 CD D7 00 CALL MODAD
0394 CD FB 00 CALL MODDA
0397 21 95 00 LXI h,TEXT_MG_RUN
039A L039A:
039A 22 FC 1F SHLD VIDEO_POINTER
039D CD 16 01 CALL OUTKE
03A0 L03A0:
03A0 2A F8 1F LHLD IN_ADR
03A3 3E 07 MVI a,007H
03A5 D3 F8 OUT 0F8H
03A7 3E 0F MVI a,00FH
03A9 D3 FA OUT 0FAH
03AB L03AB:
03AB 16 A0 MVI d,0A0H
03AD L03AD:
03AD CD 42 03 CALL L0342
03B0 DA AB 03 JC L03AB
03B3 15 DCR d
03B4 C2 AD 03 JNZ L03AD
03B7 CD 00 03 CALL TIN
03BA 3A FA 1F LDA IN_DATA
03BD B9 CMP c
03BE C2 CC 03 JNZ L03CC
03C1 L03C1:
03C1 CD 00 03 CALL TIN
03C4 71 MOV m,c
03C5 2C INR l
03C6 C2 C1 03 JNZ L03C1
03C9 C3 86 03 JMP L0386
03CC ;
03CC L03CC:
03CC DA E7 03 JC L03E7
03CF 3E 0F MVI a,00FH
03D1 CD AB 00 CALL CLEAR
03D4 79 MOV a,c
03D5 01 F6 1F LXI b,0x1FF6
03D8 CD C6 00 CALL L00C6
03DB 21 EF 1F LXI h,VIDEORAM
03DE 22 FC 1F SHLD VIDEO_POINTER
03E1 CD 16 01 CALL OUTKE
03E4 C3 A0 03 JMP L03A0
03E7 ;
03E7 L03E7:
03E7 21 ED 03 LXI h,TEXT_MG_SPAT
03EA C3 9A 03 JMP L039A
03ED TEXT_MG_SPAT:
03ED 1E 16 20 19 05 13 0A 10 1E DB 01EH,016H,020H,019H,005H,013H,00AH,010H,01EH
03F6 FF RST 7 ; volny prostor na konci PROM (lze vyuzit pro upravy)
03F7 FF RST 7
03F8 FF RST 7
03F9 FF RST 7
03FA FF RST 7
03FB FF RST 7
03FC FF RST 7
03FD FF RST 7
03FE FF RST 7
03FF FF RST 7 ;03FFh konec 1KB PROM
0400 ; Poznamka: port PB sluzebni 8255A lze nastavit
0400 ; pouze na jednoduchy vstup/vystup v rezimu 0
0400 ;
0400 ; vstup: mvi a,08Ah
0400 ; out 0FBh
0400 ;
0400 ; vystup: mvi a,088h
0400 ; out 0FBh
0400 ;
0400 ; jina nastaveni tohoto obvodu nejsou mozna!
0400 ; Pridavny 8255A lze nastavit dle libosti.
0400 ;
0400 ;***************************** www.nostalcomp.cz *****************************
_PC 0400
STACK 1FD9
INT_VECTOR 1FE6
VIDEO_POINTER1FFC
VIDEORAM 1FEF
IN_DATA 1FFA
IN_ADR 1FF8
START 0000
ENTRY 0008
L002E 002E
INTERRUPT 0038
L003D 003D
L0040 0040
L0043 0043
L004F 004F
L005C 005C
L0067 0067
L006D 006D
PRIKAZ_MEM 0072
L007A 007A
TEXT_MG_RUN 0095
TEXT_MG_STOP009E
CLEAR 00AB
L00AE 00AE
OUTAD 00BB
L00C5 00C5
L00C6 00C6
MODAD 00D7
OUTDA 00F2
MODDA 00FB
OUTKE 0116
L011E 011E
DISP 0140
LOOP1 014B
DRUHA 0181
PRVA 0182
NOKEY 0188
L0197 0197
L019D 019D
TABKEY 01A3
TPREV 01BE
TEXT_PMI_80 01E7
TEXT_ERR_ADRES01F0
TEXT_ERR_DATA01F9
TEXT_ERROR 0202
TABPRIKAZY 020B
TEXT_BR_STOP0220
PRIKAZ_EX 0229
PRIKAZ_BR 025A
PRIKAZ_R 027E
L028E 028E
L029C 029C
L02CA 02CA
L02CD 02CD
TOUT 02D4
L02D6 02D6
L02EE 02EE
L02F0 02F0
L02F4 02F4
TIN 0300
L0304 0304
L0310 0310
L031C 031C
L0329 0329
L0342 0342
L0344 0344
PRIKAZ_SAVE 034C
L037E 037E
L0386 0386
PRIKAZ_LOAD 038C
L039A 039A
L03A0 03A0
L03AB 03AB
L03AD 03AD
L03C1 03C1
L03CC 03CC
L03E7 03E7
TEXT_MG_SPAT03ED
majne: xri 23
ori 251
ei
ret
:06000000EE17F6FBFBC940
:00000001FF
0000 EE 17 MAJNE: XRI 23
0002 F6 FB ORI 251
0004 FB EI
0005 C9 RET
pa .equ 0F8h
pb .equ 0F9h
pc .equ 0FAh
pio .equ 0FBh
;*******************************************************************************
.org 1FC8h
.engine pmi
stack: ds 24 ;zásobník monitoru
save_af: ds 2 ;obrazy registrů
save_bc: ds 2
save_de: ds 2
save_hl: ds 2
save_sp: ds 2
save_pc: ds 2
br_adr: ds 2 ;adresa zarážky
br_ins: ds 1 ;instrukce přepsaná zarážkou
vector: ds 3 ;uživatelský vektor přerušení
bufptr: ds 2 ;ukazatel zobrazování
buffer: ds 9 ;video ram
keyout: ds 1 ;platná klávesa
keytmp: ds 1 ;předchozí vzorek
keycnt: ds 1 ;čítač shod
;*******************************************************************************
; RESET - inicializace monitoru
;*******************************************************************************
.org 0000h
mvi a,10001010b ;pa:výstup, pb:vstup, pch:vstup pcl:výstup
out pio ;set pio mode
xra a ;nuluj střadač
jmp init1
;*******************************************************************************
; přerušení od zarážky
;*******************************************************************************
.org 0008h
shld save_hl ;uschovej HL
push psw ;střadač a příznaky
pop h ;do hl
shld save_af ;uschovej PSW
pop h ;návratová adresa
dcx h ;před zarážku
shld save_pc ;uschovej PC
lxi h,0000h ;hl = 0
dad sp ;hl + sp
shld save_sp ;uschovej SP
lxi sp,save_hl ;adresa obrazů registrů
push d ;uschovej DE
push b ;uschovej BC
lhld br_adr ;adresa zarážky
lda br_ins ;původní instrukce
mov m,a ;obnov instrukci
lxi h,stop ;zpráva "br-stop"
jmp msg ;zobrazit
;*******************************************************************************
; inicializace - pokračování
;*******************************************************************************
init1: sta keyout ;nuluj filtr klávesnice
lxi h,stack ;zásobník aplikace
jmp init2
;*******************************************************************************
; uživatelské přerušení
;*******************************************************************************
.org 0038h
jmp vector
;*******************************************************************************
; inicializace - pokračování
;*******************************************************************************
init2: shld save_sp ;nastav zásobník aplikace
lxi h,stone ;text "Stone 1"
msg: shld bufptr ;ulož adresu textu
lxi sp,save_af ;zásobník monitoru
call getc ;čekej na klávesu
lxi h,buffer ;adresa video ram
shld bufptr ;nastav ukazatel
;*******************************************************************************
; start monitoru
;*******************************************************************************
prompt: mvi a,25h ;?
call clear ;na displej
call getc ;čekej na klávesu
lxi h,tabfc ;tabulka funkcí
mvi b,6 ;počet záznamů
func: cmp m ;porovnej kód funkce
inx h ;ukazatel na adresu
jz run ;shoda, spusť
inx h ;přeskoč adresu
inx h
dcr b ;další záznam
jnz func ;opakuj
jmp prompt ;nenalezeno
;*******************************************************************************
run: lxi b,prompt ;návratová adresa
push b ;do zásobníku
mov c,m ;načti adresu funkce
inx h
mov h,m
mov l,c
pchl ;spusť funkci
;*******************************************************************************
stop: .db 0Bh,1Bh,22h,05h,1Ch,18h,19h,27h,27h
stone: .db 27h,05h,1Ch,18h,17h,0Eh,27h,01h,27h
;*******************************************************************************
tabfc: .db 91h ;Ex
.dw exec
.db 92h ;M
.dw mem
.db 93h ;L
.dw load
.db 94h ;S
.dw save
.db 97h ;Br
.dw break
.db 9Ah ;R
.dw reg
;*******************************************************************************
; zobrazení jednoho znaku z A, zbytek mezery
;*******************************************************************************
clear: lxi h,buffer ;adresa video ram
mov m,a ;ulož symbol z A
inx h
mvi e,8 ;zbývající pozice
clear1: mvi m,27h ;mezera
inx h
dcr e ;další
jnz clear1 ;opakuj
ret
;*******************************************************************************
; editace obsahu HL
;*******************************************************************************
modad: call outad ;zobraz
call getc ;klávesa
rnc ;konec
ani 0Fh ;číselná hodnota klávesy
dad h ;hl*16
dad h
dad h
dad h
ora l ;přičti nový nible
mov l,a
jmp modad ;opakuj
;*******************************************************************************
; editace obsahu A
;*******************************************************************************
modda: mov d,a ;uschovej obsah
call outda ;zobraz
call getc ;klávesa
jc modda1 ;je to číslice
jz moddar
cpi 9ah
moddar: mov a,d ;návratová hodnota
ret ;konec
modda1: ani 0Fh ;číselná hodnota klávesy
mov b,a ;uschovej nový nible
mov a,d ;původní obsah
add a ;*16
add a
add a
add a
ora b ;přičti nový nible
jmp modda ;opakuj
;*******************************************************************************
; výstup obsahu HL na displej
;*******************************************************************************
outad: lxi b,buffer+2 ;třetí segmentovka zleva
mov a,h ;horní bajt
call outhex ;zobrazit
mov a,l ;dolní bajt
jmp outhex ;zobrazit
;*******************************************************************************
; výstup obsahu A na displej
;*******************************************************************************
outda: lxi b,buffer+7 ;předposlední segmentovka
;*******************************************************************************
; výstup obsahu A na displej v hexadecimálním tvaru
;*******************************************************************************
outhex: push d ;uschovej de
mov d,a ;kopie bajtu
ani 0F0h ;horní nible
rrc ;dolu
rrc
rrc
rrc
stax b ;na displej
inx b
mov a,d ;obnov bajt
ani 0Fh ;dolní nible
stax b ;na displej
inx b
pop d ;obnov de
ret
;*******************************************************************************
; čeká na stisk klávesy
;*******************************************************************************
getc: call mpx ;je klávesa?
jnz getc ;čekej na uvolnění
getc1: call mpx ;je klávesa?
jz getc1 ;čekej na stisk
cpi 90h ;je to '=' ?
ret
;*******************************************************************************
; obsluha displeje a filtrace klávesnice
;*******************************************************************************
mpx: push h ;uschovej hl
push d ;uschovej de
push b ;uschovej bc
lxi d,0000h ;nuluj čítač sloupců
push d ;paměť pro vzorek klávesnice
mov b,d ;nuluj pomocný ofset.hi
loop: mvi a,7Fh ;zhasnutí displeje
out pa
mov a,e ;číslo sloupce
cma ;doplněk pro dekodér
out pc
lhld bufptr ;adresa zprávy do hl
dad d ;adresa znaku (hl + de)
mov c,m ;přečti znak
lxi h,font ;tabulka fontu
dad b ;adresa obrazu (hl + bc)
mov a,m ;obraz znaku
out pa
mvi a,127 ;0,95 ms
delay: dcr a
jnz delay
mvi c,9 ;počet sloupců
lxi h,tabkey ;tabulka kláves
in pc ;přečti tlačítka
rlc
rlc
jnc prvni ;stisknuta klávesa v prvním řádku
rlc
jnc druhy ;stisknuta klávesa v druhém řádku
rlc
jc nokey ;žádná klávesa
dad b ;délka řádku (hl + bc)
druhy: dad b
prvni: dad d ;číslo sloupce (hl + de)
mov a,m ;kód klávesy
pop h ;uvolni předchozí vzorek
push psw ;ulož nový vzorek
nokey: inr e ;další sloupec
mov a,e
cmp c ;je poslední?
jnz loop ;ne, opakuj
cma ;deaktivuj sloupce
out pc
lxi h,keycnt ;adresa čítače shod
lxi d,keyout ;adresa platného stavu klávesnice
lda keytmp ;předchozí vzorek
mov b,a ;uschovej
ldax d ;platný stav
mov c,a ;uschovej
pop psw ;aktuální vzorek
cmp b ;porovnej s předchozím
jz cmpout ;shoda
sta keytmp ;nastav předchozí
mvi m,4 ;nastav počet shod
jmp result
cmpout: cmp c ;porovnej s platným
jz result ;shoda
dcr m ;počítej
jnz result
stax d ;nastav platný
result: ldax d ;platný stav klávesnice
ora a ;NZ jako příznak stisku
pop b ;obnov bc
pop d ;obnov de
pop h ;obnov hl
ret
;*******************************************************************************
font: .db 01000000b ;0
.db 01111001b ;1
.db 00100100b ;2
.db 00110000b ;3
.db 00011001b ;4
.db 00010010b ;5
.db 00000010b ;6
.db 01111000b ;7
.db 00000000b ;8
.db 00010000b ;9
.db 00001000b ;A
.db 00000011b ;b
.db 01000110b ;C
.db 00100001b ;d
.db 00000110b ;E
.db 00001110b ;F
.db 01000010b ;G
.db 00001011b ;h
.db 01111011b ;i
.db 01100001b ;J
.db 00001010b ;K
.db 01000111b ;L
.db 01001000b ;M
.db 00101011b ;n
.db 00100011b ;o
.db 00001100b ;P
.db 00011000b ;q
.db 00101111b ;r
.db 00000111b ;t
.db 01000001b ;U
.db 01100011b ;v
.db 00000001b ;w
.db 00001001b ;X
.db 00010001b ;Y
.db 00111111b ;-
.db 01011101b ;"
.db 00110111b ;=
.db 00101100b ;?
.db 01110000b ;]
.db 01111111b ;space
;*******************************************************************************
tabkey: .db 080h ;0
.db 084h ;4
.db 088h ;8
.db 091h ;Ex
.db 08Dh ;D
.db 08Ch ;C
.db 089h ;9
.db 085h ;5
.db 081h ;1
.db 082h ;2
.db 086h ;6
.db 08Ah ;A
.db 09Ah ;R
.db 08Fh ;F
.db 08Eh ;E
.db 08Bh ;B
.db 087h ;7
.db 083h ;3
.db 0FFh
.db 094h ;S
.db 093h ;L
.db 0FFh
.db 097h ;Br
.db 092h ;M
.db 0FFh
.db 0FFh
.db 090h ;=
;*******************************************************************************
; MEMORY - editace obsahu paměti
;*******************************************************************************
mem: mvi a,16h ;M
call clear ;na displej
lxi h,1800h ;počáteční adresa RAM
call modad ;úprava adresy
rnz ;není '=', konec
mem1: mov a,m ;obsah adresy
call modda ;úprava dat
rnz ;není '=', konec
mov m,a ;ulož nové data
inx h ;další adresa
call outad ;zobraz adresu
jmp mem1 ;opakuj
;*******************************************************************************
; REGISTRY - editace obsahu registrů
;*******************************************************************************
reg: mvi a,1Bh ;r
call clear ;na displej
reg1: lxi d,0000h ;nuluj čítač registrů
reg2: lxi h,regnm ;názvy registrů
dad d ;adresa názvu (hl + de)
mov b,m ;první znak
inx h
mov h,m ;druhý znak
mov l,b
shld buffer+7 ;na displej
lxi h,save_af ;obrazy registrů
dad d ;adresa obrazu registru (hl + de)
push h ;uschovej adresu
mov b,m ;obsah registru do HL
inx h
mov h,m
mov l,b
call modad ;úpravy
pop b ;obnov adresu
rnz ;konec
mov a,l ;ulož nový obsah
stax b
inx b
mov a,h
stax b
inx d ;další registr
inx d
mov a,e
cpi 0Ch ;6 registrových párů
jnz reg2 ;opakuj
jmp reg1 ;od začátku
;*******************************************************************************
regnm: .db 0Ah,0Fh ;AF
.db 0Bh,0Ch ;BC
.db 0Dh,0Eh ;DE
.db 11h,15h ;HL
.db 05h,19h ;SP
.db 19h,0Ch ;PC
;*******************************************************************************
; BREAK - vložení zarážky
;*******************************************************************************
break: mvi a,0Bh ;b
call clear ;na displej
lhld br_adr ;adresa zarážky
call modad ;uprav
rnz ;storno
shld br_adr ;ulož novou adresu
mov a,m ;původní instrukce
sta br_ins ;uschovej
mvi m,0CFh ;zarážka (rst 1)
;*******************************************************************************
; EXECUTE - spuštění uživatelského programu
;*******************************************************************************
exec: mvi a,10h ;G
call clear ;na displej
lhld save_pc ;vstupní bod
call modad ;uprav
rnz ;storno
shld save_pc ;ulož novou hodnotu
lxi sp,save_af ;obrazy registrů
pop psw ;obnov střadač
pop b ;obnov BC
pop d ;obnov DE
lhld save_sp ;ukazatel zásobníku
sphl ;obnov SP
lhld save_pc ;vstupní bod
push h ;do zásobníku
lhld save_hl ;obnov HL
ret ;obnov PC - spuštění programu
;*******************************************************************************
; LOAD - čtení z magnetofonu
;*******************************************************************************
load: ret
;*******************************************************************************
; SAVE - záznam na magnetofon
;*******************************************************************************
save: ret
;*******************************************************************************
.end
:100000003E8AD3FBAFC32E0022E61FF5E122E01F9C
:10001000E12B22EA1F2100003922E81F31E61FD51B
:10002000C52AEC1F3AEE1F77217400C3410032FD50
:070030001F21C81FC33B00A4
:10003800C3EF1F22E81F217D0022F21F31E01FCDF0
:10004800F50021F41F22F21F3E25CD9800CDF500C2
:100058002186000606BE23CA6B00232305C25D0065
:10006800C35000015000C54E236669E90B1B2205E9
:100078001C1819272727051C18170E270127911F59
:100088000292B401934002944102970A029ACD0168
:1000980021F41F77231E083627231DC29F00C9CDD0
:1000A800D600CDF500D0E60F29292929B56FC3A7B9
:1000B8000057CDE100CDF500DACA00CAC800FE9AA3
:1000C8007AC9E60F477A87878787B0C3B90001F6F0
:1000D8001F7CCDE4007DC3E40001FB1FD557E6F08B
:1000E8000F0F0F0F02037AE60F0203D1C9CD0401E7
:1000F800C2F500CD0401CAFB00FE90C9E5D5C511C3
:100108000000D5423E7FD3F87B2FD3FA2AF21F197D
:100118004E217101097ED3F83E7F3DC222010E09AE
:10012800219901DBFA0707D23C0107D23B0107DA24
:1001380040010909197EE1F51C7BB9C20C012FD3D6
:10014800FA21FF1F11FD1F3AFE1F471A4FF1B8CAC7
:10015800620132FE1F3604C36B01B9CA6B0135C296
:100168006B01121AB7C1D1E1C940792430191202C2
:1001780078001008034621060E420B7B610A4748A7
:100188002B230C182F0741630109113F5D372C7091
:100198007F808488918D8C89858182868A9A8F8ECA
:1001A8008B8783FF9493FF9792FFFF903E16CD981D
:1001B80000210018CDA700C07ECDB900C07723CD9F
:1001C800D600C3C0013E1BCD980011000021FE01DE
:1001D800194623666822FB1F21E01F19E54623669E
:1001E80068CDA700C1C07D02037C0213137BFE0CFF
:1001F800C2D501C3D2010A0F0B0C0D0E111505193A
:10020800190C3E0BCD98002AEC1FCDA700C022EC9C
:100218001F7E32EE1F36CF3E10CD98002AEA1FCD42
:10022800A700C022EA1F31E01FF1C1D12AE81FF957
:0A0238002AEA1FE52AE61FC9C9C91A
:00000001FF
0000 PA: EQU 0F8h
0000 PB: EQU 0F9h
0000 PC: EQU 0FAh
0000 PIO: EQU 0FBh
0000 ;*******************************************************************************
1FC8 .ORG 1FC8h
1FC8 .ENGINE pmi
1FC8 STACK: DS 24 ;zásobník monitoru
1FE0 SAVE_AF: DS 2 ;obrazy registrů
1FE2 SAVE_BC: DS 2
1FE4 SAVE_DE: DS 2
1FE6 SAVE_HL: DS 2
1FE8 SAVE_SP: DS 2
1FEA SAVE_PC: DS 2
1FEC BR_ADR: DS 2 ;adresa zarážky
1FEE BR_INS: DS 1 ;instrukce přepsaná zarážkou
1FEF VECTOR: DS 3 ;uživatelský vektor přerušení
1FF2 BUFPTR: DS 2 ;ukazatel zobrazování
1FF4 BUFFER: DS 9 ;video ram
1FFD KEYOUT: DS 1 ;platná klávesa
1FFE KEYTMP: DS 1 ;předchozí vzorek
1FFF KEYCNT: DS 1 ;čítač shod
2000 ;*******************************************************************************
2000 ; RESET - inicializace monitoru
2000 ;*******************************************************************************
0000 .ORG 0000h
0000 3E 8A MVI a,10001010b ;pa:výstup, pb:vstup, pch:vstup pcl:výstup
0002 D3 FB OUT pio ;set pio mode
0004 AF XRA a ;nuluj střadač
0005 C3 2E 00 JMP init1
0008 ;*******************************************************************************
0008 ; přerušení od zarážky
0008 ;*******************************************************************************
0008 .ORG 0008h
0008 22 E6 1F SHLD save_hl ;uschovej HL
000B F5 PUSH psw ;střadač a příznaky
000C E1 POP h ;do hl
000D 22 E0 1F SHLD save_af ;uschovej PSW
0010 E1 POP h ;návratová adresa
0011 2B DCX h ;před zarážku
0012 22 EA 1F SHLD save_pc ;uschovej PC
0015 21 00 00 LXI h,0000h ;hl = 0
0018 39 DAD sp ;hl + sp
0019 22 E8 1F SHLD save_sp ;uschovej SP
001C 31 E6 1F LXI sp,save_hl ;adresa obrazů registrů
001F D5 PUSH d ;uschovej DE
0020 C5 PUSH b ;uschovej BC
0021 2A EC 1F LHLD br_adr ;adresa zarážky
0024 3A EE 1F LDA br_ins ;původní instrukce
0027 77 MOV m,a ;obnov instrukci
0028 21 74 00 LXI h,stop ;zpráva "br-stop"
002B C3 41 00 JMP msg ;zobrazit
002E ;*******************************************************************************
002E ; inicializace - pokračování
002E ;*******************************************************************************
002E 32 FD 1F INIT1: STA keyout ;nuluj filtr klávesnice
0031 21 C8 1F LXI h,stack ;zásobník aplikace
0034 C3 3B 00 JMP init2
0037 ;*******************************************************************************
0037 ; uživatelské přerušení
0037 ;*******************************************************************************
0038 .ORG 0038h
0038 C3 EF 1F JMP vector
003B ;*******************************************************************************
003B ; inicializace - pokračování
003B ;*******************************************************************************
003B 22 E8 1F INIT2: SHLD save_sp ;nastav zásobník aplikace
003E 21 7D 00 LXI h,stone ;text "Stone 1"
0041 22 F2 1F MSG: SHLD bufptr ;ulož adresu textu
0044 31 E0 1F LXI sp,save_af ;zásobník monitoru
0047 CD F5 00 CALL getc ;čekej na klávesu
004A 21 F4 1F LXI h,buffer ;adresa video ram
004D 22 F2 1F SHLD bufptr ;nastav ukazatel
0050 ;*******************************************************************************
0050 ; start monitoru
0050 ;*******************************************************************************
0050 3E 25 PROMPT: MVI a,25h ;?
0052 CD 98 00 CALL clear ;na displej
0055 CD F5 00 CALL getc ;čekej na klávesu
0058 21 86 00 LXI h,tabfc ;tabulka funkcí
005B 06 06 MVI b,6 ;počet záznamů
005D BE FUNC: CMP m ;porovnej kód funkce
005E 23 INX h ;ukazatel na adresu
005F CA 6B 00 JZ run ;shoda, spusť
0062 23 INX h ;přeskoč adresu
0063 23 INX h
0064 05 DCR b ;další záznam
0065 C2 5D 00 JNZ func ;opakuj
0068 C3 50 00 JMP prompt ;nenalezeno
006B ;*******************************************************************************
006B 01 50 00 RUN: LXI b,prompt ;návratová adresa
006E C5 PUSH b ;do zásobníku
006F 4E MOV c,m ;načti adresu funkce
0070 23 INX h
0071 66 MOV h,m
0072 69 MOV l,c
0073 E9 PCHL ;spusť funkci
0074 ;*******************************************************************************
0074 0B 1B 22 05 1C 18 19 27 27 STOP: DB 0Bh,1Bh,22h,05h,1Ch,18h,19h,27h,27h
007D 27 05 1C 18 17 0E 27 01 27 STONE: DB 27h,05h,1Ch,18h,17h,0Eh,27h,01h,27h
0086 ;*******************************************************************************
0086 91 TABFC: DB 91h ;Ex
0087 1F 02 DW exec
0089 92 DB 92h ;M
008A B4 01 DW mem
008C 93 DB 93h ;L
008D 40 02 DW load
008F 94 DB 94h ;S
0090 41 02 DW save
0092 97 DB 97h ;Br
0093 0A 02 DW break
0095 9A DB 9Ah ;R
0096 CD 01 DW reg
0098 ;*******************************************************************************
0098 ; zobrazení jednoho znaku z A, zbytek mezery
0098 ;*******************************************************************************
0098 21 F4 1F CLEAR: LXI h,buffer ;adresa video ram
009B 77 MOV m,a ;ulož symbol z A
009C 23 INX h
009D 1E 08 MVI e,8 ;zbývající pozice
009F 36 27 CLEAR1: MVI m,27h ;mezera
00A1 23 INX h
00A2 1D DCR e ;další
00A3 C2 9F 00 JNZ clear1 ;opakuj
00A6 C9 RET
00A7 ;*******************************************************************************
00A7 ; editace obsahu HL
00A7 ;*******************************************************************************
00A7 CD D6 00 MODAD: CALL outad ;zobraz
00AA CD F5 00 CALL getc ;klávesa
00AD D0 RNC ;konec
00AE E6 0F ANI 0Fh ;číselná hodnota klávesy
00B0 29 DAD h ;hl*16
00B1 29 DAD h
00B2 29 DAD h
00B3 29 DAD h
00B4 B5 ORA l ;přičti nový nible
00B5 6F MOV l,a
00B6 C3 A7 00 JMP modad ;opakuj
00B9 ;*******************************************************************************
00B9 ; editace obsahu A
00B9 ;*******************************************************************************
00B9 57 MODDA: MOV d,a ;uschovej obsah
00BA CD E1 00 CALL outda ;zobraz
00BD CD F5 00 CALL getc ;klávesa
00C0 DA CA 00 JC modda1 ;je to číslice
00C3 CA C8 00 JZ moddar
00C6 FE 9A CPI 9ah
00C8 7A MODDAR: MOV a,d ;návratová hodnota
00C9 C9 RET ;konec
00CA E6 0F MODDA1: ANI 0Fh ;číselná hodnota klávesy
00CC 47 MOV b,a ;uschovej nový nible
00CD 7A MOV a,d ;původní obsah
00CE 87 ADD a ;*16
00CF 87 ADD a
00D0 87 ADD a
00D1 87 ADD a
00D2 B0 ORA b ;přičti nový nible
00D3 C3 B9 00 JMP modda ;opakuj
00D6 ;*******************************************************************************
00D6 ; výstup obsahu HL na displej
00D6 ;*******************************************************************************
00D6 01 F6 1F OUTAD: LXI b,buffer+2 ;třetí segmentovka zleva
00D9 7C MOV a,h ;horní bajt
00DA CD E4 00 CALL outhex ;zobrazit
00DD 7D MOV a,l ;dolní bajt
00DE C3 E4 00 JMP outhex ;zobrazit
00E1 ;*******************************************************************************
00E1 ; výstup obsahu A na displej
00E1 ;*******************************************************************************
00E1 01 FB 1F OUTDA: LXI b,buffer+7 ;předposlední segmentovka
00E4 ;*******************************************************************************
00E4 ; výstup obsahu A na displej v hexadecimálním tvaru
00E4 ;*******************************************************************************
00E4 D5 OUTHEX: PUSH d ;uschovej de
00E5 57 MOV d,a ;kopie bajtu
00E6 E6 F0 ANI 0F0h ;horní nible
00E8 0F RRC ;dolu
00E9 0F RRC
00EA 0F RRC
00EB 0F RRC
00EC 02 STAX b ;na displej
00ED 03 INX b
00EE 7A MOV a,d ;obnov bajt
00EF E6 0F ANI 0Fh ;dolní nible
00F1 02 STAX b ;na displej
00F2 03 INX b
00F3 D1 POP d ;obnov de
00F4 C9 RET
00F5 ;*******************************************************************************
00F5 ; čeká na stisk klávesy
00F5 ;*******************************************************************************
00F5 CD 04 01 GETC: CALL mpx ;je klávesa?
00F8 C2 F5 00 JNZ getc ;čekej na uvolnění
00FB CD 04 01 GETC1: CALL mpx ;je klávesa?
00FE CA FB 00 JZ getc1 ;čekej na stisk
0101 FE 90 CPI 90h ;je to '=' ?
0103 C9 RET
0104 ;*******************************************************************************
0104 ; obsluha displeje a filtrace klávesnice
0104 ;*******************************************************************************
0104 E5 MPX: PUSH h ;uschovej hl
0105 D5 PUSH d ;uschovej de
0106 C5 PUSH b ;uschovej bc
0107 11 00 00 LXI d,0000h ;nuluj čítač sloupců
010A D5 PUSH d ;paměť pro vzorek klávesnice
010B 42 MOV b,d ;nuluj pomocný ofset.hi
010C 3E 7F LOOP: MVI a,7Fh ;zhasnutí displeje
010E D3 F8 OUT pa
0110 7B MOV a,e ;číslo sloupce
0111 2F CMA ;doplněk pro dekodér
0112 D3 FA OUT pc
0114 2A F2 1F LHLD bufptr ;adresa zprávy do hl
0117 19 DAD d ;adresa znaku (hl + de)
0118 4E MOV c,m ;přečti znak
0119 21 71 01 LXI h,font ;tabulka fontu
011C 09 DAD b ;adresa obrazu (hl + bc)
011D 7E MOV a,m ;obraz znaku
011E D3 F8 OUT pa
0120 3E 7F MVI a,127 ;0,95 ms
0122 3D DELAY: DCR a
0123 C2 22 01 JNZ delay
0126 0E 09 MVI c,9 ;počet sloupců
0128 21 99 01 LXI h,tabkey ;tabulka kláves
012B DB FA IN pc ;přečti tlačítka
012D 07 RLC
012E 07 RLC
012F D2 3C 01 JNC prvni ;stisknuta klávesa v prvním řádku
0132 07 RLC
0133 D2 3B 01 JNC druhy ;stisknuta klávesa v druhém řádku
0136 07 RLC
0137 DA 40 01 JC nokey ;žádná klávesa
013A 09 DAD b ;délka řádku (hl + bc)
013B 09 DRUHY: DAD b
013C 19 PRVNI: DAD d ;číslo sloupce (hl + de)
013D 7E MOV a,m ;kód klávesy
013E E1 POP h ;uvolni předchozí vzorek
013F F5 PUSH psw ;ulož nový vzorek
0140 1C NOKEY: INR e ;další sloupec
0141 7B MOV a,e
0142 B9 CMP c ;je poslední?
0143 C2 0C 01 JNZ loop ;ne, opakuj
0146 2F CMA ;deaktivuj sloupce
0147 D3 FA OUT pc
0149 21 FF 1F LXI h,keycnt ;adresa čítače shod
014C 11 FD 1F LXI d,keyout ;adresa platného stavu klávesnice
014F 3A FE 1F LDA keytmp ;předchozí vzorek
0152 47 MOV b,a ;uschovej
0153 1A LDAX d ;platný stav
0154 4F MOV c,a ;uschovej
0155 F1 POP psw ;aktuální vzorek
0156 B8 CMP b ;porovnej s předchozím
0157 CA 62 01 JZ cmpout ;shoda
015A 32 FE 1F STA keytmp ;nastav předchozí
015D 36 04 MVI m,4 ;nastav počet shod
015F C3 6B 01 JMP result
0162 B9 CMPOUT: CMP c ;porovnej s platným
0163 CA 6B 01 JZ result ;shoda
0166 35 DCR m ;počítej
0167 C2 6B 01 JNZ result
016A 12 STAX d ;nastav platný
016B 1A RESULT: LDAX d ;platný stav klávesnice
016C B7 ORA a ;NZ jako příznak stisku
016D C1 POP b ;obnov bc
016E D1 POP d ;obnov de
016F E1 POP h ;obnov hl
0170 C9 RET
0171 ;*******************************************************************************
0171 40 FONT: DB 01000000b ;0
0172 79 DB 01111001b ;1
0173 24 DB 00100100b ;2
0174 30 DB 00110000b ;3
0175 19 DB 00011001b ;4
0176 12 DB 00010010b ;5
0177 02 DB 00000010b ;6
0178 78 DB 01111000b ;7
0179 00 DB 00000000b ;8
017A 10 DB 00010000b ;9
017B 08 DB 00001000b ;A
017C 03 DB 00000011b ;b
017D 46 DB 01000110b ;C
017E 21 DB 00100001b ;d
017F 06 DB 00000110b ;E
0180 0E DB 00001110b ;F
0181 42 DB 01000010b ;G
0182 0B DB 00001011b ;h
0183 7B DB 01111011b ;i
0184 61 DB 01100001b ;J
0185 0A DB 00001010b ;K
0186 47 DB 01000111b ;L
0187 48 DB 01001000b ;M
0188 2B DB 00101011b ;n
0189 23 DB 00100011b ;o
018A 0C DB 00001100b ;P
018B 18 DB 00011000b ;q
018C 2F DB 00101111b ;r
018D 07 DB 00000111b ;t
018E 41 DB 01000001b ;U
018F 63 DB 01100011b ;v
0190 01 DB 00000001b ;w
0191 09 DB 00001001b ;X
0192 11 DB 00010001b ;Y
0193 3F DB 00111111b ;-
0194 5D DB 01011101b ;"
0195 37 DB 00110111b ;=
0196 2C DB 00101100b ;?
0197 70 DB 01110000b ;]
0198 7F DB 01111111b ;space
0199 ;*******************************************************************************
0199 80 TABKEY: DB 080h ;0
019A 84 DB 084h ;4
019B 88 DB 088h ;8
019C 91 DB 091h ;Ex
019D 8D DB 08Dh ;D
019E 8C DB 08Ch ;C
019F 89 DB 089h ;9
01A0 85 DB 085h ;5
01A1 81 DB 081h ;1
01A2 82 DB 082h ;2
01A3 86 DB 086h ;6
01A4 8A DB 08Ah ;A
01A5 9A DB 09Ah ;R
01A6 8F DB 08Fh ;F
01A7 8E DB 08Eh ;E
01A8 8B DB 08Bh ;B
01A9 87 DB 087h ;7
01AA 83 DB 083h ;3
01AB FF DB 0FFh
01AC 94 DB 094h ;S
01AD 93 DB 093h ;L
01AE FF DB 0FFh
01AF 97 DB 097h ;Br
01B0 92 DB 092h ;M
01B1 FF DB 0FFh
01B2 FF DB 0FFh
01B3 90 DB 090h ;=
01B4 ;*******************************************************************************
01B4 ; MEMORY - editace obsahu paměti
01B4 ;*******************************************************************************
01B4 3E 16 MEM: MVI a,16h ;M
01B6 CD 98 00 CALL clear ;na displej
01B9 21 00 18 LXI h,1800h ;počáteční adresa RAM
01BC CD A7 00 CALL modad ;úprava adresy
01BF C0 RNZ ;není '=', konec
01C0 7E MEM1: MOV a,m ;obsah adresy
01C1 CD B9 00 CALL modda ;úprava dat
01C4 C0 RNZ ;není '=', konec
01C5 77 MOV m,a ;ulož nové data
01C6 23 INX h ;další adresa
01C7 CD D6 00 CALL outad ;zobraz adresu
01CA C3 C0 01 JMP mem1 ;opakuj
01CD ;*******************************************************************************
01CD ; REGISTRY - editace obsahu registrů
01CD ;*******************************************************************************
01CD 3E 1B REG: MVI a,1Bh ;r
01CF CD 98 00 CALL clear ;na displej
01D2 11 00 00 REG1: LXI d,0000h ;nuluj čítač registrů
01D5 21 FE 01 REG2: LXI h,regnm ;názvy registrů
01D8 19 DAD d ;adresa názvu (hl + de)
01D9 46 MOV b,m ;první znak
01DA 23 INX h
01DB 66 MOV h,m ;druhý znak
01DC 68 MOV l,b
01DD 22 FB 1F SHLD buffer+7 ;na displej
01E0 21 E0 1F LXI h,save_af ;obrazy registrů
01E3 19 DAD d ;adresa obrazu registru (hl + de)
01E4 E5 PUSH h ;uschovej adresu
01E5 46 MOV b,m ;obsah registru do HL
01E6 23 INX h
01E7 66 MOV h,m
01E8 68 MOV l,b
01E9 CD A7 00 CALL modad ;úpravy
01EC C1 POP b ;obnov adresu
01ED C0 RNZ ;konec
01EE 7D MOV a,l ;ulož nový obsah
01EF 02 STAX b
01F0 03 INX b
01F1 7C MOV a,h
01F2 02 STAX b
01F3 13 INX d ;další registr
01F4 13 INX d
01F5 7B MOV a,e
01F6 FE 0C CPI 0Ch ;6 registrových párů
01F8 C2 D5 01 JNZ reg2 ;opakuj
01FB C3 D2 01 JMP reg1 ;od začátku
01FE ;*******************************************************************************
01FE 0A 0F REGNM: DB 0Ah,0Fh ;AF
0200 0B 0C DB 0Bh,0Ch ;BC
0202 0D 0E DB 0Dh,0Eh ;DE
0204 11 15 DB 11h,15h ;HL
0206 05 19 DB 05h,19h ;SP
0208 19 0C DB 19h,0Ch ;PC
020A ;*******************************************************************************
020A ; BREAK - vložení zarážky
020A ;*******************************************************************************
020A 3E 0B BREAK: MVI a,0Bh ;b
020C CD 98 00 CALL clear ;na displej
020F 2A EC 1F LHLD br_adr ;adresa zarážky
0212 CD A7 00 CALL modad ;uprav
0215 C0 RNZ ;storno
0216 22 EC 1F SHLD br_adr ;ulož novou adresu
0219 7E MOV a,m ;původní instrukce
021A 32 EE 1F STA br_ins ;uschovej
021D 36 CF MVI m,0CFh ;zarážka (rst 1)
021F ;*******************************************************************************
021F ; EXECUTE - spuštění uživatelského programu
021F ;*******************************************************************************
021F 3E 10 EXEC: MVI a,10h ;G
0221 CD 98 00 CALL clear ;na displej
0224 2A EA 1F LHLD save_pc ;vstupní bod
0227 CD A7 00 CALL modad ;uprav
022A C0 RNZ ;storno
022B 22 EA 1F SHLD save_pc ;ulož novou hodnotu
022E 31 E0 1F LXI sp,save_af ;obrazy registrů
0231 F1 POP psw ;obnov střadač
0232 C1 POP b ;obnov BC
0233 D1 POP d ;obnov DE
0234 2A E8 1F LHLD save_sp ;ukazatel zásobníku
0237 F9 SPHL ;obnov SP
0238 2A EA 1F LHLD save_pc ;vstupní bod
023B E5 PUSH h ;do zásobníku
023C 2A E6 1F LHLD save_hl ;obnov HL
023F C9 RET ;obnov PC - spuštění programu
0240 ;*******************************************************************************
0240 ; LOAD - čtení z magnetofonu
0240 ;*******************************************************************************
0240 C9 LOAD: RET
0241 ;*******************************************************************************
0241 ; SAVE - záznam na magnetofon
0241 ;*******************************************************************************
0241 C9 SAVE: RET
0242 ;*******************************************************************************
0242 .END
_PC 0242
PA 00F8
PB 00F9
PC 00FA
PIO 00FB
STACK 1FC8
SAVE_AF 1FE0
SAVE_BC 1FE2
SAVE_DE 1FE4
SAVE_HL 1FE6
SAVE_SP 1FE8
SAVE_PC 1FEA
BR_ADR 1FEC
BR_INS 1FEE
VECTOR 1FEF
BUFPTR 1FF2
BUFFER 1FF4
KEYOUT 1FFD
KEYTMP 1FFE
KEYCNT 1FFF
INIT1 002E
INIT2 003B
MSG 0041
PROMPT 0050
FUNC 005D
RUN 006B
STOP 0074
STONE 007D
TABFC 0086
CLEAR 0098
CLEAR1 009F
MODAD 00A7
MODDA 00B9
MODDAR 00C8
MODDA1 00CA
OUTAD 00D6
OUTDA 00E1
OUTHEX 00E4
GETC 00F5
GETC1 00FB
MPX 0104
LOOP 010C
DELAY 0122
DRUHY 013B
PRVNI 013C
NOKEY 0140
CMPOUT 0162
RESULT 016B
FONT 0171
TABKEY 0199
MEM 01B4
MEM1 01C0
REG 01CD
REG1 01D2
REG2 01D5
REGNM 01FE
BREAK 020A
EXEC 021F
LOAD 0240
SAVE 0241
[30000,32500,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,8268,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,3862,7764,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,7706,3864,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,3862,7764,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7764,7706,3864,7706,3864,3862,7708,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,3862,7764,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,7706,3864,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,7706,3864,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,3862,7764,7706,3864,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7708,7706,3864,3862,7708,3862,7764,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,7706,3864,7706,3864,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,3862,7764,3862,7708,7706,3864,3862,7708,7706,3864,3862,7708,7706,3864,7706,3864,3862,7708,3862,7764,7706,3864,7706,3864,3862,7708,3862,7708,7706,3864,3862,7708,7706,3864,3862,7708,3862,7764,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,7706,3864,7706,3864,3862,7708,7706,3864,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7764,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862,7708,3862]
.org $0100
ld hl, 1-label
ADC A,C
ADC A,(HL)
ADC A,(IX+5)
ADC A,33
ADC HL,SP
ADD IY,IY
ADD IX,BC
ADD A,IXL
label: nop
djnz label
jp (ix)
rst 0x10
call $0236
call label
im 2
EX (SP), HL
EX AF,AF'
EX (SP),IY
:1001000021EFFE898EDD8E05CE21ED7AFD29DD09F8
:10011000DD850010FDDDE9D7CD3602CD1201ED5EA3
:04012000E308FDE310
:00000001FF
0100 .ORG $0100
0100 21 EF FE LD hl,1-label
0103 89 ADC A,C
0104 8E ADC A,(HL)
0105 DD 8E 05 ADC A,(IX+5)
0108 CE 21 ADC A,33
010A ED 7A ADC HL,SP
010C FD 29 ADD IY,IY
010E DD 09 ADD IX,BC
0110 DD 85 ADD A,IXL
0112 00 LABEL: NOP
0113 10 FD DJNZ label
0115 DD E9 JP (ix)
0117 D7 RST 0x10
0118 CD 36 02 CALL $0236
011B CD 12 01 CALL label
011E ED 5E IM 2
0120 E3 EX (SP),HL
0121 08 EX AF,AF'
0122 FD E3 EX (SP),IY
_PC 0122
LABEL 0112
;*************************************************************
;
; TINY BASIC FOR INTEL 8080
; VERSION 2.0
; BY LI-CHEN WANG
; MODIFIED AND TRANSLATED
; TO INTEL MNEMONICS
; BY ROGER RAUSKOLB
; 10 OCTOBER,1976
; @COPYLEFT
; ALL WRONGS RESERVED
;
;*************************************************************
;
; *** ZERO PAGE SUBROUTINES ***
;
; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL
; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR
; THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
;
.engine macz80
.MACRO DWA
DB >%%1 + 128
DB <%%1
.ENDM
;
ORG 0H
START: LXI SP,STACK ;*** COLD START ***
MVI A,0FFH
JMP INIT
;
XTHL ;*** TSTC OR RST 1 ***
RST 5 ;IGNORE BLANKS AND
CMP M ;TEST CHARACTER
JMP TC1 ;REST OF THIS IS AT TC1
;
CRLF: MVI A,CR ;*** CRLF ***
;
PUSH PSW ;*** OUTC OR RST 2 ***
LDA OCSW ;PRINT CHARACTER ONLY
ORA A ;IF OCSW SWITCH IS ON
JMP OC2 ;REST OF THIS IS AT OC2
;
CALL EXPR2 ;*** EXPR OR RST 3 ***
PUSH H ;EVALUATE AN EXPRESSION
JMP EXPR1 ;REST OF IT AT EXPR1
DB 'W'
;
MOV A,H ;*** COMP OR RST 4 ***
CMP D ;COMPARE HL WITH DE
RNZ ;RETURN CORRECT C AND
MOV A,L ;Z FLAGS
CMP E ;BUT OLD A IS LOST
RET
DB 'AN'
;
SS1: LDAX D ;*** IGNBLK/RST 5 ***
CPI 20H ;IGNORE BLANKS
RNZ ;IN TEXT (WHERE DE->)
INX D ;AND RETURN THE FIRST
JMP SS1 ;NON-BLANK CHAR. IN A
;
POP PSW ;*** FINISH/RST 6 ***
CALL FIN ;CHECK END OF COMMAND
JMP QWHAT ;PRINT "WHAT?" IF WRONG
DB 'G'
;
RST 5 ;*** TSTV OR RST 7 ***
SUI 40H ;TEST VARIABLES
RC ;C:NOT A VARIABLE
JNZ TV1 ;NOT "@" ARRAY
INX D ;IT IS THE "@" ARRAY
CALL PARN ;@ SHOULD BE FOLLOWED
DAD H ;BY (EXPR) AS ITS INDEX
JC QHOW ;IS INDEX TOO BIG?
PUSH D ;WILL IT OVERWRITE
XCHG ;TEXT?
CALL SIZE ;FIND SIZE OF FREE
RST 4 ;AND CHECK THAT
JC ASORRY ;IF SO, SAY "SORRY"
LXI H,VARBGN ;IF NOT GET ADDRESS
CALL SUBDE ;OF @(EXPR) AND PUT IT
POP D ;IN HL
RET ;C FLAG IS CLEARED
TV1: CPI 1BH ;NOT @, IS IT A TO Z?
CMC ;IF NOT RETURN C FLAG
RC
INX D ;IF A THROUGH Z
LXI H,VARBGN ;COMPUTE ADDRESS OF
RLC ;THAT VARIABLE
ADD L ;AND RETURN IT IN HL
MOV L,A ;WITH C FLAG CLEARED
MVI A,0
ADC H
MOV H,A
RET
;
;TSTC: XTHL ;*** TSTC OR RST 1 ***
; RST 5 ;THIS IS AT LOC. 8
; CMP M ;AND THEN JUMP HERE
TC1: INX H ;COMPARE THE BYTE THAT
JZ TC2 ;FOLLOWS THE RST INST.
PUSH B ;WITH THE TEXT (DE->)
MOV C,M ;IF NOT =, ADD THE 2ND
MVI B,0 ;BYTE THAT FOLLOWS THE
DAD B ;RST TO THE OLD PC
POP B ;I.E., DO A RELATIVE
DCX D ;JUMP IF NOT =
TC2: INX D ;IF =, SKIP THOSE BYTES
INX H ;AND CONTINUE
XTHL
RET
;
TSTNUM: LXI H,0 ;*** TSTNUM ***
MOV B,H ;TEST IF THE TEXT IS
RST 5 ;A NUMBER
TN1: CPI 30H ;IF NOT, RETURN 0 IN
RC ;B AND HL
CPI 3AH ;IF NUMBERS, CONVERT
RNC ;TO BINARY IN HL AND
MVI A,0F0H ;SET B TO # OF DIGITS
ANA H ;IF H>255, THERE IS NO
JNZ QHOW ;ROOM FOR NEXT DIGIT
INR B ;B COUNTS # OF DIGITS
PUSH B
MOV B,H ;HL=10*HL+(NEW DIGIT)
MOV C,L
DAD H ;WHERE 10* IS DONE BY
DAD H ;SHIFT AND ADD
DAD B
DAD H
LDAX D ;AND (DIGIT) IS FROM
INX D ;STRIPPING THE ASCII
ANI 0FH ;CODE
ADD L
MOV L,A
MVI A,0
ADC H
MOV H,A
POP B
LDAX D ;DO THIS DIGIT AFTER
JP TN1 ;DIGIT. S SAYS OVERFLOW
QHOW: PUSH D ;*** ERROR "HOW?" ***
AHOW: LXI D,HOW
JMP ERROR
HOW: DB 'HOW?'
DB CR
OK: DB 'OK'
DB CR
WHAT: DB 'WHAT?'
DB CR
SORRY: DB 'SORRY'
DB CR
;
;*************************************************************
;
; *** MAIN ***
;
; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
; AND STORES IT IN THE MEMORY.
;
; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
;
; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
;
; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
;
; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
;
RSTART: LXI SP,STACK
ST1: CALL CRLF ;AND JUMP TO HERE
LXI D,OK ;DE->STRING
SUB A ;A=0
CALL PRTSTG ;PRINT STRING UNTIL CR
LXI H,ST2+1 ;LITERAL 0
SHLD CURRNT ;CURRENT->LINE # = 0
ST2: LXI H,0
SHLD LOPVAR
SHLD STKGOS
ST3: MVI A,3EH ;PROMPT '>' AND
CALL GETLN ;READ A LINE
PUSH D ;DE->END OF LINE
LXI D,BUFFER ;DE->BEGINNING OF LINE
CALL TSTNUM ;TEST IF IT IS A NUMBER
RST 5
MOV A,H ;HL=VALUE OF THE # OR
ORA L ;0 IF NO # WAS FOUND
POP B ;BC->END OF LINE
JZ DIRECT
DCX D ;BACKUP DE AND SAVE
MOV A,H ;VALUE OF LINE # THERE
STAX D
DCX D
MOV A,L
STAX D
PUSH B ;BC,DE->BEGIN, END
PUSH D
MOV A,C
SUB E
PUSH PSW ;A=# OF BYTES IN LINE
CALL FNDLN ;FIND THIS LINE IN SAVE
PUSH D ;AREA, DE->SAVE AREA
JNZ ST4 ;NZ:NOT FOUND, INSERT
PUSH D ;Z:FOUND, DELETE IT
CALL FNDNXT ;FIND NEXT LINE
;DE->NEXT LINE
POP B ;BC->LINE TO BE DELETED
LHLD TXTUNF ;HL->UNFILLED SAVE AREA
CALL MVUP ;MOVE UP TO DELETE
MOV H,B ;TXTUNF->UNFILLED AREA
MOV L,C
SHLD TXTUNF ;UPDATE
ST4: POP B ;GET READY TO INSERT
LHLD TXTUNF ;BUT FIRST CHECK IF
POP PSW ;THE LENGTH OF NEW LINE
PUSH H ;IS 3 (LINE # AND CR)
CPI 3 ;THEN DO NOT INSERT
JZ RSTART ;MUST CLEAR THE STACK
ADD L ;COMPUTE NEW TXTUNF
MOV L,A
MVI A,0
ADC H
MOV H,A ;HL->NEW UNFILLED AREA
LXI D,TXTEND ;CHECK TO SEE IF THERE
RST 4 ;IS ENOUGH SPACE
JNC QSORRY ;SORRY, NO ROOM FOR IT
SHLD TXTUNF ;OK, UPDATE TXTUNF
POP D ;DE->OLD UNFILLED AREA
CALL MVDOWN
POP D ;DE->BEGIN, HL->END
POP H
CALL MVUP ;MOVE NEW LINE TO SAVE
JMP ST3 ;AREA
;
;*************************************************************
;
; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
;
; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
; GO BACK TO 'RSTART'.
; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
;*************************************************************
;
; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
;
; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
;
; 'STOP(CR)' GOES BACK TO 'RSTART'
;
; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
;
; THERE ARE 3 MORE ENTRIES IN 'RUN':
; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
;
; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
;
NEW: CALL ENDCHK ;*** NEW(CR) ***
LXI H,TXTBGN
SHLD TXTUNF
;
STOP: CALL ENDCHK ;*** STOP(CR) ***
JMP RSTART
;
RUN: CALL ENDCHK ;*** RUN(CR) ***
LXI D,TXTBGN ;FIRST SAVED LINE
;
RUNNXL: LXI H,0 ;*** RUNNXL ***
CALL FNDLP ;FIND WHATEVER LINE #
JC RSTART ;C:PASSED TXTUNF, QUIT
;
RUNTSL: XCHG ;*** RUNTSL ***
SHLD CURRNT ;SET 'CURRENT'->LINE #
XCHG
INX D ;BUMP PASS LINE #
INX D
;
RUNSML: CALL CHKIO ;*** RUNSML ***
LXI H,TAB2-1 ;FIND COMMAND IN TAB2
JMP EXEC ;AND EXECUTE IT
;
GOTO: RST 3 ;*** GOTO EXPR ***
PUSH D ;SAVE FOR ERROR ROUTINE
CALL ENDCHK ;MUST FIND A CR
CALL FNDLN ;FIND THE TARGET LINE
JNZ AHOW ;NO SUCH LINE #
POP PSW ;CLEAR THE PUSH DE
JMP RUNTSL ;GO DO IT
;
;*************************************************************
;
; *** LIST *** & PRINT ***
;
; LIST HAS TWO FORMS:
; 'LIST(CR)' LISTS ALL SAVED LINES
; 'LIST #(CR)' START LIST AT THIS LINE #
; YOU CAN STOP THE LISTING BY CONTROL C KEY
;
; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
;
; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
; SPECIFIED, 6 POSITIONS WILL BE USED.
;
; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
; DOUBLE QUOTES.
;
; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
;
; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
;
LIST: CALL TSTNUM ;TEST IF THERE IS A #
CALL ENDCHK ;IF NO # WE GET A 0
CALL FNDLN ;FIND THIS OR NEXT LINE
LS1: JC RSTART ;C:PASSED TXTUNF
CALL PRTLN ;PRINT THE LINE
CALL CHKIO ;STOP IF HIT CONTROL-C
CALL FNDLP ;FIND NEXT LINE
JMP LS1 ;AND LOOP BACK
;
PRINT: MVI C,6 ;C = # OF SPACES
RST 1 ;IF NULL LIST & ";"
DB 3BH
DB PR2-$-1
CALL CRLF ;GIVE CR-LF AND
JMP RUNSML ;CONTINUE SAME LINE
PR2: RST 1 ;IF NULL LIST (CR)
DB CR
DB PR0-$-1
CALL CRLF ;ALSO GIVE CR-LF AND
JMP RUNNXL ;GO TO NEXT LINE
PR0: RST 1 ;ELSE IS IT FORMAT?
DB '#'
DB PR1-$-1
RST 3 ;YES, EVALUATE EXPR.
MOV C,L ;AND SAVE IT IN C
JMP PR3 ;LOOK FOR MORE TO PRINT
PR1: CALL QTSTG ;OR IS IT A STRING?
JMP PR8 ;IF NOT, MUST BE EXPR.
PR3: RST 1 ;IF ",", GO FIND NEXT
DB ","
DB PR6-$-1
CALL FIN ;IN THE LIST.
JMP PR0 ;LIST CONTINUES
PR6: CALL CRLF ;LIST ENDS
RST 6
PR8: RST 3 ;EVALUATE THE EXPR
PUSH B
CALL PRTNUM ;PRINT THE VALUE
POP B
JMP PR3 ;MORE TO PRINT?
;
;*************************************************************
;
; *** GOSUB *** & RETURN ***
;
; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
;
; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
;
GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR"
RST 3 ;PARAMETERS
PUSH D ;AND TEXT POINTER
CALL FNDLN ;FIND THE TARGET LINE
JNZ AHOW ;NOT THERE. SAY "HOW?"
LHLD CURRNT ;FOUND IT, SAVE OLD
PUSH H ;'CURRNT' OLD 'STKGOS'
LHLD STKGOS
PUSH H
LXI H,0 ;AND LOAD NEW ONES
SHLD LOPVAR
DAD SP
SHLD STKGOS
JMP RUNTSL ;THEN RUN THAT LINE
RETURN: CALL ENDCHK ;THERE MUST BE A CR
LHLD STKGOS ;OLD STACK POINTER
MOV A,H ;0 MEANS NOT EXIST
ORA L
JZ QWHAT ;SO, WE SAY: "WHAT?"
SPHL ;ELSE, RESTORE IT
POP H
SHLD STKGOS ;AND THE OLD 'STKGOS'
POP H
SHLD CURRNT ;AND THE OLD 'CURRNT'
POP D ;OLD TEXT POINTER
CALL POPA ;OLD "FOR" PARAMETERS
RST 6 ;AND WE ARE BACK HOME
;
;*************************************************************
;
; *** FOR *** & NEXT ***
;
; 'FOR' HAS TWO FORMS:
; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
; EXP3=1. (I.E., WITH A STEP OF +1.)
; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
; BEFORE THE NEW ONE OVERWRITES IT.
; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
; (PURGED FROM THE STACK..)
;
; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
; IS PURGED AND EXECUTION CONTINUES.
;
FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA
CALL SETVAL ;SET THE CONTROL VAR.
DCX H ;HL IS ITS ADDRESS
SHLD LOPVAR ;SAVE THAT
LXI H,TAB5-1 ;USE 'EXEC' TO LOOK
JMP EXEC ;FOR THE WORD 'TO'
FR1: RST 3 ;EVALUATE THE LIMIT
SHLD LOPLMT ;SAVE THAT
LXI H,TAB6-1 ;USE 'EXEC' TO LOOK
JMP EXEC ;FOR THE WORD 'STEP'
FR2: RST 3 ;FOUND IT, GET STEP
JMP FR4
FR3: LXI H,1H ;NOT FOUND, SET TO 1
FR4: SHLD LOPINC ;SAVE THAT TOO
FR5: LHLD CURRNT ;SAVE CURRENT LINE #
SHLD LOPLN
XCHG ;AND TEXT POINTER
SHLD LOPPT
LXI B,0AH ;DIG INTO STACK TO
LHLD LOPVAR ;FIND 'LOPVAR'
XCHG
MOV H,B
MOV L,B ;HL=0 NOW
DAD SP ;HERE IS THE STACK
DB 3EH
FR7: DAD B ;EACH LEVEL IS 10 DEEP
MOV A,M ;GET THAT OLD 'LOPVAR'
INX H
ORA M
JZ FR8 ;0 SAYS NO MORE IN IT
MOV A,M
DCX H
CMP D ;SAME AS THIS ONE?
JNZ FR7
MOV A,M ;THE OTHER HALF?
CMP E
JNZ FR7
XCHG ;YES, FOUND ONE
LXI H,0H
DAD SP ;TRY TO MOVE SP
MOV B,H
MOV C,L
LXI H,0AH
DAD D
CALL MVDOWN ;AND PURGE 10 WORDS
SPHL ;IN THE STACK
FR8: LHLD LOPPT ;JOB DONE, RESTORE DE
XCHG
RST 6 ;AND CONTINUE
;
NEXT: RST 7 ;GET ADDRESS OF VAR.
JC QWHAT ;NO VARIABLE, "WHAT?"
SHLD VARNXT ;YES, SAVE IT
NX0: PUSH D ;SAVE TEXT POINTER
XCHG
LHLD LOPVAR ;GET VAR. IN 'FOR'
MOV A,H
ORA L ;0 SAYS NEVER HAD ONE
JZ AWHAT ;SO WE ASK: "WHAT?"
RST 4 ;ELSE WE CHECK THEM
JZ NX3 ;OK, THEY AGREE
POP D ;NO, LET'S SEE
CALL POPA ;PURGE CURRENT LOOP
LHLD VARNXT ;AND POP ONE LEVEL
JMP NX0 ;GO CHECK AGAIN
NX3: MOV E,M ;COME HERE WHEN AGREED
INX H
MOV D,M ;DE=VALUE OF VAR.
LHLD LOPINC
PUSH H
MOV A,H
XRA D
MOV A,D
DAD D ;ADD ONE STEP
JM NX4
XRA H
JM NX5
NX4: XCHG
LHLD LOPVAR ;PUT IT BACK
MOV M,E
INX H
MOV M,D
LHLD LOPLMT ;HL->LIMIT
POP PSW ;OLD HL
ORA A
JP NX1 ;STEP > 0
XCHG ;STEP < 0
NX1: CALL CKHLDE ;COMPARE WITH LIMIT
POP D ;RESTORE TEXT POINTER
JC NX2 ;OUTSIDE LIMIT
LHLD LOPLN ;WITHIN LIMIT, GO
SHLD CURRNT ;BACK TO THE SAVED
LHLD LOPPT ;'CURRNT' AND TEXT
XCHG ;POINTER
RST 6
NX5: POP H
POP D
NX2: CALL POPA ;PURGE THIS LOOP
RST 6
;
;*************************************************************
;
; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
;
; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
;
; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
; EXECUTION CONTINUES AT THE NEXT LINE.
;
; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
;
; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
; THIS IS HANDLED IN 'INPERR'.
;
; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
; THIS IS DONE BY 'DEFLT'.
;
REM: LXI H,0H ;*** REM ***
DB 3EH ;THIS IS LIKE 'IF 0'
;
IFF: RST 3 ;*** IF ***
MOV A,H ;IS THE EXPR.=0?
ORA L
JNZ RUNSML ;NO, CONTINUE
CALL FNDSKP ;YES, SKIP REST OF LINE
JNC RUNTSL ;AND RUN THE NEXT LINE
JMP RSTART ;IF NO NEXT, RE-START
;
INPERR: LHLD STKINP ;*** INPERR ***
SPHL ;RESTORE OLD SP
POP H ;AND OLD 'CURRNT'
SHLD CURRNT
POP D ;AND OLD TEXT POINTER
POP D ;REDO INPUT
;
INPUT: ;*** INPUT ***
IP1: PUSH D ;SAVE IN CASE OF ERROR
CALL QTSTG ;IS NEXT ITEM A STRING?
JMP IP2 ;NO
RST 7 ;YES, BUT FOLLOWED BY A
JC IP4 ;VARIABLE? NO.
JMP IP3 ;YES. INPUT VARIABLE
IP2: PUSH D ;SAVE FOR 'PRTSTG'
RST 7 ;MUST BE VARIABLE NOW
JC QWHAT ;"WHAT?" IT IS NOT?
LDAX D ;GET READY FOR 'PRTSTR'
MOV C,A
SUB A
STAX D
POP D
CALL PRTSTG ;PRINT STRING AS PROMPT
MOV A,C ;RESTORE TEXT
DCX D
STAX D
IP3: PUSH D ;SAVE TEXT POINTER
XCHG
LHLD CURRNT ;ALSO SAVE 'CURRNT'
PUSH H
LXI H,IP1 ;A NEGATIVE NUMBER
SHLD CURRNT ;AS A FLAG
LXI H,0H ;SAVE SP TOO
DAD SP
SHLD STKINP
PUSH D ;OLD HL
MVI A,3AH ;PRINT THIS TOO
CALL GETLN ;AND GET A LINE
LXI D,BUFFER ;POINTS TO BUFFER
RST 3 ;EVALUATE INPUT
NOP ;CAN BE 'CALL ENDCHK'
NOP
NOP
POP D ;OK, GET OLD HL
XCHG
MOV M,E ;SAVE VALUE IN VAR.
INX H
MOV M,D
POP H ;GET OLD 'CURRNT'
SHLD CURRNT
POP D ;AND OLD TEXT POINTER
IP4: POP PSW ;PURGE JUNK IN STACK
RST 1 ;IS NEXT CH. ','?
DB ","
DB IP5-$-1
JMP IP1 ;YES, MORE ITEMS.
IP5: RST 6
;
DEFLT: LDAX D ;*** DEFLT ***
CPI CR ;EMPTY LINE IS OK
JZ LT1 ;ELSE IT IS 'LET'
;
LET: CALL SETVAL ;*** LET ***
RST 1 ;SET VALUE TO VAR.
DB ","
DB LT1-$-1
JMP LET ;ITEM BY ITEM
LT1: RST 6 ;UNTIL FINISH
;
;*************************************************************
;
; *** EXPR ***
;
; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
; <EXPR>::<EXPR2>
; <EXPR2><REL.OP.><EXPR2>
; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
; <EXPR4>::=<VARIABLE>
; <FUNCTION>
; (<EXPR>)
; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
;
;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18
; PUSH H ;SAVE <EXPR2> VALUE
EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP.
JMP EXEC ;GO DO IT
XP11: CALL XP18 ;REL.OP.">="
RC ;NO, RETURN HL=0
MOV L,A ;YES, RETURN HL=1
RET
XP12: CALL XP18 ;REL.OP."#"
RZ ;FALSE, RETURN HL=0
MOV L,A ;TRUE, RETURN HL=1
RET
XP13: CALL XP18 ;REL.OP.">"
RZ ;FALSE
RC ;ALSO FALSE, HL=0
MOV L,A ;TRUE, HL=1
RET
XP14: CALL XP18 ;REL.OP."<="
MOV L,A ;SET HL=1
RZ ;REL. TRUE, RETURN
RC
MOV L,H ;ELSE SET HL=0
RET
XP15: CALL XP18 ;REL.OP."="
RNZ ;FALSE, RETURN HL=0
MOV L,A ;ELSE SET HL=1
RET
XP16: CALL XP18 ;REL.OP."<"
RNC ;FALSE, RETURN HL=0
MOV L,A ;ELSE SET HL=1
RET
XP17: POP H ;NOT .REL.OP
RET ;RETURN HL=<EXPR2>
XP18: MOV A,C ;SUBROUTINE FOR ALL
POP H ;REL.OP.'S
POP B
PUSH H ;REVERSE TOP OF STACK
PUSH B
MOV C,A
CALL EXPR2 ;GET 2ND <EXPR2>
XCHG ;VALUE IN DE NOW
XTHL ;1ST <EXPR2> IN HL
CALL CKHLDE ;COMPARE 1ST WITH 2ND
POP D ;RESTORE TEXT POINTER
LXI H,0H ;SET HL=0, A=1
MVI A,1
RET
;
EXPR2: RST 1 ;NEGATIVE SIGN?
DB '-'
DB XP21-$-1
LXI H,0H ;YES, FAKE '0-'
JMP XP26 ;TREAT LIKE SUBTRACT
XP21: RST 1 ;POSITIVE SIGN? IGNORE
DB '+'
DB XP22-$-1
XP22: CALL EXPR3 ;1ST <EXPR3>
XP23: RST 1 ;ADD?
DB '+'
DB XP25-$-1
PUSH H ;YES, SAVE VALUE
CALL EXPR3 ;GET 2ND <EXPR3>
XP24: XCHG ;2ND IN DE
XTHL ;1ST IN HL
MOV A,H ;COMPARE SIGN
XRA D
MOV A,D
DAD D
POP D ;RESTORE TEXT POINTER
JM XP23 ;1ST AND 2ND SIGN DIFFER
XRA H ;1ST AND 2ND SIGN EQUAL
JP XP23 ;SO IS RESULT
JMP QHOW ;ELSE WE HAVE OVERFLOW
XP25: RST 1 ;SUBTRACT?
DB '-'
DB XP42-$-1
XP26: PUSH H ;YES, SAVE 1ST <EXPR3>
CALL EXPR3 ;GET 2ND <EXPR3>
CALL CHGSGN ;NEGATE
JMP XP24 ;AND ADD THEM
;
EXPR3: CALL EXPR4 ;GET 1ST <EXPR4>
XP31: RST 1 ;MULTIPLY?
DB '*'
DB XP34-$-1
PUSH H ;YES, SAVE 1ST
CALL EXPR4 ;AND GET 2ND <EXPR4>
MVI B,0H ;CLEAR B FOR SIGN
CALL CHKSGN ;CHECK SIGN
XTHL ;1ST IN HL
CALL CHKSGN ;CHECK SIGN OF 1ST
XCHG
XTHL
MOV A,H ;IS HL > 255 ?
ORA A
JZ XP32 ;NO
MOV A,D ;YES, HOW ABOUT DE
ORA D
XCHG ;PUT SMALLER IN HL
JNZ AHOW ;ALSO >, WILL OVERFLOW
XP32: MOV A,L ;THIS IS DUMB
LXI H,0H ;CLEAR RESULT
ORA A ;ADD AND COUNT
JZ XP35
XP33: DAD D
JC AHOW ;OVERFLOW
DCR A
JNZ XP33
JMP XP35 ;FINISHED
XP34: RST 1 ;DIVIDE?
DB '/'
DB XP42-$-1
PUSH H ;YES, SAVE 1ST <EXPR4>
CALL EXPR4 ;AND GET THE SECOND ONE
MVI B,0H ;CLEAR B FOR SIGN
CALL CHKSGN ;CHECK SIGN OF 2ND
XTHL ;GET 1ST IN HL
CALL CHKSGN ;CHECK SIGN OF 1ST
XCHG
XTHL
XCHG
MOV A,D ;DIVIDE BY 0?
ORA E
JZ AHOW ;SAY "HOW?"
PUSH B ;ELSE SAVE SIGN
CALL DIVIDE ;USE SUBROUTINE
MOV H,B ;RESULT IN HL NOW
MOV L,C
POP B ;GET SIGN BACK
XP35: POP D ;AND TEXT POINTER
MOV A,H ;HL MUST BE +
ORA A
JM QHOW ;ELSE IT IS OVERFLOW
MOV A,B
ORA A
CM CHGSGN ;CHANGE SIGN IF NEEDED
JMP XP31 ;LOOK FOR MORE TERMS
;
EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4
JMP EXEC ;AND GO DO IT
XP40: RST 7 ;NO, NOT A FUNCTION
JC XP41 ;NOR A VARIABLE
MOV A,M ;VARIABLE
INX H
MOV H,M ;VALUE IN HL
MOV L,A
RET
XP41: CALL TSTNUM ;OR IS IT A NUMBER
MOV A,B ;# OF DIGIT
ORA A
RNZ ;OK
PARN: RST 1
DB '('
DB XP43-$-1
RST 3 ;"(EXPR)"
RST 1
DB ')'
DB XP43-$-1
XP42: RET
XP43: JMP QWHAT ;ELSE SAY: "WHAT?"
;
RND: CALL PARN ;*** RND(EXPR) ***
MOV A,H ;EXPR MUST BE +
ORA A
JM QHOW
ORA L ;AND NON-ZERO
JZ QHOW
PUSH D ;SAVE BOTH
PUSH H
LHLD RANPNT ;GET MEMORY AS RANDOM
LXI D,LSTROM ;NUMBER
RST 4
JC RA1 ;WRAP AROUND IF LAST
LXI H,START
RA1: MOV E,M
INX H
MOV D,M
SHLD RANPNT
POP H
XCHG
PUSH B
CALL DIVIDE ;RND(N)=MOD(M,N)+1
POP B
POP D
INX H
RET
;
ABS: CALL PARN ;*** ABS(EXPR) ***
DCX D
CALL CHKSGN ;CHECK SIGN
INX D
RET
;
SIZE: LHLD TXTUNF ;*** SIZE ***
PUSH D ;GET THE NUMBER OF FREE
XCHG ;BYTES BETWEEN 'TXTUNF'
LXI H,VARBGN ;AND 'VARBGN'
CALL SUBDE
POP D
RET
;
;*************************************************************
;
; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
;
; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
;
; 'SUBDE' SUBSTRACTS DE FROM HL
;
; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
; SIGN AND FLIP SIGN OF B.
;
; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
;
; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
;
DIVIDE: PUSH H ;*** DIVIDE ***
MOV L,H ;DIVIDE H BY DE
MVI H,0
CALL DV1
MOV B,C ;SAVE RESULT IN B
MOV A,L ;(REMINDER+L)/DE
POP H
MOV H,A
DV1: MVI C,0FFH ;RESULT IN C
DV2: INR C ;DUMB ROUTINE
CALL SUBDE ;DIVIDE BY SUBTRACT
JNC DV2 ;AND COUNT
DAD D
RET
;
SUBDE: MOV A,L ;*** SUBDE ***
SUB E ;SUBSTRACT DE FROM
MOV L,A ;HL
MOV A,H
SBB D
MOV H,A
RET
;
CHKSGN: MOV A,H ;*** CHKSGN ***
ORA A ;CHECK SIGN OF HL
RP ;IF -, CHANGE SIGN
;
CHGSGN: MOV A,H ;*** CHGSGN ***
PUSH PSW
CMA ;CHANGE SIGN OF HL
MOV H,A
MOV A,L
CMA
MOV L,A
INX H
POP PSW
XRA H
JP QHOW
MOV A,B ;AND ALSO FLIP B
XRI 80H
MOV B,A
RET
;
CKHLDE: MOV A,H
XRA D ;SAME SIGN?
JP CK1 ;YES, COMPARE
XCHG ;NO, XCH AND COMP
CK1: RST 4
RET
;
;*************************************************************
;
; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
;
; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
; TO THAT VALUE.
;
; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";",
; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
; NEXT LINE AND CONTINUE FROM THERE.
;
; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
;
; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
; NOT TERMINATED BUT CONTINUED AT 'INPERR'.
;
; RELATED TO 'ERROR' ARE THE FOLLOWING:
; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
;
SETVAL: RST 7 ;*** SETVAL ***
JC QWHAT ;"WHAT?" NO VARIABLE
PUSH H ;SAVE ADDRESS OF VAR.
RST 1 ;PASS "=" SIGN
DB '='
DB SV1-$-1
RST 3 ;EVALUATE EXPR.
MOV B,H ;VALUE IS IN BC NOW
MOV C,L
POP H ;GET ADDRESS
MOV M,C ;SAVE VALUE
INX H
MOV M,B
RET
SV1: JMP QWHAT ;NO "=" SIGN
;
FIN: RST 1 ;*** FIN ***
DB 3BH
DB FI1-$-1
POP PSW ;";", PURGE RET. ADDR.
JMP RUNSML ;CONTINUE SAME LINE
FI1: RST 1 ;NOT ";", IS IT CR?
DB CR
DB FI2-$-1
POP PSW ;YES, PURGE RET. ADDR.
JMP RUNNXL ;RUN NEXT LINE
FI2: RET ;ELSE RETURN TO CALLER
;
ENDCHK: RST 5 ;*** ENDCHK ***
CPI CR ;END WITH CR?
RZ ;OK, ELSE SAY: "WHAT?"
;
QWHAT: PUSH D ;*** QWHAT ***
AWHAT: LXI D,WHAT ;*** AWHAT ***
ERROR: SUB A ;*** ERROR ***
CALL PRTSTG ;PRINT 'WHAT?', 'HOW?'
POP D ;OR 'SORRY'
LDAX D ;SAVE THE CHARACTER
PUSH PSW ;AT WHERE OLD DE ->
SUB A ;AND PUT A 0 THERE
STAX D
LHLD CURRNT ;GET CURRENT LINE #
PUSH H
MOV A,M ;CHECK THE VALUE
INX H
ORA M
POP D
JZ RSTART ;IF ZERO, JUST RESTART
MOV A,M ;IF NEGATIVE,
ORA A
JM INPERR ;REDO INPUT
CALL PRTLN ;ELSE PRINT THE LINE
DCX D ;UPTO WHERE THE 0 IS
POP PSW ;RESTORE THE CHARACTER
STAX D
MVI A,3FH ;PRINT A "?"
RST 2
SUB A ;AND THE REST OF THE
CALL PRTSTG ;LINE
JMP RSTART ;THEN RESTART
;
QSORRY: PUSH D ;*** QSORRY ***
ASORRY: LXI D,SORRY ;*** ASORRY ***
JMP ERROR
;
;*************************************************************
;
; *** GETLN *** FNDLN (& FRIENDS) ***
;
; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
;
; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
; LINE, FLAGS ARE C & NZ.
; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
;
GETLN: RST 2 ;*** GETLN ***
LXI D,BUFFER ;PROMPT AND INIT.
GL1: CALL CHKIO ;CHECK KEYBOARD
JZ GL1 ;NO INPUT, WAIT
CPI 7FH ;DELETE LAST CHARACTER?
JZ GL3 ;YES
RST 2 ;INPUT, ECHO BACK
CPI 0AH ;IGNORE LF
JZ GL1
ORA A ;IGNORE NULL
JZ GL1
CPI 7DH ;DELETE THE WHOLE LINE?
JZ GL4 ;YES
STAX D ;ELSE SAVE INPUT
INX D ;AND BUMP POINTER
CPI 0DH ;WAS IT CR?
RZ ;YES, END OF LINE
MOV A,E ;ELSE MORE FREE ROOM?
CPI <BUFEND
JNZ GL1 ;YES, GET NEXT INPUT
GL3: MOV A,E ;DELETE LAST CHARACTER
CPI <BUFFER ;BUT DO WE HAVE ANY?
JZ GL4 ;NO, REDO WHOLE LINE
DCX D ;YES, BACKUP POINTER
MVI A,5CH ;AND ECHO A BACK-SLASH
RST 2
JMP GL1 ;GO GET NEXT INPUT
GL4: CALL CRLF ;REDO ENTIRE LINE
MVI A,05EH ;CR, LF AND UP-ARROW
JMP GETLN
;
FNDLN: MOV A,H ;*** FNDLN ***
ORA A ;CHECK SIGN OF HL
JM QHOW ;IT CANNOT BE -
LXI D,TXTBGN ;INIT TEXT POINTER
;
FNDLP: ;*** FDLNP ***
FL1: PUSH H ;SAVE LINE #
LHLD TXTUNF ;CHECK IF WE PASSED END
DCX H
RST 4
POP H ;GET LINE # BACK
RC ;C,NZ PASSED END
LDAX D ;WE DID NOT, GET BYTE 1
SUB L ;IS THIS THE LINE?
MOV B,A ;COMPARE LOW ORDER
INX D
LDAX D ;GET BYTE 2
SBB H ;COMPARE HIGH ORDER
JC FL2 ;NO, NOT THERE YET
DCX D ;ELSE WE EITHER FOUND
ORA B ;IT, OR IT IS NOT THERE
RET ;NC,Z:FOUND, NC,NZ:NO
;
FNDNXT: ;*** FNDNXT ***
INX D ;FIND NEXT LINE
FL2: INX D ;JUST PASSED BYTE 1 & 2
;
FNDSKP: LDAX D ;*** FNDSKP ***
CPI CR ;TRY TO FIND CR
JNZ FL2 ;KEEP LOOKING
INX D ;FOUND CR, SKIP OVER
JMP FL1 ;CHECK IF END OF TEXT
;
;*************************************************************
;
; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
;
; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
;
; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
; OVER (USUALLY A JUMP INSTRUCTION.
;
; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
;
; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
;
PRTSTG: MOV B,A ;*** PRTSTG ***
PS1: LDAX D ;GET A CHARACTER
INX D ;BUMP POINTER
CMP B ;SAME AS OLD A?
RZ ;YES, RETURN
RST 2 ;ELSE PRINT IT
CPI CR ;WAS IT A CR?
JNZ PS1 ;NO, NEXT
RET ;YES, RETURN
;
QTSTG: RST 1 ;*** QTSTG ***
DB '"'
DB QT3-$-1
MVI A,22H ;IT IS A "
QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER
CPI CR ;WAS LAST ONE A CR?
POP H ;RETURN ADDRESS
JZ RUNNXL ;WAS CR, RUN NEXT LINE
QT2: INX H ;SKIP 3 BYTES ON RETURN
INX H
INX H
PCHL ;RETURN
QT3: RST 1 ;IS IT A '?
DB 27H
DB QT4-$-1
MVI A,27H ;YES, DO THE SAME
JMP QT1 ;AS IN "
QT4: RST 1 ;IS IT BACK-ARROW?
DB 5FH
DB QT5-$-1
MVI A,08DH ;YES, CR WITHOUT LF
RST 2 ;DO IT TWICE TO GIVE
RST 2 ;TTY ENOUGH TIME
POP H ;RETURN ADDRESS
JMP QT2
QT5: RET ;NONE OF ABOVE
;
PRTNUM: MVI B,0 ;*** PRTNUM ***
CALL CHKSGN ;CHECK SIGN
JP PN1 ;NO SIGN
MVI B,'-' ;B=SIGN
DCR C ;'-' TAKES SPACE
PN1: PUSH D ;SAVE
LXI D,0AH ;DECIMAL
PUSH D ;SAVE AS A FLAG
DCR C ;C=SPACES
PUSH B ;SAVE SIGN & SPACE
PN2: CALL DIVIDE ;DIVIDE HL BY 10
MOV A,B ;RESULT 0?
ORA C
JZ PN3 ;YES, WE GOT ALL
XTHL ;NO, SAVE REMAINDER
DCR L ;AND COUNT SPACE
PUSH H ;HL IS OLD BC
MOV H,B ;MOVE RESULT TO BC
MOV L,C
JMP PN2 ;AND DIVIDE BY 10
PN3: POP B ;WE GOT ALL DIGITS IN
PN4: DCR C ;THE STACK
MOV A,C ;LOOK AT SPACE COUNT
ORA A
JM PN5 ;NO LEADING BLANKS
MVI A,20H ;LEADING BLANKS
RST 2
JMP PN4 ;MORE?
PN5: MOV A,B ;PRINT SIGN
ORA A
CNZ 10H
MOV E,L ;LAST REMAINDER IN E
PN6: MOV A,E ;CHECK DIGIT IN E
CPI 0AH ;10 IS FLAG FOR NO MORE
POP D
RZ ;IF SO, RETURN
ADI 30H ;ELSE CONVERT TO ASCII
RST 2 ;AND PRINT THE DIGIT
JMP PN6 ;GO BACK FOR MORE
;
PRTLN: LDAX D ;*** PRTLN ***
MOV L,A ;LOW ORDER LINE #
INX D
LDAX D ;HIGH ORDER
MOV H,A
INX D
MVI C,4H ;PRINT 4 DIGIT LINE #
CALL PRTNUM
MVI A,20H ;FOLLOWED BY A BLANK
RST 2
SUB A ;AND THEN THE NEXT
CALL PRTSTG
RET
;
;*************************************************************
;
; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
;
; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
; DE = HL
;
; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
; UNTIL DE = BC
;
; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
; STACK
;
; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
; STACK
;
MVUP: RST 4 ;*** MVUP ***
RZ ;DE = HL, RETURN
LDAX D ;GET ONE BYTE
STAX B ;MOVE IT
INX D ;INCREASE BOTH POINTERS
INX B
JMP MVUP ;UNTIL DONE
;
MVDOWN: MOV A,B ;*** MVDOWN ***
SUB D ;TEST IF DE = BC
JNZ MD1 ;NO, GO MOVE
MOV A,C ;MAYBE, OTHER BYTE?
SUB E
RZ ;YES, RETURN
MD1: DCX D ;ELSE MOVE A BYTE
DCX H ;BUT FIRST DECREASE
LDAX D ;BOTH POINTERS AND
MOV M,A ;THEN DO IT
JMP MVDOWN ;LOOP BACK
;
POPA: POP B ;BC = RETURN ADDR.
POP H ;RESTORE LOPVAR, BUT
SHLD LOPVAR ;=0 MEANS NO MORE
MOV A,H
ORA L
JZ PP1 ;YEP, GO RETURN
POP H ;NOP, RESTORE OTHERS
SHLD LOPINC
POP H
SHLD LOPLMT
POP H
SHLD LOPLN
POP H
SHLD LOPPT
PP1: PUSH B ;BC = RETURN ADDR.
RET
;
PUSHA: LXI H,STKLMT ;*** PUSHA ***
CALL CHGSGN
POP B ;BC=RETURN ADDRESS
DAD SP ;IS STACK NEAR THE TOP?
JNC QSORRY ;YES, SORRY FOR THAT
LHLD LOPVAR ;ELSE SAVE LOOP VAR'S
MOV A,H ;BUT IF LOPVAR IS 0
ORA L ;THAT WILL BE ALL
JZ PU1
LHLD LOPPT ;ELSE, MORE TO SAVE
PUSH H
LHLD LOPLN
PUSH H
LHLD LOPLMT
PUSH H
LHLD LOPINC
PUSH H
LHLD LOPVAR
PU1: PUSH H
PUSH B ;BC = RETURN ADDR.
RET
;
;*************************************************************
;
; *** OUTC *** & CHKIO ***
;
; THESE ARE THE ONLY I/O ROUTINES IN TBI.
; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0
; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0,
; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO
; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG.
; ARE RESTORED.
;
; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO
; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG
; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE
; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL
; RESTART TBI AND DO NOT RETURN TO THE CALLER.
;
;OUTC: PUSH PSW ;THIS IS AT LOC. 10
; LDA OCSW ;CHECK SOFTWARE SWITCH
; ORA A
INIT: STA OCSW
MVI A,3 ;RESET ACIA
OUT 16
MVI A,15H ;15H FOR 8N1, 11H FOR 8N2
OUT 16
MVI D,19H
PATLOP:
CALL CRLF
DCR D
JNZ PATLOP
SUB A
LXI D,MSG1
CALL PRTSTG
LXI H,START
SHLD RANPNT
LXI H,TXTBGN
SHLD TXTUNF
JMP RSTART
OC2: JNZ OC3 ;IT IS ON
POP PSW ;IT IS OFF
RET ;RESTORE AF AND RETURN
OC3: IN 0 ;COME HERE TO DO OUTPUT
ANI 2H ;STATUS BIT
JZ OC3 ;NOT READY, WAIT
POP PSW ;READY, GET OLD A BACK
OUT 1 ;AND SEND IT OUT
CPI CR ;WAS IT CR?
RNZ ;NO, FINISHED
MVI A,LF ;YES, WE SEND LF TOO
RST 2 ;THIS IS RECURSIVE
MVI A,CR ;GET CR BACK IN A
RET
;
CHKIO: IN 0 ;*** CHKIO ***
NOP ;STATUS BIT FLIPPED?
ANI 20H ;MASK STATUS BIT
RZ ;NOT READY, RETURN "Z"
IN 1 ;READY, READ DATA
ANI 7FH ;MASK BIT 7 OFF
CPI 0FH ;IS IT CONTROL-O?
JNZ CI1 ;NO, MORE CHECKING
LDA OCSW ;CONTROL-O FLIPS OCSW
CMA ;ON TO OFF, OFF TO ON
STA OCSW
JMP CHKIO ;GET ANOTHER INPUT
CI1: CPI 3H ;IS IT CONTROL-C?
RNZ ;NO, RETURN "NZ"
JMP RSTART ;YES, RESTART TBI
;
MSG1: DB 'TINY '
DB 'BASIC'
DB CR
;
;*************************************************************
;
; *** TABLES *** DIRECT *** & EXEC ***
;
; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
; OF CODE ACCORDING TO THE TABLE.
;
; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
; ALL DIRECT AND STATEMENT COMMANDS.
;
; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
;
; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
; BYTE SET TO 1.
;
; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
; MATCH THIS NULL ITEM AS DEFAULT.
;
TAB1: ;DIRECT COMMANDS
DB 'LIST'
DWA LIST
DB 'RUN'
DWA RUN
DB 'NEW'
DWA NEW
;
TAB2: ;DIRECT/STATEMENT
DB 'NEXT'
DWA NEXT
DB 'LET'
DWA LET
DB 'IF'
DWA IFF
DB 'GOTO'
DWA GOTO
DB 'GOSUB'
DWA GOSUB
DB 'RETURN'
DWA RETURN
DB 'REM'
DWA REM
DB 'FOR'
DWA FOR
DB 'INPUT'
DWA INPUT
DB 'PRINT'
DWA PRINT
DB 'STOP'
DWA STOP
DWA DEFLT
;
TAB4: ;FUNCTIONS
DB 'RND'
DWA RND
DB 'ABS'
DWA ABS
DB 'SIZE'
DWA SIZE
DWA XP40
;
TAB5: ;"TO" IN "FOR"
DB 'TO'
DWA FR1
DWA QWHAT
;
TAB6: ;"STEP" IN "FOR"
DB 'STEP'
DWA FR2
DWA FR3
;
TAB8: ;RELATION OPERATORS
DB '>='
DWA XP11
DB '#'
DWA XP12
DB '>'
DWA XP13
DB '='
DWA XP15
DB '<='
DWA XP14
DB '<'
DWA XP16
DWA XP17
;
DIRECT: LXI H,TAB1-1 ;*** DIRECT ***
;
EXEC: ;*** EXEC ***
EX0: RST 5 ;IGNORE LEADING BLANKS
PUSH D ;SAVE POINTER
EX1: LDAX D ;IF FOUND '.' IN STRING
INX D ;BEFORE ANY MISMATCH
CPI 2EH ;WE DECLARE A MATCH
JZ EX3
INX H ;HL->TABLE
CMP M ;IF MATCH, TEST NEXT
JZ EX1
MVI A,07FH ;ELSE SEE IF BIT 7
DCX D ;OF TABLE IS SET, WHICH
CMP M ;IS THE JUMP ADDR. (HI)
JC EX5 ;C:YES, MATCHED
EX2: INX H ;NC:NO, FIND JUMP ADDR.
CMP M
JNC EX2
INX H ;BUMP TO NEXT TAB. ITEM
POP D ;RESTORE STRING POINTER
JMP EX0 ;TEST AGAINST NEXT ITEM
EX3: MVI A,07FH ;PARTIAL MATCH, FIND
EX4: INX H ;JUMP ADDR., WHICH IS
CMP M ;FLAGGED BY BIT 7
JNC EX4
EX5: MOV A,M ;LOAD HL WITH THE JUMP
INX H ;ADDRESS FROM THE TABLE
MOV L,M
ANI 7FH ;MASK OFF BIT 7
MOV H,A
POP PSW ;CLEAN UP THE GABAGE
PCHL ;AND WE GO DO IT
;
LSTROM: ;ALL ABOVE CAN BE ROM
ORG 1000H ;HERE DOWN MUST BE RAM
; ORG 0800H
OCSW: DS 1 ;SWITCH FOR OUTPUT
CURRNT: DS 2 ;POINTS TO CURRENT LINE
STKGOS: DS 2 ;SAVES SP IN 'GOSUB'
VARNXT: DS 2 ;TEMP STORAGE
STKINP: DS 2 ;SAVES SP IN 'INPUT'
LOPVAR: DS 2 ;'FOR' LOOP SAVE AREA
LOPINC: DS 2 ;INCREMENT
LOPLMT: DS 2 ;LIMIT
LOPLN: DS 2 ;LINE NUMBER
LOPPT: DS 2 ;TEXT POINTER
RANPNT: DS 2 ;RANDOM NUMBER POINTER
TXTUNF: DS 2 ;->UNFILLED TEXT AREA
TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS
ORG 1366H
; ORG 1F00H
TXTEND: DS 0 ;TEXT SAVE AREA ENDS
VARBGN: DS 55 ;VARIABLE @(0)
BUFFER: DS 64 ;INPUT BUFFER
BUFEND: DS 1 ;BUFFER ENDS
STKLMT: DS 1 ;TOP LIMIT FOR STACK
ORG 1400H
; ORG 2000H
STACK: DS 0 ;STACK STARTS HERE
;
CR EQU 0DH
LF EQU 0AH
END
:100000003100143EFFC34206E3EFBEC368003E0D5D
:10001000F53A0010B7C36C06CD7103E5C32D035745
:100020007CBAC07DBBC9414E1AFE20C013C3280054
:10003000F1CDB304C3C60447EFD640D8C25800136D
:10004000CD1A0429DA9F00D5EBCD5904E7DAF40480
:10005000216613CD7C04D1C9FE1B3FD81321661342
:1000600007856F3E008C67C923CA7300C54E060022
:1000700009C11B1323E3C921000044EFFE30D8FE61
:100080003AD03EF0A4C29F0004C5444D2929092955
:100090001A13E60F856F3E008C67C11AF27C00D5FB
:1000A00011A600C3CA04484F573F0D4F4B0D574888
:1000B00041543F0D534F5252590D310014CD0E0093
:1000C00011AB0097CD600521CE0022011021000068
:1000D0002209102203103E3ECDFA04D5119D13CD06
:1000E0007700EF7CB5C1CA38071B7C121B7D12C597
:1000F000D57993F5CD3805D5C20B01D5CD5405C1C1
:100100002A1510CDE5056069221510C12A1510F1D8
:10011000E5FE03CABA00856F3E008C67116613E7DF
:10012000D2F304221510D1CDEE05D1E1CDE505C302
:10013000D600CDC204211710221510CDC204C3BAB7
:1001400000CDC204111710210000CD4005DABA001D
:10015000EB220110EB1313CD840621BD06C33B0730
:10016000DFD5CDC204CD3805C2A000F1C35001CD0A
:100170007700CDC204CD3805DABA00CDD205CD84E2
:1001800006CD4005C378010E06CF3B06CD0E00C359
:100190005701CF0D06CD0E00C34701CF2305DF4D1C
:1001A000C3A901CD6C05C3B601CF2C06CDB304C3E2
:1001B0009B01CD0E00F7DFC5CD9205C1C3A901CDCE
:1001C0001906DFD5CD3805C2A0002A0110E52A03A3
:1001D00010E521000022091039220310C35001CD7F
:1001E000C2042A03107CB5CAC604F9E1220310E157
:1001F000220110D1CDFD05F7CD1906CDA0042B228B
:100200000910211307C33B07DF220D10211907C373
:100210003B07DFC31902210100220B102A01102223
:100220000F10EB221110010A002A0910EB60683947
:100230003E097E23B6CA52027E2BBAC231027EBB71
:10024000C23102EB21000039444D210A0019CDEEE4
:1002500005F92A1110EBF7FFDAC604220510D5EBD9
:100260002A09107CB5CAC704E7CA7602D1CDFD05BC
:100270002A0510C35E025E23562A0B10E57CAA7A7B
:1002800019FA8802ACFAAA02EB2A09107323722A1F
:100290000D10F1B7F29802EBCD9804D1DAAC022A36
:1002A0000F102201102A1110EBF7E1D1CDFD05F757
:1002B0002100003EDF7CB5C25701CD5605D250016A
:1002C000C3BA002A0710F9E1220110D1D1D5CD6CB3
:1002D00005C3DB02FFDA1503C3EB02D5FFDAC60460
:1002E0001A4F9712D1CD6005791B12D5EB2A011058
:1002F000E521CD0222011021000039220710D53E50
:100300003ACDFA04119D13DF000000D1EB73237284
:10031000E1220110D1F1CF2C03C3CD02F71AFE0D5B
:10032000CA2C03CDA004CF2C03C32303F72121073C
:10033000C33B07CD5C03D86FC9CD5C03C86FC9CD83
:100340005C03C8D86FC9CD5C036FC8D86CC9CD5CDD
:1003500003C06FC9CD5C03D06FC9E1C979E1C1E5C4
:10036000C54FCD7103EBE3CD9804D12100003E01D0
:10037000C9CF2D06210000C39B03CF2B00CDA503C1
:10038000CF2B15E5CDA503EBE37CAA7A19D1FA8032
:1003900003ACF28003C39F00CF2D86E5CDA503CD2E
:1003A0008604C38703CD0504CF2A2DE5CD050406B9
:1003B00000CD8304E3CD8304EBE37CB7CAC5037AA5
:1003C000B2EBC2A0007D210000B7CAF70319DAA082
:1003D000003DC2CD03C3F703CF2F46E5CD0504068C
:1003E00000CD8304E3CD8304EBE3EB7AB3CAA00032
:1003F000C5CD66046069C1D17CB7FA9F0078B7FCAF
:100400008604C3A803210107C33B07FFDA14047E57
:1004100023666FC9CD770078B7C0CF2805DFCF2915
:1004200001C9C3C604CD1A047CB7FA9F00B5CA9FA0
:1004300000D5E52A1310116907E7DA40042100000E
:100440005E2356221310E1EBC5CD6604C1D123C94A
:10045000CD1A041BCD830413C92A1510D5EB2166D0
:1004600013CD7C04D1C9E56C2600CD7104417DE13A
:10047000670EFF0CCD7C04D2730419C97D936F7C89
:100480009A67C97CB7F07CF52F677D2F6F23F1AC9D
:10049000F29F0078EE8047C97CAAF29E04EBE7C980
:1004A000FFDAC604E5CF3D08DF444DE1712370C992
:1004B000C3C604CF3B04F1C35701CF0D04F1C347BA
:1004C00001C9EFFE0DC8D511AE0097CD6005D11A58
:1004D000F597122A0110E57E23B6D1CABA007EB77D
:1004E000FAC302CDD2051BF1123E3FD797CD60056E
:1004F000C3BA00D511B400C3CA04D7119D13CD846B
:1005000006CAFE04FE7FCA2305D7FE0ACAFE04B748
:10051000CAFE04FE7DCA30051213FE0DC87BFEDD47
:10052000C2FE047BFE9DCA30051B3E5CD7C3FE04A1
:10053000CD0E003E5EC3FA047CB7FA9F001117107F
:10054000E52A15102BE7E1D81A9547131A9CDA55BE
:10055000051BB0C913131AFE0DC2550513C3400580
:10056000471A13B8C8D7FE0DC26105C9CF220F3E86
:1005700022CD6005FE0DE1CA4701232323E9CF27E1
:10058000053E27C37105CF5F083E8DD7D7E1C37AFB
:1005900005C90600CD8304F29D05062D0DD5110A6F
:1005A00000D50DC5CD660478B1CAB405E32DE5606C
:1005B00069C3A405C10D79B7FAC1053E20D7C3B5FB
:1005C0000578B7C410005D7BFE0AD1C8C630D7C31A
:1005D000C7051A6F131A67130E04CD92053E20D774
:1005E00097CD6005C9E7C81A021303C3E5057892E1
:1005F000C2F6057993C81B2B1A77C3EE05C1E12219
:1006000009107CB5CA1706E1220B10E1220D10E19A
:10061000220F10E1221110C5C921DE13CD8604C1BD
:1006200039D2F3042A09107CB5CA3F062A1110E515
:100630002A0F10E52A0D10E52A0B10E52A0910E50E
:10064000C5C93200103E03D3103E15D3101619CD84
:100650000E0015C24F069711A306CD6005210000BC
:10066000221310211710221510C3BA00C27106F10F
:10067000C9DB00E602CA7106F1D301FE0DC03E0AD5
:10068000D73E0DC9DB0000E620C8DB01E67FFE0F88
:10069000C29D063A00102F320010C38406FE03C02C
:1006A000C3BA0054494E592042415349430D4C4965
:1006B0005354816F52554E81414E455781324E45BC
:1006C000585482574C45548323494682B4474F546B
:1006D0004F8160474F53554281BF52455455524E4A
:1006E00081DF52454D82B0464F5281F8494E5055F8
:1006F0005482CD5052494E54818753544F50813BC0
:10070000831D524E448425414253845053495A45D7
:100710008459840B544F820884C653544550821226
:1007200082163E3D83332383393E833F3D834E3CD7
:100730003D83463C8354835A21AD06EFD51A13FE00
:100740002ECA5A0723BECA3D073E7F1BBEDA610789
:1007500023BED2500723D1C33B073E7F23BED25CCA
:09076000077E236EE67F67F1E9D4
:00000001FF
0000 ;*************************************************************
0000 ;
0000 ; TINY BASIC FOR INTEL 8080
0000 ; VERSION 2.0
0000 ; BY LI-CHEN WANG
0000 ; MODIFIED AND TRANSLATED
0000 ; TO INTEL MNEMONICS
0000 ; BY ROGER RAUSKOLB
0000 ; 10 OCTOBER,1976
0000 ; @COPYLEFT
0000 ; ALL WRONGS RESERVED
0000 ;
0000 ;*************************************************************
0000 ;
0000 ; *** ZERO PAGE SUBROUTINES ***
0000 ;
0000 ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
0000 ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
0000 ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
0000 ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL
0000 ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR
0000 ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
0000 ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
0000 ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
0000 ;
0000 .ENGINE macz80
0000 ;
0000 .ORG 0H
0000 31 00 14 START: LXI SP,STACK ;*** COLD START ***
0003 3E FF MVI A,0FFH
0005 C3 42 06 JMP INIT
0008 ;
0008 E3 XTHL ;*** TSTC OR RST 1 ***
0009 EF RST 5 ;IGNORE BLANKS AND
000A BE CMP M ;TEST CHARACTER
000B C3 68 00 JMP TC1 ;REST OF THIS IS AT TC1
000E ;
000E 3E 0D CRLF: MVI A,CR ;*** CRLF ***
0010 ;
0010 F5 PUSH PSW ;*** OUTC OR RST 2 ***
0011 3A 00 10 LDA OCSW ;PRINT CHARACTER ONLY
0014 B7 ORA A ;IF OCSW SWITCH IS ON
0015 C3 6C 06 JMP OC2 ;REST OF THIS IS AT OC2
0018 ;
0018 CD 71 03 CALL EXPR2 ;*** EXPR OR RST 3 ***
001B E5 PUSH H ;EVALUATE AN EXPRESSION
001C C3 2D 03 JMP EXPR1 ;REST OF IT AT EXPR1
001F 57 DB 'W'
0020 ;
0020 7C MOV A,H ;*** COMP OR RST 4 ***
0021 BA CMP D ;COMPARE HL WITH DE
0022 C0 RNZ ;RETURN CORRECT C AND
0023 7D MOV A,L ;Z FLAGS
0024 BB CMP E ;BUT OLD A IS LOST
0025 C9 RET
0026 41 4E DB 'AN'
0028 ;
0028 1A SS1: LDAX D ;*** IGNBLK/RST 5 ***
0029 FE 20 CPI 20H ;IGNORE BLANKS
002B C0 RNZ ;IN TEXT (WHERE DE->)
002C 13 INX D ;AND RETURN THE FIRST
002D C3 28 00 JMP SS1 ;NON-BLANK CHAR. IN A
0030 ;
0030 F1 POP PSW ;*** FINISH/RST 6 ***
0031 CD B3 04 CALL FIN ;CHECK END OF COMMAND
0034 C3 C6 04 JMP QWHAT ;PRINT "WHAT?" IF WRONG
0037 47 DB 'G'
0038 ;
0038 EF RST 5 ;*** TSTV OR RST 7 ***
0039 D6 40 SUI 40H ;TEST VARIABLES
003B D8 RC ;C:NOT A VARIABLE
003C C2 58 00 JNZ TV1 ;NOT "@" ARRAY
003F 13 INX D ;IT IS THE "@" ARRAY
0040 CD 1A 04 CALL PARN ;@ SHOULD BE FOLLOWED
0043 29 DAD H ;BY (EXPR) AS ITS INDEX
0044 DA 9F 00 JC QHOW ;IS INDEX TOO BIG?
0047 D5 PUSH D ;WILL IT OVERWRITE
0048 EB XCHG ;TEXT?
0049 CD 59 04 CALL SIZE ;FIND SIZE OF FREE
004C E7 RST 4 ;AND CHECK THAT
004D DA F4 04 JC ASORRY ;IF SO, SAY "SORRY"
0050 21 66 13 LXI H,VARBGN ;IF NOT GET ADDRESS
0053 CD 7C 04 CALL SUBDE ;OF @(EXPR) AND PUT IT
0056 D1 POP D ;IN HL
0057 C9 RET ;C FLAG IS CLEARED
0058 FE 1B TV1: CPI 1BH ;NOT @, IS IT A TO Z?
005A 3F CMC ;IF NOT RETURN C FLAG
005B D8 RC
005C 13 INX D ;IF A THROUGH Z
005D 21 66 13 LXI H,VARBGN ;COMPUTE ADDRESS OF
0060 07 RLC ;THAT VARIABLE
0061 85 ADD L ;AND RETURN IT IN HL
0062 6F MOV L,A ;WITH C FLAG CLEARED
0063 3E 00 MVI A,0
0065 8C ADC H
0066 67 MOV H,A
0067 C9 RET
0068 ;
0068 ;TSTC: XTHL ;*** TSTC OR RST 1 ***
0068 ; RST 5 ;THIS IS AT LOC. 8
0068 ; CMP M ;AND THEN JUMP HERE
0068 23 TC1: INX H ;COMPARE THE BYTE THAT
0069 CA 73 00 JZ TC2 ;FOLLOWS THE RST INST.
006C C5 PUSH B ;WITH THE TEXT (DE->)
006D 4E MOV C,M ;IF NOT =, ADD THE 2ND
006E 06 00 MVI B,0 ;BYTE THAT FOLLOWS THE
0070 09 DAD B ;RST TO THE OLD PC
0071 C1 POP B ;I.E., DO A RELATIVE
0072 1B DCX D ;JUMP IF NOT =
0073 13 TC2: INX D ;IF =, SKIP THOSE BYTES
0074 23 INX H ;AND CONTINUE
0075 E3 XTHL
0076 C9 RET
0077 ;
0077 21 00 00 TSTNUM: LXI H,0 ;*** TSTNUM ***
007A 44 MOV B,H ;TEST IF THE TEXT IS
007B EF RST 5 ;A NUMBER
007C FE 30 TN1: CPI 30H ;IF NOT, RETURN 0 IN
007E D8 RC ;B AND HL
007F FE 3A CPI 3AH ;IF NUMBERS, CONVERT
0081 D0 RNC ;TO BINARY IN HL AND
0082 3E F0 MVI A,0F0H ;SET B TO # OF DIGITS
0084 A4 ANA H ;IF H>255, THERE IS NO
0085 C2 9F 00 JNZ QHOW ;ROOM FOR NEXT DIGIT
0088 04 INR B ;B COUNTS # OF DIGITS
0089 C5 PUSH B
008A 44 MOV B,H ;HL=10*HL+(NEW DIGIT)
008B 4D MOV C,L
008C 29 DAD H ;WHERE 10* IS DONE BY
008D 29 DAD H ;SHIFT AND ADD
008E 09 DAD B
008F 29 DAD H
0090 1A LDAX D ;AND (DIGIT) IS FROM
0091 13 INX D ;STRIPPING THE ASCII
0092 E6 0F ANI 0FH ;CODE
0094 85 ADD L
0095 6F MOV L,A
0096 3E 00 MVI A,0
0098 8C ADC H
0099 67 MOV H,A
009A C1 POP B
009B 1A LDAX D ;DO THIS DIGIT AFTER
009C F2 7C 00 JP TN1 ;DIGIT. S SAYS OVERFLOW
009F D5 QHOW: PUSH D ;*** ERROR "HOW?" ***
00A0 11 A6 00 AHOW: LXI D,HOW
00A3 C3 CA 04 JMP ERROR
00A6 48 4F 57 3F HOW: DB 'HOW?'
00AA 0D DB CR
00AB 4F 4B OK: DB 'OK'
00AD 0D DB CR
00AE 57 48 41 54 3F WHAT: DB 'WHAT?'
00B3 0D DB CR
00B4 53 4F 52 52 59 SORRY: DB 'SORRY'
00B9 0D DB CR
00BA ;
00BA ;*************************************************************
00BA ;
00BA ; *** MAIN ***
00BA ;
00BA ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
00BA ; AND STORES IT IN THE MEMORY.
00BA ;
00BA ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
00BA ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
00BA ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
00BA ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
00BA ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
00BA ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
00BA ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
00BA ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
00BA ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
00BA ;
00BA ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
00BA ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
00BA ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
00BA ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
00BA ;
00BA ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
00BA ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
00BA ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
00BA ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
00BA ;
00BA ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
00BA ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
00BA ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
00BA ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
00BA ;
00BA 31 00 14 RSTART: LXI SP,STACK
00BD CD 0E 00 ST1: CALL CRLF ;AND JUMP TO HERE
00C0 11 AB 00 LXI D,OK ;DE->STRING
00C3 97 SUB A ;A=0
00C4 CD 60 05 CALL PRTSTG ;PRINT STRING UNTIL CR
00C7 21 CE 00 LXI H,ST2+1 ;LITERAL 0
00CA 22 01 10 SHLD CURRNT ;CURRENT->LINE # = 0
00CD 21 00 00 ST2: LXI H,0
00D0 22 09 10 SHLD LOPVAR
00D3 22 03 10 SHLD STKGOS
00D6 3E 3E ST3: MVI A,3EH ;PROMPT '>' AND
00D8 CD FA 04 CALL GETLN ;READ A LINE
00DB D5 PUSH D ;DE->END OF LINE
00DC 11 9D 13 LXI D,BUFFER ;DE->BEGINNING OF LINE
00DF CD 77 00 CALL TSTNUM ;TEST IF IT IS A NUMBER
00E2 EF RST 5
00E3 7C MOV A,H ;HL=VALUE OF THE # OR
00E4 B5 ORA L ;0 IF NO # WAS FOUND
00E5 C1 POP B ;BC->END OF LINE
00E6 CA 38 07 JZ DIRECT
00E9 1B DCX D ;BACKUP DE AND SAVE
00EA 7C MOV A,H ;VALUE OF LINE # THERE
00EB 12 STAX D
00EC 1B DCX D
00ED 7D MOV A,L
00EE 12 STAX D
00EF C5 PUSH B ;BC,DE->BEGIN, END
00F0 D5 PUSH D
00F1 79 MOV A,C
00F2 93 SUB E
00F3 F5 PUSH PSW ;A=# OF BYTES IN LINE
00F4 CD 38 05 CALL FNDLN ;FIND THIS LINE IN SAVE
00F7 D5 PUSH D ;AREA, DE->SAVE AREA
00F8 C2 0B 01 JNZ ST4 ;NZ:NOT FOUND, INSERT
00FB D5 PUSH D ;Z:FOUND, DELETE IT
00FC CD 54 05 CALL FNDNXT ;FIND NEXT LINE
00FF ;DE->NEXT LINE
00FF C1 POP B ;BC->LINE TO BE DELETED
0100 2A 15 10 LHLD TXTUNF ;HL->UNFILLED SAVE AREA
0103 CD E5 05 CALL MVUP ;MOVE UP TO DELETE
0106 60 MOV H,B ;TXTUNF->UNFILLED AREA
0107 69 MOV L,C
0108 22 15 10 SHLD TXTUNF ;UPDATE
010B C1 ST4: POP B ;GET READY TO INSERT
010C 2A 15 10 LHLD TXTUNF ;BUT FIRST CHECK IF
010F F1 POP PSW ;THE LENGTH OF NEW LINE
0110 E5 PUSH H ;IS 3 (LINE # AND CR)
0111 FE 03 CPI 3 ;THEN DO NOT INSERT
0113 CA BA 00 JZ RSTART ;MUST CLEAR THE STACK
0116 85 ADD L ;COMPUTE NEW TXTUNF
0117 6F MOV L,A
0118 3E 00 MVI A,0
011A 8C ADC H
011B 67 MOV H,A ;HL->NEW UNFILLED AREA
011C 11 66 13 LXI D,TXTEND ;CHECK TO SEE IF THERE
011F E7 RST 4 ;IS ENOUGH SPACE
0120 D2 F3 04 JNC QSORRY ;SORRY, NO ROOM FOR IT
0123 22 15 10 SHLD TXTUNF ;OK, UPDATE TXTUNF
0126 D1 POP D ;DE->OLD UNFILLED AREA
0127 CD EE 05 CALL MVDOWN
012A D1 POP D ;DE->BEGIN, HL->END
012B E1 POP H
012C CD E5 05 CALL MVUP ;MOVE NEW LINE TO SAVE
012F C3 D6 00 JMP ST3 ;AREA
0132 ;
0132 ;*************************************************************
0132 ;
0132 ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
0132 ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
0132 ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
0132 ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
0132 ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
0132 ;
0132 ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
0132 ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
0132 ; GO BACK TO 'RSTART'.
0132 ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
0132 ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
0132 ; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
0132 ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
0132 ;*************************************************************
0132 ;
0132 ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
0132 ;
0132 ; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
0132 ;
0132 ; 'STOP(CR)' GOES BACK TO 'RSTART'
0132 ;
0132 ; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
0132 ; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
0132 ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
0132 ;
0132 ; THERE ARE 3 MORE ENTRIES IN 'RUN':
0132 ; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
0132 ; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
0132 ; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
0132 ;
0132 ; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
0132 ; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
0132 ;
0132 CD C2 04 NEW: CALL ENDCHK ;*** NEW(CR) ***
0135 21 17 10 LXI H,TXTBGN
0138 22 15 10 SHLD TXTUNF
013B ;
013B CD C2 04 STOP: CALL ENDCHK ;*** STOP(CR) ***
013E C3 BA 00 JMP RSTART
0141 ;
0141 CD C2 04 RUN: CALL ENDCHK ;*** RUN(CR) ***
0144 11 17 10 LXI D,TXTBGN ;FIRST SAVED LINE
0147 ;
0147 21 00 00 RUNNXL: LXI H,0 ;*** RUNNXL ***
014A CD 40 05 CALL FNDLP ;FIND WHATEVER LINE #
014D DA BA 00 JC RSTART ;C:PASSED TXTUNF, QUIT
0150 ;
0150 EB RUNTSL: XCHG ;*** RUNTSL ***
0151 22 01 10 SHLD CURRNT ;SET 'CURRENT'->LINE #
0154 EB XCHG
0155 13 INX D ;BUMP PASS LINE #
0156 13 INX D
0157 ;
0157 CD 84 06 RUNSML: CALL CHKIO ;*** RUNSML ***
015A 21 BD 06 LXI H,TAB2-1 ;FIND COMMAND IN TAB2
015D C3 3B 07 JMP EXEC ;AND EXECUTE IT
0160 ;
0160 DF GOTO: RST 3 ;*** GOTO EXPR ***
0161 D5 PUSH D ;SAVE FOR ERROR ROUTINE
0162 CD C2 04 CALL ENDCHK ;MUST FIND A CR
0165 CD 38 05 CALL FNDLN ;FIND THE TARGET LINE
0168 C2 A0 00 JNZ AHOW ;NO SUCH LINE #
016B F1 POP PSW ;CLEAR THE PUSH DE
016C C3 50 01 JMP RUNTSL ;GO DO IT
016F ;
016F ;*************************************************************
016F ;
016F ; *** LIST *** & PRINT ***
016F ;
016F ; LIST HAS TWO FORMS:
016F ; 'LIST(CR)' LISTS ALL SAVED LINES
016F ; 'LIST #(CR)' START LIST AT THIS LINE #
016F ; YOU CAN STOP THE LISTING BY CONTROL C KEY
016F ;
016F ; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
016F ; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
016F ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
016F ;
016F ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
016F ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
016F ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
016F ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
016F ; SPECIFIED, 6 POSITIONS WILL BE USED.
016F ;
016F ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
016F ; DOUBLE QUOTES.
016F ;
016F ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
016F ;
016F ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
016F ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
016F ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
016F ;
016F CD 77 00 LIST: CALL TSTNUM ;TEST IF THERE IS A #
0172 CD C2 04 CALL ENDCHK ;IF NO # WE GET A 0
0175 CD 38 05 CALL FNDLN ;FIND THIS OR NEXT LINE
0178 DA BA 00 LS1: JC RSTART ;C:PASSED TXTUNF
017B CD D2 05 CALL PRTLN ;PRINT THE LINE
017E CD 84 06 CALL CHKIO ;STOP IF HIT CONTROL-C
0181 CD 40 05 CALL FNDLP ;FIND NEXT LINE
0184 C3 78 01 JMP LS1 ;AND LOOP BACK
0187 ;
0187 0E 06 PRINT: MVI C,6 ;C = # OF SPACES
0189 CF RST 1 ;IF NULL LIST & ";"
018A 3B DB 3BH
018B 06 DB PR2-$-1
018C CD 0E 00 CALL CRLF ;GIVE CR-LF AND
018F C3 57 01 JMP RUNSML ;CONTINUE SAME LINE
0192 CF PR2: RST 1 ;IF NULL LIST (CR)
0193 0D DB CR
0194 06 DB PR0-$-1
0195 CD 0E 00 CALL CRLF ;ALSO GIVE CR-LF AND
0198 C3 47 01 JMP RUNNXL ;GO TO NEXT LINE
019B CF PR0: RST 1 ;ELSE IS IT FORMAT?
019C 23 DB '#'
019D 05 DB PR1-$-1
019E DF RST 3 ;YES, EVALUATE EXPR.
019F 4D MOV C,L ;AND SAVE IT IN C
01A0 C3 A9 01 JMP PR3 ;LOOK FOR MORE TO PRINT
01A3 CD 6C 05 PR1: CALL QTSTG ;OR IS IT A STRING?
01A6 C3 B6 01 JMP PR8 ;IF NOT, MUST BE EXPR.
01A9 CF PR3: RST 1 ;IF ",", GO FIND NEXT
01AA 2C DB ","
01AB 06 DB PR6-$-1
01AC CD B3 04 CALL FIN ;IN THE LIST.
01AF C3 9B 01 JMP PR0 ;LIST CONTINUES
01B2 CD 0E 00 PR6: CALL CRLF ;LIST ENDS
01B5 F7 RST 6
01B6 DF PR8: RST 3 ;EVALUATE THE EXPR
01B7 C5 PUSH B
01B8 CD 92 05 CALL PRTNUM ;PRINT THE VALUE
01BB C1 POP B
01BC C3 A9 01 JMP PR3 ;MORE TO PRINT?
01BF ;
01BF ;*************************************************************
01BF ;
01BF ; *** GOSUB *** & RETURN ***
01BF ;
01BF ; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
01BF ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
01BF ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
01BF ; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
01BF ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
01BF ; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
01BF ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
01BF ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
01BF ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
01BF ;
01BF ; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
01BF ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
01BF ; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
01BF ; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
01BF ;
01BF CD 19 06 GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR"
01C2 DF RST 3 ;PARAMETERS
01C3 D5 PUSH D ;AND TEXT POINTER
01C4 CD 38 05 CALL FNDLN ;FIND THE TARGET LINE
01C7 C2 A0 00 JNZ AHOW ;NOT THERE. SAY "HOW?"
01CA 2A 01 10 LHLD CURRNT ;FOUND IT, SAVE OLD
01CD E5 PUSH H ;'CURRNT' OLD 'STKGOS'
01CE 2A 03 10 LHLD STKGOS
01D1 E5 PUSH H
01D2 21 00 00 LXI H,0 ;AND LOAD NEW ONES
01D5 22 09 10 SHLD LOPVAR
01D8 39 DAD SP
01D9 22 03 10 SHLD STKGOS
01DC C3 50 01 JMP RUNTSL ;THEN RUN THAT LINE
01DF CD C2 04 RETURN: CALL ENDCHK ;THERE MUST BE A CR
01E2 2A 03 10 LHLD STKGOS ;OLD STACK POINTER
01E5 7C MOV A,H ;0 MEANS NOT EXIST
01E6 B5 ORA L
01E7 CA C6 04 JZ QWHAT ;SO, WE SAY: "WHAT?"
01EA F9 SPHL ;ELSE, RESTORE IT
01EB E1 POP H
01EC 22 03 10 SHLD STKGOS ;AND THE OLD 'STKGOS'
01EF E1 POP H
01F0 22 01 10 SHLD CURRNT ;AND THE OLD 'CURRNT'
01F3 D1 POP D ;OLD TEXT POINTER
01F4 CD FD 05 CALL POPA ;OLD "FOR" PARAMETERS
01F7 F7 RST 6 ;AND WE ARE BACK HOME
01F8 ;
01F8 ;*************************************************************
01F8 ;
01F8 ; *** FOR *** & NEXT ***
01F8 ;
01F8 ; 'FOR' HAS TWO FORMS:
01F8 ; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
01F8 ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
01F8 ; EXP3=1. (I.E., WITH A STEP OF +1.)
01F8 ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
01F8 ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
01F8 ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
01F8 ; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
01F8 ; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
01F8 ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
01F8 ; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
01F8 ; BEFORE THE NEW ONE OVERWRITES IT.
01F8 ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
01F8 ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
01F8 ; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
01F8 ; (PURGED FROM THE STACK..)
01F8 ;
01F8 ; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
01F8 ; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
01F8 ; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
01F8 ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
01F8 ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
01F8 ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
01F8 ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
01F8 ; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
01F8 ; IS PURGED AND EXECUTION CONTINUES.
01F8 ;
01F8 CD 19 06 FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA
01FB CD A0 04 CALL SETVAL ;SET THE CONTROL VAR.
01FE 2B DCX H ;HL IS ITS ADDRESS
01FF 22 09 10 SHLD LOPVAR ;SAVE THAT
0202 21 13 07 LXI H,TAB5-1 ;USE 'EXEC' TO LOOK
0205 C3 3B 07 JMP EXEC ;FOR THE WORD 'TO'
0208 DF FR1: RST 3 ;EVALUATE THE LIMIT
0209 22 0D 10 SHLD LOPLMT ;SAVE THAT
020C 21 19 07 LXI H,TAB6-1 ;USE 'EXEC' TO LOOK
020F C3 3B 07 JMP EXEC ;FOR THE WORD 'STEP'
0212 DF FR2: RST 3 ;FOUND IT, GET STEP
0213 C3 19 02 JMP FR4
0216 21 01 00 FR3: LXI H,1H ;NOT FOUND, SET TO 1
0219 22 0B 10 FR4: SHLD LOPINC ;SAVE THAT TOO
021C 2A 01 10 FR5: LHLD CURRNT ;SAVE CURRENT LINE #
021F 22 0F 10 SHLD LOPLN
0222 EB XCHG ;AND TEXT POINTER
0223 22 11 10 SHLD LOPPT
0226 01 0A 00 LXI B,0AH ;DIG INTO STACK TO
0229 2A 09 10 LHLD LOPVAR ;FIND 'LOPVAR'
022C EB XCHG
022D 60 MOV H,B
022E 68 MOV L,B ;HL=0 NOW
022F 39 DAD SP ;HERE IS THE STACK
0230 3E DB 3EH
0231 09 FR7: DAD B ;EACH LEVEL IS 10 DEEP
0232 7E MOV A,M ;GET THAT OLD 'LOPVAR'
0233 23 INX H
0234 B6 ORA M
0235 CA 52 02 JZ FR8 ;0 SAYS NO MORE IN IT
0238 7E MOV A,M
0239 2B DCX H
023A BA CMP D ;SAME AS THIS ONE?
023B C2 31 02 JNZ FR7
023E 7E MOV A,M ;THE OTHER HALF?
023F BB CMP E
0240 C2 31 02 JNZ FR7
0243 EB XCHG ;YES, FOUND ONE
0244 21 00 00 LXI H,0H
0247 39 DAD SP ;TRY TO MOVE SP
0248 44 MOV B,H
0249 4D MOV C,L
024A 21 0A 00 LXI H,0AH
024D 19 DAD D
024E CD EE 05 CALL MVDOWN ;AND PURGE 10 WORDS
0251 F9 SPHL ;IN THE STACK
0252 2A 11 10 FR8: LHLD LOPPT ;JOB DONE, RESTORE DE
0255 EB XCHG
0256 F7 RST 6 ;AND CONTINUE
0257 ;
0257 FF NEXT: RST 7 ;GET ADDRESS OF VAR.
0258 DA C6 04 JC QWHAT ;NO VARIABLE, "WHAT?"
025B 22 05 10 SHLD VARNXT ;YES, SAVE IT
025E D5 NX0: PUSH D ;SAVE TEXT POINTER
025F EB XCHG
0260 2A 09 10 LHLD LOPVAR ;GET VAR. IN 'FOR'
0263 7C MOV A,H
0264 B5 ORA L ;0 SAYS NEVER HAD ONE
0265 CA C7 04 JZ AWHAT ;SO WE ASK: "WHAT?"
0268 E7 RST 4 ;ELSE WE CHECK THEM
0269 CA 76 02 JZ NX3 ;OK, THEY AGREE
026C D1 POP D ;NO, LET'S SEE
026D CD FD 05 CALL POPA ;PURGE CURRENT LOOP
0270 2A 05 10 LHLD VARNXT ;AND POP ONE LEVEL
0273 C3 5E 02 JMP NX0 ;GO CHECK AGAIN
0276 5E NX3: MOV E,M ;COME HERE WHEN AGREED
0277 23 INX H
0278 56 MOV D,M ;DE=VALUE OF VAR.
0279 2A 0B 10 LHLD LOPINC
027C E5 PUSH H
027D 7C MOV A,H
027E AA XRA D
027F 7A MOV A,D
0280 19 DAD D ;ADD ONE STEP
0281 FA 88 02 JM NX4
0284 AC XRA H
0285 FA AA 02 JM NX5
0288 EB NX4: XCHG
0289 2A 09 10 LHLD LOPVAR ;PUT IT BACK
028C 73 MOV M,E
028D 23 INX H
028E 72 MOV M,D
028F 2A 0D 10 LHLD LOPLMT ;HL->LIMIT
0292 F1 POP PSW ;OLD HL
0293 B7 ORA A
0294 F2 98 02 JP NX1 ;STEP > 0
0297 EB XCHG ;STEP < 0
0298 CD 98 04 NX1: CALL CKHLDE ;COMPARE WITH LIMIT
029B D1 POP D ;RESTORE TEXT POINTER
029C DA AC 02 JC NX2 ;OUTSIDE LIMIT
029F 2A 0F 10 LHLD LOPLN ;WITHIN LIMIT, GO
02A2 22 01 10 SHLD CURRNT ;BACK TO THE SAVED
02A5 2A 11 10 LHLD LOPPT ;'CURRNT' AND TEXT
02A8 EB XCHG ;POINTER
02A9 F7 RST 6
02AA E1 NX5: POP H
02AB D1 POP D
02AC CD FD 05 NX2: CALL POPA ;PURGE THIS LOOP
02AF F7 RST 6
02B0 ;
02B0 ;*************************************************************
02B0 ;
02B0 ; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
02B0 ;
02B0 ; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
02B0 ; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
02B0 ;
02B0 ; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
02B0 ; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
02B0 ; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
02B0 ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
02B0 ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
02B0 ; EXECUTION CONTINUES AT THE NEXT LINE.
02B0 ;
02B0 ; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
02B0 ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
02B0 ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
02B0 ; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
02B0 ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
02B0 ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
02B0 ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
02B0 ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
02B0 ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
02B0 ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
02B0 ;
02B0 ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
02B0 ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
02B0 ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
02B0 ; THIS IS HANDLED IN 'INPERR'.
02B0 ;
02B0 ; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
02B0 ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
02B0 ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
02B0 ; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
02B0 ; THIS IS DONE BY 'DEFLT'.
02B0 ;
02B0 21 00 00 REM: LXI H,0H ;*** REM ***
02B3 3E DB 3EH ;THIS IS LIKE 'IF 0'
02B4 ;
02B4 DF IFF: RST 3 ;*** IF ***
02B5 7C MOV A,H ;IS THE EXPR.=0?
02B6 B5 ORA L
02B7 C2 57 01 JNZ RUNSML ;NO, CONTINUE
02BA CD 56 05 CALL FNDSKP ;YES, SKIP REST OF LINE
02BD D2 50 01 JNC RUNTSL ;AND RUN THE NEXT LINE
02C0 C3 BA 00 JMP RSTART ;IF NO NEXT, RE-START
02C3 ;
02C3 2A 07 10 INPERR: LHLD STKINP ;*** INPERR ***
02C6 F9 SPHL ;RESTORE OLD SP
02C7 E1 POP H ;AND OLD 'CURRNT'
02C8 22 01 10 SHLD CURRNT
02CB D1 POP D ;AND OLD TEXT POINTER
02CC D1 POP D ;REDO INPUT
02CD ;
02CD INPUT: ;*** INPUT ***
02CD D5 IP1: PUSH D ;SAVE IN CASE OF ERROR
02CE CD 6C 05 CALL QTSTG ;IS NEXT ITEM A STRING?
02D1 C3 DB 02 JMP IP2 ;NO
02D4 FF RST 7 ;YES, BUT FOLLOWED BY A
02D5 DA 15 03 JC IP4 ;VARIABLE? NO.
02D8 C3 EB 02 JMP IP3 ;YES. INPUT VARIABLE
02DB D5 IP2: PUSH D ;SAVE FOR 'PRTSTG'
02DC FF RST 7 ;MUST BE VARIABLE NOW
02DD DA C6 04 JC QWHAT ;"WHAT?" IT IS NOT?
02E0 1A LDAX D ;GET READY FOR 'PRTSTR'
02E1 4F MOV C,A
02E2 97 SUB A
02E3 12 STAX D
02E4 D1 POP D
02E5 CD 60 05 CALL PRTSTG ;PRINT STRING AS PROMPT
02E8 79 MOV A,C ;RESTORE TEXT
02E9 1B DCX D
02EA 12 STAX D
02EB D5 IP3: PUSH D ;SAVE TEXT POINTER
02EC EB XCHG
02ED 2A 01 10 LHLD CURRNT ;ALSO SAVE 'CURRNT'
02F0 E5 PUSH H
02F1 21 CD 02 LXI H,IP1 ;A NEGATIVE NUMBER
02F4 22 01 10 SHLD CURRNT ;AS A FLAG
02F7 21 00 00 LXI H,0H ;SAVE SP TOO
02FA 39 DAD SP
02FB 22 07 10 SHLD STKINP
02FE D5 PUSH D ;OLD HL
02FF 3E 3A MVI A,3AH ;PRINT THIS TOO
0301 CD FA 04 CALL GETLN ;AND GET A LINE
0304 11 9D 13 LXI D,BUFFER ;POINTS TO BUFFER
0307 DF RST 3 ;EVALUATE INPUT
0308 00 NOP ;CAN BE 'CALL ENDCHK'
0309 00 NOP
030A 00 NOP
030B D1 POP D ;OK, GET OLD HL
030C EB XCHG
030D 73 MOV M,E ;SAVE VALUE IN VAR.
030E 23 INX H
030F 72 MOV M,D
0310 E1 POP H ;GET OLD 'CURRNT'
0311 22 01 10 SHLD CURRNT
0314 D1 POP D ;AND OLD TEXT POINTER
0315 F1 IP4: POP PSW ;PURGE JUNK IN STACK
0316 CF RST 1 ;IS NEXT CH. ','?
0317 2C DB ","
0318 03 DB IP5-$-1
0319 C3 CD 02 JMP IP1 ;YES, MORE ITEMS.
031C F7 IP5: RST 6
031D ;
031D 1A DEFLT: LDAX D ;*** DEFLT ***
031E FE 0D CPI CR ;EMPTY LINE IS OK
0320 CA 2C 03 JZ LT1 ;ELSE IT IS 'LET'
0323 ;
0323 CD A0 04 LET: CALL SETVAL ;*** LET ***
0326 CF RST 1 ;SET VALUE TO VAR.
0327 2C DB ","
0328 03 DB LT1-$-1
0329 C3 23 03 JMP LET ;ITEM BY ITEM
032C F7 LT1: RST 6 ;UNTIL FINISH
032D ;
032D ;*************************************************************
032D ;
032D ; *** EXPR ***
032D ;
032D ; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
032D ; <EXPR>::<EXPR2>
032D ; <EXPR2><REL.OP.><EXPR2>
032D ; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
032D ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
032D ; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
032D ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
032D ; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
032D ; <EXPR4>::=<VARIABLE>
032D ; <FUNCTION>
032D ; (<EXPR>)
032D ; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
032D ; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
032D ; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
032D ;
032D ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18
032D ; PUSH H ;SAVE <EXPR2> VALUE
032D 21 21 07 EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP.
0330 C3 3B 07 JMP EXEC ;GO DO IT
0333 CD 5C 03 XP11: CALL XP18 ;REL.OP.">="
0336 D8 RC ;NO, RETURN HL=0
0337 6F MOV L,A ;YES, RETURN HL=1
0338 C9 RET
0339 CD 5C 03 XP12: CALL XP18 ;REL.OP."#"
033C C8 RZ ;FALSE, RETURN HL=0
033D 6F MOV L,A ;TRUE, RETURN HL=1
033E C9 RET
033F CD 5C 03 XP13: CALL XP18 ;REL.OP.">"
0342 C8 RZ ;FALSE
0343 D8 RC ;ALSO FALSE, HL=0
0344 6F MOV L,A ;TRUE, HL=1
0345 C9 RET
0346 CD 5C 03 XP14: CALL XP18 ;REL.OP."<="
0349 6F MOV L,A ;SET HL=1
034A C8 RZ ;REL. TRUE, RETURN
034B D8 RC
034C 6C MOV L,H ;ELSE SET HL=0
034D C9 RET
034E CD 5C 03 XP15: CALL XP18 ;REL.OP."="
0351 C0 RNZ ;FALSE, RETURN HL=0
0352 6F MOV L,A ;ELSE SET HL=1
0353 C9 RET
0354 CD 5C 03 XP16: CALL XP18 ;REL.OP."<"
0357 D0 RNC ;FALSE, RETURN HL=0
0358 6F MOV L,A ;ELSE SET HL=1
0359 C9 RET
035A E1 XP17: POP H ;NOT .REL.OP
035B C9 RET ;RETURN HL=<EXPR2>
035C 79 XP18: MOV A,C ;SUBROUTINE FOR ALL
035D E1 POP H ;REL.OP.'S
035E C1 POP B
035F E5 PUSH H ;REVERSE TOP OF STACK
0360 C5 PUSH B
0361 4F MOV C,A
0362 CD 71 03 CALL EXPR2 ;GET 2ND <EXPR2>
0365 EB XCHG ;VALUE IN DE NOW
0366 E3 XTHL ;1ST <EXPR2> IN HL
0367 CD 98 04 CALL CKHLDE ;COMPARE 1ST WITH 2ND
036A D1 POP D ;RESTORE TEXT POINTER
036B 21 00 00 LXI H,0H ;SET HL=0, A=1
036E 3E 01 MVI A,1
0370 C9 RET
0371 ;
0371 CF EXPR2: RST 1 ;NEGATIVE SIGN?
0372 2D DB '-'
0373 06 DB XP21-$-1
0374 21 00 00 LXI H,0H ;YES, FAKE '0-'
0377 C3 9B 03 JMP XP26 ;TREAT LIKE SUBTRACT
037A CF XP21: RST 1 ;POSITIVE SIGN? IGNORE
037B 2B DB '+'
037C 00 DB XP22-$-1
037D CD A5 03 XP22: CALL EXPR3 ;1ST <EXPR3>
0380 CF XP23: RST 1 ;ADD?
0381 2B DB '+'
0382 15 DB XP25-$-1
0383 E5 PUSH H ;YES, SAVE VALUE
0384 CD A5 03 CALL EXPR3 ;GET 2ND <EXPR3>
0387 EB XP24: XCHG ;2ND IN DE
0388 E3 XTHL ;1ST IN HL
0389 7C MOV A,H ;COMPARE SIGN
038A AA XRA D
038B 7A MOV A,D
038C 19 DAD D
038D D1 POP D ;RESTORE TEXT POINTER
038E FA 80 03 JM XP23 ;1ST AND 2ND SIGN DIFFER
0391 AC XRA H ;1ST AND 2ND SIGN EQUAL
0392 F2 80 03 JP XP23 ;SO IS RESULT
0395 C3 9F 00 JMP QHOW ;ELSE WE HAVE OVERFLOW
0398 CF XP25: RST 1 ;SUBTRACT?
0399 2D DB '-'
039A 86 DB XP42-$-1
039B E5 XP26: PUSH H ;YES, SAVE 1ST <EXPR3>
039C CD A5 03 CALL EXPR3 ;GET 2ND <EXPR3>
039F CD 86 04 CALL CHGSGN ;NEGATE
03A2 C3 87 03 JMP XP24 ;AND ADD THEM
03A5 ;
03A5 CD 05 04 EXPR3: CALL EXPR4 ;GET 1ST <EXPR4>
03A8 CF XP31: RST 1 ;MULTIPLY?
03A9 2A DB '*'
03AA 2D DB XP34-$-1
03AB E5 PUSH H ;YES, SAVE 1ST
03AC CD 05 04 CALL EXPR4 ;AND GET 2ND <EXPR4>
03AF 06 00 MVI B,0H ;CLEAR B FOR SIGN
03B1 CD 83 04 CALL CHKSGN ;CHECK SIGN
03B4 E3 XTHL ;1ST IN HL
03B5 CD 83 04 CALL CHKSGN ;CHECK SIGN OF 1ST
03B8 EB XCHG
03B9 E3 XTHL
03BA 7C MOV A,H ;IS HL > 255 ?
03BB B7 ORA A
03BC CA C5 03 JZ XP32 ;NO
03BF 7A MOV A,D ;YES, HOW ABOUT DE
03C0 B2 ORA D
03C1 EB XCHG ;PUT SMALLER IN HL
03C2 C2 A0 00 JNZ AHOW ;ALSO >, WILL OVERFLOW
03C5 7D XP32: MOV A,L ;THIS IS DUMB
03C6 21 00 00 LXI H,0H ;CLEAR RESULT
03C9 B7 ORA A ;ADD AND COUNT
03CA CA F7 03 JZ XP35
03CD 19 XP33: DAD D
03CE DA A0 00 JC AHOW ;OVERFLOW
03D1 3D DCR A
03D2 C2 CD 03 JNZ XP33
03D5 C3 F7 03 JMP XP35 ;FINISHED
03D8 CF XP34: RST 1 ;DIVIDE?
03D9 2F DB '/'
03DA 46 DB XP42-$-1
03DB E5 PUSH H ;YES, SAVE 1ST <EXPR4>
03DC CD 05 04 CALL EXPR4 ;AND GET THE SECOND ONE
03DF 06 00 MVI B,0H ;CLEAR B FOR SIGN
03E1 CD 83 04 CALL CHKSGN ;CHECK SIGN OF 2ND
03E4 E3 XTHL ;GET 1ST IN HL
03E5 CD 83 04 CALL CHKSGN ;CHECK SIGN OF 1ST
03E8 EB XCHG
03E9 E3 XTHL
03EA EB XCHG
03EB 7A MOV A,D ;DIVIDE BY 0?
03EC B3 ORA E
03ED CA A0 00 JZ AHOW ;SAY "HOW?"
03F0 C5 PUSH B ;ELSE SAVE SIGN
03F1 CD 66 04 CALL DIVIDE ;USE SUBROUTINE
03F4 60 MOV H,B ;RESULT IN HL NOW
03F5 69 MOV L,C
03F6 C1 POP B ;GET SIGN BACK
03F7 D1 XP35: POP D ;AND TEXT POINTER
03F8 7C MOV A,H ;HL MUST BE +
03F9 B7 ORA A
03FA FA 9F 00 JM QHOW ;ELSE IT IS OVERFLOW
03FD 78 MOV A,B
03FE B7 ORA A
03FF FC 86 04 CM CHGSGN ;CHANGE SIGN IF NEEDED
0402 C3 A8 03 JMP XP31 ;LOOK FOR MORE TERMS
0405 ;
0405 21 01 07 EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4
0408 C3 3B 07 JMP EXEC ;AND GO DO IT
040B FF XP40: RST 7 ;NO, NOT A FUNCTION
040C DA 14 04 JC XP41 ;NOR A VARIABLE
040F 7E MOV A,M ;VARIABLE
0410 23 INX H
0411 66 MOV H,M ;VALUE IN HL
0412 6F MOV L,A
0413 C9 RET
0414 CD 77 00 XP41: CALL TSTNUM ;OR IS IT A NUMBER
0417 78 MOV A,B ;# OF DIGIT
0418 B7 ORA A
0419 C0 RNZ ;OK
041A CF PARN: RST 1
041B 28 DB '('
041C 05 DB XP43-$-1
041D DF RST 3 ;"(EXPR)"
041E CF RST 1
041F 29 DB ')'
0420 01 DB XP43-$-1
0421 C9 XP42: RET
0422 C3 C6 04 XP43: JMP QWHAT ;ELSE SAY: "WHAT?"
0425 ;
0425 CD 1A 04 RND: CALL PARN ;*** RND(EXPR) ***
0428 7C MOV A,H ;EXPR MUST BE +
0429 B7 ORA A
042A FA 9F 00 JM QHOW
042D B5 ORA L ;AND NON-ZERO
042E CA 9F 00 JZ QHOW
0431 D5 PUSH D ;SAVE BOTH
0432 E5 PUSH H
0433 2A 13 10 LHLD RANPNT ;GET MEMORY AS RANDOM
0436 11 69 07 LXI D,LSTROM ;NUMBER
0439 E7 RST 4
043A DA 40 04 JC RA1 ;WRAP AROUND IF LAST
043D 21 00 00 LXI H,START
0440 5E RA1: MOV E,M
0441 23 INX H
0442 56 MOV D,M
0443 22 13 10 SHLD RANPNT
0446 E1 POP H
0447 EB XCHG
0448 C5 PUSH B
0449 CD 66 04 CALL DIVIDE ;RND(N)=MOD(M,N)+1
044C C1 POP B
044D D1 POP D
044E 23 INX H
044F C9 RET
0450 ;
0450 CD 1A 04 ABS: CALL PARN ;*** ABS(EXPR) ***
0453 1B DCX D
0454 CD 83 04 CALL CHKSGN ;CHECK SIGN
0457 13 INX D
0458 C9 RET
0459 ;
0459 2A 15 10 SIZE: LHLD TXTUNF ;*** SIZE ***
045C D5 PUSH D ;GET THE NUMBER OF FREE
045D EB XCHG ;BYTES BETWEEN 'TXTUNF'
045E 21 66 13 LXI H,VARBGN ;AND 'VARBGN'
0461 CD 7C 04 CALL SUBDE
0464 D1 POP D
0465 C9 RET
0466 ;
0466 ;*************************************************************
0466 ;
0466 ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
0466 ;
0466 ; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
0466 ;
0466 ; 'SUBDE' SUBSTRACTS DE FROM HL
0466 ;
0466 ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
0466 ; SIGN AND FLIP SIGN OF B.
0466 ;
0466 ; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
0466 ;
0466 ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
0466 ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
0466 ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
0466 ;
0466 E5 DIVIDE: PUSH H ;*** DIVIDE ***
0467 6C MOV L,H ;DIVIDE H BY DE
0468 26 00 MVI H,0
046A CD 71 04 CALL DV1
046D 41 MOV B,C ;SAVE RESULT IN B
046E 7D MOV A,L ;(REMINDER+L)/DE
046F E1 POP H
0470 67 MOV H,A
0471 0E FF DV1: MVI C,0FFH ;RESULT IN C
0473 0C DV2: INR C ;DUMB ROUTINE
0474 CD 7C 04 CALL SUBDE ;DIVIDE BY SUBTRACT
0477 D2 73 04 JNC DV2 ;AND COUNT
047A 19 DAD D
047B C9 RET
047C ;
047C 7D SUBDE: MOV A,L ;*** SUBDE ***
047D 93 SUB E ;SUBSTRACT DE FROM
047E 6F MOV L,A ;HL
047F 7C MOV A,H
0480 9A SBB D
0481 67 MOV H,A
0482 C9 RET
0483 ;
0483 7C CHKSGN: MOV A,H ;*** CHKSGN ***
0484 B7 ORA A ;CHECK SIGN OF HL
0485 F0 RP ;IF -, CHANGE SIGN
0486 ;
0486 7C CHGSGN: MOV A,H ;*** CHGSGN ***
0487 F5 PUSH PSW
0488 2F CMA ;CHANGE SIGN OF HL
0489 67 MOV H,A
048A 7D MOV A,L
048B 2F CMA
048C 6F MOV L,A
048D 23 INX H
048E F1 POP PSW
048F AC XRA H
0490 F2 9F 00 JP QHOW
0493 78 MOV A,B ;AND ALSO FLIP B
0494 EE 80 XRI 80H
0496 47 MOV B,A
0497 C9 RET
0498 ;
0498 7C CKHLDE: MOV A,H
0499 AA XRA D ;SAME SIGN?
049A F2 9E 04 JP CK1 ;YES, COMPARE
049D EB XCHG ;NO, XCH AND COMP
049E E7 CK1: RST 4
049F C9 RET
04A0 ;
04A0 ;*************************************************************
04A0 ;
04A0 ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
04A0 ;
04A0 ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
04A0 ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
04A0 ; TO THAT VALUE.
04A0 ;
04A0 ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH "§",
04A0 ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
04A0 ; NEXT LINE AND CONTINUE FROM THERE.
04A0 ;
04A0 ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
04A0 ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
04A0 ;
04A0 ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
04A0 ; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
04A0 ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
04A0 ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
04A0 ; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
04A0 ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
04A0 ; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
04A0 ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
04A0 ; NOT TERMINATED BUT CONTINUED AT 'INPERR'.
04A0 ;
04A0 ; RELATED TO 'ERROR' ARE THE FOLLOWING:
04A0 ; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
04A0 ; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
04A0 ; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
04A0 ; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
04A0 ;
04A0 FF SETVAL: RST 7 ;*** SETVAL ***
04A1 DA C6 04 JC QWHAT ;"WHAT?" NO VARIABLE
04A4 E5 PUSH H ;SAVE ADDRESS OF VAR.
04A5 CF RST 1 ;PASS "=" SIGN
04A6 3D DB '='
04A7 08 DB SV1-$-1
04A8 DF RST 3 ;EVALUATE EXPR.
04A9 44 MOV B,H ;VALUE IS IN BC NOW
04AA 4D MOV C,L
04AB E1 POP H ;GET ADDRESS
04AC 71 MOV M,C ;SAVE VALUE
04AD 23 INX H
04AE 70 MOV M,B
04AF C9 RET
04B0 C3 C6 04 SV1: JMP QWHAT ;NO "=" SIGN
04B3 ;
04B3 CF FIN: RST 1 ;*** FIN ***
04B4 3B DB 3BH
04B5 04 DB FI1-$-1
04B6 F1 POP PSW ;";", PURGE RET. ADDR.
04B7 C3 57 01 JMP RUNSML ;CONTINUE SAME LINE
04BA CF FI1: RST 1 ;NOT ";", IS IT CR?
04BB 0D DB CR
04BC 04 DB FI2-$-1
04BD F1 POP PSW ;YES, PURGE RET. ADDR.
04BE C3 47 01 JMP RUNNXL ;RUN NEXT LINE
04C1 C9 FI2: RET ;ELSE RETURN TO CALLER
04C2 ;
04C2 EF ENDCHK: RST 5 ;*** ENDCHK ***
04C3 FE 0D CPI CR ;END WITH CR?
04C5 C8 RZ ;OK, ELSE SAY: "WHAT?"
04C6 ;
04C6 D5 QWHAT: PUSH D ;*** QWHAT ***
04C7 11 AE 00 AWHAT: LXI D,WHAT ;*** AWHAT ***
04CA 97 ERROR: SUB A ;*** ERROR ***
04CB CD 60 05 CALL PRTSTG ;PRINT 'WHAT?', 'HOW?'
04CE D1 POP D ;OR 'SORRY'
04CF 1A LDAX D ;SAVE THE CHARACTER
04D0 F5 PUSH PSW ;AT WHERE OLD DE ->
04D1 97 SUB A ;AND PUT A 0 THERE
04D2 12 STAX D
04D3 2A 01 10 LHLD CURRNT ;GET CURRENT LINE #
04D6 E5 PUSH H
04D7 7E MOV A,M ;CHECK THE VALUE
04D8 23 INX H
04D9 B6 ORA M
04DA D1 POP D
04DB CA BA 00 JZ RSTART ;IF ZERO, JUST RESTART
04DE 7E MOV A,M ;IF NEGATIVE,
04DF B7 ORA A
04E0 FA C3 02 JM INPERR ;REDO INPUT
04E3 CD D2 05 CALL PRTLN ;ELSE PRINT THE LINE
04E6 1B DCX D ;UPTO WHERE THE 0 IS
04E7 F1 POP PSW ;RESTORE THE CHARACTER
04E8 12 STAX D
04E9 3E 3F MVI A,3FH ;PRINT A "?"
04EB D7 RST 2
04EC 97 SUB A ;AND THE REST OF THE
04ED CD 60 05 CALL PRTSTG ;LINE
04F0 C3 BA 00 JMP RSTART ;THEN RESTART
04F3 ;
04F3 D5 QSORRY: PUSH D ;*** QSORRY ***
04F4 11 B4 00 ASORRY: LXI D,SORRY ;*** ASORRY ***
04F7 C3 CA 04 JMP ERROR
04FA ;
04FA ;*************************************************************
04FA ;
04FA ; *** GETLN *** FNDLN (& FRIENDS) ***
04FA ;
04FA ; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
04FA ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
04FA ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
04FA ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
04FA ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
04FA ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
04FA ; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
04FA ;
04FA ; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
04FA ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
04FA ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
04FA ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
04FA ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
04FA ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
04FA ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
04FA ; LINE, FLAGS ARE C & NZ.
04FA ; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
04FA ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
04FA ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
04FA ; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
04FA ; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
04FA ; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
04FA ;
04FA D7 GETLN: RST 2 ;*** GETLN ***
04FB 11 9D 13 LXI D,BUFFER ;PROMPT AND INIT.
04FE CD 84 06 GL1: CALL CHKIO ;CHECK KEYBOARD
0501 CA FE 04 JZ GL1 ;NO INPUT, WAIT
0504 FE 7F CPI 7FH ;DELETE LAST CHARACTER?
0506 CA 23 05 JZ GL3 ;YES
0509 D7 RST 2 ;INPUT, ECHO BACK
050A FE 0A CPI 0AH ;IGNORE LF
050C CA FE 04 JZ GL1
050F B7 ORA A ;IGNORE NULL
0510 CA FE 04 JZ GL1
0513 FE 7D CPI 7DH ;DELETE THE WHOLE LINE?
0515 CA 30 05 JZ GL4 ;YES
0518 12 STAX D ;ELSE SAVE INPUT
0519 13 INX D ;AND BUMP POINTER
051A FE 0D CPI 0DH ;WAS IT CR?
051C C8 RZ ;YES, END OF LINE
051D 7B MOV A,E ;ELSE MORE FREE ROOM?
051E FE DD CPI <BUFEND
0520 C2 FE 04 JNZ GL1 ;YES, GET NEXT INPUT
0523 7B GL3: MOV A,E ;DELETE LAST CHARACTER
0524 FE 9D CPI <BUFFER ;BUT DO WE HAVE ANY?
0526 CA 30 05 JZ GL4 ;NO, REDO WHOLE LINE
0529 1B DCX D ;YES, BACKUP POINTER
052A 3E 5C MVI A,5CH ;AND ECHO A BACK-SLASH
052C D7 RST 2
052D C3 FE 04 JMP GL1 ;GO GET NEXT INPUT
0530 CD 0E 00 GL4: CALL CRLF ;REDO ENTIRE LINE
0533 3E 5E MVI A,05EH ;CR, LF AND UP-ARROW
0535 C3 FA 04 JMP GETLN
0538 ;
0538 7C FNDLN: MOV A,H ;*** FNDLN ***
0539 B7 ORA A ;CHECK SIGN OF HL
053A FA 9F 00 JM QHOW ;IT CANNOT BE -
053D 11 17 10 LXI D,TXTBGN ;INIT TEXT POINTER
0540 ;
0540 FNDLP: ;*** FDLNP ***
0540 E5 FL1: PUSH H ;SAVE LINE #
0541 2A 15 10 LHLD TXTUNF ;CHECK IF WE PASSED END
0544 2B DCX H
0545 E7 RST 4
0546 E1 POP H ;GET LINE # BACK
0547 D8 RC ;C,NZ PASSED END
0548 1A LDAX D ;WE DID NOT, GET BYTE 1
0549 95 SUB L ;IS THIS THE LINE?
054A 47 MOV B,A ;COMPARE LOW ORDER
054B 13 INX D
054C 1A LDAX D ;GET BYTE 2
054D 9C SBB H ;COMPARE HIGH ORDER
054E DA 55 05 JC FL2 ;NO, NOT THERE YET
0551 1B DCX D ;ELSE WE EITHER FOUND
0552 B0 ORA B ;IT, OR IT IS NOT THERE
0553 C9 RET ;NC,Z:FOUND, NC,NZ:NO
0554 ;
0554 FNDNXT: ;*** FNDNXT ***
0554 13 INX D ;FIND NEXT LINE
0555 13 FL2: INX D ;JUST PASSED BYTE 1 & 2
0556 ;
0556 1A FNDSKP: LDAX D ;*** FNDSKP ***
0557 FE 0D CPI CR ;TRY TO FIND CR
0559 C2 55 05 JNZ FL2 ;KEEP LOOKING
055C 13 INX D ;FOUND CR, SKIP OVER
055D C3 40 05 JMP FL1 ;CHECK IF END OF TEXT
0560 ;
0560 ;*************************************************************
0560 ;
0560 ; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
0560 ;
0560 ; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
0560 ; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
0560 ; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
0560 ; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
0560 ;
0560 ; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
0560 ; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
0560 ; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
0560 ; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
0560 ; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
0560 ; OVER (USUALLY A JUMP INSTRUCTION.
0560 ;
0560 ; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
0560 ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
0560 ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
0560 ; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
0560 ; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
0560 ;
0560 ; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
0560 ;
0560 47 PRTSTG: MOV B,A ;*** PRTSTG ***
0561 1A PS1: LDAX D ;GET A CHARACTER
0562 13 INX D ;BUMP POINTER
0563 B8 CMP B ;SAME AS OLD A?
0564 C8 RZ ;YES, RETURN
0565 D7 RST 2 ;ELSE PRINT IT
0566 FE 0D CPI CR ;WAS IT A CR?
0568 C2 61 05 JNZ PS1 ;NO, NEXT
056B C9 RET ;YES, RETURN
056C ;
056C CF QTSTG: RST 1 ;*** QTSTG ***
056D 22 DB '"'
056E 0F DB QT3-$-1
056F 3E 22 MVI A,22H ;IT IS A "
0571 CD 60 05 QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER
0574 FE 0D CPI CR ;WAS LAST ONE A CR?
0576 E1 POP H ;RETURN ADDRESS
0577 CA 47 01 JZ RUNNXL ;WAS CR, RUN NEXT LINE
057A 23 QT2: INX H ;SKIP 3 BYTES ON RETURN
057B 23 INX H
057C 23 INX H
057D E9 PCHL ;RETURN
057E CF QT3: RST 1 ;IS IT A '?
057F 27 DB 27H
0580 05 DB QT4-$-1
0581 3E 27 MVI A,27H ;YES, DO THE SAME
0583 C3 71 05 JMP QT1 ;AS IN "
0586 CF QT4: RST 1 ;IS IT BACK-ARROW?
0587 5F DB 5FH
0588 08 DB QT5-$-1
0589 3E 8D MVI A,08DH ;YES, CR WITHOUT LF
058B D7 RST 2 ;DO IT TWICE TO GIVE
058C D7 RST 2 ;TTY ENOUGH TIME
058D E1 POP H ;RETURN ADDRESS
058E C3 7A 05 JMP QT2
0591 C9 QT5: RET ;NONE OF ABOVE
0592 ;
0592 06 00 PRTNUM: MVI B,0 ;*** PRTNUM ***
0594 CD 83 04 CALL CHKSGN ;CHECK SIGN
0597 F2 9D 05 JP PN1 ;NO SIGN
059A 06 2D MVI B,'-' ;B=SIGN
059C 0D DCR C ;'-' TAKES SPACE
059D D5 PN1: PUSH D ;SAVE
059E 11 0A 00 LXI D,0AH ;DECIMAL
05A1 D5 PUSH D ;SAVE AS A FLAG
05A2 0D DCR C ;C=SPACES
05A3 C5 PUSH B ;SAVE SIGN & SPACE
05A4 CD 66 04 PN2: CALL DIVIDE ;DIVIDE HL BY 10
05A7 78 MOV A,B ;RESULT 0?
05A8 B1 ORA C
05A9 CA B4 05 JZ PN3 ;YES, WE GOT ALL
05AC E3 XTHL ;NO, SAVE REMAINDER
05AD 2D DCR L ;AND COUNT SPACE
05AE E5 PUSH H ;HL IS OLD BC
05AF 60 MOV H,B ;MOVE RESULT TO BC
05B0 69 MOV L,C
05B1 C3 A4 05 JMP PN2 ;AND DIVIDE BY 10
05B4 C1 PN3: POP B ;WE GOT ALL DIGITS IN
05B5 0D PN4: DCR C ;THE STACK
05B6 79 MOV A,C ;LOOK AT SPACE COUNT
05B7 B7 ORA A
05B8 FA C1 05 JM PN5 ;NO LEADING BLANKS
05BB 3E 20 MVI A,20H ;LEADING BLANKS
05BD D7 RST 2
05BE C3 B5 05 JMP PN4 ;MORE?
05C1 78 PN5: MOV A,B ;PRINT SIGN
05C2 B7 ORA A
05C3 C4 10 00 CNZ 10H
05C6 5D MOV E,L ;LAST REMAINDER IN E
05C7 7B PN6: MOV A,E ;CHECK DIGIT IN E
05C8 FE 0A CPI 0AH ;10 IS FLAG FOR NO MORE
05CA D1 POP D
05CB C8 RZ ;IF SO, RETURN
05CC C6 30 ADI 30H ;ELSE CONVERT TO ASCII
05CE D7 RST 2 ;AND PRINT THE DIGIT
05CF C3 C7 05 JMP PN6 ;GO BACK FOR MORE
05D2 ;
05D2 1A PRTLN: LDAX D ;*** PRTLN ***
05D3 6F MOV L,A ;LOW ORDER LINE #
05D4 13 INX D
05D5 1A LDAX D ;HIGH ORDER
05D6 67 MOV H,A
05D7 13 INX D
05D8 0E 04 MVI C,4H ;PRINT 4 DIGIT LINE #
05DA CD 92 05 CALL PRTNUM
05DD 3E 20 MVI A,20H ;FOLLOWED BY A BLANK
05DF D7 RST 2
05E0 97 SUB A ;AND THEN THE NEXT
05E1 CD 60 05 CALL PRTSTG
05E4 C9 RET
05E5 ;
05E5 ;*************************************************************
05E5 ;
05E5 ; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
05E5 ;
05E5 ; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
05E5 ; DE = HL
05E5 ;
05E5 ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
05E5 ; UNTIL DE = BC
05E5 ;
05E5 ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
05E5 ; STACK
05E5 ;
05E5 ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
05E5 ; STACK
05E5 ;
05E5 E7 MVUP: RST 4 ;*** MVUP ***
05E6 C8 RZ ;DE = HL, RETURN
05E7 1A LDAX D ;GET ONE BYTE
05E8 02 STAX B ;MOVE IT
05E9 13 INX D ;INCREASE BOTH POINTERS
05EA 03 INX B
05EB C3 E5 05 JMP MVUP ;UNTIL DONE
05EE ;
05EE 78 MVDOWN: MOV A,B ;*** MVDOWN ***
05EF 92 SUB D ;TEST IF DE = BC
05F0 C2 F6 05 JNZ MD1 ;NO, GO MOVE
05F3 79 MOV A,C ;MAYBE, OTHER BYTE?
05F4 93 SUB E
05F5 C8 RZ ;YES, RETURN
05F6 1B MD1: DCX D ;ELSE MOVE A BYTE
05F7 2B DCX H ;BUT FIRST DECREASE
05F8 1A LDAX D ;BOTH POINTERS AND
05F9 77 MOV M,A ;THEN DO IT
05FA C3 EE 05 JMP MVDOWN ;LOOP BACK
05FD ;
05FD C1 POPA: POP B ;BC = RETURN ADDR.
05FE E1 POP H ;RESTORE LOPVAR, BUT
05FF 22 09 10 SHLD LOPVAR ;=0 MEANS NO MORE
0602 7C MOV A,H
0603 B5 ORA L
0604 CA 17 06 JZ PP1 ;YEP, GO RETURN
0607 E1 POP H ;NOP, RESTORE OTHERS
0608 22 0B 10 SHLD LOPINC
060B E1 POP H
060C 22 0D 10 SHLD LOPLMT
060F E1 POP H
0610 22 0F 10 SHLD LOPLN
0613 E1 POP H
0614 22 11 10 SHLD LOPPT
0617 C5 PP1: PUSH B ;BC = RETURN ADDR.
0618 C9 RET
0619 ;
0619 21 DE 13 PUSHA: LXI H,STKLMT ;*** PUSHA ***
061C CD 86 04 CALL CHGSGN
061F C1 POP B ;BC=RETURN ADDRESS
0620 39 DAD SP ;IS STACK NEAR THE TOP?
0621 D2 F3 04 JNC QSORRY ;YES, SORRY FOR THAT
0624 2A 09 10 LHLD LOPVAR ;ELSE SAVE LOOP VAR'S
0627 7C MOV A,H ;BUT IF LOPVAR IS 0
0628 B5 ORA L ;THAT WILL BE ALL
0629 CA 3F 06 JZ PU1
062C 2A 11 10 LHLD LOPPT ;ELSE, MORE TO SAVE
062F E5 PUSH H
0630 2A 0F 10 LHLD LOPLN
0633 E5 PUSH H
0634 2A 0D 10 LHLD LOPLMT
0637 E5 PUSH H
0638 2A 0B 10 LHLD LOPINC
063B E5 PUSH H
063C 2A 09 10 LHLD LOPVAR
063F E5 PU1: PUSH H
0640 C5 PUSH B ;BC = RETURN ADDR.
0641 C9 RET
0642 ;
0642 ;*************************************************************
0642 ;
0642 ; *** OUTC *** & CHKIO ***
0642 ;
0642 ; THESE ARE THE ONLY I/O ROUTINES IN TBI.
0642 ; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0
0642 ; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0,
0642 ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO
0642 ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG.
0642 ; ARE RESTORED.
0642 ;
0642 ; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO
0642 ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG
0642 ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE
0642 ; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
0642 ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL
0642 ; RESTART TBI AND DO NOT RETURN TO THE CALLER.
0642 ;
0642 ;OUTC: PUSH PSW ;THIS IS AT LOC. 10
0642 ; LDA OCSW ;CHECK SOFTWARE SWITCH
0642 ; ORA A
0642 32 00 10 INIT: STA OCSW
0645 3E 03 MVI A,3 ;RESET ACIA
0647 D3 10 OUT 16
0649 3E 15 MVI A,15H ;15H FOR 8N1, 11H FOR 8N2
064B D3 10 OUT 16
064D 16 19 MVI D,19H
064F PATLOP:
064F CD 0E 00 CALL CRLF
0652 15 DCR D
0653 C2 4F 06 JNZ PATLOP
0656 97 SUB A
0657 11 A3 06 LXI D,MSG1
065A CD 60 05 CALL PRTSTG
065D 21 00 00 LXI H,START
0660 22 13 10 SHLD RANPNT
0663 21 17 10 LXI H,TXTBGN
0666 22 15 10 SHLD TXTUNF
0669 C3 BA 00 JMP RSTART
066C C2 71 06 OC2: JNZ OC3 ;IT IS ON
066F F1 POP PSW ;IT IS OFF
0670 C9 RET ;RESTORE AF AND RETURN
0671 DB 00 OC3: IN 0 ;COME HERE TO DO OUTPUT
0673 E6 02 ANI 2H ;STATUS BIT
0675 CA 71 06 JZ OC3 ;NOT READY, WAIT
0678 F1 POP PSW ;READY, GET OLD A BACK
0679 D3 01 OUT 1 ;AND SEND IT OUT
067B FE 0D CPI CR ;WAS IT CR?
067D C0 RNZ ;NO, FINISHED
067E 3E 0A MVI A,LF ;YES, WE SEND LF TOO
0680 D7 RST 2 ;THIS IS RECURSIVE
0681 3E 0D MVI A,CR ;GET CR BACK IN A
0683 C9 RET
0684 ;
0684 DB 00 CHKIO: IN 0 ;*** CHKIO ***
0686 00 NOP ;STATUS BIT FLIPPED?
0687 E6 20 ANI 20H ;MASK STATUS BIT
0689 C8 RZ ;NOT READY, RETURN "Z"
068A DB 01 IN 1 ;READY, READ DATA
068C E6 7F ANI 7FH ;MASK BIT 7 OFF
068E FE 0F CPI 0FH ;IS IT CONTROL-O?
0690 C2 9D 06 JNZ CI1 ;NO, MORE CHECKING
0693 3A 00 10 LDA OCSW ;CONTROL-O FLIPS OCSW
0696 2F CMA ;ON TO OFF, OFF TO ON
0697 32 00 10 STA OCSW
069A C3 84 06 JMP CHKIO ;GET ANOTHER INPUT
069D FE 03 CI1: CPI 3H ;IS IT CONTROL-C?
069F C0 RNZ ;NO, RETURN "NZ"
06A0 C3 BA 00 JMP RSTART ;YES, RESTART TBI
06A3 ;
06A3 54 49 4E 59 20 MSG1: DB 'TINY '
06A8 42 41 53 49 43 DB 'BASIC'
06AD 0D DB CR
06AE ;
06AE ;*************************************************************
06AE ;
06AE ; *** TABLES *** DIRECT *** & EXEC ***
06AE ;
06AE ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
06AE ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
06AE ; OF CODE ACCORDING TO THE TABLE.
06AE ;
06AE ; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
06AE ; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
06AE ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
06AE ; ALL DIRECT AND STATEMENT COMMANDS.
06AE ;
06AE ; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
06AE ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
06AE ; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
06AE ;
06AE ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
06AE ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
06AE ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
06AE ; BYTE SET TO 1.
06AE ;
06AE ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
06AE ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
06AE ; MATCH THIS NULL ITEM AS DEFAULT.
06AE ;
06AE TAB1: ;DIRECT COMMANDS
06AE 4C 49 53 54 DB 'LIST'
**MACRO UNROLL - DWA
06B2 81 DB >LIST + 128
06B3 6F DB <LIST
06B4 52 55 4E DB 'RUN'
**MACRO UNROLL - DWA
06B7 81 DB >RUN + 128
06B8 41 DB <RUN
06B9 4E 45 57 DB 'NEW'
**MACRO UNROLL - DWA
06BC 81 DB >NEW + 128
06BD 32 DB <NEW
06BE ;
06BE TAB2: ;DIRECT/STATEMENT
06BE 4E 45 58 54 DB 'NEXT'
**MACRO UNROLL - DWA
06C2 82 DB >NEXT + 128
06C3 57 DB <NEXT
06C4 4C 45 54 DB 'LET'
**MACRO UNROLL - DWA
06C7 83 DB >LET + 128
06C8 23 DB <LET
06C9 49 46 DB 'IF'
**MACRO UNROLL - DWA
06CB 82 DB >IFF + 128
06CC B4 DB <IFF
06CD 47 4F 54 4F DB 'GOTO'
**MACRO UNROLL - DWA
06D1 81 DB >GOTO + 128
06D2 60 DB <GOTO
06D3 47 4F 53 55 42 DB 'GOSUB'
**MACRO UNROLL - DWA
06D8 81 DB >GOSUB + 128
06D9 BF DB <GOSUB
06DA 52 45 54 55 52 4E DB 'RETURN'
**MACRO UNROLL - DWA
06E0 81 DB >RETURN + 128
06E1 DF DB <RETURN
06E2 52 45 4D DB 'REM'
**MACRO UNROLL - DWA
06E5 82 DB >REM + 128
06E6 B0 DB <REM
06E7 46 4F 52 DB 'FOR'
**MACRO UNROLL - DWA
06EA 81 DB >FOR + 128
06EB F8 DB <FOR
06EC 49 4E 50 55 54 DB 'INPUT'
**MACRO UNROLL - DWA
06F1 82 DB >INPUT + 128
06F2 CD DB <INPUT
06F3 50 52 49 4E 54 DB 'PRINT'
**MACRO UNROLL - DWA
06F8 81 DB >PRINT + 128
06F9 87 DB <PRINT
06FA 53 54 4F 50 DB 'STOP'
**MACRO UNROLL - DWA
06FE 81 DB >STOP + 128
06FF 3B DB <STOP
**MACRO UNROLL - DWA
0700 83 DB >DEFLT + 128
0701 1D DB <DEFLT
0702 ;
0702 TAB4: ;FUNCTIONS
0702 52 4E 44 DB 'RND'
**MACRO UNROLL - DWA
0705 84 DB >RND + 128
0706 25 DB <RND
0707 41 42 53 DB 'ABS'
**MACRO UNROLL - DWA
070A 84 DB >ABS + 128
070B 50 DB <ABS
070C 53 49 5A 45 DB 'SIZE'
**MACRO UNROLL - DWA
0710 84 DB >SIZE + 128
0711 59 DB <SIZE
**MACRO UNROLL - DWA
0712 84 DB >XP40 + 128
0713 0B DB <XP40
0714 ;
0714 TAB5: ;"TO" IN "FOR"
0714 54 4F DB 'TO'
**MACRO UNROLL - DWA
0716 82 DB >FR1 + 128
0717 08 DB <FR1
**MACRO UNROLL - DWA
0718 84 DB >QWHAT + 128
0719 C6 DB <QWHAT
071A ;
071A TAB6: ;"STEP" IN "FOR"
071A 53 54 45 50 DB 'STEP'
**MACRO UNROLL - DWA
071E 82 DB >FR2 + 128
071F 12 DB <FR2
**MACRO UNROLL - DWA
0720 82 DB >FR3 + 128
0721 16 DB <FR3
0722 ;
0722 TAB8: ;RELATION OPERATORS
0722 3E 3D DB '>='
**MACRO UNROLL - DWA
0724 83 DB >XP11 + 128
0725 33 DB <XP11
0726 23 DB '#'
**MACRO UNROLL - DWA
0727 83 DB >XP12 + 128
0728 39 DB <XP12
0729 3E DB '>'
**MACRO UNROLL - DWA
072A 83 DB >XP13 + 128
072B 3F DB <XP13
072C 3D DB '='
**MACRO UNROLL - DWA
072D 83 DB >XP15 + 128
072E 4E DB <XP15
072F 3C 3D DB '<='
**MACRO UNROLL - DWA
0731 83 DB >XP14 + 128
0732 46 DB <XP14
0733 3C DB '<'
**MACRO UNROLL - DWA
0734 83 DB >XP16 + 128
0735 54 DB <XP16
**MACRO UNROLL - DWA
0736 83 DB >XP17 + 128
0737 5A DB <XP17
0738 ;
0738 21 AD 06 DIRECT: LXI H,TAB1-1 ;*** DIRECT ***
073B ;
073B EXEC: ;*** EXEC ***
073B EF EX0: RST 5 ;IGNORE LEADING BLANKS
073C D5 PUSH D ;SAVE POINTER
073D 1A EX1: LDAX D ;IF FOUND '.' IN STRING
073E 13 INX D ;BEFORE ANY MISMATCH
073F FE 2E CPI 2EH ;WE DECLARE A MATCH
0741 CA 5A 07 JZ EX3
0744 23 INX H ;HL->TABLE
0745 BE CMP M ;IF MATCH, TEST NEXT
0746 CA 3D 07 JZ EX1
0749 3E 7F MVI A,07FH ;ELSE SEE IF BIT 7
074B 1B DCX D ;OF TABLE IS SET, WHICH
074C BE CMP M ;IS THE JUMP ADDR. (HI)
074D DA 61 07 JC EX5 ;C:YES, MATCHED
0750 23 EX2: INX H ;NC:NO, FIND JUMP ADDR.
0751 BE CMP M
0752 D2 50 07 JNC EX2
0755 23 INX H ;BUMP TO NEXT TAB. ITEM
0756 D1 POP D ;RESTORE STRING POINTER
0757 C3 3B 07 JMP EX0 ;TEST AGAINST NEXT ITEM
075A 3E 7F EX3: MVI A,07FH ;PARTIAL MATCH, FIND
075C 23 EX4: INX H ;JUMP ADDR., WHICH IS
075D BE CMP M ;FLAGGED BY BIT 7
075E D2 5C 07 JNC EX4
0761 7E EX5: MOV A,M ;LOAD HL WITH THE JUMP
0762 23 INX H ;ADDRESS FROM THE TABLE
0763 6E MOV L,M
0764 E6 7F ANI 7FH ;MASK OFF BIT 7
0766 67 MOV H,A
0767 F1 POP PSW ;CLEAN UP THE GABAGE
0768 E9 PCHL ;AND WE GO DO IT
0769 ;
0769 LSTROM: ;ALL ABOVE CAN BE ROM
1000 .ORG 1000H ;HERE DOWN MUST BE RAM
1000 ; ORG 0800H
1000 OCSW: DS 1 ;SWITCH FOR OUTPUT
1001 CURRNT: DS 2 ;POINTS TO CURRENT LINE
1003 STKGOS: DS 2 ;SAVES SP IN 'GOSUB'
1005 VARNXT: DS 2 ;TEMP STORAGE
1007 STKINP: DS 2 ;SAVES SP IN 'INPUT'
1009 LOPVAR: DS 2 ;'FOR' LOOP SAVE AREA
100B LOPINC: DS 2 ;INCREMENT
100D LOPLMT: DS 2 ;LIMIT
100F LOPLN: DS 2 ;LINE NUMBER
1011 LOPPT: DS 2 ;TEXT POINTER
1013 RANPNT: DS 2 ;RANDOM NUMBER POINTER
1015 TXTUNF: DS 2 ;->UNFILLED TEXT AREA
1017 TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS
1366 .ORG 1366H
1366 ; ORG 1F00H
1366 TXTEND: DS 0 ;TEXT SAVE AREA ENDS
1366 VARBGN: DS 55 ;VARIABLE @(0)
139D BUFFER: DS 64 ;INPUT BUFFER
13DD BUFEND: DS 1 ;BUFFER ENDS
13DE STKLMT: DS 1 ;TOP LIMIT FOR STACK
1400 .ORG 1400H
1400 ; ORG 2000H
1400 STACK: DS 0 ;STACK STARTS HERE
1400 ;
1400 CR: EQU 0DH
1400 LF: EQU 0AH
1400 END
_PC 1400
START 0000
CRLF 000E
SS1 0028
TV1 0058
TC1 0068
TC2 0073
TSTNUM 0077
TN1 007C
QHOW 009F
AHOW 00A0
HOW 00A6
OK 00AB
WHAT 00AE
SORRY 00B4
RSTART 00BA
ST1 00BD
ST2 00CD
ST3 00D6
ST4 010B
NEW 0132
STOP 013B
RUN 0141
RUNNXL 0147
RUNTSL 0150
RUNSML 0157
GOTO 0160
LIST 016F
LS1 0178
PRINT 0187
PR2 0192
PR0 019B
PR1 01A3
PR3 01A9
PR6 01B2
PR8 01B6
GOSUB 01BF
RETURN 01DF
FOR 01F8
FR1 0208
FR2 0212
FR3 0216
FR4 0219
FR5 021C
FR7 0231
FR8 0252
NEXT 0257
NX0 025E
NX3 0276
NX4 0288
NX1 0298
NX5 02AA
NX2 02AC
REM 02B0
IFF 02B4
INPERR 02C3
INPUT 02CD
IP1 02CD
IP2 02DB
IP3 02EB
IP4 0315
IP5 031C
DEFLT 031D
LET 0323
LT1 032C
EXPR1 032D
XP11 0333
XP12 0339
XP13 033F
XP14 0346
XP15 034E
XP16 0354
XP17 035A
XP18 035C
EXPR2 0371
XP21 037A
XP22 037D
XP23 0380
XP24 0387
XP25 0398
XP26 039B
EXPR3 03A5
XP31 03A8
XP32 03C5
XP33 03CD
XP34 03D8
XP35 03F7
EXPR4 0405
XP40 040B
XP41 0414
PARN 041A
XP42 0421
XP43 0422
RND 0425
RA1 0440
ABS 0450
SIZE 0459
DIVIDE 0466
DV1 0471
DV2 0473
SUBDE 047C
CHKSGN 0483
CHGSGN 0486
CKHLDE 0498
CK1 049E
SETVAL 04A0
SV1 04B0
FIN 04B3
FI1 04BA
FI2 04C1
ENDCHK 04C2
QWHAT 04C6
AWHAT 04C7
ERROR 04CA
QSORRY 04F3
ASORRY 04F4
GETLN 04FA
GL1 04FE
GL3 0523
GL4 0530
FNDLN 0538
FNDLP 0540
FL1 0540
FNDNXT 0554
FL2 0555
FNDSKP 0556
PRTSTG 0560
PS1 0561
QTSTG 056C
QT1 0571
QT2 057A
QT3 057E
QT4 0586
QT5 0591
PRTNUM 0592
PN1 059D
PN2 05A4
PN3 05B4
PN4 05B5
PN5 05C1
PN6 05C7
PRTLN 05D2
MVUP 05E5
MVDOWN 05EE
MD1 05F6
POPA 05FD
PP1 0617
PUSHA 0619
PU1 063F
INIT 0642
PATLOP 064F
OC2 066C
OC3 0671
CHKIO 0684
CI1 069D
MSG1 06A3
TAB1 06AE
TAB2 06BE
TAB4 0702
TAB5 0714
TAB6 071A
TAB8 0722
DIRECT 0738
EXEC 073B
EX0 073B
EX1 073D
EX2 0750
EX3 075A
EX4 075C
EX5 0761
LSTROM 0769
OCSW 1000
CURRNT 1001
STKGOS 1003
VARNXT 1005
STKINP 1007
LOPVAR 1009
LOPINC 100B
LOPLMT 100D
LOPLN 100F
LOPPT 1011
RANPNT 1013
TXTUNF 1015
TXTBGN 1017
TXTEND 1366
VARBGN 1366
BUFFER 139D
BUFEND 13DD
STKLMT 13DE
STACK 1400
CR 000D
LF 000A
;*************************************************************
;*
;* TINY BASIC FOR INTEL 8080
;* VERSION 1.0
;* BY LI-CHEN WANG
;* 10 JUNE, 1976
;* @COPYLEFT
;* ALL WRONGS RESERVED
;*
;*************************************************************
;*
;* *** ZERO PAGE SUBROUTINES ***
;*
;* THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
;* MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
;* THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
;* THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL
;* USE RST 0 AS START OR RESTART AND RST 1 THROUGH RST 7 FOR
;* THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
;* TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
;* SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
;*
CR EQU 0DH ;ASCII CR
LF EQU 0AH ;ASCII LF
QT EQU 27H ;ASCII SINGLE QUOTE
CNTLO EQU 0FH ;ASCII CONTROL-O
CNTLC EQU 03H ;ASCII CONTROL-C
DLLN EQU 7DH ;DELETE LINE TELETYPE, BUT WE USE
CNTLU EQU 15H ;ASCII CONTROL-U FOR DELETE LINE
BKS EQU 5CH ;ASCII BACK-SLASH
BKA EQU 5FH ;ASCII UNDERLINE (BACK-ARROW)
UPA EQU 5EH ;ASCII UP-ARROW
DEL EQU 7FH ;ASCII DEL
;
; MACRO TO CREATE TABLE ADDRESS ITEMS
;
.MACRO ITEM
DB >%%1 + 0x80
DB <%%1
.ENDM
;
ORG 0000H
START: DI ;*** START/RESTART ***
LXI SP,STACK ;INITIALIZE THE STACK
JMP ST1 ;GO TO THE MAIN SECTION
DB 'L'
;
XTHL ;*** TSTC OR RST 1 ***
RST 5 ;IGNORE BLANKS AND
CMP M ;TEST CHARACTER
JMP TC1 ;REST OF THIS IS AT TC1
;
CRLF: MVI A,CR ;*** CRLF ***
;
PUSH PSW ;*** OUTC OR RST 2 ***
LDA OCSW ;PRINT CHARACTER ONLY
ORA A ;IF OCSW SWITCH IS ON
JMP OC2 ;REST OF THIS IS AT OC2
;
CALL EXPR2 ;*** EXPR OR RST 3 ***
PUSH H ;EVALUATE AN EXPRESSION
JMP EXPR1 ;REST OF IT AT EXPR1
DB 'W'
;
MOV A,H ;*** COMP OR RST 4 ***
CMP D ;COMPARE HL WITH DE
RNZ ;RETURN CORRECT C AND
MOV A,L ;Z FLAGS
CMP E ;BUT OLD A IS LOST
RET
DB 'AN'
;
SS1: LDAX D ;*** IGNBLK/RST 5 ***
CPI ' ' ;IGNORE BLANKS
RNZ ;IN TEXT (WHERE DE->)
INX D ;AND RETURN THE FIRST
JMP SS1 ;NON-BLANK CHAR. IN A
;
POP PSW ;*** FINISH/RST 6 ***
CALL FIN ;CHECK END OF COMMAND
JMP QWHAT ;PRINT "WHAT?" IF WRONG
DB 'G'
;
RST 5 ;*** TSTV OR RST 7 ***
SUI '@' ;TEST VARIABLES
RC ;C:NOT A VARIABLE
JNZ TV1 ;NOT "@" ARRAY
INX D ;IT IS THE "@" ARRAY
CALL PARN ;@ SHOULD BE FOLLOWED
DAD H ;BY (EXPR) AS ITS INDEX
JC QHOW ;IS INDEX TOO BIG?
PUSH D ;WILL IT OVERWRITE
XCHG ;TEXT?
CALL SIZE ;FIND SIZE OF FREE
RST 4 ;AND CHECK THAT
JC ASORRY ;IF SO, SAY "SORRY"
LXI H,VARBGN ;IF NOT GET ADDRESS
CALL SUBDE ;OF @(EXPR) AND PUT IT
POP D ;IN HL
RET ;C FLAG IS CLEARED
TV1: CPI 27 ;NOT @, IS IT A TO Z?
CMC ;IF NOT RETURN C FLAG
RC
INX D ;IF A THROUGH Z
LXI H,VARBGN ;COMPUTE ADDRESS OF
RLC ;THAT VARIABLE
ADD L ;AND RETURN IT IN HL
MOV L,A ;WITH C FLAG CLEARED
MVI A,0
ADC H
MOV H,A
RET
;
;TSTC: XTHL ;*** TSTC OR RST 1 ***
; RST 5 ;THIS IS AT LOC. 8
; CMP M ;AND THEN JUMP HERE
TC1: INX H ;COMPARE THE BYTE THAT
JZ TC2 ;FOLLOWS THE RST INST.
PUSH B ;WITH THE TEXT (DE->)
MOV C,M ;IF NOT =, ADD THE 2ND
MVI B,0 ;BYTE THAT FOLLOWS THE
DAD B ;RST TO THE OLD PC
POP B ;I.E., DO A RELATIVE
DCX D ;JUMP IF NOT =
TC2: INX D ;IF =, SKIP THOSE BYTES
INX H ;AND CONTINUE
XTHL
RET
;
TSTNUM: LXI H,0 ;*** TSTNUM ***
MOV B,H ;TEST IF THE TEXT IS
RST 5 ;A NUMBER
TN1: CPI '0' ;IF NOT, RETURN 0 IN
RC ;B AND HL
CPI 3AH ;IF NUMBERS, CONVERT
RNC ;TO BINARY IN HL AND
MVI A,0F0H ;SET B TO # OF DIGITS
ANA H ;IF H>255, THERE IS NO
JNZ QHOW ;ROOM FOR NEXT DIGIT
INR B ;B COUNTS # OF DIGITS
PUSH B
MOV B,H ;HL=10*HL+(NEW DIGIT)
MOV C,L
DAD H ;WHERE 10* IS DONE BY
DAD H ;SHIFT AND ADD
DAD B
DAD H
LDAX D ;AND (DIGIT) IS FROM
INX D ;STRIPPING THE ASCII
ANI 0FH ;CODE
ADD L
MOV L,A
MVI A,0
ADC H
MOV H,A
POP B
LDAX D ;DO THIS DIGIT AFTER
JP TN1 ;DIGIT. S SAYS OVERFLOW
QHOW: PUSH D ;*** ERROR "HOW?" ***
AHOW: LXI D,HOW
JMP ERROR
HOW: DB 'HOW?',CR
OK: DB 'OK',CR
WHAT: DB 'WHAT?',CR
SORRY: DB 'SORRY',CR
;
;*************************************************************
;*
;* *** MAIN ***
;*
;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
;* AND STORES IT IN THE MEMORY.
;*
;* AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
;* STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
;* ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
;* NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
;* IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
;* NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
;* THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
;*
;* AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
;* LOOPS BACK AND ASK FOR ANOTHER LINE. THIS LOOP WILL BE
;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
;*
;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
;* LABELED "TXTBGN" AND ENDED AT "TXTEND". WE ALWAYS FILL THIS
;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
;*
;* THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
;* THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
;* (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
;*
;START: LXI SP,STACK ;THIS IS AT LOC. 0
ST1: CALL CRLF ;AND JUMP TO HERE
LXI D,OK ;DE->STRING
SUB A ;A=0
CALL PRTSTG ;PRINT STRING UNTIL CR
LXI H,ST2+1 ;LITERAL 0
SHLD CURRNT ;CURRENT->LINE # = 0
ST2: LXI H,0
SHLD LOPVAR
SHLD STKGOS
ST3: MVI A,'>' ;PROMPT '>' AND
CALL GETLN ;READ A LINE
PUSH D ;DE->END OF LINE
LXI D,BUFFER ;DE->BEGINNING OF LINE
CALL TSTNUM ;TEST IF IT IS A NUMBER
RST 5
MOV A,H ;HL=VALUE OF THE # OR
ORA L ;0 IF NO # WAS FOUND
POP B ;BC->END OF LINE
JZ DIRECT
DCX D ;BACKUP DE AND SAVE
MOV A,H ;VALUE OF LINE # THERE
STAX D
DCX D
MOV A,L
STAX D
PUSH B ;BC,DE->BEGIN, END
PUSH D
MOV A,C
SUB E
PUSH PSW ;A=# OF BYTES IN LINE
CALL FNDLN ;FIND THIS LINE IN SAVE
PUSH D ;AREA, DE->SAVE AREA
JNZ ST4 ;NZ:NOT FOUND, INSERT
PUSH D ;Z:FOUND, DELETE IT
CALL FNDNXT ;FIND NEXT LINE
;DE->NEXT LINE
POP B ;BC->LINE TO BE DELETED
LHLD TXTUNF ;HL->UNFILLED SAVE AREA
CALL MVUP ;MOVE UP TO DELETE
MOV H,B ;TXTUNF->UNFILLED AREA
MOV L,C
SHLD TXTUNF ;UPDATE
ST4: POP B ;GET READY TO INSERT
LHLD TXTUNF ;BUT FIRST CHECK IF
POP PSW ;THE LENGTH OF NEW LINE
PUSH H ;IS 3 (LINE # AND CR)
CPI 3 ;THEN DO NOT INSERT
JZ START ;MUST CLEAR THE STACK
ADD L ;COMPUTE NEW TXTUNF
MOV L,A
MVI A,0
ADC H
MOV H,A ;HL->NEW UNFILLED AREA
LXI D,TXTEND ;CHECK TO SEE IF THERE
RST 4 ;IS ENOUGH SPACE
JNC QSORRY ;SORRY, NO ROOM FOR IT
SHLD TXTUNF ;OK, UPDATE TXTUNF
POP D ;DE->OLD UNFILLED AREA
CALL MVDOWN
POP D ;DE->BEGIN, HL->END
POP H
CALL MVUP ;MOVE NEW LINE TO SAVE
JMP ST3 ;AREA
;
;*************************************************************
;*
;* *** TABLES *** DIRECT *** & EXEC ***
;*
;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
;* OF CODE ACCORDING TO THE TABLE.
;*
;* AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
;* TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
;* ALL DIRECT AND STATEMENT COMMANDS.
;*
;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
;* MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
;*
;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
;* BYTE SET TO 1.
;*
;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
;* MATCH THIS NULL ITEM AS DEFAULT.
;*
TAB1 EQU $ ;DIRECT COMMANDS
DB 'LIST'
ITEM LIST
DB 'RUN'
ITEM RUN
DB 'NEW'
ITEM NEW
TAB2 EQU $ ;DIRECT/STATEMENT
DB 'NEXT'
ITEM NEXT
DB 'LET'
ITEM LET
DB 'IF'
ITEM IFF
DB 'GOTO'
ITEM GOTO
DB 'GOSUB'
ITEM GOSUB
DB 'RETURN'
ITEM RETURN
DB 'REM'
ITEM REM
DB 'FOR'
ITEM FOR
DB 'INPUT'
ITEM INPUT
DB 'PRINT'
ITEM PRINT
DB 'STOP'
ITEM STOP
ITEM DEFLT
DB 'YOU MAY INSERT MORE COMMANDS.'
TAB4 EQU $ ;FUNCTIONS
DB 'RND'
ITEM RND
DB 'ABS'
ITEM ABS
DB 'SIZE'
ITEM SIZE
ITEM XP40
DB 'YOU MAY INSERT MORE FUNCTIONS'
TAB5 EQU $ ;"TO" IN "FOR"
DB 'TO'
ITEM FR1
ITEM QWHAT
TAB6 EQU $ ;"STEP" IN "FOR"
DB 'STEP'
ITEM FR2
ITEM FR3
TAB8 EQU $ ;RELATION OPERATORS
DB '>='
ITEM XP11
DB '#'
ITEM XP12
DB '>'
ITEM XP13
DB '='
ITEM XP15
DB '<='
ITEM XP14
DB '<'
ITEM XP16
ITEM XP17
;
DIRECT: LXI H,TAB1-1 ;*** DIRECT ***
;
EXEC EQU $ ;*** EXEC ***
EX0: RST 5 ;IGNORE LEADING BLANKS
PUSH D ;SAVE POINTER
EX1: LDAX D ;IF FOUND '.' IN STRING
INX D ;BEFORE ANY MISMATCH
CPI '.' ;WE DECLARE A MATCH
JZ EX3
INX H ;HL->TABLE
CMP M ;IF MATCH, TEST NEXT
JZ EX1
MVI A,7FH ;ELSE SEE IF BIT 7
DCX D ;OF TABLE IS SET, WHICH
CMP M ;IS THE JUMP ADDR. (HI)
JC EX5 ;C:YES, MATCHED
EX2: INX H ;NC:NO, FIND JUMP ADDR.
CMP M
JNC EX2
INX H ;BUMP TO NEXT TAB. ITEM
POP D ;RESTORE STRING POINTER
JMP EX0 ;TEST AGAINST NEXT ITEM
EX3: MVI A,7FH ;PARTIAL MATCH, FIND
EX4: INX H ;JUMP ADDR., WHICH IS
CMP M ;FLAGGED BY BIT 7
JNC EX4
EX5: MOV A,M ;LOAD HL WITH THE JUMP
INX H ;ADDRESS FROM THE TABLE
MOV L,M
ANI 07FH ;MASK OFF BIT 7
MOV H,A
POP PSW ;CLEAN UP THE GABAGE
PCHL ;AND WE GO DO IT
;
;*************************************************************
;*
;* WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
;* COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
;* SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
;* TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
;*
;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'START'
;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
;* GO BACK TO 'START'.
;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
;* FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'START', ELSE
;* GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
;*************************************************************
;*
;* *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
;*
;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
;*
;* 'STOP(CR)' GOES BACK TO 'START'
;*
;* 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
;* 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
;*
;* THERE ARE 3 MORE ENTRIES IN 'RUN':
;* 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
;*
;* 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
;* LINE, AND JUMP TO 'RUNTSL' TO DO IT.
;*
NEW: CALL ENDCHK ;*** NEW(CR) ***
LXI H,TXTBGN
SHLD TXTUNF
;
STOP: CALL ENDCHK ;*** STOP(CR) ***
RST 0
;
RUN: CALL ENDCHK ;*** RUN(CR) ***
LXI D,TXTBGN ;FIRST SAVED LINE
;
RUNNXL: LXI H,0 ;*** RUNNXL ***
CALL FDLNP ;FIND WHATEVER LINE #
JC START ;C:PASSED TXTUNF, QUIT
;
RUNTSL: XCHG ;*** RUNTSL ***
SHLD CURRNT ;SET 'CURRENT'->LINE #
XCHG
INX D ;BUMP PASS LINE #
INX D
;
RUNSML: CALL CHKIO ;*** RUNSML ***
LXI H,TAB2-1 ;FIND COMMAND IN TAB2
JMP EXEC ;AND EXECUTE IT
;
GOTO: RST 3 ;*** GOTO EXPR ***
PUSH D ;SAVE FOR ERROR ROUTINE
CALL ENDCHK ;MUST FIND A CR
CALL FNDLN ;FIND THE TARGET LINE
JNZ AHOW ;NO SUCH LINE #
POP PSW ;CLEAR THE PUSH DE
JMP RUNTSL ;GO DO IT
;
;*************************************************************
;*
;* *** LIST *** & PRINT ***
;*
;* LIST HAS TWO FORMS:
;* 'LIST(CR)' LISTS ALL SAVED LINES
;* 'LIST #(CR)' START LIST AT THIS LINE #
;* YOU CAN STOP THE LISTING BY CONTROL C KEY
;*
;* PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
;* WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
;* ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
;*
;* A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
;* THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
;* BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
;* SPECIFIED, 6 POSITIONS WILL BE USED.
;*
;* A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
;* DOUBLE QUOTES.
;*
;* A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
;*
;* A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
;* PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
;* ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
;*
LIST: CALL TSTNUM ;TEST IF THERE IS A #
CALL ENDCHK ;IF NO # WE GET A 0
CALL FNDLN ;FIND THIS OR NEXT LINE
LS1: JC START ;C:PASSED TXTUNF
CALL PRTLN ;PRINT THE LINE
CALL CHKIO ;STOP IF HIT CONTROL-C
CALL FDLNP ;FIND NEXT LINE
JMP LS1 ;AND LOOP BACK
;
PRINT: MVI C,6 ;C = # OF SPACES
RST 1 ;IF NULL LIST & ";"
DB ";"
DB PR2-$-1
CALL CRLF ;GIVE CR-LF AND
JMP RUNSML ;CONTINUE SAME LINE
PR2: RST 1 ;IF NULL LIST (CR)
DB CR
DB PR0-$-1
CALL CRLF ;ALSO GIVE CR-LF AND
JMP RUNNXL ;GO TO NEXT LINE
PR0: RST 1 ;ELSE IS IT FORMAT?
DB '#'
DB PR1-$-1
RST 3 ;YES, EVALUATE EXPR.
MOV C,L ;AND SAVE IT IN C
JMP PR3 ;LOOK FOR MORE TO PRINT
PR1: CALL QTSTG ;OR IS IT A STRING?
JMP PR8 ;IF NOT, MUST BE EXPR.
PR3: RST 1 ;IF ",", GO FIND NEXT
DB ","
DB PR6-$-1
CALL FIN ;IN THE LIST.
JMP PR0 ;LIST CONTINUES
PR6: CALL CRLF ;LIST ENDS
RST 6
PR8: RST 3 ;EVALUATE THE EXPR
PUSH B
CALL PRTNUM ;PRINT THE VALUE
POP B
JMP PR3 ;MORE TO PRINT?
;
;*************************************************************
;*
;* *** GOSUB *** & RETURN ***
;*
;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
;* SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
;* THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
;* SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
;* BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
;*
;* 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
;* RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
;* 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
;*
GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR"
RST 3 ;PARAMETERS
PUSH D ;AND TEXT POINTER
CALL FNDLN ;FIND THE TARGET LINE
JNZ AHOW ;NOT THERE. SAY "HOW?"
LHLD CURRNT ;FOUND IT, SAVE OLD
PUSH H ;'CURRNT' OLD 'STKGOS'
LHLD STKGOS
PUSH H
LXI H,0 ;AND LOAD NEW ONES
SHLD LOPVAR
DAD SP
SHLD STKGOS
JMP RUNTSL ;THEN RUN THAT LINE
RETURN: CALL ENDCHK ;THERE MUST BE A CR
LHLD STKGOS ;OLD STACK POINTER
MOV A,H ;0 MEANS NOT EXIST
ORA L
JZ QWHAT ;SO, WE SAY: "WHAT?"
SPHL ;ELSE, RESTORE IT
POP H
SHLD STKGOS ;AND THE OLD 'STKGOS'
POP H
SHLD CURRNT ;AND THE OLD 'CURRNT'
POP D ;OLD TEXT POINTER
CALL POPA ;OLD "FOR" PARAMETERS
RST 6 ;AND WE ARE BACK HOME
;
;*************************************************************
;*
;* *** FOR *** & NEXT ***
;*
;* 'FOR' HAS TWO FORMS:
;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2'
;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
;* EXP1=1. (I.E., WITH A STEP OF +1.)
;* TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
;* CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXPR2 AND EXP1
;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
;* 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
;* BEFORE THE NEW ONE OVERWRITES IT.
;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
;* IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
;* (PURGED FROM THE STACK..)
;*
;* 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
;* END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
;* WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
;* THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
;* DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
;* FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
;* IS PURGED AND EXECUTION CONTINUES.
;*
FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA
CALL SETVAL ;SET THE CONTROL VAR.
DCX H ;HL IS ITS ADDRESS
SHLD LOPVAR ;SAVE THAT
LXI H,TAB5-1 ;USE 'EXEC' TO LOOK
JMP EXEC ;FOR THE WORD 'TO'
FR1: RST 3 ;EVALUATE THE LIMIT
SHLD LOPLMT ;SAVE THAT
LXI H,TAB6-1 ;USE 'EXEC' TO LOOK
JMP EXEC ;FOR THE WORD 'STEP'
FR2: RST 3 ;FOUND IT, GET STEP
JMP FR4
FR3: LXI H,1 ;NOT FOUND, SET TO 1
FR4: SHLD LOPINC ;SAVE THAT TOO
FR5: LHLD CURRNT ;SAVE CURRENT LINE #
SHLD LOPLN
XCHG ;AND TEXT POINTER
SHLD LOPPT
LXI B,10 ;DIG INTO STACK TO
LHLD LOPVAR ;FIND 'LOPVAR'
XCHG
MOV H,B
MOV L,B ;HL=0 NOW
DAD SP ;HERE IS THE STACK
DB 3EH
FR7: DAD B ;EACH LEVEL IS 10 DEEP
MOV A,M ;GET THAT OLD 'LOPVAR'
INX H
ORA M
JZ FR8 ;0 SAYS NO MORE IN IT
MOV A,M
DCX H
CMP D ;SAME AS THIS ONE?
JNZ FR7
MOV A,M ;THE OTHER HALF?
CMP E
JNZ FR7
XCHG ;YES, FOUND ONE
LXI H,0
DAD SP ;TRY TO MOVE SP
MOV B,H
MOV C,L
LXI H,10
DAD D
CALL MVDOWN ;AND PURGE 10 WORDS
SPHL ;IN THE STACK
FR8: LHLD LOPPT ;JOB DONE, RESTORE DE
XCHG
RST 6 ;AND CONTINUE
;
NEXT: RST 7 ;GET ADDRESS OF VAR.
JC QWHAT ;NO VARIABLE, "WHAT?"
SHLD VARNXT ;YES, SAVE IT
NX0: PUSH D ;SAVE TEXT POINTER
XCHG
LHLD LOPVAR ;GET VAR. IN 'FOR'
MOV A,H
ORA L ;0 SAYS NEVER HAD ONE
JZ AWHAT ;SO WE ASK: "WHAT?"
RST 4 ;ELSE WE CHECK THEM
JZ NX3 ;OK, THEY AGREE
POP D ;NO, LET'S SEE
CALL POPA ;PURGE CURRENT LOOP
LHLD VARNXT ;AND POP ONE LEVEL
JMP NX0 ;GO CHECK AGAIN
NX3: MOV E,M ;COME HERE WHEN AGREED
INX H
MOV D,M ;DE=VALUE OF VAR.
LHLD LOPINC
PUSH H
DAD D ;ADD ONE STEP
XCHG
LHLD LOPVAR ;PUT IT BACK
MOV M,E
INX H
MOV M,D
LHLD LOPLMT ;HL->LIMIT
POP PSW ;OLD HL
ORA A
JP NX1 ;STEP > 0
XCHG ;STEP < 0
NX1: CALL CKHLDE ;COMPARE WITH LIMIT
POP D ;RESTORE TEXT POINTER
JC NX2 ;OUTSIDE LIMIT
LHLD LOPLN ;WITHIN LIMIT, GO
SHLD CURRNT ;BACK TO THE SAVED
LHLD LOPPT ;'CURRNT' AND TEXT
XCHG ;POINTER
RST 6
NX2: CALL POPA ;PURGE THIS LOOP
RST 6
;
;*************************************************************
;*
;* *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
;*
;* 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
;* TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
;*
;* 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
;* COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
;* NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
;* EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
;* EXECUTION CONTINUES AT THE NEXT LINE.
;*
;* 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
;* BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
;* IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
;* PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
;* EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
;* VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
;* PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
;*
;* IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
;* "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
;* THIS IS HANDLED IN 'INPERR'.
;*
;* 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
;* EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
;* TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
;* TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
;* THIS IS DONE BY 'DEFLT'.
;*
REM: LXI H,0 ;*** REM ***
DB 3EH ;THIS IS LIKE 'IF 0'
;
IFF: RST 3 ;*** IF ***
MOV A,H ;IS THE EXPR.=0?
ORA L
JNZ RUNSML ;NO, CONTINUE
CALL FNDSKP ;YES, SKIP REST OF LINE
JNC RUNTSL ;AND RUN THE NEXT LINE
RST 0 ;IF NO NEXT, RE-START
;
INPERR: LHLD STKINP ;*** INPERR ***
SPHL ;RESTORE OLD SP
POP H ;AND OLD 'CURRNT'
SHLD CURRNT
POP D ;AND OLD TEXT POINTER
POP D
;
INPUT EQU $ ;*** INPUT ***
IP1: PUSH D ;SAVE IN CASE OF ERROR
CALL QTSTG ;IS NEXT ITEM A STRING?
JMP IP2 ;NO
RST 7 ;YES, BUT FOLLOWED BY A
JC IP4 ;VARIABLE? NO.
JMP IP3 ;YES. INPUT VARIABLE
IP2: PUSH D ;SAVE FOR 'PRTSTG'
RST 7 ;MUST BE VARIABLE NOW
JC QWHAT ;"WHAT?" IT IS NOT?
LDAX D ;GET READY FOR 'PRTSTR'
MOV C,A
SUB A
STAX D
POP D
CALL PRTSTG ;PRINT STRING AS PROMPT
MOV A,C ;RESTORE TEXT
DCX D
STAX D
IP3: PUSH D ;SAVE IN CASE OF ERROR
XCHG
LHLD CURRNT ;ALSO SAVE 'CURRNT'
PUSH H
LXI H,IP1 ;A NEGATIVE NUMBER
SHLD CURRNT ;AS A FLAG
LXI H,0 ;SAVE SP TOO
DAD SP
SHLD STKINP
PUSH D ;OLD HL
MVI A,':' ;PRINT THIS TOO
CALL GETLN ;AND GET A LINE
LXI D,BUFFER ;POINTS TO BUFFER
RST 3 ;EVALUATE INPUT
NOP ;CAN BE 'CALL ENDCHK'
NOP
NOP
POP D ;OK, GET OLD HL
XCHG
MOV M,E ;SAVE VALUE IN VAR.
INX H
MOV M,D
POP H ;GET OLD 'CURRNT'
SHLD CURRNT
POP D ;AND OLD TEXT POINTER
IP4: POP PSW ;PURGE JUNK IN STACK
RST 1 ;IS NEXT CH. ','?
DB ","
DB IP5-$-1
JMP IP1 ;YES, MORE ITEMS.
IP5: RST 6
;
DEFLT: LDAX D ;*** DEFLT ***
CPI CR ;EMPTY LINE IS OK
JZ LT1 ;ELSE IT IS 'LET'
;
LET: CALL SETVAL ;*** LET ***
RST 1 ;SET VALUE TO VAR.
DB ","
DB LT1-$-1
JMP LET ;ITEM BY ITEM
LT1: RST 6 ;UNTIL FINISH
;
;*************************************************************
;*
;* *** EXPR ***
;*
;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
;* <EXPR>::<EXPR2>
;* <EXPR2><REL.OP.><EXPR2>
;* WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
;* RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
;* <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
;* <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
;* <EXPR4>::=<VARIABLE>
;* <FUNCTION>
;* (<EXPR>)
;* <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
;* AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
;* <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
;*
;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18
; PUSH H ;SAVE <EXPR2> VALUE
EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP.
JMP EXEC ;GO DO IT
XP11: CALL XP18 ;REL.OP.">="
RC ;NO, RETURN HL=0
MOV L,A ;YES, RETURN HL=1
RET
XP12: CALL XP18 ;REL.OP."#"
RZ ;FALSE, RETURN HL=0
MOV L,A ;TRUE, RETURN HL=1
RET
XP13: CALL XP18 ;REL.OP.">"
RZ ;FALSE
RC ;ALSO FALSE, HL=0
MOV L,A ;TRUE, HL=1
RET
XP14: CALL XP18 ;REL.OP."<="
MOV L,A ;SET HL=1
RZ ;REL. TRUE, RETURN
RC
MOV L,H ;ELSE SET HL=0
RET
XP15: CALL XP18 ;REL.OP."="
RNZ ;FALSE, RETURN HL=0
MOV L,A ;ELSE SET HL=1
RET
XP16: CALL XP18 ;REL.OP."<"
RNC ;FALSE, RETURN HL=0
MOV L,A ;ELSE SET HL=1
RET
XP17: POP H ;NOT .REL.OP
RET ;RETURN HL=<EXPR2>
XP18: MOV A,C ;SUBROUTINE FOR ALL
POP H ;REL.OP.'S
POP B
PUSH H ;REVERSE TOP OF STACK
PUSH B
MOV C,A
CALL EXPR2 ;GET 2ND <EXPR2>
XCHG ;VALUE IN DE NOW
XTHL ;1ST <EXPR2> IN HL
CALL CKHLDE ;COMPARE 1ST WITH 2ND
POP D ;RESTORE TEXT POINTER
LXI H,0 ;SET HL=0, A=1
MVI A,1
RET
;
EXPR2: RST 1 ;NEGATIVE SIGN?
DB '-'
DB XP21-$-1
LXI H,0 ;YES, FAKE '0-'
JMP XP26 ;TREAT LIKE SUBTRACT
XP21: RST 1 ;POSITIVE SIGN? IGNORE
DB '+'
DB XP22-$-1
XP22: CALL EXPR3 ;1ST <EXPR3>
XP23: RST 1 ;ADD?
DB '+'
DB XP25-$-1
PUSH H ;YES, SAVE VALUE
CALL EXPR3 ;GET 2ND <EXPR3>
XP24: XCHG ;2ND IN DE
XTHL ;1ST IN HL
MOV A,H ;COMPARE SIGN
XRA D
MOV A,D
DAD D
POP D ;RESTORE TEXT POINTER
JM XP23 ;1ST AND 2ND SIGN DIFFER
XRA H ;1ST AND 2ND SIGN EQUAL
JP XP23 ;SO IS RESULT
JMP QHOW ;ELSE WE HAVE OVERFLOW
XP25: RST 1 ;SUBTRACT?
DB '-'
DB XP42-$-1
XP26: PUSH H ;YES, SAVE 1ST <EXPR3>
CALL EXPR3 ;GET 2ND <EXPR3>
CALL CHGSGN ;NEGATE
JMP XP24 ;AND ADD THEM
;
EXPR3: CALL EXPR4 ;GET 1ST <EXPR4>
XP31: RST 1 ;MULTIPLY?
DB '*'
DB XP34-$-1
PUSH H ;YES, SAVE 1ST
CALL EXPR4 ;AND GET 2ND <EXPR4>
MVI B,0 ;CLEAR B FOR SIGN
CALL CHKSGN ;CHECK SIGN
XCHG ;2ND IN DE NOW
XTHL ;1ST IN HL
CALL CHKSGN ;CHECK SIGN OF 1ST
MOV A,H ;IS HL > 255 ?
ORA A
JZ XP32 ;NO
MOV A,D ;YES, HOW ABOUT DE
ORA D
XCHG ;PUT SMALLER IN HL
JNZ AHOW ;ALSO >, WILL OVERFLOW
XP32: MOV A,L ;THIS IS DUMB
LXI H,0 ;CLEAR RESULT
ORA A ;ADD AND COUNT
JZ XP35
XP33: DAD D
JC AHOW ;OVERFLOW
DCR A
JNZ XP33
JMP XP35 ;FINISHED
XP34: RST 1 ;DIVIDE?
DB '/'
DB XP42-$-1
PUSH H ;YES, SAVE 1ST <EXPR4>
CALL EXPR4 ;AND GET THE SECOND ONE
MVI B,0 ;CLEAR B FOR SIGN
CALL CHKSGN ;CHECK SIGN OF 2ND
XCHG ;PUT 2ND IN DE
XTHL ;GET 1ST IN HL
CALL CHKSGN ;CHECK SIGN OF 1ST
MOV A,D ;DIVIDE BY 0?
ORA E
JZ AHOW ;SAY "HOW?"
PUSH B ;ELSE SAVE SIGN
CALL DIVIDE ;USE SUBROUTINE
MOV H,B ;RESULT IN HL NOW
MOV L,C
POP B ;GET SIGN BACK
XP35: POP D ;AND TEXT POINTER
MOV A,H ;HL MUST BE +
ORA A
JM QHOW ;ELSE IT IS OVERFLOW
MOV A,B
ORA A
CM CHGSGN ;CHANGE SIGN IF NEEDED
JMP XP31 ;LOOK FOR MORE TERMS
;
EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4
JMP EXEC ;AND GO DO IT
XP40: RST 7 ;NO, NOT A FUNCTION
JC XP41 ;NOR A VARIABLE
MOV A,M ;VARIABLE
INX H
MOV H,M ;VALUE IN HL
MOV L,A
RET
XP41: CALL TSTNUM ;OR IS IT A NUMBER
MOV A,B ;# OF DIGIT
ORA A
RNZ ;OK
PARN: RST 1
DB '('
DB XP43-$-1
RST 3 ;"(EXPR)"
RST 1
DB ')'
DB XP43-$-1
XP42: RET
XP43: JMP QWHAT ;ELSE SAY: "WHAT?"
;
RND: CALL PARN ;*** RND(EXPR) ***
MOV A,H ;EXPR MUST BE +
ORA A
JM QHOW
ORA L ;AND NON-ZERO
JZ QHOW
PUSH D ;SAVE BOTH
PUSH H
LHLD RANPNT ;GET MEMORY AS RANDOM
LXI D,LSTROM ;NUMBER
RST 4
JC RA1 ;WRAP AROUND IF LAST
LXI H,START
RA1: MOV E,M
INX H
MOV D,M
SHLD RANPNT
POP H
XCHG
PUSH B
CALL DIVIDE ;RND(N)=MOD(M,N)+1
POP B
POP D
INX H
RET
;
ABS: CALL PARN ;*** ABS(EXPR) ***
CALL CHKSGN ;CHECK SIGN
MOV A,H ;NOTE THAT -32768
ORA H ;CANNOT CHANGE SIGN
JM QHOW ;SO SAY: "HOW?"
RET
;
SIZE: LHLD TXTUNF ;*** SIZE ***
PUSH D ;GET THE NUMBER OF FREE
XCHG ;BYTES BETWEEN 'TXTUNF'
LXI H,VARBGN ;AND 'VARBGN'
CALL SUBDE
POP D
RET
;
;*************************************************************
;*
;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
;*
;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
;*
;* 'SUBDE' SUBSTRACTS DE FROM HL
;*
;* 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
;* SIGN AND FLIP SIGN OF B.
;*
;* 'CHGSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY.
;*
;* 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
;* ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
;*
DIVIDE: PUSH H ;*** DIVIDE ***
MOV L,H ;DIVIDE H BY DE
MVI H,0
CALL DV1
MOV B,C ;SAVE RESULT IN B
MOV A,L ;(REMINDER+L)/DE
POP H
MOV H,A
DV1: MVI C,-1 ;RESULT IN C
DV2: INR C ;DUMB ROUTINE
CALL SUBDE ;DIVIDE BY SUBTRACT
JNC DV2 ;AND COUNT
DAD D
RET
;
SUBDE: MOV A,L ;*** SUBDE ***
SUB E ;SUBSTRACT DE FROM
MOV L,A ;HL
MOV A,H
SBB D
MOV H,A
RET
;
CHKSGN: MOV A,H ;*** CHKSGN ***
ORA A ;CHECK SIGN OF HL
RP ;IF -, CHANGE SIGN
;
CHGSGN: MOV A,H ;*** CHGSGN ***
CMA ;CHANGE SIGN OF HL
MOV H,A
MOV A,L
CMA
MOV L,A
INX H
MOV A,B ;AND ALSO FLIP B
XRI 80H
MOV B,A
RET
;
CKHLDE: MOV A,H
XRA D ;SAME SIGN?
JP CK1 ;YES, COMPARE
XCHG ;NO, XCH AND COMP
CK1: RST 4
RET
;
;*************************************************************
;*
;* *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
;*
;* "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
;* THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
;* TO THAT VALUE.
;*
;* "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";",
;* EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
;* NEXT LINE AND CONTINUE FROM THERE.
;*
;* "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
;* REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
;*
;* "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
;* IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
;* INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
;* OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
;* AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
;* PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
;* COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
;* NOT TERMINATED BUT CONTINUED AT 'INPERR'.
;*
;* RELATED TO 'ERROR' ARE THE FOLLOWING:
;* 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
;* 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
;* 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
;*
SETVAL: RST 7 ;*** SETVAL ***
JC QWHAT ;"WHAT?" NO VARIABLE
PUSH H ;SAVE ADDRESS OF VAR.
RST 1 ;PASS "=" SIGN
DB '='
DB SV1-$-1
RST 3 ;EVALUATE EXPR.
MOV B,H ;VALUE IS IN BC NOW
MOV C,L
POP H ;GET ADDRESS
MOV M,C ;SAVE VALUE
INX H
MOV M,B
RET
SV1: JMP QWHAT ;NO "=" SIGN
;
FIN: RST 1 ;*** FIN ***
DB ";"
DB FI1-$-1
POP PSW ;";", PURGE RET. ADDR.
JMP RUNSML ;CONTINUE SAME LINE
FI1: RST 1 ;NOT ";", IS IT CR?
DB CR
DB FI2-$-1
POP PSW ;YES, PURGE RET. ADDR.
JMP RUNNXL ;RUN NEXT LINE
FI2: RET ;ELSE RETURN TO CALLER
;
ENDCHK: RST 5 ;*** ENDCHK ***
CPI CR ;END WITH CR?
RZ ;OK, ELSE SAY: "WHAT?"
;
QWHAT: PUSH D ;*** QWHAT ***
AWHAT: LXI D,WHAT ;*** AWHAT ***
ERROR: SUB A ;*** ERROR ***
CALL PRTSTG ;PRINT 'WHAT?', 'HOW?'
POP D ;OR 'SORRY'
LDAX D ;SAVE THE CHARACTER
PUSH PSW ;AT WHERE OLD DE ->
SUB A ;AND PUT A 0 THERE
STAX D
LHLD CURRNT ;GET CURRENT LINE #
PUSH H
MOV A,M ;CHECK THE VALUE
INX H
ORA M
POP D
JZ START ;IF ZERO, JUST RESTART
MOV A,M ;IF NEGATIVE,
ORA A
JM INPERR ;REDO INPUT
CALL PRTLN ;ELSE PRINT THE LINE
DCX D ;UPTO WHERE THE 0 IS
POP PSW ;RESTORE THE CHARACTER
STAX D
MVI A,'?' ;PRINT A "?"
RST 2
SUB A ;AND THE REST OF THE
CALL PRTSTG ;LINE
RST 0 ;THEN RESTART
;
QSORRY: PUSH D ;*** QSORRY ***
ASORRY: LXI D,SORRY ;*** ASORRY ***
JMP ERROR
;
;*************************************************************
;*
;* *** GETLN *** FNDLN (& FRIENDS) ***
;*
;* 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
;* THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
;* THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
;* ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
;* THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
;* CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
;*
;* 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
;* TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
;* LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
;* (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
;* IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
;* WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
;* LINE, FLAGS ARE C & NZ.
;* 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
;* AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
;* ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
;* 'FDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
;* 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
;* 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
;*
GETLN: RST 2 ;*** GETLN ***
LXI D,BUFFER ;PROMPT AND INIT.
GL1: CALL CHKIO ;CHECK KEYBOARD
JZ GL1 ;NO INPUT, WAIT
RST 2 ;INPUT, ECHO BACK
CPI LF ;IGNORE LF
JZ GL1
ORA A ;IGNORE NULL
JZ GL1
CPI DEL ;DELETE LAST CHARACTER?
JZ GL3 ;YES
; CPI DLLN ;DELETE THE WHOLE LINE?
CPI CNTLU
JZ GL4 ;YES
STAX D ;ELSE SAVE INPUT
INX D ;AND BUMP POINTER
CPI CR ;WAS IT CR?
RZ ;YES, END OF LINE
MOV A,E ;ELSE MORE FREE ROOM?
CPI BUFEND
JNZ GL1 ;YES, GET NEXT INPUT
GL3: MOV A,E ;DELETE LAST CHARACTER
CPI BUFFER ;BUT DO WE HAVE ANY?
JZ GL4 ;NO, REDO WHOLE LINE
DCX D ;YES, BACKUP POINTER
MVI A,BKS ;AND ECHO A BACK-SLASH
RST 2
JMP GL1 ;GO GET NEXT INPUT
GL4: CALL CRLF ;REDO ENTIRE LINE
MVI A,UPA ;CR, LF AND UP-ARROW
JMP GETLN
;
FNDLN: MOV A,H ;*** FNDLN ***
ORA A ;CHECK SIGN OF HL
JM QHOW ;IT CANNOT BE -
LXI D,TXTBGN ;INIT TEXT POINTER
;
FDLNP EQU $ ;*** FDLNP ***
FL1: PUSH H ;SAVE LINE #
LHLD TXTUNF ;CHECK IF WE PASSED END
DCX H
RST 4
POP H ;GET LINE # BACK
RC ;C,NZ PASSED END
LDAX D ;WE DID NOT, GET BYTE 1
SUB L ;IS THIS THE LINE?
MOV B,A ;COMPARE LOW ORDER
INX D
LDAX D ;GET BYTE 2
SBB H ;COMPARE HIGH ORDER
JC FL2 ;NO, NOT THERE YET
DCX D ;ELSE WE EITHER FOUND
ORA B ;IT, OR IT IS NOT THERE
RET ;NC,Z:FOUND, NC,NZ:NO
;
FNDNXT EQU $ ;*** FNDNXT ***
INX D ;FIND NEXT LINE
FL2: INX D ;JUST PASSED BYTE 1 & 2
;
FNDSKP: LDAX D ;*** FNDSKP ***
CPI CR ;TRY TO FIND CR
JNZ FL2 ;KEEP LOOKING
INX D ;FOUND CR, SKIP OVER
JMP FL1 ;CHECK IF END OF TEXT
;
;*************************************************************
;*
;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
;*
;* 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
;* AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
;* THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
;* CALLER). OLD A IS STORED IN B, OLD B IS LOST.
;*
;* 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
;* QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
;* OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
;* THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
;* AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
;* OVER (USUALLY A JUMP INSTRUCTION.
;*
;* 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
;* IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
;* HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
;* C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
;* PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
;*
;* 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
;*
PRTSTG: MOV B,A ;*** PRTSTG ***
PS1: LDAX D ;GET A CHARACTER
INX D ;BUMP POINTER
CMP B ;SAME AS OLD A?
RZ ;YES, RETURN
RST 2 ;ELSE PRINT IT
CPI CR ;WAS IT A CR?
JNZ PS1 ;NO, NEXT
RET ;YES, RETURN
;
QTSTG: RST 1 ;*** QTSTG ***
DB 0x22 ;'"'
DB QT3-$-1
MVI A,0x22 ;IT IS A "
QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER
CPI CR ;WAS LAST ONE A CR?
POP H ;RETURN ADDRESS
JZ RUNNXL ;WAS CR, RUN NEXT LINE
QT2: INX H ;SKIP 3 BYTES ON RETURN
INX H
INX H
PCHL ;RETURN
QT3: RST 1 ;IS IT A '?
DB QT
DB QT4-$-1
MVI A,QT ;YES, DO THE SAME
JMP QT1 ;AS IN "
QT4: RST 1 ;IS IT BACK-ARROW?
DB BKA
DB QT5-$-1
MVI A,8DH ;YES, CR WITHOUT LF
RST 2 ;DO IT TWICE TO GIVE
RST 2 ;TTY ENOUGH TIME
POP H ;RETURN ADDRESS
JMP QT2
QT5: RET ;NONE OF ABOVE
;
PRTNUM: PUSH D ;*** PRTNUM ***
LXI D,10 ;DECIMAL
PUSH D ;SAVE AS A FLAG
MOV B,D ;B=SIGN
DCR C ;C=SPACES
CALL CHKSGN ;CHECK SIGN
JP PN1 ;NO SIGN
MVI B,'-' ;B=SIGN
DCR C ;'-' TAKES SPACE
PN1: PUSH B ;SAVE SIGN & SPACE
PN2: CALL DIVIDE ;DIVIDE HL BY 10
MOV A,B ;RESULT 0?
ORA C
JZ PN3 ;YES, WE GOT ALL
XTHL ;NO, SAVE REMAINDER
DCR L ;AND COUNT SPACE
PUSH H ;HL IS OLD BC
MOV H,B ;MOVE RESULT TO BC
MOV L,C
JMP PN2 ;AND DIVIDE BY 10
PN3: POP B ;WE GOT ALL DIGITS IN
PN4: DCR C ;THE STACK
MOV A,C ;LOOK AT SPACE COUNT
ORA A
JM PN5 ;NO LEADING BLANKS
MVI A,' ' ;LEADING BLANKS
RST 2
JMP PN4 ;MORE?
PN5: MOV A,B ;PRINT SIGN
RST 2 ;MAYBE - OR NULL
MOV E,L ;LAST REMAINDER IN E
PN6: MOV A,E ;CHECK DIGIT IN E
CPI 10 ;10 IS FLAG FOR NO MORE
POP D
RZ ;IF SO, RETURN
ADI '0' ;ELSE CONVERT TO ASCII
RST 2 ;AND PRINT THE DIGIT
JMP PN6 ;GO BACK FOR MORE
;
PRTLN: LDAX D ;*** PRTLN ***
MOV L,A ;LOW ORDER LINE #
INX D
LDAX D ;HIGH ORDER
MOV H,A
INX D
MVI C,4 ;PRINT 4 DIGIT LINE #
CALL PRTNUM
MVI A,' ' ;FOLLOWED BY A BLANK
RST 2
SUB A ;AND THEN THE NEXT
CALL PRTSTG
RET
;
;*************************************************************
;*
;* *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
;*
;* 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
;* DE = HL
;*
;* 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
;* UNTIL DE = BC
;*
;* 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
;* STACK
;*
;* 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
;* STACK
;*
MVUP: RST 4 ;*** MVUP ***
RZ ;DE = HL, RETURN
LDAX D ;GET ONE BYTE
STAX B ;MOVE IT
INX D ;INCREASE BOTH POINTERS
INX B
JMP MVUP ;UNTIL DONE
;
MVDOWN: MOV A,B ;*** MVDOWN ***
SUB D ;TEST IF DE = BC
JNZ MD1 ;NO, GO MOVE
MOV A,C ;MAYBE, OTHER BYTE?
SUB E
RZ ;YES, RETURN
MD1: DCX D ;ELSE MOVE A BYTE
DCX H ;BUT FIRST DECREASE
LDAX D ;BOTH POINTERS AND
MOV M,A ;THEN DO IT
JMP MVDOWN ;LOOP BACK
;
POPA: POP B ;BC = RETURN ADDR.
POP H ;RESTORE LOPVAR, BUT
SHLD LOPVAR ;=0 MEANS NO MORE
MOV A,H
ORA L
JZ PP1 ;YEP, GO RETURN
POP H ;NOP, RESTORE OTHERS
SHLD LOPINC
POP H
SHLD LOPLMT
POP H
SHLD LOPLN
POP H
SHLD LOPPT
PP1: PUSH B ;BC = RETURN ADDR.
RET
;
PUSHA: LXI H,STKLMT ;*** PUSHA ***
CALL CHGSGN
POP B ;BC=RETURN ADDRESS
DAD SP ;IS STACK NEAR THE TOP?
JNC QSORRY ;YES, SORRY FOR THAT
LHLD LOPVAR ;ELSE SAVE LOOP VAR'S
MOV A,H ;BUT IF LOPVAR IS 0
ORA L ;THAT WILL BE ALL
JZ PU1
LHLD LOPPT ;ELSE, MORE TO SAVE
PUSH H
LHLD LOPLN
PUSH H
LHLD LOPLMT
PUSH H
LHLD LOPINC
PUSH H
LHLD LOPVAR
PU1: PUSH H
PUSH B ;BC = RETURN ADDR.
RET
;
;*************************************************************
;*
;* *** OUTC *** & CHKIO ***
;*
;* THESE ARE THE ONLY I/O ROUTINES IN TBI.
;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0
;* 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0,
;* IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO
;* SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG.
;* ARE RESTORED.
;*
;* 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO
;* THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG
;* IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE
;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
;* Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL
;* RESTART TBI AND DO NOT RETURN TO THE CALLER.
;*
;OUTC: PUSH PSW ;THIS IS AT LOC. 10
; LDA OCSW ;CHECK SOFTWARE SWITCH
; ORA A
OC2: JNZ OC3 ;IT IS ON
POP PSW ;IT IS OFF
RET ;RESTORE AF AND RETURN
OC3: IN 0 ;COME HERE TO DO OUTPUT
ANI 02H ;STATUS BIT
JZ OC3 ;NOT READY, WAIT
POP PSW ;READY, GET OLD A BACK
OUT 1 ;AND SEND IT OUT
CPI CR ;WAS IT CR?
RNZ ;NO, FINISHED
MVI A,LF ;YES, WE SEND LF TOO
RST 2 ;THIS IS RECURSIVE
MVI A,CR ;GET CR BACK IN A
RET
;
CHKIO: IN 0 ;*** CHKIO ***
NOP ;STATUS BIT FLIPPED?
ANI 20H ;MASK STATUS BIT
RZ ;NOT READY, RETURN "Z"
IN 1 ;READY, READ DATA
ANI 7FH ;MASK BIT 7 OFF
CPI CNTLO ;IS IT CONTROL-O?
JNZ CI1 ;NO, MORE CHECKING
LDA OCSW ;CONTROL-O FLIPS OCSW
CMA ;ON TO OFF, OFF TO ON
STA OCSW
JMP CHKIO ;GET ANOTHER INPUT
CI1: CPI CNTLC ;IS IT CONTROL-C?
RNZ ;NO, RETURN "NZ"
RST 0 ;YES, RESTART TBI
;
DB 'YOU MAY NEED THIS SPACE TO'
DB "PATCH UP THE I/O ROUTINES,"
DB "TO FIX UP BUGS, OR TO ADD"
DB 'MORE COMMANDS AND FUNCTIONS.'
DB 'SKY (SPACE) IS THE LIMIT.'
DB 'GOOD LUCK AND GOOD BYE.'
DB "LICHEN WANG, 10 JUNE 76"
;
LSTROM EQU $ ;ALL ABOVE CAN BE ROM
ORG 1000H ;HERE DOWN MUST BE RAM
OCSW: DB 0FFH ;SWITCH FOR OUTPUT
CURRNT: DW 0 ;POINTS TO CURRENT LINE
STKGOS: DW 0 ;SAVES SP IN 'GOSUB'
VARNXT EQU $ ;TEMP STORAGE
STKINP: DW 0 ;SAVES SP IN 'INPUT'
LOPVAR: DW 0 ;'FOR' LOOP SAVE AREA
LOPINC: DW 0 ;INCREMENT
LOPLMT: DW 0 ;LIMIT
LOPLN: DW 0 ;LINE NUMBER
LOPPT: DW 0 ;TEXT POINTER
RANPNT: DW START ;RANDOM NUMBER POINTER
TXTUNF: DW TXTBGN ;->UNFILLED TEXT AREA
TXTBGN: DS 1 ;TEXT SAVE AREA BEGINS
ORG 1300H
TXTEND EQU $ ;TEXT SAVE AREA ENDS
VARBGN: DS 2*27 ;VARIABLE @(0)
DS 1 ;EXTRA BYTE FOR BUFFER
BUFFER: DS 72 ;INPUT BUFFER
BUFEND EQU $ ;BUFFER ENDS
DS 40 ;EXTRA BYTES FOR STACK
STKLMT EQU $ ;TOP LIMIT FOR STACK
ORG 1400H
STACK EQU $ ;STACK STARTS HERE
END
:10000000F3310014C3BA004CE3EFBEC368003E0DE9
:10001000F53A0010B7C31A07CD5504E5C3110457CC
:100020007CBAC07DBBC9414E1AFE20C013C3280054
:10003000F1CD9105C3A40547EFD640D8C2580013AF
:10004000CDFB0429DA9F00D5EBCD3D05E7DAD005DD
:10005000210013CD6005D1C9FE1B3FD81321001329
:1000600007856F3E008C67C923CA7300C54E060022
:1000700009C11B1323E3C921000044EFFE30D8FE61
:100080003AD03EF0A4C29F0004C5444D2929092955
:100090001A13E60F856F3E008C67C11AF27C00D5FB
:1000A00011A600C3A805484F573F0D4F4B0D5748A9
:1000B00041543F0D534F5252590DCD0E0011AB001C
:1000C00097CD3C0621CB0022011021000022071011
:1000D0002203103E3ECDD605D5113713CD7700EF64
:1000E0007CB5C1CAF5011B7C121B7D12C5D5799365
:1000F000F5CD1406D5C20801D5CD3006C12A13109E
:10010000CDBD066069221310C12A1310F1E5FE036C
:10011000CA0000856F3E008C67110013E7D2CF053F
:10012000221310D1CDC606D1E1CDBD06C3D3004CFC
:10013000495354826152554E82334E455782264E62
:1001400045585483494C455484074946839A474F40
:10015000544F8252474F53554282B15245545552E3
:100160004E82D152454D8396464F5282EA494E50B7
:10017000555483B15052494E54827953544F508252
:100180002F8401594F55204D415920494E53455216
:100190005420204D4F524520434F4D4D414E445326
:1001A0002E524E448506414253853153495A458566
:1001B0003D84EC594F55204D415920494E534552ED
:1001C0005420204D4F52452046554E4354494F4EE2
:1001D00053544F82FA85A453544550830483083EF8
:1001E0003D841723841D3E84233D84323C3D842A74
:1001F0003C8438843E212E01EFD51A13FE2ECA17F7
:100200000223BECAFA013E7F1BBEDA1E0223BED203
:100210000D0223D1C3F8013E7F23BED219027E23F3
:100220006EE67F67F1E9CDA005211510221310CDF0
:10023000A005C7CDA005111510210000CD1C06DAC0
:100240000000EB220110EB1313CD3207213E01C356
:10025000F801DFD5CDA005CD1406C2A000F1C34240
:1002600002CD7700CDA005CD1406DA0000CDAA0698
:10027000CD3207CD1C06C36A020E06CF3B06CD0E5B
:1002800000C34902CF0D06CD0E00C33902CF2305AE
:10029000DF4DC39B02CD4806C3A802CF2C06CD91EB
:1002A00005C38D02CD0E00F7DFC5CD6E06C1C39B21
:1002B00002CDF106DFD5CD1406C2A0002A0110E55B
:1002C0002A0310E521000022071039220310C3423F
:1002D00002CDA0052A03107CB5CAA405F9E12203CA
:1002E00010E1220110D1CDD506F7CDF106CD7E0566
:1002F0002B22071021D001C3F801DF220B1021D6D9
:1003000001C3F801DFC30B032101002209102A01F8
:1003100010220D10EB220F10010A002A0710EB60CB
:1003200068393E097E23B6CA44037E2BBAC2230332
:100330007EBBC22303EB21000039444D210A001982
:10034000CDC606F92A0F10EBF7FFDAA40522051037
:10035000D5EB2A07107CB5CAA505E7CA6803D1CD3D
:10036000D5062A0510C350035E23562A0910E51945
:10037000EB2A07107323722A0B10F1B7F28003EBFC
:10038000CD7605D1DA92032A0D102201102A0F1022
:10039000EBF7CDD506F72100003EDF7CB5C2490260
:1003A000CD3206D24202C72A0510F9E1220110D14E
:1003B000D1D5CD4806C3BF03FFDAF903C3CF03D5B8
:1003C000FFDAA4051A4F9712D1CD3C06791B12D53E
:1003D000EB2A0110E521B10322011021000039228E
:1003E0000510D53E3ACDD605113713DF000000D1F8
:1003F000EB732372E1220110D1F1CF2C03C3B103BF
:10040000F71AFE0DCA1004CD7E05CF2C03C30704D6
:10041000F721DE01C3F801CD4004D86FC9CD4004F7
:10042000C86FC9CD4004C8D86FC9CD40046FC8D8C3
:100430006CC9CD4004C06FC9CD4004D06FC9E1C9BB
:1004400079E1C1E5C54FCD5504EBE3CD7605D1216A
:1004500000003E01C9CF2D06210000C37F04CF2B31
:1004600000CD8904CF2B15E5CD8904EBE37CAA7A76
:1004700019D1FA6404ACF26404C39F00CF2D83E564
:10048000CD8904CD6A05C36B04CDE604CF2A2CE5E3
:10049000CDE6040600CD6705EBE3CD67057CB7CA62
:1004A000A8047AB2EBC2A0007D210000B7CAD8042C
:1004B00019DAA0003DC2B004C3D804CF2F44E5CD63
:1004C000E6040600CD6705EBE3CD67057AB3CAA065
:1004D00000C5CD4A056069C1D17CB7FA9F0078B7E5
:1004E000FC6A05C38C0421A001C3F801FFDAF504FE
:1004F0007E23666FC9CD770078B7C0CF2805DFCFE0
:100500002901C9C3A405CDFB047CB7FA9F00B5CA75
:100510009F00D5E52A111011FF07E7DA2105210018
:10052000005E2356221110E1EBC5CD4A05C1D1234F
:10053000C9CDFB04CD67057CB4FA9F00C92A13100E
:10054000D5EB210013CD6005D1C9E56C2600CD5552
:1005500005417DE1670EFF0CCD6005D2570519C935
:100560007D936F7C9A67C97CB7F07C2F677D2F6F76
:100570002378EE8047C97CAAF27C05EBE7C9FFDA55
:10058000A405E5CF3D08DF444DE1712370C9C3A444
:1005900005CF3B04F1C34902CF0D04F1C33902C9B1
:1005A000EFFE0DC8D511AE0097CD3C06D11AF597D8
:1005B000122A0110E57E23B6D1CA00007EB7FAA741
:1005C00003CDAA061BF1123E3FD797CD3C06C7D5F7
:1005D00011B400C3A805D7113713CD3207CADA0505
:1005E000D7FE0ACADA05B7CADA05FE7FCAFF05FEDA
:1005F00015CA0C061213FE0DC87BFE7FC2DA057BFE
:10060000FE37CA0C061B3E5CD7C3DA05CD0E003E92
:100610005EC3D6057CB7FA9F00111510E52A1310AA
:100620002BE7E1D81A9547131A9CDA31061BB0C99B
:1006300013131AFE0DC2310613C31C06471A13B852
:10064000C8D7FE0DC23D06C9CF220F3E22CD3C06C3
:10065000FE0DE1CA3902232323E9CF27053E27C334
:100660004D06CF5F083E8DD7D7E1C35606C9D511D9
:100670000A00D5420DCD6705F27E06062D0DC5CDCB
:100680004A0578B1CA8F06E32DE56069C37F06C1CC
:100690000D79B7FA9C063E20D7C3900678D75D7BCC
:1006A000FE0AD1C8C630D7C39F061A6F131A671344
:1006B0000E04CD6E063E20D797CD3C06C9E7C81A7A
:1006C000021303C3BD067892C2CE067993C81B2BD2
:1006D0001A77C3C606C1E12207107CB5CAEF06E14E
:1006E000220910E1220B10E1220D10E1220F10C5AA
:1006F000C921A713CD6A05C139D2CF052A07107CBD
:10070000B5CA17072A0F10E52A0D10E52A0B10E5C8
:100710002A0910E52A0710E5C5C9C21F07F1C9DB80
:1007200000E602CA1F07F1D301FE0DC03E0AD73E04
:100730000DC9DB0000E620C8DB01E67FFE0FC24BDF
:10074000073A00102F320010C33207FE03C0C7590A
:100750004F55204D4159204E45454420544849535A
:1007600020535041434520544F5041544348205555
:10077000502054484520492F4F20524F5554494E40
:1007800045532C544F204649582055502042554738
:10079000532C204F5220544F204144444D4F52453A
:1007A00020434F4D4D414E445320414E4420465529
:1007B0004E4354494F4E532E534B592028535041CA
:1007C00043452920495320544845204C494D49541C
:1007D0002E474F4F44204C55434B20414E44204719
:1007E0004F4F44204259452E4C494348454E2057CF
:0F07F000414E472C203130204A554E4520373698
:10100000FF000000000000000000000000000000E1
:051010000000001510B6
:00000001FF
0000 ;*************************************************************
0000 ;*
0000 ;* TINY BASIC FOR INTEL 8080
0000 ;* VERSION 1.0
0000 ;* BY LI-CHEN WANG
0000 ;* 10 JUNE, 1976
0000 ;* @COPYLEFT
0000 ;* ALL WRONGS RESERVED
0000 ;*
0000 ;*************************************************************
0000 ;*
0000 ;* *** ZERO PAGE SUBROUTINES ***
0000 ;*
0000 ;* THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
0000 ;* MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
0000 ;* THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
0000 ;* THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL
0000 ;* USE RST 0 AS START OR RESTART AND RST 1 THROUGH RST 7 FOR
0000 ;* THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
0000 ;* TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
0000 ;* SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
0000 ;*
0000 CR: EQU 0DH
0000 LF: EQU 0AH
0000 QT: EQU 27H
0000 CNTLO: EQU 0FH
0000 CNTLC: EQU 03H
0000 DLLN: EQU 7DH
0000 CNTLU: EQU 15H
0000 BKS: EQU 5CH
0000 BKA: EQU 5FH
0000 UPA: EQU 5EH
0000 DEL: EQU 7FH
0000 ;
0000 ; MACRO TO CREATE TABLE ADDRESS ITEMS
0000 ;
0000 ;
0000 .ORG 0000H
0000 F3 START: DI ;*** START/RESTART ***
0001 31 00 14 LXI SP,STACK ;INITIALIZE THE STACK
0004 C3 BA 00 JMP ST1 ;GO TO THE MAIN SECTION
0007 4C DB 'L'
0008 ;
0008 E3 XTHL ;*** TSTC OR RST 1 ***
0009 EF RST 5 ;IGNORE BLANKS AND
000A BE CMP M ;TEST CHARACTER
000B C3 68 00 JMP TC1 ;REST OF THIS IS AT TC1
000E ;
000E 3E 0D CRLF: MVI A,CR ;*** CRLF ***
0010 ;
0010 F5 PUSH PSW ;*** OUTC OR RST 2 ***
0011 3A 00 10 LDA OCSW ;PRINT CHARACTER ONLY
0014 B7 ORA A ;IF OCSW SWITCH IS ON
0015 C3 1A 07 JMP OC2 ;REST OF THIS IS AT OC2
0018 ;
0018 CD 55 04 CALL EXPR2 ;*** EXPR OR RST 3 ***
001B E5 PUSH H ;EVALUATE AN EXPRESSION
001C C3 11 04 JMP EXPR1 ;REST OF IT AT EXPR1
001F 57 DB 'W'
0020 ;
0020 7C MOV A,H ;*** COMP OR RST 4 ***
0021 BA CMP D ;COMPARE HL WITH DE
0022 C0 RNZ ;RETURN CORRECT C AND
0023 7D MOV A,L ;Z FLAGS
0024 BB CMP E ;BUT OLD A IS LOST
0025 C9 RET
0026 41 4E DB 'AN'
0028 ;
0028 1A SS1: LDAX D ;*** IGNBLK/RST 5 ***
0029 FE 20 CPI ' ' ;IGNORE BLANKS
002B C0 RNZ ;IN TEXT (WHERE DE->)
002C 13 INX D ;AND RETURN THE FIRST
002D C3 28 00 JMP SS1 ;NON-BLANK CHAR. IN A
0030 ;
0030 F1 POP PSW ;*** FINISH/RST 6 ***
0031 CD 91 05 CALL FIN ;CHECK END OF COMMAND
0034 C3 A4 05 JMP QWHAT ;PRINT "WHAT?" IF WRONG
0037 47 DB 'G'
0038 ;
0038 EF RST 5 ;*** TSTV OR RST 7 ***
0039 D6 40 SUI '@' ;TEST VARIABLES
003B D8 RC ;C:NOT A VARIABLE
003C C2 58 00 JNZ TV1 ;NOT "@" ARRAY
003F 13 INX D ;IT IS THE "@" ARRAY
0040 CD FB 04 CALL PARN ;@ SHOULD BE FOLLOWED
0043 29 DAD H ;BY (EXPR) AS ITS INDEX
0044 DA 9F 00 JC QHOW ;IS INDEX TOO BIG?
0047 D5 PUSH D ;WILL IT OVERWRITE
0048 EB XCHG ;TEXT?
0049 CD 3D 05 CALL SIZE ;FIND SIZE OF FREE
004C E7 RST 4 ;AND CHECK THAT
004D DA D0 05 JC ASORRY ;IF SO, SAY "SORRY"
0050 21 00 13 LXI H,VARBGN ;IF NOT GET ADDRESS
0053 CD 60 05 CALL SUBDE ;OF @(EXPR) AND PUT IT
0056 D1 POP D ;IN HL
0057 C9 RET ;C FLAG IS CLEARED
0058 FE 1B TV1: CPI 27 ;NOT @, IS IT A TO Z?
005A 3F CMC ;IF NOT RETURN C FLAG
005B D8 RC
005C 13 INX D ;IF A THROUGH Z
005D 21 00 13 LXI H,VARBGN ;COMPUTE ADDRESS OF
0060 07 RLC ;THAT VARIABLE
0061 85 ADD L ;AND RETURN IT IN HL
0062 6F MOV L,A ;WITH C FLAG CLEARED
0063 3E 00 MVI A,0
0065 8C ADC H
0066 67 MOV H,A
0067 C9 RET
0068 ;
0068 ;TSTC: XTHL ;*** TSTC OR RST 1 ***
0068 ; RST 5 ;THIS IS AT LOC. 8
0068 ; CMP M ;AND THEN JUMP HERE
0068 23 TC1: INX H ;COMPARE THE BYTE THAT
0069 CA 73 00 JZ TC2 ;FOLLOWS THE RST INST.
006C C5 PUSH B ;WITH THE TEXT (DE->)
006D 4E MOV C,M ;IF NOT =, ADD THE 2ND
006E 06 00 MVI B,0 ;BYTE THAT FOLLOWS THE
0070 09 DAD B ;RST TO THE OLD PC
0071 C1 POP B ;I.E., DO A RELATIVE
0072 1B DCX D ;JUMP IF NOT =
0073 13 TC2: INX D ;IF =, SKIP THOSE BYTES
0074 23 INX H ;AND CONTINUE
0075 E3 XTHL
0076 C9 RET
0077 ;
0077 21 00 00 TSTNUM: LXI H,0 ;*** TSTNUM ***
007A 44 MOV B,H ;TEST IF THE TEXT IS
007B EF RST 5 ;A NUMBER
007C FE 30 TN1: CPI '0' ;IF NOT, RETURN 0 IN
007E D8 RC ;B AND HL
007F FE 3A CPI 3AH ;IF NUMBERS, CONVERT
0081 D0 RNC ;TO BINARY IN HL AND
0082 3E F0 MVI A,0F0H ;SET B TO # OF DIGITS
0084 A4 ANA H ;IF H>255, THERE IS NO
0085 C2 9F 00 JNZ QHOW ;ROOM FOR NEXT DIGIT
0088 04 INR B ;B COUNTS # OF DIGITS
0089 C5 PUSH B
008A 44 MOV B,H ;HL=10*HL+(NEW DIGIT)
008B 4D MOV C,L
008C 29 DAD H ;WHERE 10* IS DONE BY
008D 29 DAD H ;SHIFT AND ADD
008E 09 DAD B
008F 29 DAD H
0090 1A LDAX D ;AND (DIGIT) IS FROM
0091 13 INX D ;STRIPPING THE ASCII
0092 E6 0F ANI 0FH ;CODE
0094 85 ADD L
0095 6F MOV L,A
0096 3E 00 MVI A,0
0098 8C ADC H
0099 67 MOV H,A
009A C1 POP B
009B 1A LDAX D ;DO THIS DIGIT AFTER
009C F2 7C 00 JP TN1 ;DIGIT. S SAYS OVERFLOW
009F D5 QHOW: PUSH D ;*** ERROR "HOW?" ***
00A0 11 A6 00 AHOW: LXI D,HOW
00A3 C3 A8 05 JMP ERROR
00A6 48 4F 57 3F 0D HOW: DB 'HOW?',CR
00AB 4F 4B 0D OK: DB 'OK',CR
00AE 57 48 41 54 3F 0D WHAT: DB 'WHAT?',CR
00B4 53 4F 52 52 59 0D SORRY: DB 'SORRY',CR
00BA ;
00BA ;*************************************************************
00BA ;*
00BA ;* *** MAIN ***
00BA ;*
00BA ;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
00BA ;* AND STORES IT IN THE MEMORY.
00BA ;*
00BA ;* AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
00BA ;* STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
00BA ;* ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
00BA ;* NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
00BA ;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
00BA ;* IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
00BA ;* NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
00BA ;* THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
00BA ;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
00BA ;*
00BA ;* AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
00BA ;* LOOPS BACK AND ASK FOR ANOTHER LINE. THIS LOOP WILL BE
00BA ;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
00BA ;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
00BA ;*
00BA ;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
00BA ;* LABELED "TXTBGN" AND ENDED AT "TXTEND". WE ALWAYS FILL THIS
00BA ;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
00BA ;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
00BA ;*
00BA ;* THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
00BA ;* THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
00BA ;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
00BA ;* (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
00BA ;*
00BA ;START: LXI SP,STACK ;THIS IS AT LOC. 0
00BA CD 0E 00 ST1: CALL CRLF ;AND JUMP TO HERE
00BD 11 AB 00 LXI D,OK ;DE->STRING
00C0 97 SUB A ;A=0
00C1 CD 3C 06 CALL PRTSTG ;PRINT STRING UNTIL CR
00C4 21 CB 00 LXI H,ST2+1 ;LITERAL 0
00C7 22 01 10 SHLD CURRNT ;CURRENT->LINE # = 0
00CA 21 00 00 ST2: LXI H,0
00CD 22 07 10 SHLD LOPVAR
00D0 22 03 10 SHLD STKGOS
00D3 3E 3E ST3: MVI A,'>' ;PROMPT '>' AND
00D5 CD D6 05 CALL GETLN ;READ A LINE
00D8 D5 PUSH D ;DE->END OF LINE
00D9 11 37 13 LXI D,BUFFER ;DE->BEGINNING OF LINE
00DC CD 77 00 CALL TSTNUM ;TEST IF IT IS A NUMBER
00DF EF RST 5
00E0 7C MOV A,H ;HL=VALUE OF THE # OR
00E1 B5 ORA L ;0 IF NO # WAS FOUND
00E2 C1 POP B ;BC->END OF LINE
00E3 CA F5 01 JZ DIRECT
00E6 1B DCX D ;BACKUP DE AND SAVE
00E7 7C MOV A,H ;VALUE OF LINE # THERE
00E8 12 STAX D
00E9 1B DCX D
00EA 7D MOV A,L
00EB 12 STAX D
00EC C5 PUSH B ;BC,DE->BEGIN, END
00ED D5 PUSH D
00EE 79 MOV A,C
00EF 93 SUB E
00F0 F5 PUSH PSW ;A=# OF BYTES IN LINE
00F1 CD 14 06 CALL FNDLN ;FIND THIS LINE IN SAVE
00F4 D5 PUSH D ;AREA, DE->SAVE AREA
00F5 C2 08 01 JNZ ST4 ;NZ:NOT FOUND, INSERT
00F8 D5 PUSH D ;Z:FOUND, DELETE IT
00F9 CD 30 06 CALL FNDNXT ;FIND NEXT LINE
00FC ;DE->NEXT LINE
00FC C1 POP B ;BC->LINE TO BE DELETED
00FD 2A 13 10 LHLD TXTUNF ;HL->UNFILLED SAVE AREA
0100 CD BD 06 CALL MVUP ;MOVE UP TO DELETE
0103 60 MOV H,B ;TXTUNF->UNFILLED AREA
0104 69 MOV L,C
0105 22 13 10 SHLD TXTUNF ;UPDATE
0108 C1 ST4: POP B ;GET READY TO INSERT
0109 2A 13 10 LHLD TXTUNF ;BUT FIRST CHECK IF
010C F1 POP PSW ;THE LENGTH OF NEW LINE
010D E5 PUSH H ;IS 3 (LINE # AND CR)
010E FE 03 CPI 3 ;THEN DO NOT INSERT
0110 CA 00 00 JZ START ;MUST CLEAR THE STACK
0113 85 ADD L ;COMPUTE NEW TXTUNF
0114 6F MOV L,A
0115 3E 00 MVI A,0
0117 8C ADC H
0118 67 MOV H,A ;HL->NEW UNFILLED AREA
0119 11 00 13 LXI D,TXTEND ;CHECK TO SEE IF THERE
011C E7 RST 4 ;IS ENOUGH SPACE
011D D2 CF 05 JNC QSORRY ;SORRY, NO ROOM FOR IT
0120 22 13 10 SHLD TXTUNF ;OK, UPDATE TXTUNF
0123 D1 POP D ;DE->OLD UNFILLED AREA
0124 CD C6 06 CALL MVDOWN
0127 D1 POP D ;DE->BEGIN, HL->END
0128 E1 POP H
0129 CD BD 06 CALL MVUP ;MOVE NEW LINE TO SAVE
012C C3 D3 00 JMP ST3 ;AREA
012F ;
012F ;*************************************************************
012F ;*
012F ;* *** TABLES *** DIRECT *** & EXEC ***
012F ;*
012F ;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
012F ;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
012F ;* OF CODE ACCORDING TO THE TABLE.
012F ;*
012F ;* AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
012F ;* TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
012F ;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
012F ;* ALL DIRECT AND STATEMENT COMMANDS.
012F ;*
012F ;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
012F ;* MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
012F ;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
012F ;*
012F ;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
012F ;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
012F ;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
012F ;* BYTE SET TO 1.
012F ;*
012F ;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
012F ;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
012F ;* MATCH THIS NULL ITEM AS DEFAULT.
012F ;*
012F TAB1: EQU $
012F 4C 49 53 54 DB 'LIST'
**MACRO UNROLL - ITEM
0133 82 DB >LIST + 0x80
0134 61 DB <LIST
0135 52 55 4E DB 'RUN'
**MACRO UNROLL - ITEM
0138 82 DB >RUN + 0x80
0139 33 DB <RUN
013A 4E 45 57 DB 'NEW'
**MACRO UNROLL - ITEM
013D 82 DB >NEW + 0x80
013E 26 DB <NEW
013F TAB2: EQU $
013F 4E 45 58 54 DB 'NEXT'
**MACRO UNROLL - ITEM
0143 83 DB >NEXT + 0x80
0144 49 DB <NEXT
0145 4C 45 54 DB 'LET'
**MACRO UNROLL - ITEM
0148 84 DB >LET + 0x80
0149 07 DB <LET
014A 49 46 DB 'IF'
**MACRO UNROLL - ITEM
014C 83 DB >IFF + 0x80
014D 9A DB <IFF
014E 47 4F 54 4F DB 'GOTO'
**MACRO UNROLL - ITEM
0152 82 DB >GOTO + 0x80
0153 52 DB <GOTO
0154 47 4F 53 55 42 DB 'GOSUB'
**MACRO UNROLL - ITEM
0159 82 DB >GOSUB + 0x80
015A B1 DB <GOSUB
015B 52 45 54 55 52 4E DB 'RETURN'
**MACRO UNROLL - ITEM
0161 82 DB >RETURN + 0x80
0162 D1 DB <RETURN
0163 52 45 4D DB 'REM'
**MACRO UNROLL - ITEM
0166 83 DB >REM + 0x80
0167 96 DB <REM
0168 46 4F 52 DB 'FOR'
**MACRO UNROLL - ITEM
016B 82 DB >FOR + 0x80
016C EA DB <FOR
016D 49 4E 50 55 54 DB 'INPUT'
**MACRO UNROLL - ITEM
0172 83 DB >INPUT + 0x80
0173 B1 DB <INPUT
0174 50 52 49 4E 54 DB 'PRINT'
**MACRO UNROLL - ITEM
0179 82 DB >PRINT + 0x80
017A 79 DB <PRINT
017B 53 54 4F 50 DB 'STOP'
**MACRO UNROLL - ITEM
017F 82 DB >STOP + 0x80
0180 2F DB <STOP
**MACRO UNROLL - ITEM
0181 84 DB >DEFLT + 0x80
0182 01 DB <DEFLT
0183 59 4F 55 20 4D 41 59 20 49 4E 53 45 52 54 20 20 4D 4F 52 45 20 43 4F 4D 4D 41 4E 44 53 2E DB 'YOU MAY INSERT MORE COMMANDS.'
01A1 TAB4: EQU $
01A1 52 4E 44 DB 'RND'
**MACRO UNROLL - ITEM
01A4 85 DB >RND + 0x80
01A5 06 DB <RND
01A6 41 42 53 DB 'ABS'
**MACRO UNROLL - ITEM
01A9 85 DB >ABS + 0x80
01AA 31 DB <ABS
01AB 53 49 5A 45 DB 'SIZE'
**MACRO UNROLL - ITEM
01AF 85 DB >SIZE + 0x80
01B0 3D DB <SIZE
**MACRO UNROLL - ITEM
01B1 84 DB >XP40 + 0x80
01B2 EC DB <XP40
01B3 59 4F 55 20 4D 41 59 20 49 4E 53 45 52 54 20 20 4D 4F 52 45 20 46 55 4E 43 54 49 4F 4E 53 DB 'YOU MAY INSERT MORE FUNCTIONS'
01D1 TAB5: EQU $
01D1 54 4F DB 'TO'
**MACRO UNROLL - ITEM
01D3 82 DB >FR1 + 0x80
01D4 FA DB <FR1
**MACRO UNROLL - ITEM
01D5 85 DB >QWHAT + 0x80
01D6 A4 DB <QWHAT
01D7 TAB6: EQU $
01D7 53 54 45 50 DB 'STEP'
**MACRO UNROLL - ITEM
01DB 83 DB >FR2 + 0x80
01DC 04 DB <FR2
**MACRO UNROLL - ITEM
01DD 83 DB >FR3 + 0x80
01DE 08 DB <FR3
01DF TAB8: EQU $
01DF 3E 3D DB '>='
**MACRO UNROLL - ITEM
01E1 84 DB >XP11 + 0x80
01E2 17 DB <XP11
01E3 23 DB '#'
**MACRO UNROLL - ITEM
01E4 84 DB >XP12 + 0x80
01E5 1D DB <XP12
01E6 3E DB '>'
**MACRO UNROLL - ITEM
01E7 84 DB >XP13 + 0x80
01E8 23 DB <XP13
01E9 3D DB '='
**MACRO UNROLL - ITEM
01EA 84 DB >XP15 + 0x80
01EB 32 DB <XP15
01EC 3C 3D DB '<='
**MACRO UNROLL - ITEM
01EE 84 DB >XP14 + 0x80
01EF 2A DB <XP14
01F0 3C DB '<'
**MACRO UNROLL - ITEM
01F1 84 DB >XP16 + 0x80
01F2 38 DB <XP16
**MACRO UNROLL - ITEM
01F3 84 DB >XP17 + 0x80
01F4 3E DB <XP17
01F5 ;
01F5 21 2E 01 DIRECT: LXI H,TAB1-1 ;*** DIRECT ***
01F8 ;
01F8 EXEC: EQU $
01F8 EF EX0: RST 5 ;IGNORE LEADING BLANKS
01F9 D5 PUSH D ;SAVE POINTER
01FA 1A EX1: LDAX D ;IF FOUND '.' IN STRING
01FB 13 INX D ;BEFORE ANY MISMATCH
01FC FE 2E CPI '.' ;WE DECLARE A MATCH
01FE CA 17 02 JZ EX3
0201 23 INX H ;HL->TABLE
0202 BE CMP M ;IF MATCH, TEST NEXT
0203 CA FA 01 JZ EX1
0206 3E 7F MVI A,7FH ;ELSE SEE IF BIT 7
0208 1B DCX D ;OF TABLE IS SET, WHICH
0209 BE CMP M ;IS THE JUMP ADDR. (HI)
020A DA 1E 02 JC EX5 ;C:YES, MATCHED
020D 23 EX2: INX H ;NC:NO, FIND JUMP ADDR.
020E BE CMP M
020F D2 0D 02 JNC EX2
0212 23 INX H ;BUMP TO NEXT TAB. ITEM
0213 D1 POP D ;RESTORE STRING POINTER
0214 C3 F8 01 JMP EX0 ;TEST AGAINST NEXT ITEM
0217 3E 7F EX3: MVI A,7FH ;PARTIAL MATCH, FIND
0219 23 EX4: INX H ;JUMP ADDR., WHICH IS
021A BE CMP M ;FLAGGED BY BIT 7
021B D2 19 02 JNC EX4
021E 7E EX5: MOV A,M ;LOAD HL WITH THE JUMP
021F 23 INX H ;ADDRESS FROM THE TABLE
0220 6E MOV L,M
0221 E6 7F ANI 07FH ;MASK OFF BIT 7
0223 67 MOV H,A
0224 F1 POP PSW ;CLEAN UP THE GABAGE
0225 E9 PCHL ;AND WE GO DO IT
0226 ;
0226 ;*************************************************************
0226 ;*
0226 ;* WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
0226 ;* COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
0226 ;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
0226 ;* SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
0226 ;* TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
0226 ;*
0226 ;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'START'
0226 ;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
0226 ;* GO BACK TO 'START'.
0226 ;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
0226 ;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
0226 ;* FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'START', ELSE
0226 ;* GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
0226 ;*************************************************************
0226 ;*
0226 ;* *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
0226 ;*
0226 ;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
0226 ;*
0226 ;* 'STOP(CR)' GOES BACK TO 'START'
0226 ;*
0226 ;* 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
0226 ;* 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
0226 ;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
0226 ;*
0226 ;* THERE ARE 3 MORE ENTRIES IN 'RUN':
0226 ;* 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
0226 ;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
0226 ;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
0226 ;*
0226 ;* 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
0226 ;* LINE, AND JUMP TO 'RUNTSL' TO DO IT.
0226 ;*
0226 CD A0 05 NEW: CALL ENDCHK ;*** NEW(CR) ***
0229 21 15 10 LXI H,TXTBGN
022C 22 13 10 SHLD TXTUNF
022F ;
022F CD A0 05 STOP: CALL ENDCHK ;*** STOP(CR) ***
0232 C7 RST 0
0233 ;
0233 CD A0 05 RUN: CALL ENDCHK ;*** RUN(CR) ***
0236 11 15 10 LXI D,TXTBGN ;FIRST SAVED LINE
0239 ;
0239 21 00 00 RUNNXL: LXI H,0 ;*** RUNNXL ***
023C CD 1C 06 CALL FDLNP ;FIND WHATEVER LINE #
023F DA 00 00 JC START ;C:PASSED TXTUNF, QUIT
0242 ;
0242 EB RUNTSL: XCHG ;*** RUNTSL ***
0243 22 01 10 SHLD CURRNT ;SET 'CURRENT'->LINE #
0246 EB XCHG
0247 13 INX D ;BUMP PASS LINE #
0248 13 INX D
0249 ;
0249 CD 32 07 RUNSML: CALL CHKIO ;*** RUNSML ***
024C 21 3E 01 LXI H,TAB2-1 ;FIND COMMAND IN TAB2
024F C3 F8 01 JMP EXEC ;AND EXECUTE IT
0252 ;
0252 DF GOTO: RST 3 ;*** GOTO EXPR ***
0253 D5 PUSH D ;SAVE FOR ERROR ROUTINE
0254 CD A0 05 CALL ENDCHK ;MUST FIND A CR
0257 CD 14 06 CALL FNDLN ;FIND THE TARGET LINE
025A C2 A0 00 JNZ AHOW ;NO SUCH LINE #
025D F1 POP PSW ;CLEAR THE PUSH DE
025E C3 42 02 JMP RUNTSL ;GO DO IT
0261 ;
0261 ;*************************************************************
0261 ;*
0261 ;* *** LIST *** & PRINT ***
0261 ;*
0261 ;* LIST HAS TWO FORMS:
0261 ;* 'LIST(CR)' LISTS ALL SAVED LINES
0261 ;* 'LIST #(CR)' START LIST AT THIS LINE #
0261 ;* YOU CAN STOP THE LISTING BY CONTROL C KEY
0261 ;*
0261 ;* PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
0261 ;* WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
0261 ;* ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
0261 ;*
0261 ;* A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
0261 ;* THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
0261 ;* BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
0261 ;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
0261 ;* SPECIFIED, 6 POSITIONS WILL BE USED.
0261 ;*
0261 ;* A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
0261 ;* DOUBLE QUOTES.
0261 ;*
0261 ;* A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
0261 ;*
0261 ;* A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
0261 ;* PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
0261 ;* ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
0261 ;*
0261 CD 77 00 LIST: CALL TSTNUM ;TEST IF THERE IS A #
0264 CD A0 05 CALL ENDCHK ;IF NO # WE GET A 0
0267 CD 14 06 CALL FNDLN ;FIND THIS OR NEXT LINE
026A DA 00 00 LS1: JC START ;C:PASSED TXTUNF
026D CD AA 06 CALL PRTLN ;PRINT THE LINE
0270 CD 32 07 CALL CHKIO ;STOP IF HIT CONTROL-C
0273 CD 1C 06 CALL FDLNP ;FIND NEXT LINE
0276 C3 6A 02 JMP LS1 ;AND LOOP BACK
0279 ;
0279 0E 06 PRINT: MVI C,6 ;C = # OF SPACES
027B CF RST 1 ;IF NULL LIST & ";"
027C 3B DB ";"
027D 06 DB PR2-$-1
027E CD 0E 00 CALL CRLF ;GIVE CR-LF AND
0281 C3 49 02 JMP RUNSML ;CONTINUE SAME LINE
0284 CF PR2: RST 1 ;IF NULL LIST (CR)
0285 0D DB CR
0286 06 DB PR0-$-1
0287 CD 0E 00 CALL CRLF ;ALSO GIVE CR-LF AND
028A C3 39 02 JMP RUNNXL ;GO TO NEXT LINE
028D CF PR0: RST 1 ;ELSE IS IT FORMAT?
028E 23 DB '#'
028F 05 DB PR1-$-1
0290 DF RST 3 ;YES, EVALUATE EXPR.
0291 4D MOV C,L ;AND SAVE IT IN C
0292 C3 9B 02 JMP PR3 ;LOOK FOR MORE TO PRINT
0295 CD 48 06 PR1: CALL QTSTG ;OR IS IT A STRING?
0298 C3 A8 02 JMP PR8 ;IF NOT, MUST BE EXPR.
029B CF PR3: RST 1 ;IF ",", GO FIND NEXT
029C 2C DB ","
029D 06 DB PR6-$-1
029E CD 91 05 CALL FIN ;IN THE LIST.
02A1 C3 8D 02 JMP PR0 ;LIST CONTINUES
02A4 CD 0E 00 PR6: CALL CRLF ;LIST ENDS
02A7 F7 RST 6
02A8 DF PR8: RST 3 ;EVALUATE THE EXPR
02A9 C5 PUSH B
02AA CD 6E 06 CALL PRTNUM ;PRINT THE VALUE
02AD C1 POP B
02AE C3 9B 02 JMP PR3 ;MORE TO PRINT?
02B1 ;
02B1 ;*************************************************************
02B1 ;*
02B1 ;* *** GOSUB *** & RETURN ***
02B1 ;*
02B1 ;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
02B1 ;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
02B1 ;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
02B1 ;* SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
02B1 ;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
02B1 ;* THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
02B1 ;* SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
02B1 ;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
02B1 ;* BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
02B1 ;*
02B1 ;* 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
02B1 ;* RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
02B1 ;* 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
02B1 ;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
02B1 ;*
02B1 CD F1 06 GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR"
02B4 DF RST 3 ;PARAMETERS
02B5 D5 PUSH D ;AND TEXT POINTER
02B6 CD 14 06 CALL FNDLN ;FIND THE TARGET LINE
02B9 C2 A0 00 JNZ AHOW ;NOT THERE. SAY "HOW?"
02BC 2A 01 10 LHLD CURRNT ;FOUND IT, SAVE OLD
02BF E5 PUSH H ;'CURRNT' OLD 'STKGOS'
02C0 2A 03 10 LHLD STKGOS
02C3 E5 PUSH H
02C4 21 00 00 LXI H,0 ;AND LOAD NEW ONES
02C7 22 07 10 SHLD LOPVAR
02CA 39 DAD SP
02CB 22 03 10 SHLD STKGOS
02CE C3 42 02 JMP RUNTSL ;THEN RUN THAT LINE
02D1 CD A0 05 RETURN: CALL ENDCHK ;THERE MUST BE A CR
02D4 2A 03 10 LHLD STKGOS ;OLD STACK POINTER
02D7 7C MOV A,H ;0 MEANS NOT EXIST
02D8 B5 ORA L
02D9 CA A4 05 JZ QWHAT ;SO, WE SAY: "WHAT?"
02DC F9 SPHL ;ELSE, RESTORE IT
02DD E1 POP H
02DE 22 03 10 SHLD STKGOS ;AND THE OLD 'STKGOS'
02E1 E1 POP H
02E2 22 01 10 SHLD CURRNT ;AND THE OLD 'CURRNT'
02E5 D1 POP D ;OLD TEXT POINTER
02E6 CD D5 06 CALL POPA ;OLD "FOR" PARAMETERS
02E9 F7 RST 6 ;AND WE ARE BACK HOME
02EA ;
02EA ;*************************************************************
02EA ;*
02EA ;* *** FOR *** & NEXT ***
02EA ;*
02EA ;* 'FOR' HAS TWO FORMS:
02EA ;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2'
02EA ;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
02EA ;* EXP1=1. (I.E., WITH A STEP OF +1.)
02EA ;* TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
02EA ;* CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXPR2 AND EXP1
02EA ;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
02EA ;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
02EA ;* 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
02EA ;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
02EA ;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
02EA ;* BEFORE THE NEW ONE OVERWRITES IT.
02EA ;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
02EA ;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
02EA ;* IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
02EA ;* (PURGED FROM THE STACK..)
02EA ;*
02EA ;* 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
02EA ;* END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
02EA ;* WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
02EA ;* THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
02EA ;* DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
02EA ;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
02EA ;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
02EA ;* FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
02EA ;* IS PURGED AND EXECUTION CONTINUES.
02EA ;*
02EA CD F1 06 FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA
02ED CD 7E 05 CALL SETVAL ;SET THE CONTROL VAR.
02F0 2B DCX H ;HL IS ITS ADDRESS
02F1 22 07 10 SHLD LOPVAR ;SAVE THAT
02F4 21 D0 01 LXI H,TAB5-1 ;USE 'EXEC' TO LOOK
02F7 C3 F8 01 JMP EXEC ;FOR THE WORD 'TO'
02FA DF FR1: RST 3 ;EVALUATE THE LIMIT
02FB 22 0B 10 SHLD LOPLMT ;SAVE THAT
02FE 21 D6 01 LXI H,TAB6-1 ;USE 'EXEC' TO LOOK
0301 C3 F8 01 JMP EXEC ;FOR THE WORD 'STEP'
0304 DF FR2: RST 3 ;FOUND IT, GET STEP
0305 C3 0B 03 JMP FR4
0308 21 01 00 FR3: LXI H,1 ;NOT FOUND, SET TO 1
030B 22 09 10 FR4: SHLD LOPINC ;SAVE THAT TOO
030E 2A 01 10 FR5: LHLD CURRNT ;SAVE CURRENT LINE #
0311 22 0D 10 SHLD LOPLN
0314 EB XCHG ;AND TEXT POINTER
0315 22 0F 10 SHLD LOPPT
0318 01 0A 00 LXI B,10 ;DIG INTO STACK TO
031B 2A 07 10 LHLD LOPVAR ;FIND 'LOPVAR'
031E EB XCHG
031F 60 MOV H,B
0320 68 MOV L,B ;HL=0 NOW
0321 39 DAD SP ;HERE IS THE STACK
0322 3E DB 3EH
0323 09 FR7: DAD B ;EACH LEVEL IS 10 DEEP
0324 7E MOV A,M ;GET THAT OLD 'LOPVAR'
0325 23 INX H
0326 B6 ORA M
0327 CA 44 03 JZ FR8 ;0 SAYS NO MORE IN IT
032A 7E MOV A,M
032B 2B DCX H
032C BA CMP D ;SAME AS THIS ONE?
032D C2 23 03 JNZ FR7
0330 7E MOV A,M ;THE OTHER HALF?
0331 BB CMP E
0332 C2 23 03 JNZ FR7
0335 EB XCHG ;YES, FOUND ONE
0336 21 00 00 LXI H,0
0339 39 DAD SP ;TRY TO MOVE SP
033A 44 MOV B,H
033B 4D MOV C,L
033C 21 0A 00 LXI H,10
033F 19 DAD D
0340 CD C6 06 CALL MVDOWN ;AND PURGE 10 WORDS
0343 F9 SPHL ;IN THE STACK
0344 2A 0F 10 FR8: LHLD LOPPT ;JOB DONE, RESTORE DE
0347 EB XCHG
0348 F7 RST 6 ;AND CONTINUE
0349 ;
0349 FF NEXT: RST 7 ;GET ADDRESS OF VAR.
034A DA A4 05 JC QWHAT ;NO VARIABLE, "WHAT?"
034D 22 05 10 SHLD VARNXT ;YES, SAVE IT
0350 D5 NX0: PUSH D ;SAVE TEXT POINTER
0351 EB XCHG
0352 2A 07 10 LHLD LOPVAR ;GET VAR. IN 'FOR'
0355 7C MOV A,H
0356 B5 ORA L ;0 SAYS NEVER HAD ONE
0357 CA A5 05 JZ AWHAT ;SO WE ASK: "WHAT?"
035A E7 RST 4 ;ELSE WE CHECK THEM
035B CA 68 03 JZ NX3 ;OK, THEY AGREE
035E D1 POP D ;NO, LET'S SEE
035F CD D5 06 CALL POPA ;PURGE CURRENT LOOP
0362 2A 05 10 LHLD VARNXT ;AND POP ONE LEVEL
0365 C3 50 03 JMP NX0 ;GO CHECK AGAIN
0368 5E NX3: MOV E,M ;COME HERE WHEN AGREED
0369 23 INX H
036A 56 MOV D,M ;DE=VALUE OF VAR.
036B 2A 09 10 LHLD LOPINC
036E E5 PUSH H
036F 19 DAD D ;ADD ONE STEP
0370 EB XCHG
0371 2A 07 10 LHLD LOPVAR ;PUT IT BACK
0374 73 MOV M,E
0375 23 INX H
0376 72 MOV M,D
0377 2A 0B 10 LHLD LOPLMT ;HL->LIMIT
037A F1 POP PSW ;OLD HL
037B B7 ORA A
037C F2 80 03 JP NX1 ;STEP > 0
037F EB XCHG ;STEP < 0
0380 CD 76 05 NX1: CALL CKHLDE ;COMPARE WITH LIMIT
0383 D1 POP D ;RESTORE TEXT POINTER
0384 DA 92 03 JC NX2 ;OUTSIDE LIMIT
0387 2A 0D 10 LHLD LOPLN ;WITHIN LIMIT, GO
038A 22 01 10 SHLD CURRNT ;BACK TO THE SAVED
038D 2A 0F 10 LHLD LOPPT ;'CURRNT' AND TEXT
0390 EB XCHG ;POINTER
0391 F7 RST 6
0392 CD D5 06 NX2: CALL POPA ;PURGE THIS LOOP
0395 F7 RST 6
0396 ;
0396 ;*************************************************************
0396 ;*
0396 ;* *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
0396 ;*
0396 ;* 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
0396 ;* TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
0396 ;*
0396 ;* 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
0396 ;* COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
0396 ;* NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
0396 ;* EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
0396 ;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
0396 ;* EXECUTION CONTINUES AT THE NEXT LINE.
0396 ;*
0396 ;* 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
0396 ;* BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
0396 ;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
0396 ;* IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
0396 ;* PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
0396 ;* EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
0396 ;* VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
0396 ;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
0396 ;* PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
0396 ;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
0396 ;*
0396 ;* IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
0396 ;* "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
0396 ;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
0396 ;* THIS IS HANDLED IN 'INPERR'.
0396 ;*
0396 ;* 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
0396 ;* EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
0396 ;* TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
0396 ;* TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
0396 ;* THIS IS DONE BY 'DEFLT'.
0396 ;*
0396 21 00 00 REM: LXI H,0 ;*** REM ***
0399 3E DB 3EH ;THIS IS LIKE 'IF 0'
039A ;
039A DF IFF: RST 3 ;*** IF ***
039B 7C MOV A,H ;IS THE EXPR.=0?
039C B5 ORA L
039D C2 49 02 JNZ RUNSML ;NO, CONTINUE
03A0 CD 32 06 CALL FNDSKP ;YES, SKIP REST OF LINE
03A3 D2 42 02 JNC RUNTSL ;AND RUN THE NEXT LINE
03A6 C7 RST 0 ;IF NO NEXT, RE-START
03A7 ;
03A7 2A 05 10 INPERR: LHLD STKINP ;*** INPERR ***
03AA F9 SPHL ;RESTORE OLD SP
03AB E1 POP H ;AND OLD 'CURRNT'
03AC 22 01 10 SHLD CURRNT
03AF D1 POP D ;AND OLD TEXT POINTER
03B0 D1 POP D
03B1 ;
03B1 INPUT: EQU $
03B1 D5 IP1: PUSH D ;SAVE IN CASE OF ERROR
03B2 CD 48 06 CALL QTSTG ;IS NEXT ITEM A STRING?
03B5 C3 BF 03 JMP IP2 ;NO
03B8 FF RST 7 ;YES, BUT FOLLOWED BY A
03B9 DA F9 03 JC IP4 ;VARIABLE? NO.
03BC C3 CF 03 JMP IP3 ;YES. INPUT VARIABLE
03BF D5 IP2: PUSH D ;SAVE FOR 'PRTSTG'
03C0 FF RST 7 ;MUST BE VARIABLE NOW
03C1 DA A4 05 JC QWHAT ;"WHAT?" IT IS NOT?
03C4 1A LDAX D ;GET READY FOR 'PRTSTR'
03C5 4F MOV C,A
03C6 97 SUB A
03C7 12 STAX D
03C8 D1 POP D
03C9 CD 3C 06 CALL PRTSTG ;PRINT STRING AS PROMPT
03CC 79 MOV A,C ;RESTORE TEXT
03CD 1B DCX D
03CE 12 STAX D
03CF D5 IP3: PUSH D ;SAVE IN CASE OF ERROR
03D0 EB XCHG
03D1 2A 01 10 LHLD CURRNT ;ALSO SAVE 'CURRNT'
03D4 E5 PUSH H
03D5 21 B1 03 LXI H,IP1 ;A NEGATIVE NUMBER
03D8 22 01 10 SHLD CURRNT ;AS A FLAG
03DB 21 00 00 LXI H,0 ;SAVE SP TOO
03DE 39 DAD SP
03DF 22 05 10 SHLD STKINP
03E2 D5 PUSH D ;OLD HL
03E3 3E 3A MVI A,':' ;PRINT THIS TOO
03E5 CD D6 05 CALL GETLN ;AND GET A LINE
03E8 11 37 13 LXI D,BUFFER ;POINTS TO BUFFER
03EB DF RST 3 ;EVALUATE INPUT
03EC 00 NOP ;CAN BE 'CALL ENDCHK'
03ED 00 NOP
03EE 00 NOP
03EF D1 POP D ;OK, GET OLD HL
03F0 EB XCHG
03F1 73 MOV M,E ;SAVE VALUE IN VAR.
03F2 23 INX H
03F3 72 MOV M,D
03F4 E1 POP H ;GET OLD 'CURRNT'
03F5 22 01 10 SHLD CURRNT
03F8 D1 POP D ;AND OLD TEXT POINTER
03F9 F1 IP4: POP PSW ;PURGE JUNK IN STACK
03FA CF RST 1 ;IS NEXT CH. ','?
03FB 2C DB ","
03FC 03 DB IP5-$-1
03FD C3 B1 03 JMP IP1 ;YES, MORE ITEMS.
0400 F7 IP5: RST 6
0401 ;
0401 1A DEFLT: LDAX D ;*** DEFLT ***
0402 FE 0D CPI CR ;EMPTY LINE IS OK
0404 CA 10 04 JZ LT1 ;ELSE IT IS 'LET'
0407 ;
0407 CD 7E 05 LET: CALL SETVAL ;*** LET ***
040A CF RST 1 ;SET VALUE TO VAR.
040B 2C DB ","
040C 03 DB LT1-$-1
040D C3 07 04 JMP LET ;ITEM BY ITEM
0410 F7 LT1: RST 6 ;UNTIL FINISH
0411 ;
0411 ;*************************************************************
0411 ;*
0411 ;* *** EXPR ***
0411 ;*
0411 ;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
0411 ;* <EXPR>::<EXPR2>
0411 ;* <EXPR2><REL.OP.><EXPR2>
0411 ;* WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
0411 ;* RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
0411 ;* <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
0411 ;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
0411 ;* <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
0411 ;* <EXPR4>::=<VARIABLE>
0411 ;* <FUNCTION>
0411 ;* (<EXPR>)
0411 ;* <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
0411 ;* AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
0411 ;* <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
0411 ;*
0411 ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18
0411 ; PUSH H ;SAVE <EXPR2> VALUE
0411 21 DE 01 EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP.
0414 C3 F8 01 JMP EXEC ;GO DO IT
0417 CD 40 04 XP11: CALL XP18 ;REL.OP.">="
041A D8 RC ;NO, RETURN HL=0
041B 6F MOV L,A ;YES, RETURN HL=1
041C C9 RET
041D CD 40 04 XP12: CALL XP18 ;REL.OP."#"
0420 C8 RZ ;FALSE, RETURN HL=0
0421 6F MOV L,A ;TRUE, RETURN HL=1
0422 C9 RET
0423 CD 40 04 XP13: CALL XP18 ;REL.OP.">"
0426 C8 RZ ;FALSE
0427 D8 RC ;ALSO FALSE, HL=0
0428 6F MOV L,A ;TRUE, HL=1
0429 C9 RET
042A CD 40 04 XP14: CALL XP18 ;REL.OP."<="
042D 6F MOV L,A ;SET HL=1
042E C8 RZ ;REL. TRUE, RETURN
042F D8 RC
0430 6C MOV L,H ;ELSE SET HL=0
0431 C9 RET
0432 CD 40 04 XP15: CALL XP18 ;REL.OP."="
0435 C0 RNZ ;FALSE, RETURN HL=0
0436 6F MOV L,A ;ELSE SET HL=1
0437 C9 RET
0438 CD 40 04 XP16: CALL XP18 ;REL.OP."<"
043B D0 RNC ;FALSE, RETURN HL=0
043C 6F MOV L,A ;ELSE SET HL=1
043D C9 RET
043E E1 XP17: POP H ;NOT .REL.OP
043F C9 RET ;RETURN HL=<EXPR2>
0440 79 XP18: MOV A,C ;SUBROUTINE FOR ALL
0441 E1 POP H ;REL.OP.'S
0442 C1 POP B
0443 E5 PUSH H ;REVERSE TOP OF STACK
0444 C5 PUSH B
0445 4F MOV C,A
0446 CD 55 04 CALL EXPR2 ;GET 2ND <EXPR2>
0449 EB XCHG ;VALUE IN DE NOW
044A E3 XTHL ;1ST <EXPR2> IN HL
044B CD 76 05 CALL CKHLDE ;COMPARE 1ST WITH 2ND
044E D1 POP D ;RESTORE TEXT POINTER
044F 21 00 00 LXI H,0 ;SET HL=0, A=1
0452 3E 01 MVI A,1
0454 C9 RET
0455 ;
0455 CF EXPR2: RST 1 ;NEGATIVE SIGN?
0456 2D DB '-'
0457 06 DB XP21-$-1
0458 21 00 00 LXI H,0 ;YES, FAKE '0-'
045B C3 7F 04 JMP XP26 ;TREAT LIKE SUBTRACT
045E CF XP21: RST 1 ;POSITIVE SIGN? IGNORE
045F 2B DB '+'
0460 00 DB XP22-$-1
0461 CD 89 04 XP22: CALL EXPR3 ;1ST <EXPR3>
0464 CF XP23: RST 1 ;ADD?
0465 2B DB '+'
0466 15 DB XP25-$-1
0467 E5 PUSH H ;YES, SAVE VALUE
0468 CD 89 04 CALL EXPR3 ;GET 2ND <EXPR3>
046B EB XP24: XCHG ;2ND IN DE
046C E3 XTHL ;1ST IN HL
046D 7C MOV A,H ;COMPARE SIGN
046E AA XRA D
046F 7A MOV A,D
0470 19 DAD D
0471 D1 POP D ;RESTORE TEXT POINTER
0472 FA 64 04 JM XP23 ;1ST AND 2ND SIGN DIFFER
0475 AC XRA H ;1ST AND 2ND SIGN EQUAL
0476 F2 64 04 JP XP23 ;SO IS RESULT
0479 C3 9F 00 JMP QHOW ;ELSE WE HAVE OVERFLOW
047C CF XP25: RST 1 ;SUBTRACT?
047D 2D DB '-'
047E 83 DB XP42-$-1
047F E5 XP26: PUSH H ;YES, SAVE 1ST <EXPR3>
0480 CD 89 04 CALL EXPR3 ;GET 2ND <EXPR3>
0483 CD 6A 05 CALL CHGSGN ;NEGATE
0486 C3 6B 04 JMP XP24 ;AND ADD THEM
0489 ;
0489 CD E6 04 EXPR3: CALL EXPR4 ;GET 1ST <EXPR4>
048C CF XP31: RST 1 ;MULTIPLY?
048D 2A DB '*'
048E 2C DB XP34-$-1
048F E5 PUSH H ;YES, SAVE 1ST
0490 CD E6 04 CALL EXPR4 ;AND GET 2ND <EXPR4>
0493 06 00 MVI B,0 ;CLEAR B FOR SIGN
0495 CD 67 05 CALL CHKSGN ;CHECK SIGN
0498 EB XCHG ;2ND IN DE NOW
0499 E3 XTHL ;1ST IN HL
049A CD 67 05 CALL CHKSGN ;CHECK SIGN OF 1ST
049D 7C MOV A,H ;IS HL > 255 ?
049E B7 ORA A
049F CA A8 04 JZ XP32 ;NO
04A2 7A MOV A,D ;YES, HOW ABOUT DE
04A3 B2 ORA D
04A4 EB XCHG ;PUT SMALLER IN HL
04A5 C2 A0 00 JNZ AHOW ;ALSO >, WILL OVERFLOW
04A8 7D XP32: MOV A,L ;THIS IS DUMB
04A9 21 00 00 LXI H,0 ;CLEAR RESULT
04AC B7 ORA A ;ADD AND COUNT
04AD CA D8 04 JZ XP35
04B0 19 XP33: DAD D
04B1 DA A0 00 JC AHOW ;OVERFLOW
04B4 3D DCR A
04B5 C2 B0 04 JNZ XP33
04B8 C3 D8 04 JMP XP35 ;FINISHED
04BB CF XP34: RST 1 ;DIVIDE?
04BC 2F DB '/'
04BD 44 DB XP42-$-1
04BE E5 PUSH H ;YES, SAVE 1ST <EXPR4>
04BF CD E6 04 CALL EXPR4 ;AND GET THE SECOND ONE
04C2 06 00 MVI B,0 ;CLEAR B FOR SIGN
04C4 CD 67 05 CALL CHKSGN ;CHECK SIGN OF 2ND
04C7 EB XCHG ;PUT 2ND IN DE
04C8 E3 XTHL ;GET 1ST IN HL
04C9 CD 67 05 CALL CHKSGN ;CHECK SIGN OF 1ST
04CC 7A MOV A,D ;DIVIDE BY 0?
04CD B3 ORA E
04CE CA A0 00 JZ AHOW ;SAY "HOW?"
04D1 C5 PUSH B ;ELSE SAVE SIGN
04D2 CD 4A 05 CALL DIVIDE ;USE SUBROUTINE
04D5 60 MOV H,B ;RESULT IN HL NOW
04D6 69 MOV L,C
04D7 C1 POP B ;GET SIGN BACK
04D8 D1 XP35: POP D ;AND TEXT POINTER
04D9 7C MOV A,H ;HL MUST BE +
04DA B7 ORA A
04DB FA 9F 00 JM QHOW ;ELSE IT IS OVERFLOW
04DE 78 MOV A,B
04DF B7 ORA A
04E0 FC 6A 05 CM CHGSGN ;CHANGE SIGN IF NEEDED
04E3 C3 8C 04 JMP XP31 ;LOOK FOR MORE TERMS
04E6 ;
04E6 21 A0 01 EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4
04E9 C3 F8 01 JMP EXEC ;AND GO DO IT
04EC FF XP40: RST 7 ;NO, NOT A FUNCTION
04ED DA F5 04 JC XP41 ;NOR A VARIABLE
04F0 7E MOV A,M ;VARIABLE
04F1 23 INX H
04F2 66 MOV H,M ;VALUE IN HL
04F3 6F MOV L,A
04F4 C9 RET
04F5 CD 77 00 XP41: CALL TSTNUM ;OR IS IT A NUMBER
04F8 78 MOV A,B ;# OF DIGIT
04F9 B7 ORA A
04FA C0 RNZ ;OK
04FB CF PARN: RST 1
04FC 28 DB '('
04FD 05 DB XP43-$-1
04FE DF RST 3 ;"(EXPR)"
04FF CF RST 1
0500 29 DB ')'
0501 01 DB XP43-$-1
0502 C9 XP42: RET
0503 C3 A4 05 XP43: JMP QWHAT ;ELSE SAY: "WHAT?"
0506 ;
0506 CD FB 04 RND: CALL PARN ;*** RND(EXPR) ***
0509 7C MOV A,H ;EXPR MUST BE +
050A B7 ORA A
050B FA 9F 00 JM QHOW
050E B5 ORA L ;AND NON-ZERO
050F CA 9F 00 JZ QHOW
0512 D5 PUSH D ;SAVE BOTH
0513 E5 PUSH H
0514 2A 11 10 LHLD RANPNT ;GET MEMORY AS RANDOM
0517 11 FF 07 LXI D,LSTROM ;NUMBER
051A E7 RST 4
051B DA 21 05 JC RA1 ;WRAP AROUND IF LAST
051E 21 00 00 LXI H,START
0521 5E RA1: MOV E,M
0522 23 INX H
0523 56 MOV D,M
0524 22 11 10 SHLD RANPNT
0527 E1 POP H
0528 EB XCHG
0529 C5 PUSH B
052A CD 4A 05 CALL DIVIDE ;RND(N)=MOD(M,N)+1
052D C1 POP B
052E D1 POP D
052F 23 INX H
0530 C9 RET
0531 ;
0531 CD FB 04 ABS: CALL PARN ;*** ABS(EXPR) ***
0534 CD 67 05 CALL CHKSGN ;CHECK SIGN
0537 7C MOV A,H ;NOTE THAT -32768
0538 B4 ORA H ;CANNOT CHANGE SIGN
0539 FA 9F 00 JM QHOW ;SO SAY: "HOW?"
053C C9 RET
053D ;
053D 2A 13 10 SIZE: LHLD TXTUNF ;*** SIZE ***
0540 D5 PUSH D ;GET THE NUMBER OF FREE
0541 EB XCHG ;BYTES BETWEEN 'TXTUNF'
0542 21 00 13 LXI H,VARBGN ;AND 'VARBGN'
0545 CD 60 05 CALL SUBDE
0548 D1 POP D
0549 C9 RET
054A ;
054A ;*************************************************************
054A ;*
054A ;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
054A ;*
054A ;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
054A ;*
054A ;* 'SUBDE' SUBSTRACTS DE FROM HL
054A ;*
054A ;* 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
054A ;* SIGN AND FLIP SIGN OF B.
054A ;*
054A ;* 'CHGSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY.
054A ;*
054A ;* 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
054A ;* ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
054A ;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
054A ;*
054A E5 DIVIDE: PUSH H ;*** DIVIDE ***
054B 6C MOV L,H ;DIVIDE H BY DE
054C 26 00 MVI H,0
054E CD 55 05 CALL DV1
0551 41 MOV B,C ;SAVE RESULT IN B
0552 7D MOV A,L ;(REMINDER+L)/DE
0553 E1 POP H
0554 67 MOV H,A
0555 0E FF DV1: MVI C,-1 ;RESULT IN C
0557 0C DV2: INR C ;DUMB ROUTINE
0558 CD 60 05 CALL SUBDE ;DIVIDE BY SUBTRACT
055B D2 57 05 JNC DV2 ;AND COUNT
055E 19 DAD D
055F C9 RET
0560 ;
0560 7D SUBDE: MOV A,L ;*** SUBDE ***
0561 93 SUB E ;SUBSTRACT DE FROM
0562 6F MOV L,A ;HL
0563 7C MOV A,H
0564 9A SBB D
0565 67 MOV H,A
0566 C9 RET
0567 ;
0567 7C CHKSGN: MOV A,H ;*** CHKSGN ***
0568 B7 ORA A ;CHECK SIGN OF HL
0569 F0 RP ;IF -, CHANGE SIGN
056A ;
056A 7C CHGSGN: MOV A,H ;*** CHGSGN ***
056B 2F CMA ;CHANGE SIGN OF HL
056C 67 MOV H,A
056D 7D MOV A,L
056E 2F CMA
056F 6F MOV L,A
0570 23 INX H
0571 78 MOV A,B ;AND ALSO FLIP B
0572 EE 80 XRI 80H
0574 47 MOV B,A
0575 C9 RET
0576 ;
0576 7C CKHLDE: MOV A,H
0577 AA XRA D ;SAME SIGN?
0578 F2 7C 05 JP CK1 ;YES, COMPARE
057B EB XCHG ;NO, XCH AND COMP
057C E7 CK1: RST 4
057D C9 RET
057E ;
057E ;*************************************************************
057E ;*
057E ;* *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
057E ;*
057E ;* "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
057E ;* THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
057E ;* TO THAT VALUE.
057E ;*
057E ;* "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH "§",
057E ;* EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
057E ;* NEXT LINE AND CONTINUE FROM THERE.
057E ;*
057E ;* "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
057E ;* REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
057E ;*
057E ;* "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
057E ;* IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
057E ;* INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
057E ;* OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
057E ;* AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
057E ;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
057E ;* PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
057E ;* COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
057E ;* NOT TERMINATED BUT CONTINUED AT 'INPERR'.
057E ;*
057E ;* RELATED TO 'ERROR' ARE THE FOLLOWING:
057E ;* 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
057E ;* 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
057E ;* 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
057E ;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
057E ;*
057E FF SETVAL: RST 7 ;*** SETVAL ***
057F DA A4 05 JC QWHAT ;"WHAT?" NO VARIABLE
0582 E5 PUSH H ;SAVE ADDRESS OF VAR.
0583 CF RST 1 ;PASS "=" SIGN
0584 3D DB '='
0585 08 DB SV1-$-1
0586 DF RST 3 ;EVALUATE EXPR.
0587 44 MOV B,H ;VALUE IS IN BC NOW
0588 4D MOV C,L
0589 E1 POP H ;GET ADDRESS
058A 71 MOV M,C ;SAVE VALUE
058B 23 INX H
058C 70 MOV M,B
058D C9 RET
058E C3 A4 05 SV1: JMP QWHAT ;NO "=" SIGN
0591 ;
0591 CF FIN: RST 1 ;*** FIN ***
0592 3B DB ";"
0593 04 DB FI1-$-1
0594 F1 POP PSW ;";", PURGE RET. ADDR.
0595 C3 49 02 JMP RUNSML ;CONTINUE SAME LINE
0598 CF FI1: RST 1 ;NOT ";", IS IT CR?
0599 0D DB CR
059A 04 DB FI2-$-1
059B F1 POP PSW ;YES, PURGE RET. ADDR.
059C C3 39 02 JMP RUNNXL ;RUN NEXT LINE
059F C9 FI2: RET ;ELSE RETURN TO CALLER
05A0 ;
05A0 EF ENDCHK: RST 5 ;*** ENDCHK ***
05A1 FE 0D CPI CR ;END WITH CR?
05A3 C8 RZ ;OK, ELSE SAY: "WHAT?"
05A4 ;
05A4 D5 QWHAT: PUSH D ;*** QWHAT ***
05A5 11 AE 00 AWHAT: LXI D,WHAT ;*** AWHAT ***
05A8 97 ERROR: SUB A ;*** ERROR ***
05A9 CD 3C 06 CALL PRTSTG ;PRINT 'WHAT?', 'HOW?'
05AC D1 POP D ;OR 'SORRY'
05AD 1A LDAX D ;SAVE THE CHARACTER
05AE F5 PUSH PSW ;AT WHERE OLD DE ->
05AF 97 SUB A ;AND PUT A 0 THERE
05B0 12 STAX D
05B1 2A 01 10 LHLD CURRNT ;GET CURRENT LINE #
05B4 E5 PUSH H
05B5 7E MOV A,M ;CHECK THE VALUE
05B6 23 INX H
05B7 B6 ORA M
05B8 D1 POP D
05B9 CA 00 00 JZ START ;IF ZERO, JUST RESTART
05BC 7E MOV A,M ;IF NEGATIVE,
05BD B7 ORA A
05BE FA A7 03 JM INPERR ;REDO INPUT
05C1 CD AA 06 CALL PRTLN ;ELSE PRINT THE LINE
05C4 1B DCX D ;UPTO WHERE THE 0 IS
05C5 F1 POP PSW ;RESTORE THE CHARACTER
05C6 12 STAX D
05C7 3E 3F MVI A,'?' ;PRINT A "?"
05C9 D7 RST 2
05CA 97 SUB A ;AND THE REST OF THE
05CB CD 3C 06 CALL PRTSTG ;LINE
05CE C7 RST 0 ;THEN RESTART
05CF ;
05CF D5 QSORRY: PUSH D ;*** QSORRY ***
05D0 11 B4 00 ASORRY: LXI D,SORRY ;*** ASORRY ***
05D3 C3 A8 05 JMP ERROR
05D6 ;
05D6 ;*************************************************************
05D6 ;*
05D6 ;* *** GETLN *** FNDLN (& FRIENDS) ***
05D6 ;*
05D6 ;* 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
05D6 ;* THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
05D6 ;* THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
05D6 ;* ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
05D6 ;* THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
05D6 ;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
05D6 ;* CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
05D6 ;*
05D6 ;* 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
05D6 ;* TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
05D6 ;* LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
05D6 ;* (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
05D6 ;* IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
05D6 ;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
05D6 ;* WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
05D6 ;* LINE, FLAGS ARE C & NZ.
05D6 ;* 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
05D6 ;* AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
05D6 ;* ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
05D6 ;* 'FDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
05D6 ;* 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
05D6 ;* 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
05D6 ;*
05D6 D7 GETLN: RST 2 ;*** GETLN ***
05D7 11 37 13 LXI D,BUFFER ;PROMPT AND INIT.
05DA CD 32 07 GL1: CALL CHKIO ;CHECK KEYBOARD
05DD CA DA 05 JZ GL1 ;NO INPUT, WAIT
05E0 D7 RST 2 ;INPUT, ECHO BACK
05E1 FE 0A CPI LF ;IGNORE LF
05E3 CA DA 05 JZ GL1
05E6 B7 ORA A ;IGNORE NULL
05E7 CA DA 05 JZ GL1
05EA FE 7F CPI DEL ;DELETE LAST CHARACTER?
05EC CA FF 05 JZ GL3 ;YES
05EF ; CPI DLLN ;DELETE THE WHOLE LINE?
05EF FE 15 CPI CNTLU
05F1 CA 0C 06 JZ GL4 ;YES
05F4 12 STAX D ;ELSE SAVE INPUT
05F5 13 INX D ;AND BUMP POINTER
05F6 FE 0D CPI CR ;WAS IT CR?
05F8 C8 RZ ;YES, END OF LINE
05F9 7B MOV A,E ;ELSE MORE FREE ROOM?
05FA FE 7F CPI BUFEND
05FC C2 DA 05 JNZ GL1 ;YES, GET NEXT INPUT
05FF 7B GL3: MOV A,E ;DELETE LAST CHARACTER
0600 FE 37 CPI BUFFER ;BUT DO WE HAVE ANY?
0602 CA 0C 06 JZ GL4 ;NO, REDO WHOLE LINE
0605 1B DCX D ;YES, BACKUP POINTER
0606 3E 5C MVI A,BKS ;AND ECHO A BACK-SLASH
0608 D7 RST 2
0609 C3 DA 05 JMP GL1 ;GO GET NEXT INPUT
060C CD 0E 00 GL4: CALL CRLF ;REDO ENTIRE LINE
060F 3E 5E MVI A,UPA ;CR, LF AND UP-ARROW
0611 C3 D6 05 JMP GETLN
0614 ;
0614 7C FNDLN: MOV A,H ;*** FNDLN ***
0615 B7 ORA A ;CHECK SIGN OF HL
0616 FA 9F 00 JM QHOW ;IT CANNOT BE -
0619 11 15 10 LXI D,TXTBGN ;INIT TEXT POINTER
061C ;
061C FDLNP: EQU $
061C E5 FL1: PUSH H ;SAVE LINE #
061D 2A 13 10 LHLD TXTUNF ;CHECK IF WE PASSED END
0620 2B DCX H
0621 E7 RST 4
0622 E1 POP H ;GET LINE # BACK
0623 D8 RC ;C,NZ PASSED END
0624 1A LDAX D ;WE DID NOT, GET BYTE 1
0625 95 SUB L ;IS THIS THE LINE?
0626 47 MOV B,A ;COMPARE LOW ORDER
0627 13 INX D
0628 1A LDAX D ;GET BYTE 2
0629 9C SBB H ;COMPARE HIGH ORDER
062A DA 31 06 JC FL2 ;NO, NOT THERE YET
062D 1B DCX D ;ELSE WE EITHER FOUND
062E B0 ORA B ;IT, OR IT IS NOT THERE
062F C9 RET ;NC,Z:FOUND, NC,NZ:NO
0630 ;
0630 FNDNXT: EQU $
0630 13 INX D ;FIND NEXT LINE
0631 13 FL2: INX D ;JUST PASSED BYTE 1 & 2
0632 ;
0632 1A FNDSKP: LDAX D ;*** FNDSKP ***
0633 FE 0D CPI CR ;TRY TO FIND CR
0635 C2 31 06 JNZ FL2 ;KEEP LOOKING
0638 13 INX D ;FOUND CR, SKIP OVER
0639 C3 1C 06 JMP FL1 ;CHECK IF END OF TEXT
063C ;
063C ;*************************************************************
063C ;*
063C ;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
063C ;*
063C ;* 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
063C ;* AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
063C ;* THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
063C ;* CALLER). OLD A IS STORED IN B, OLD B IS LOST.
063C ;*
063C ;* 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
063C ;* QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
063C ;* OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
063C ;* THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
063C ;* AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
063C ;* OVER (USUALLY A JUMP INSTRUCTION.
063C ;*
063C ;* 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
063C ;* IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
063C ;* HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
063C ;* C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
063C ;* PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
063C ;*
063C ;* 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
063C ;*
063C 47 PRTSTG: MOV B,A ;*** PRTSTG ***
063D 1A PS1: LDAX D ;GET A CHARACTER
063E 13 INX D ;BUMP POINTER
063F B8 CMP B ;SAME AS OLD A?
0640 C8 RZ ;YES, RETURN
0641 D7 RST 2 ;ELSE PRINT IT
0642 FE 0D CPI CR ;WAS IT A CR?
0644 C2 3D 06 JNZ PS1 ;NO, NEXT
0647 C9 RET ;YES, RETURN
0648 ;
0648 CF QTSTG: RST 1 ;*** QTSTG ***
0649 22 DB 0x22 ;'"'
064A 0F DB QT3-$-1
064B 3E 22 MVI A,0x22 ;IT IS A "
064D CD 3C 06 QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER
0650 FE 0D CPI CR ;WAS LAST ONE A CR?
0652 E1 POP H ;RETURN ADDRESS
0653 CA 39 02 JZ RUNNXL ;WAS CR, RUN NEXT LINE
0656 23 QT2: INX H ;SKIP 3 BYTES ON RETURN
0657 23 INX H
0658 23 INX H
0659 E9 PCHL ;RETURN
065A CF QT3: RST 1 ;IS IT A '?
065B 27 DB QT
065C 05 DB QT4-$-1
065D 3E 27 MVI A,QT ;YES, DO THE SAME
065F C3 4D 06 JMP QT1 ;AS IN "
0662 CF QT4: RST 1 ;IS IT BACK-ARROW?
0663 5F DB BKA
0664 08 DB QT5-$-1
0665 3E 8D MVI A,8DH ;YES, CR WITHOUT LF
0667 D7 RST 2 ;DO IT TWICE TO GIVE
0668 D7 RST 2 ;TTY ENOUGH TIME
0669 E1 POP H ;RETURN ADDRESS
066A C3 56 06 JMP QT2
066D C9 QT5: RET ;NONE OF ABOVE
066E ;
066E D5 PRTNUM: PUSH D ;*** PRTNUM ***
066F 11 0A 00 LXI D,10 ;DECIMAL
0672 D5 PUSH D ;SAVE AS A FLAG
0673 42 MOV B,D ;B=SIGN
0674 0D DCR C ;C=SPACES
0675 CD 67 05 CALL CHKSGN ;CHECK SIGN
0678 F2 7E 06 JP PN1 ;NO SIGN
067B 06 2D MVI B,'-' ;B=SIGN
067D 0D DCR C ;'-' TAKES SPACE
067E C5 PN1: PUSH B ;SAVE SIGN & SPACE
067F CD 4A 05 PN2: CALL DIVIDE ;DIVIDE HL BY 10
0682 78 MOV A,B ;RESULT 0?
0683 B1 ORA C
0684 CA 8F 06 JZ PN3 ;YES, WE GOT ALL
0687 E3 XTHL ;NO, SAVE REMAINDER
0688 2D DCR L ;AND COUNT SPACE
0689 E5 PUSH H ;HL IS OLD BC
068A 60 MOV H,B ;MOVE RESULT TO BC
068B 69 MOV L,C
068C C3 7F 06 JMP PN2 ;AND DIVIDE BY 10
068F C1 PN3: POP B ;WE GOT ALL DIGITS IN
0690 0D PN4: DCR C ;THE STACK
0691 79 MOV A,C ;LOOK AT SPACE COUNT
0692 B7 ORA A
0693 FA 9C 06 JM PN5 ;NO LEADING BLANKS
0696 3E 20 MVI A,' ' ;LEADING BLANKS
0698 D7 RST 2
0699 C3 90 06 JMP PN4 ;MORE?
069C 78 PN5: MOV A,B ;PRINT SIGN
069D D7 RST 2 ;MAYBE - OR NULL
069E 5D MOV E,L ;LAST REMAINDER IN E
069F 7B PN6: MOV A,E ;CHECK DIGIT IN E
06A0 FE 0A CPI 10 ;10 IS FLAG FOR NO MORE
06A2 D1 POP D
06A3 C8 RZ ;IF SO, RETURN
06A4 C6 30 ADI '0' ;ELSE CONVERT TO ASCII
06A6 D7 RST 2 ;AND PRINT THE DIGIT
06A7 C3 9F 06 JMP PN6 ;GO BACK FOR MORE
06AA ;
06AA 1A PRTLN: LDAX D ;*** PRTLN ***
06AB 6F MOV L,A ;LOW ORDER LINE #
06AC 13 INX D
06AD 1A LDAX D ;HIGH ORDER
06AE 67 MOV H,A
06AF 13 INX D
06B0 0E 04 MVI C,4 ;PRINT 4 DIGIT LINE #
06B2 CD 6E 06 CALL PRTNUM
06B5 3E 20 MVI A,' ' ;FOLLOWED BY A BLANK
06B7 D7 RST 2
06B8 97 SUB A ;AND THEN THE NEXT
06B9 CD 3C 06 CALL PRTSTG
06BC C9 RET
06BD ;
06BD ;*************************************************************
06BD ;*
06BD ;* *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
06BD ;*
06BD ;* 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
06BD ;* DE = HL
06BD ;*
06BD ;* 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
06BD ;* UNTIL DE = BC
06BD ;*
06BD ;* 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
06BD ;* STACK
06BD ;*
06BD ;* 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
06BD ;* STACK
06BD ;*
06BD E7 MVUP: RST 4 ;*** MVUP ***
06BE C8 RZ ;DE = HL, RETURN
06BF 1A LDAX D ;GET ONE BYTE
06C0 02 STAX B ;MOVE IT
06C1 13 INX D ;INCREASE BOTH POINTERS
06C2 03 INX B
06C3 C3 BD 06 JMP MVUP ;UNTIL DONE
06C6 ;
06C6 78 MVDOWN: MOV A,B ;*** MVDOWN ***
06C7 92 SUB D ;TEST IF DE = BC
06C8 C2 CE 06 JNZ MD1 ;NO, GO MOVE
06CB 79 MOV A,C ;MAYBE, OTHER BYTE?
06CC 93 SUB E
06CD C8 RZ ;YES, RETURN
06CE 1B MD1: DCX D ;ELSE MOVE A BYTE
06CF 2B DCX H ;BUT FIRST DECREASE
06D0 1A LDAX D ;BOTH POINTERS AND
06D1 77 MOV M,A ;THEN DO IT
06D2 C3 C6 06 JMP MVDOWN ;LOOP BACK
06D5 ;
06D5 C1 POPA: POP B ;BC = RETURN ADDR.
06D6 E1 POP H ;RESTORE LOPVAR, BUT
06D7 22 07 10 SHLD LOPVAR ;=0 MEANS NO MORE
06DA 7C MOV A,H
06DB B5 ORA L
06DC CA EF 06 JZ PP1 ;YEP, GO RETURN
06DF E1 POP H ;NOP, RESTORE OTHERS
06E0 22 09 10 SHLD LOPINC
06E3 E1 POP H
06E4 22 0B 10 SHLD LOPLMT
06E7 E1 POP H
06E8 22 0D 10 SHLD LOPLN
06EB E1 POP H
06EC 22 0F 10 SHLD LOPPT
06EF C5 PP1: PUSH B ;BC = RETURN ADDR.
06F0 C9 RET
06F1 ;
06F1 21 A7 13 PUSHA: LXI H,STKLMT ;*** PUSHA ***
06F4 CD 6A 05 CALL CHGSGN
06F7 C1 POP B ;BC=RETURN ADDRESS
06F8 39 DAD SP ;IS STACK NEAR THE TOP?
06F9 D2 CF 05 JNC QSORRY ;YES, SORRY FOR THAT
06FC 2A 07 10 LHLD LOPVAR ;ELSE SAVE LOOP VAR'S
06FF 7C MOV A,H ;BUT IF LOPVAR IS 0
0700 B5 ORA L ;THAT WILL BE ALL
0701 CA 17 07 JZ PU1
0704 2A 0F 10 LHLD LOPPT ;ELSE, MORE TO SAVE
0707 E5 PUSH H
0708 2A 0D 10 LHLD LOPLN
070B E5 PUSH H
070C 2A 0B 10 LHLD LOPLMT
070F E5 PUSH H
0710 2A 09 10 LHLD LOPINC
0713 E5 PUSH H
0714 2A 07 10 LHLD LOPVAR
0717 E5 PU1: PUSH H
0718 C5 PUSH B ;BC = RETURN ADDR.
0719 C9 RET
071A ;
071A ;*************************************************************
071A ;*
071A ;* *** OUTC *** & CHKIO ***
071A ;*
071A ;* THESE ARE THE ONLY I/O ROUTINES IN TBI.
071A ;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0
071A ;* 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0,
071A ;* IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO
071A ;* SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG.
071A ;* ARE RESTORED.
071A ;*
071A ;* 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO
071A ;* THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG
071A ;* IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE
071A ;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
071A ;* Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL
071A ;* RESTART TBI AND DO NOT RETURN TO THE CALLER.
071A ;*
071A ;OUTC: PUSH PSW ;THIS IS AT LOC. 10
071A ; LDA OCSW ;CHECK SOFTWARE SWITCH
071A ; ORA A
071A C2 1F 07 OC2: JNZ OC3 ;IT IS ON
071D F1 POP PSW ;IT IS OFF
071E C9 RET ;RESTORE AF AND RETURN
071F DB 00 OC3: IN 0 ;COME HERE TO DO OUTPUT
0721 E6 02 ANI 02H ;STATUS BIT
0723 CA 1F 07 JZ OC3 ;NOT READY, WAIT
0726 F1 POP PSW ;READY, GET OLD A BACK
0727 D3 01 OUT 1 ;AND SEND IT OUT
0729 FE 0D CPI CR ;WAS IT CR?
072B C0 RNZ ;NO, FINISHED
072C 3E 0A MVI A,LF ;YES, WE SEND LF TOO
072E D7 RST 2 ;THIS IS RECURSIVE
072F 3E 0D MVI A,CR ;GET CR BACK IN A
0731 C9 RET
0732 ;
0732 DB 00 CHKIO: IN 0 ;*** CHKIO ***
0734 00 NOP ;STATUS BIT FLIPPED?
0735 E6 20 ANI 20H ;MASK STATUS BIT
0737 C8 RZ ;NOT READY, RETURN "Z"
0738 DB 01 IN 1 ;READY, READ DATA
073A E6 7F ANI 7FH ;MASK BIT 7 OFF
073C FE 0F CPI CNTLO ;IS IT CONTROL-O?
073E C2 4B 07 JNZ CI1 ;NO, MORE CHECKING
0741 3A 00 10 LDA OCSW ;CONTROL-O FLIPS OCSW
0744 2F CMA ;ON TO OFF, OFF TO ON
0745 32 00 10 STA OCSW
0748 C3 32 07 JMP CHKIO ;GET ANOTHER INPUT
074B FE 03 CI1: CPI CNTLC ;IS IT CONTROL-C?
074D C0 RNZ ;NO, RETURN "NZ"
074E C7 RST 0 ;YES, RESTART TBI
074F ;
074F 59 4F 55 20 4D 41 59 20 4E 45 45 44 20 54 48 49 53 20 53 50 41 43 45 20 54 4F DB 'YOU MAY NEED THIS SPACE TO'
0769 50 41 54 43 48 20 55 50 20 54 48 45 20 49 2F 4F 20 52 4F 55 54 49 4E 45 53 2C DB "PATCH UP THE I/O ROUTINES,"
0783 54 4F 20 46 49 58 20 55 50 20 42 55 47 53 2C 20 4F 52 20 54 4F 20 41 44 44 DB "TO FIX UP BUGS, OR TO ADD"
079C 4D 4F 52 45 20 43 4F 4D 4D 41 4E 44 53 20 41 4E 44 20 46 55 4E 43 54 49 4F 4E 53 2E DB 'MORE COMMANDS AND FUNCTIONS.'
07B8 53 4B 59 20 28 53 50 41 43 45 29 20 49 53 20 54 48 45 20 4C 49 4D 49 54 2E DB 'SKY (SPACE) IS THE LIMIT.'
07D1 47 4F 4F 44 20 4C 55 43 4B 20 41 4E 44 20 47 4F 4F 44 20 42 59 45 2E DB 'GOOD LUCK AND GOOD BYE.'
07E8 4C 49 43 48 45 4E 20 57 41 4E 47 2C 20 31 30 20 4A 55 4E 45 20 37 36 DB "LICHEN WANG, 10 JUNE 76"
07FF ;
07FF LSTROM: EQU $
1000 .ORG 1000H ;HERE DOWN MUST BE RAM
1000 FF OCSW: DB 0FFH ;SWITCH FOR OUTPUT
1001 00 00 CURRNT: DW 0 ;POINTS TO CURRENT LINE
1003 00 00 STKGOS: DW 0 ;SAVES SP IN 'GOSUB'
1005 VARNXT: EQU $
1005 00 00 STKINP: DW 0 ;SAVES SP IN 'INPUT'
1007 00 00 LOPVAR: DW 0 ;'FOR' LOOP SAVE AREA
1009 00 00 LOPINC: DW 0 ;INCREMENT
100B 00 00 LOPLMT: DW 0 ;LIMIT
100D 00 00 LOPLN: DW 0 ;LINE NUMBER
100F 00 00 LOPPT: DW 0 ;TEXT POINTER
1011 00 00 RANPNT: DW START ;RANDOM NUMBER POINTER
1013 15 10 TXTUNF: DW TXTBGN ;->UNFILLED TEXT AREA
1015 TXTBGN: DS 1 ;TEXT SAVE AREA BEGINS
1300 .ORG 1300H
1300 TXTEND: EQU $
1300 VARBGN: DS 2*27 ;VARIABLE @(0)
1336 DS 1 ;EXTRA BYTE FOR BUFFER
1337 BUFFER: DS 72 ;INPUT BUFFER
137F BUFEND: EQU $
137F DS 40 ;EXTRA BYTES FOR STACK
13A7 STKLMT: EQU $
1400 .ORG 1400H
1400 STACK: EQU $
1400 END
_PC 1400
CR 000D
LF 000A
QT 0027
CNTLO 000F
CNTLC 0003
DLLN 007D
CNTLU 0015
BKS 005C
BKA 005F
UPA 005E
DEL 007F
START 0000
CRLF 000E
SS1 0028
TV1 0058
TC1 0068
TC2 0073
TSTNUM 0077
TN1 007C
QHOW 009F
AHOW 00A0
HOW 00A6
OK 00AB
WHAT 00AE
SORRY 00B4
ST1 00BA
ST2 00CA
ST3 00D3
ST4 0108
TAB1 012F
TAB2 013F
TAB4 01A1
TAB5 01D1
TAB6 01D7
TAB8 01DF
DIRECT 01F5
EXEC 01F8
EX0 01F8
EX1 01FA
EX2 020D
EX3 0217
EX4 0219
EX5 021E
NEW 0226
STOP 022F
RUN 0233
RUNNXL 0239
RUNTSL 0242
RUNSML 0249
GOTO 0252
LIST 0261
LS1 026A
PRINT 0279
PR2 0284
PR0 028D
PR1 0295
PR3 029B
PR6 02A4
PR8 02A8
GOSUB 02B1
RETURN 02D1
FOR 02EA
FR1 02FA
FR2 0304
FR3 0308
FR4 030B
FR5 030E
FR7 0323
FR8 0344
NEXT 0349
NX0 0350
NX3 0368
NX1 0380
NX2 0392
REM 0396
IFF 039A
INPERR 03A7
INPUT 03B1
IP1 03B1
IP2 03BF
IP3 03CF
IP4 03F9
IP5 0400
DEFLT 0401
LET 0407
LT1 0410
EXPR1 0411
XP11 0417
XP12 041D
XP13 0423
XP14 042A
XP15 0432
XP16 0438
XP17 043E
XP18 0440
EXPR2 0455
XP21 045E
XP22 0461
XP23 0464
XP24 046B
XP25 047C
XP26 047F
EXPR3 0489
XP31 048C
XP32 04A8
XP33 04B0
XP34 04BB
XP35 04D8
EXPR4 04E6
XP40 04EC
XP41 04F5
PARN 04FB
XP42 0502
XP43 0503
RND 0506
RA1 0521
ABS 0531
SIZE 053D
DIVIDE 054A
DV1 0555
DV2 0557
SUBDE 0560
CHKSGN 0567
CHGSGN 056A
CKHLDE 0576
CK1 057C
SETVAL 057E
SV1 058E
FIN 0591
FI1 0598
FI2 059F
ENDCHK 05A0
QWHAT 05A4
AWHAT 05A5
ERROR 05A8
QSORRY 05CF
ASORRY 05D0
GETLN 05D6
GL1 05DA
GL3 05FF
GL4 060C
FNDLN 0614
FDLNP 061C
FL1 061C
FNDNXT 0630
FL2 0631
FNDSKP 0632
PRTSTG 063C
PS1 063D
QTSTG 0648
QT1 064D
QT2 0656
QT3 065A
QT4 0662
QT5 066D
PRTNUM 066E
PN1 067E
PN2 067F
PN3 068F
PN4 0690
PN5 069C
PN6 069F
PRTLN 06AA
MVUP 06BD
MVDOWN 06C6
MD1 06CE
POPA 06D5
PP1 06EF
PUSHA 06F1
PU1 0717
OC2 071A
OC3 071F
CHKIO 0732
CI1 074B
LSTROM 07FF
OCSW 1000
CURRNT 1001
STKGOS 1003
VARNXT 1005
STKINP 1005
LOPVAR 1007
LOPINC 1009
LOPLMT 100B
LOPLN 100D
LOPPT 100F
RANPNT 1011
TXTUNF 1013
TXTBGN 1015
TXTEND 1300
VARBGN 1300
BUFFER 1337
BUFEND 137F
STKLMT 13A7
STACK 1400
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment