Mindmaster 2.0
Mastermind-Solver in Z80-Assembler, für CP/M
mm.asm.txt
—
Plain Text,
32 kB (33128 bytes)
Dateiinhalt
;=======================================================================*
; PROGRAMM: M I N D M A S T E R 2.0 TYP: Spielprogramm *
;=======================================================================*
; BESCHREIBUNG: Mastermind-Algorithmus mit Treiber fuer CP/M. *
; Das Programm spielt das als MasterMind oder Superhirn bekannte Spiel *
; gegen den Benutzer. Der Benutzer denkt sich eine Farbkombination aus, *
; das Programm versucht, diese durch Nachfragen herauszubekommen. *
; Der verwendete Algorithmus ist fast optimal: es wird - nach der *
; ersten Frage - jeweils eine weitere Frage errechnet, die unabhaengig *
; von ihrer Beanwortung moeglichst wenige Faelle uebriglaesst. *
; Jedoch werden zur Beschleunigung nur Fragen aus den noch vorhandenen *
; Moeglichkeiten gestellt - eine Bewertung aller moeglichen Fragen *
; koennte die Anzahl der noetigen Fragen weiter reduzieren. *
; Davon abgesehen wird immer das einschrittige Optimum ausgerechnet. *
; Es ist eine Zeitschranke eingebaut, die jedoch nur im Fall 5x7 und *
; nach der ersten Frage richtig wirksam wird und die Suche nach dem *
; Optimum begrenzt. Auf die Zahl der noetigen Antworten scheint das *
; aber keinen Einfluss zu haben. *
; Das Programm erlaubt Generierung fuer NASCOM mit und ohne IVC, *
; bis zu 7 Farben und bis zu 5 Plaetzen. *
; *
; (C) Wolfgang Strobl 1980, '82 V1.0 25.08.80 *
; V1.1 1.09.80 *
; Anpassung an CP/M V2.0 29.12.82 *
;-----------------------------------------------------------------------*
; Schwarz bedeutet: Farbe & Pos richtig. Weiss bedeutet: Farbe richtig *
; *
;-----------------------------------------------------------------------*
???nas set 0 ; NASCOM or IVC/GALAXY Version
???test set 0 ; Testswitch: prepare for Debugger
.pla equ 5 ; 3..5 std: 5 Anzahl Plaetze max wegen compress
.farb equ 7 ; 2..7 std: 7 Anzahl Farben " " "
; Siehe auch TTABLE.
if ???test=1
.start equ 600h ; Zum leicheren Entwanzen auf
.par equ 200h ; leicht merkbare Grenzen legen.
.work equ 1000h ; Bei Assemblierfehler hochsetzen.
endif
org 100h ; Orig TPA
if ???test=1
call .begin
rst 38h
else
call .begin
jp .boot ; Das wird z.Zt. aber nicht benutzt
endif
;-----------------------------------------------*
; Daten und Parameterlisten *
;-----------------------------------------------*
if ???test=1
org .par
; Datenbereich, als I: und O: (in/out) vom Standpunkt von 'mm' beschrieben
else
.par equ $
endif
wstr db 1,2,3,4,5 ; erlaubt sogar 7 Plaetze
rstr db 0,0,0,0,0 ;
flag db 0 ; I: Erster Aufruf?
.first equ 0
.next equ 1
anzpla db .pla ; I: Anzahl Plaetze
cperg:
cmpsw db 0 ; Parm mmu: Schwarz Pos + Farb
cmpws db 0 ; Parm mmu: Weiss Farb
pstr db 0,0,0,0,0 ; O: Neuer Vorschlag
vstr db 0,0,0,0,0 ; I: Alte Frage
aptr dw .work ; I: A(Workspace)
alen dw 0 ; O: Len(Workspace used)
bptr dw 0
max dw 0 ; O: Maximaler naechster Suchraum
maxp dw 0 ; O: Zeiger auf maximales Element
six dw 0
answ: ; I: Antwort vom Spieler
anssw db 1 ; I: Schwarz
answs db 0 ; I: Weiss
versuch db 0 ; Anzahl Versuche bis jetzt
nr dw 0
rcount dw 0 ; Zaehler zur Zeitbegrenzung
rcountm dw 20000 ; " Maximum
ds 32 ; own stack
stack equ $
;---------------------------------------------*
; Farben *
;---------------------------------------------*
farben
dw what ; Farbe 0
dw gelb ; 1
dw gruen ; 2
dw rot ; 3
dw blau ; 4
dw braun ; 5
dw lila ; 6
dw weiss ; 7
farben. equ $-farben
what db ' ?',0
gelb db ' Gelb',0
gruen db ' Gruen',0
rot db ' Rot',0
blau db ' Blau',0
braun db ' Braun',0
lila db ' Lila',0
weiss db ' Weiss',0
; moegliche Fragen: Anfang, mittendrin, Ende, Display
msgfs db ' Ist es ',0
msgvm db 'Ich vermute ',0
msgfi db 'Es ist wohl ',0
msgsp db ' ',0
;-----------------------------------------------*
; Farbenliste ausgeben. IX -> F1..Fn *
; modifies IX, AF *
;-----------------------------------------------*
prfa:
push hl
push de
push bc
if ???nas=0
call prs
db '(',0
endif
ld b,.pla ; $for #(farben)
prfal1 ld a,(ix) ; hole nummer der farbe
inc ix ; naechste farbennummer adressieren
add a,a ; farb#*2 als index
ld hl,farben ; farbentabelle
ld e,a ; de := farb#*2
ld d,0
add hl,de ; hl := a(farben+farb#*2)
ld a,(hl)
inc hl
ld h,(hl)
ld l,a ; hl := [hl]
call prm ; Farbe ausgeben
call space ; blank
djnz prfal1 ; for$
if ???nas=0
call prs
db ')',0
endif
pop bc
pop de
pop hl
ret
; Abbruchroutine
break
if ???test=1
rst 38h ; jump to debugger
halt
else
jp .boot ; or reboot
endif
; break search if BRKCHR has been typed
BRKCHR equ ' ' ; printable!
brkchk
push af ; save accu
call instat ; has char been typed?
or a
jr z,brkcn ; no: return
call inchar ; yes: get 'm
cp BRKCHR
jr z,brkcb ; restart if BRKCHR typed
brkcn pop af
ret
brkcb ld a,-1 ; make time count negative
ld (rcount+1),a ; to break search loop
call prs ; remove echoed break char
db bs,0 ;
pop af
ret ; and continue
;-----------------------------------------------*
; M A I N L O O P *
;-----------------------------------------------*
.begin
ld sp,stack
ld hl,flag ; Merken: erster Versuch
ld (hl),.first
call initmsg ; Beim Spieler anmelden
call firsttry ; Erste Frage aussuchen
call questf ; Erste Frage stellen
qlop call display ; und Liste der Farben ausgeben
call ask ; und nach Treffern fragen
jp c,quest ; redisplay if necessary
cmm
call prs
db ' ',0
call mm ; Suche guenstigste naechste Frage
ld hl,flag ; Merken: schon mittendrin
ld (hl),.next
call stat ; Statistik ausgeben
jr c,.begin ; Inkonsistenz gefunden? ja: neues Spiel
jr z,single ; Nur noch eine Moeglichkeit? Ja: sagen
ld hl,versuch ; Versuchszaehler hochzaehlen
inc (hl)
ld hl,pstr ; guenstigste Frage
ld de,vstr ; stellen
ld bc,.pla
ldir
quest call questn ; Fragetext ausgeben
jr qlop
single ld hl,msgfi ; jetzt wissen wir's genau
call prm ; also anderen Fragetext
call display ; ausgeben
call crlf
jr .begin ; und ein neues Spiel
initmsg
call prs
if ???nas=1
db cr,lf,'**********************************************'
db cr,lf,'* Mind Master 2.0 ';5x7 (C) Strobl 1982 *'
db ' ',.pla+'0',' x ',.farb+'0',' (C) Strobl 1982 *'
db cr,lf,'**********************************************'
db cr,lf,0
else
db cr,lf,'********************************************************************'
db cr,lf,'* M i n d M a s t e r 2.0 ';5 x 7 (C) W. Strobl 1982 *'
db ' ',.pla+'0',' x ',.farb+'0',' (C) W. Strobl 1982 *'
db cr,lf,'********************************************************************'
db cr,lf,lf,0
endif
ret
firsttry: ; Make Random First Question
ld b,.pla ; init count
ld hl,vstr ; destination
ld a,r ; get random from refresh reg
ld d,2 ; addr page 2
ld e,a ; random addr
ftryl1
inc de ; next memory position
ld a,(de) ; get 'random' from memory
and 7 ; mask for 0..7
inc a ; 1..8
cp .farb+1 ; exclude .farb+1..8
jr nc,ftryl1 ; retry
cp c
jr z,ftryl1 ; exclude reptitions
ld c,a
ld (hl),a ; move to destination
inc hl ; next position
djnz ftryl1 ; and repeat
ret
questf
ld hl,msgfs
call prm
ret
questn
ld hl,msgvm
call prm
ret
display
ld ix,vstr
call prfa
ret
ask
if ???nas=1
call prs
db cr,lf,0
endif
ask1 ld hl,msgsw
call askb
ret c ; return for redisplay
ld (anssw),a
cp .pla+1
jr c,ask2
call askbs4
jr ask1
ask2 ld hl,msgws
call askb
ld (answs),a
ld b,a
ld a,(anssw)
add a,b
cp .pla+1
jr c,ask3
call askbs4
call askbs4
jr ask1
ask3 or a ; ret with NC
ret
askbs4 call prs
db bs,bs,bs,bs,0
ret
msgsw db ' S-',0
msgws db ' W-',0
askb
call prm
call inchar
cp CAN
jr z,askbr
cp '?' ; space display requested?
jr z,askb2
jr asko
askbr call crlf ; break requested
call break ; bkpt
jr askb ; try again if possible
asko sub '0' ; make binary
or a ; clear carry
ret
askb2 call showsp ; display current space
scf ; request redisplay
ret
stat
if ???nas=1
call crlf
endif
ld hl,(alen)
srl h ; HL := HL/2
rr l
ld (nr),hl ; nr := max/2
ld hl,(nr)
call binword
ld hl,(max)
call binword
call crlf
ld hl,(nr)
ld a,h
or a
ret nz ; return NZ if nr > 1
ld a,l
or a
jr z,empty ; inconsistent answers if nr=0
cp 1 ; return Z if nr = 1
ret
empty call prs
db 'Mindestens eine der Antworten stimmt nicht !'
db cr,lf,0
scf ; return C if nr = 0
ret
binword
push hl
ld ix,statau.
ld b,$statau
call binstr
ld hl,statau
call prm
pop hl
ret
statau db '....'
$statau equ $-statau
statau. db 0
;
showsp
push af
call crlf
ld ix,(aptr)
showl1 ld a,(ix+0)
or a
jr z,showspe
ld iy,showfa
ld a,.expa
call mmu
push ix
ld hl,msgsp
call prm
ld ix,showfa
call prfa
call crlf
pop ix
inc ix
inc ix
jr showl1
showspe
pop af
ret
showfa ds 7
;------------------------------------------------------------
if ???test=1
org .start
endif
mm:
ld ix,(aptr)
ld (six),ix
; generieren des ersten Array's
genf ld hl,pstr ; PSTR := 1 1 1 1 1
ld b,.pla-1
il1 ld (hl),1
inc hl
djnz il1
ld (hl),0
ld ix,(aptr)
jr next
;
gena ld de,wstr
ld hl,pstr
ld bc,.pla
ldir ; wstr := pstr
ld de,rstr
ld hl,vstr
ld bc,.pla
ldir ; rstr := vstr
ld hl,(answ) ; gegebene Antwort
call testans ; ueberpruefen
jr nz,next ; stimmt nicht
ld iy,pstr
ld a,.cmpr
call mmu ; compress IX
inc ix
inc ix ; next position
;
next call gnext ; pstr := pstr + 1/NEXT P.
jr nc,gena ; loop generate Array
ld (ix+0),0 ; mark end of Array
push ix
pop hl
ld de,(aptr)
or a
sbc hl,de
ld (alen),hl
ld a,h
or l ; war or a ???
jr nz,go1
ld a,l
cp 1
jr z,ret
jr c,ret
go1 inc ix
ld (bptr),ix ; free store
jr overut1
ret
ret
gnext ld a,(flag) ; first call?
or a
jr z,gnx0 ; Array to be generated
ld iy,pstr
ld hl,(six)
ld a,(hl)
or a
jr z,gnx3 ; END OF ARRAY
push ix
push hl ; IX:=HL
pop ix
ld a,.expa
call mmu ; expand
inc ix
inc ix
ld (six),ix ; next old array element
pop ix
jr gnx5
gnx0 ld b,.pla
ld hl,pstr+.pla-1
gnx1 ld a,(hl)
inc a
cp .farb+1
jr nz,gnx2
ld a,1
ld (hl),a
dec hl
djnz gnx1
gnx3 scf
ret
gnx2 ld (hl),a
gnx5 or a
ret
testans push de
ld a,.verg
call mmu ; compare
ld de,(cperg) ; ergebnis compare
or a
sbc hl,de
pop de
ret
; INIT outer loop
overut1
call prs
db ' ',0 ; Show Activity ...
ld hl,(rcountm) ; init time limit
ld (rcount),hl
ld ix,(aptr) ; first element
ld hl,0ffffh ; biggest
ld (max),hl
ld (maxp),hl ; garbage
; $LOOP outer loop
tsl1 equ $
ld hl,(bptr)
dec hl
ld de,(bptr)
ld bc,.ttable*2+1
ldir ; clear freq. table
ld iy,vstr
ld a,.expa
call mmu ; expand
push ix
; INIT inner loop
ld ix,(aptr)
; $LOOP inner loop
tsl2 ld iy,wstr
ld a,.expa
call mmu ; expand
push bc
ld de,rstr
ld hl,vstr
ld bc,.pla
ldir
pop bc
ld a,.verg
call mmu ; COMPARE
ld a,(cperg+1)
ld b,a
ld a,(cperg)
rlca
rlca
rlca
or b
ld hl,ttable ; load address
ld bc,.ttable
cpir
jp nz,interr
ex de,hl
ld hl,ttable ; load address
or a
ex de,hl
sbc hl,de
add hl,hl
ex de,hl
ld hl,(bptr)
add hl,de
push hl
pop iy ; IY [BPTR].type
ld d,(iy+1) ; count for this one
ld e,(iy+0)
inc de ; one more
ld (iy+1),d
ld (iy+0),e
inc ix ; next Array element
inc ix
ld hl,(rcount) ; decr time count
dec hl
ld (rcount),hl
ld a,(ix+0) ; end of Array?
or a
; LOOP$ inner loop
jr nz,tsl2 ; no.
;-----------------------------------------------*
; We have finished for this row. Now at [BPTR] *
; there is a table of sizes . For each possible *
; answer it contains the size of the set of *
; combinations giving that answer. Now search *
; its maixmal element's value. *
;-----------------------------------------------*
; INIT inner loop (search max)
srm ld b,.ttable ; spaces
ld de,0 ; current max
ld ix,(bptr) ; first entry
; $LOOP inner loop
spl1 ld h,(ix+1)
ld l,(ix+0)
or a
sbc hl,de ; entry-oldmax
jr c,spl1e
ld h,(ix+1)
ld l,(ix+0)
ex de,hl ; new max
spl1e inc ix
inc ix
djnz spl1
; LOOP$ inner loop
;
; we now have the size of current space
;
pop ix ; get outer element
ld hl,(max) ; outer minimum
or a ; clear carry
sbc hl,de ; oldmin-entry
jr c,nxto ; carry: bigger means garbage
jr z,nxto ; same too
ld (maxp),ix ; points to "lowest" element
ld (max),de ; new min
push ix
push hl
push de
call askbs4 ; Show Activity
ex de,hl
call binword
pop de
pop hl
pop ix
nxto inc ix ; next outer element
inc ix
call brkchk ; allow break
ld a,(rcount+1) ; early end?
or a
jp m,fguess ; yes if rcount negative
ld a,(ix+0) ; was last one?
or a
; LOOP$ outer loop
jp nz,tsl1 ; no.
;
fguess
ld ix,(maxp) ; fetch best guess
ld a,.expa ; expand
ld iy,pstr
call mmu
call askbs4 ; Show Activity
call askbs4
jp ret ; THAT WAS IT !
;-----------------------------------------------*
interr call prs
db 'Internal Error',cr,lf,0
call break
halt
;-----------------------------------------------*
ttable:
; Teil 1 fuer bis zu 5 Plaetzen
db 0*8+0,0*8+1,0*8+2,0*8+3,0*8+4,0*8+5
db 1*8+0,1*8+1,1*8+2,1*8+3,1*8+4
db 2*8+0,2*8+1,2*8+2,2*8+3
db 3*8+0,3*8+1,3*8+2
db 4*8+0,4*8+1
db 5*8+0
if .pla>5
; Teil 2 fuer bis zu 7 Plaetzen
db 0*8+6,1*8+5,2*8+4,3*8+3,4*8+2,5*8+1,6*8+0
db 0*8+7,1*8+6,2*8+5,3*8+4,4*8+3,5*8+2,6*8+1,7*8+0
endif
.ttable equ $-ttable
db 0
;------------------------------------------------
;
; mmutil/2.2
;-2.2-------------------------------------*
; PRG: MMUTIL TYP: subr fuer mastermind
; {COMPARE EXPAND COMPRESS}
; Steuerparamter
; A .verg COMPARE
; .expa EXPAND
; .cmpr COMPRESS
; Beschreibung COMPARE:
; FUNKTION: teste zwei Farbkombinationen
; gegeneinander. Expandiere.
; INPUTPARAMETER:
; ANZPLA Byte Anzahl Plaetze
; WSTR String
; RSTR String
;
; OUTPUTPARAMETER:
; CMPSW Byte Anzahl richtig (schwarz)
; CMPWS Byte Anzahl Farb treff(weiss)
;
; BESCHREIBUNG:
; Die Strings bei RSTR und WSTR werden in
; der Laenge ANZPLA verglichen. Die Anzahl
; der uebereinstimmender Bytes wird in
; CMPSW notiert. Von den restlichen Bytes
; wird die Anzahl uebereinstimmender Werte
; in CMPWS notiert.
; 3.9. W. Strobl 22.8.80
;-----------------------------------------*
; EQUATES
.verg equ 0 ; call COMPARE
.expa equ 1 ; call EXPAND
.cmpr equ 2 ; call COMPRESS
;--------- programm --------------------*
;
mmu: push af
push bc
push de
push hl
push ix
cp .verg
jr z,compare
jr expand ; will test others
compare ld a,(anzpla)
ld b,a ; Anzahl Plaetze B
ld c,0 ; Schwarz Count
ld hl,rstr
ld de,wstr
cpl1 ld a,(de)
cp (hl)
jr nz,cpl1e
xor a ; A:=0
ld (de),a ; clear both elements
ld (hl),a ; to exclude them from
inc c ; pass two; Count them.
cpl1e inc de ; select next element's
inc hl
djnz cpl1 ; repeat black loop
ld a,c
ld (cmpsw),a
;----------------------------------------
ld a,(anzpla)
ld e,a
ld b,a
ld d,0 ; white count
ld hl,rstr
cpl2 ld a,(hl)
or a
jr z,cpl2e ; missing Element
push bc ; for inner loop
ld b,e ; anz. plaetze
ld ix,wstr
cpl3 ld a,(ix+0)
or a ; already used?
jr z,cpl3e ; yes
cp (hl) ; this two bytes eq?
jr nz,cpl3e
inc d ; yes: count them
xor a
ld (hl),a ; say: used
ld (ix+0),a ; "
cpl3e inc ix ; select next one
djnz cpl3
pop bc
cpl2e inc hl ; select next one
djnz cpl2
ld a,d
ld (cmpws),a
; PROC$
return pop ix
pop hl
pop de
pop bc
pop af
ret
;----------------------------------------*
; EXPAND dekomprimiere 2 byte 5 byte *
; *
; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 <-IX *
; \____/\____/\______/\____/\____/ *
; 1 2 3 4 5 <-IY *
;----------------------------------------*
expand cp .expa
jr nz,compres ; will test others
ld a,(ix+0)
ld b,a
and 0e0h
rlca
rlca
rlca
ld (iy+0),a ; -1-
ld a,b
and 01ch
rrca
rrca
ld (iy+1),a ; -2-
ld a,b
and 003h
ld b,a
ld a,(ix+1)
ld c,a ; save it
rlca
ld a,b
rla
ld (iy+2),a ; -3-
ld a,c
and 070h
rrca
rrca
rrca
rrca
ld (iy+3),a ; -4-
ld a,c
and 00eh
rrca
ld (iy+4),a ; -5-
toretrn jr return
;----------------------------------------*
; COMPRESS * EXPAND = id *
;----------------------------------------*
compres cp .cmpr
jr nz,toretrn ; don't know
ld a,(iy+0) ; -1-
rrca
rrca
rrca
and 0e0h
ld b,a
ld a,(iy+1) ; -2-
rlca
rlca
and 01ch
or b
ld b,a
ld a,(iy+2) ; -3-
rrca
and 003h
or b
ld (ix+0),a ; first compr byte
ld a,(iy+2) ; again -3-
rrca
and 080h
ld b,a
ld a,(iy+3) ; -4-
rlca
rlca
rlca
rlca
and 070h
or b
ld b,a
ld a,(iy+4) ; -5-
rlca
and 00eh
or b
ld b,a
ld (ix+1),a
jr toretrn
mmend equ $
mmlen equ mmend-mm
.boot equ 0
; SERVICE.ZAP Serviceroutinen 82-09-23/82-09-24
;----------------------------------------------------------------
;
; prs - print string constant
; ahex - print a hex
; hlhex - print hl hex
; hexbyte - print hex byte (a), space
; hexword - print hex word(hl), space
; space - print space
; crlf - print newline
; outchar - print char in a
; inchar - get char into a
; instat - check if char has been typed A=0 means no
; crtkbd - get char into a from crt (no wait)
; crtget - get char into a from crt (wait)
; crtput - put char in a to crt
;
.svbdos equ 5
.svconin equ 1
.svconout equ 2
.svconst equ 11
.svdc equ 6 ; direct console i/o
.svdcin equ 0ffh ; - input
;
.svcr equ 0dh
.svlf equ 0ah
; print string
; usage: call prs, string, 0
;
prs equ $
ex (sp),hl
push af
prsl ld a,(hl)
inc hl
; output unless 0
or a
jr z,prsr
prs2 call outchar
jr prsl
prsr pop af
ex (sp),hl
dret ret
;
; prm Print Message HL -> Message, 0
;
prm equ $
prml ld a,(hl)
inc hl
or a
ret z
call outchar
jr prml
;
; prt Print String HL -> string BC=len (0..2^16)
;
prt
push bc
prtl ld a,b
or c
jr z,prtr
ld a,(hl)
call outchar
inc hl
dec bc
jr prtl
prtr pop bc
ret
if ???test=1
;
; print [a] hex
; modified: af
;
ahex equ $
b2hex push af
rra
rra
rra
rra
call b1hex
pop af
; output low half a
b1hex and 0fh
add a,'0'
cp '9'+1
jr c,b1h4
add a,'a'-'0'-10
; output char
b1h4 call outchar
ret
;
hlhex equ $
ld a,h
call ahex
ld a,l
call ahex
ret
endif
;
space equ $
ld a,' '
call outchar
ret
if ???test=1
;
hexword equ $
push af
call hlhex
call space
pop af
ret
;
hexbyte equ $
push af
call ahex
call space
pop af
ret
endif
;
crlf ld a,.svcr
call outchar
ld a,.svlf
call outchar
ret
;
outchar equ $
push bc
push de
push hl
ld e,a
ld c,.svconout
call .svbdos
pop hl
pop de
pop bc
ret
;
inchar equ $
push bc
push de
push hl
ld c,.svconin
call .svbdos
pop hl
pop de
pop bc
ret
;
instat equ $
push bc
push de
push hl
ld c,.svconst
call .svbdos
pop hl
pop de
pop bc
ret
; scan CRT Keybord, char into A, A=0 means no char available
crtkbd equ $
push bc
push de
push hl
ld c,.svdc
ld e,.svdcin
call .svbdos
pop hl
pop de
pop bc
ret
; get char from CRT into A
crtget equ $
call crtkbd
or a
jr z,crtget
ret
; output A to CRT
crtput equ $
push bc
push de
push hl
ld c,.svdc
ld e,a
call .svbdos
pop hl
pop de
pop bc
ret
; put char from A to IVC
putvid push af
pv0 in a,(0b2h)
rrca
jr c,pv0
pop af
out (0b1h),a
ret
;----------------------------------------------
; div - 16-bit divide
; divides two 16-bit unsigned integers.
; No divide check (/0) is made!
; i: HL: divisor DE: dividend
; o: HL: result DE: remainder
;----------------------------------------------
div equ $
push bc
xor a
ld c,a
ld b,a
$divlp1 push hl
sbc hl,de
ccf
pop hl
jr nc,$divout
sla e
rl d
inc b
jr nc,$divlp1
$divout push af
or b
jr z,$divres
pop af
$divlp2 rr d
rr e
push hl
sbc hl,de
ccf
jr nc,$divold
ex (sp),hl
$divold pop hl
rla
rl c
djnz $divlp2
push af
$divres pop af
ex de,hl
ld h,c
ld l,a
pop bc
ret
; multiply HL with 10
;mult10 z.Zt. nicht benutzt
push de
add hl,hl ; HL=HL*2
ex de,hl ; DE=IN*2
push de
pop hl
add hl,hl
add hl,hl ; HL=IN*8
add hl,de ; HL=IN*8+IN*2
pop de
ret
;
; Conversion BIN -> CHAR
; HL auszugebende Zahl IX Ende-Ausgabebereich B Anzahl Stellen
;
binstr
binstr1
ld de,10
call div ;
ld a,e
add a,'0'
ld (ix-1),a
ld a,d
or e
or h
or l
jr nz,binstr2
ld (ix-1),' '
binstr2
dec ix
djnz binstr1
ret
if 1=0 ; unused
mark
ld a,esc
call outchar
ld a,'A'
call outchar
ret
unmark
ld a,esc
call outchar
ld a,'N'
call outchar
ret
endif
;-----------------------------------------------*
cr equ 0dh
lf equ 0ah
bs equ 08h
CAN equ 03h
esc equ 1bh
if ???test=1
org .work
else
.work equ $
endif
end
