home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 4
/
FreshFish_May-June1994.bin
/
new
/
amigalibdisks
/
d999
/
adam
/
adam_v3.source
< prev
next >
Wrap
Text File
|
1994-04-05
|
71KB
|
4,720 lines
; **************************************************
; ******************* ADAM_V3 **********************
; **************** rechenprogramm ******************
; ****** verbesserte version : mehr als 5mal *******
; ********** schneller als version 2 !!! ***********
; ************** bcd-codierte zahlen ***************
; ****** dokumentation siehe in file `dokuv3` ******
; **************************************************
; ************ konstanten ************
; vst und nst müssen durch 4 teilbar sein !!!
vst=200; vorkommastellen
nst=200; nachkommastellen
variab_anz=10; anzahl der zahlenvariablen
rech_anz=5; anzahl der rechenfelder
dez_anz=3; anzahl der konstanten
vsb=vst/2
nsb=nst/2
st=vst+nst
sb=vsb+nsb
st1=sb+2
st2=sb+4
st3=sb+6
ast1=st+2
ast2=st+4
ast3=st+6
rt1_gr=sb*3+50
tabr_gr=sb+4*21+50
feldgr=sb+10
; libraryoffsets
allocmem=-198
freemem=-210
openlib=-552
closelib=-414
open=-30
close=-36
read=-42
write=-48
input=-54
forbid=-132
permit=-138
mode_old=1005
mode_new=1006
; *************** makros ****************
; 1 --> startadresse 2 --> end-adresse
prtxt: macro
move.l #?1*8,d3
bsr print_text
endm
; 1 --> anzahl der zeichen
p_buf: macro
moveq #?1,d3
bsr print_buf
endm
; 1 --> startadresse 2 --> länge
print: macro
lea ?1(pc),a0
moveq #?2,d3
bsr print_sub
endm
; ************ hauptprogramm ************
x:
movem.l d1-d7/a0-a6,-(sp)
lea stackpt(pc),a0
move.l a7,(a0)
lea fdruck(pc),a0
clr.w (a0)
bra allocmemory
alloc_rueck:
bra openwind
openw_rueck:
bra st_pruefen
st_pr_rueck:
bra dezwandel
haupt:
prtxt 10; hauptmenubild malen
move.w #vst,d4
bsr zahlaus
move.l buffer(pc),a0
move.l #$0a099b36,(a0)+
move.b #$43,(a0)
p_buf 5
move.w #nst,d4
bsr zahlaus
readfunk:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
cmp.b #$1b,(a4)
beq.s a
cmp.b #$9b,(a4)
bne.s readfunk
addq.l #1,a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #4,d3
jsr read(a6)
move.b (a4),d4
lea cmp_tab(pc),a3
moveq #4,d5
suchz:
cmp.b (a3)+,d4
beq.s gefund
dbf d5,suchz
bra.s readfunk
pidisp:
bsr pi1
bra haupt
help1:
bsr helptext
bra haupt
change_lang:
lea text_tab+4(pc),a0
tst.l (a0)
beq.s text_ger_eng
clr.l (a0)
bra haupt
text_ger_eng:
move.l #eng_ttab-text_tabanf,(a0)
bra haupt
gefund:
print sicht,3
lea cmp_tab(pc),a3
cmp.b (a3)+,d4
beq.s a
cmp.b (a3)+,d4
beq.s rechnen
cmp.b (a3)+,d4
beq.s pidisp
cmp.b (a3)+,d4
beq.s help1
cmp.b (a3)+,d4
beq.s change_lang
a:
move.l conhandle(pc),d1
jsr close(a6)
close_dos:
move.l 4.w,a6
move.l dosbase(pc),a1
jsr closelib(a6)
dosoperr:
bra freememory
freem_rueck:
ende:
move.l stackpt(pc),a7
movem.l (a7)+,d1-d7/a0-a6
moveq #0,d0
rts
; ************ rechnen *************
rechnen:
bsr bild
move.l bcd1(pc),a0
bsr zahlein
kopin:
move.l buffer(pc),a0
bsr feldloesch
bra operand
rueckoperand:
move.l bcd2(pc),a0
bsr zahlein
bra operation
rueck1:
bra ergebnis
rueck2:
prtxt 2
readin:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #2,d3
jsr read(a6)
cmp.b #$1b,(a4)
beq haupt
cmp.b #$9b,(a4)
bne.s readin
addq.l #1,a4
move.l conhandle(pc),d1
moveq #2,d3
jsr read(a6)
move.b -1(a4),d0
cmp.b #$30,d0
beq haupt
cmp.b #$31,d0
beq rechnen
cmp.b #$32,d0
beq.s nochmalkop
cmp.b #$33,d0
beq.s format_ae
cmp.b #$34,d0
beq.s speich_nochm
cmp.b #$35,d0
beq.s help2
bra readin
nochmalkop:
bsr bild
move.l bcd1(pc),a0
bsr druck
bra kopin
format_ae:
lea format(pc),a0
tst.b (a0)
bne.s formj_n
move.b #1,(a0)
prtxt 39
bra rueck2
formj_n:
clr.b (a0)
prtxt 38
bra rueck2
speich_nochm:
move.l bcd1(pc),a0
move.l speicher(pc),a1
bsr kopieren
bra rechnen
help2:
bsr helptext
bsr bild
move.l bcd1(pc),a0
bsr druck
prtxt 2
bra readin
bild:
prtxt 7
move.l speicher(pc),a0
bsr druck
print home,2
rts
helptext:
prtxt 1
bsr r_buf
print sicht,3
rts
;********** weitere makros ***************
mkopieren: macro
move.l ?1,a0
move.l ?2,a1
bsr kopieren
endm
mquadrat: macro
move.l ?1,a0
bsr quadrat
endm
mfeldloesch: macro
move.l ?1,a0
bsr feldloesch
endm
mplusu: macro
move.l ?1,a0
move.l ?2,a1
bsr plusu
endm
mminusu: macro
move.l ?1,a0
move.l ?2,a1
bsr minusu
endm
mmals: macro
move.l ?1,a0
move.l ?2,a1
bsr mals
endm
mdiv: macro
move.l ?1,a0
move.l ?2,a1
bsr div
endm
mdruck: macro
move.l ?1,a0
bsr druck
endm
mincrem: macro
move.l ?1,a0
bsr increm
endm
mveru: macro
move.l ?1,a0
move.l ?2,a1
bsr veru
endm
mal10: macro; multipliziert ein register mit #10
move.w ?1,d0
add.w d0,d0
add.w d0,d0
add.w d0,?1
add.w ?1,?1
endm
;************* fehlermeldungen **************
allocerr:
move.l 4.w,a6
lea dosname(pc),a1
moveq #0,d0
jsr openlib(a6); dos.library öffnen
lea dosbase(pc),a0
move.l d0,(a0)
beq dosoperr
move.l dosbase(pc),a6
jsr -54(a6)
lea conhandle(pc),a0
move.l d0,(a0)
beq close_dos
prtxt 44
bra close_dos
vst_nst_falsch:
bsr prtxt12
prtxt 6
print lflf,2
prtxt 13
bsr r_buf
bra a
st3fehler:
bsr prtxt12
prtxt 14
bra fehleraus
div_null:
bsr prtxt12
prtxt 21
bra fehleraus
sqr_negativ:
bsr.s prtxt12
prtxt 15
bra.s fehleraus
add_uberlauf:
bsr.s prtxt12
prtxt 27
bra.s fehleraus
mal_uberlauf:
bsr.s prtxt12
prtxt 29
bra.s fehleraus
div_uberlauf:
bsr.s prtxt12
prtxt 28
bra.s fehleraus
fakfehler:
bsr.s prtxt12
prtxt 34
fehleraus:
print lflf,2
prtxt 13
bsr r_buf
move.l stackpt(pc),a7
bra haupt
prtxt12:
prtxt 12
rts
;************* unterprogramme **************
;----------------------------------
openwind:
move.l 4.w,a6
lea dosname(pc),a1
moveq #0,d0
jsr openlib(a6); dos.library öffnen
lea dosbase(pc),a0
move.l d0,(a0)
beq dosoperr
; maximale fenstergröße suchen
lea intname(pc),a1
moveq #33,d0
jsr openlib(a6); intuition.lib öffnen
tst.l d0
beq.s no_intui
move.l d0,a6
move.l 56(a6),a1; aktueller screen
lea windsize(pc),a0
moveq #0,d0
move.w 12(a1),d0; smax_width
moveq #10,d1
moveq #$30,d2
bsr.s maked0
move.b #`/`,(a0)+
moveq #0,d0
move.w 14(a1),d0; smax_height
bsr.s maked0
move.l a6,a1
move.l 4.w,a6
jsr closelib(a6)
no_intui:
move.l dosbase(pc),a6
lea name(pc),a0
move.l a0,d1
move.l #mode_old,d2
jsr open(a6); fenster öffnen
lea conhandle(pc),a0
move.l d0,(a0)
beq.s no_window
bra openw_rueck
no_window:
jsr -54(a6)
lea conhandle(pc),a0
move.l d0,(a0)
beq close_dos
prtxt 45
bra close_dos
maked0:
divu d1,d0
swap d0
add.b d2,d0
move.w d0,-(sp)
clr.w d0
swap d0
divu d1,d0
swap d0
add.b d2,d0
move.w d0,-(sp)
swap d0
add.b d2,d0
move.b d0,(a0)+
move.w (sp)+,d0
move.b d0,(a0)+
move.w (sp)+,d0
move.b d0,(a0)+
rts
;----------------------------------
st_pruefen:
move.w #vst,d4
cmp.w #30000,d4
bhs vst_nst_falsch
cmp.w #20,d4
blo vst_nst_falsch
and.w #%11,d4
bne vst_nst_falsch
move.w #nst,d4
cmp.w #30000,d4
bhs vst_nst_falsch
cmp.w #20,d4
blo vst_nst_falsch
and.w #%11,d4
bne vst_nst_falsch
bra st_pr_rueck
;----------------------------------
; 1 ---> länge
; 2 ---> adresse
alloc: macro
move.l #?1,d0
move.l d6,d1
jsr allocmem(a6)
tst.l d0
beq allocerr
move.l #?1,(a4)+
move.l d0,(a4)+
lea ?2(pc),a0
move.l d0,(a0)
endm
; der belegte speicher wird in die memlist eingetragen,
; die mit 0,0 abgeschlossen ist.
allocmemory:
move.l 4.w,a6
lea memlist(pc),a4
moveq #29,d0
alloccl:
clr.l (a4)+
dbf d0,alloccl
lea memlist(pc),a4
move.l #$10000,d6
; speicher für buffer, byte1, rt1, r1 und tabr
alloc st+48,buffer
alloc rt1_gr,rt1
alloc tabr_gr,tabr
alloc st+10,byte1
alloc st+10,r1
alloc sb+10,pi
; speicher für variablen speicher,bcd1-9
move.w #feldgr,d0
mulu #variab_anz,d0
move.l d0,d7
move.l d6,d1
jsr allocmem(a6)
tst.l d0
beq allocerr
move.l d7,(a4)+
move.l d0,(a4)+
moveq #variab_anz-1,d1
lea speicher(pc),a0
makev:
move.l d0,(a0)+
add.l #feldgr,d0
dbf d1,makev
; speicher für rechenfelder sqr1-4,quadrat
move.w #feldgr,d0
mulu #rech_anz,d0
move.l d0,d7
move.l d6,d1
jsr allocmem(a6)
tst.l d0
beq allocerr
move.l d7,(a4)+
move.l d0,(a4)+
moveq #rech_anz-1,d1
lea sqr1(pc),a0
makerech:
move.l d0,(a0)+
add.l #feldgr,d0
dbf d1,makerech
; speicher für konstantenfelder dez1-6
move.w #feldgr,d0
mulu #dez_anz,d0
move.l d0,d7
move.l d6,d1
jsr allocmem(a6)
tst.l d0
beq allocerr
move.l d7,(a4)+
move.l d0,(a4)+
moveq #dez_anz-1,d1
lea dez1(pc),a0
makedez:
move.l d0,(a0)+
add.l #feldgr,d0
dbf d1,makedez
clr.l (a4)+
clr.l (a4)
bra alloc_rueck
;----------------------------------
freememory:
move.l 4.w,a6
lea memlist(pc),a4
freem_in:
move.l (a4)+,d0
beq.s freem_aus
move.l (a4)+,a1
jsr freemem(a6)
bra.s freem_in
freem_aus:
bra freem_rueck
;----------------------------------
; diese routine kopiert alle zahlenkonstanten in die
; konstantenfelder dez1, dez2, ...
dezwandel:
movem.l d0-d7/a0-a3,-(sp)
moveq #dez_anz-1,d6
lea dezdat1(pc),a0
lea dez1(pc),a3
move.l byte1(pc),a2
wanf:
move.l a2,a1
move.w #st/2+3,d0
clrb1:
clr.w (a1)+
dbf d0,clrb1
move.l a2,a1
move.w (a0)+,ast1(a2)
move.w (a0)+,ast2(a2)
move.w (a0)+,ast3(a2)
cmp.w #1,ast3(a2)
beq.s gerade
tst.w ast1(a2)
beq.s nachw
move.w ast1(a2),d5
move.l #vst,d4
sub.w d5,d4
add.l d4,a1
subq.w #1,d5
vorwand:
move.b (a0)+,(a1)+
dbf d5,vorwand
nachw:
tst.w ast2(a2)
beq.s wandaus
move.l byte1(pc),a1
move.w ast2(a2),d5
subq.w #1,d5
add.l #vst,a1
nachwand:
move.b (a0)+,(a1)+
dbf d5,nachwand
wandaus:
move.l a0,d0
btst #0,d0
beq gerade
ungerade:
addq.l #1,a0
gerade:
movem.l a0/a1,-(sp)
move.l byte1(pc),a0
move.l (a3)+,a1
bsr wandbyte_bcd; zahl in bcd-format wandeln
movem.l (sp)+,a0/a1
dbf d6,wanf
mfeldloesch speicher(pc)
mkopieren dez1(pc),bcd1(pc)
mdiv dez3(pc),bcd1(pc)
mkopieren bcd1(pc),dez3(pc)
; pi einlesen
move.l pi(pc),a0
bsr feldloesch
move.b #3,vsb-1(a0)
move.w #1,st1(a0)
move.w #2,st3(a0)
move.l a0,a4
lea piname(pc),a0
move.l a0,d1
move.l #mode_old,d2
jsr open(a6)
move.l d0,d7; datei öffnen
beq.s pi_notfound
move.l d7,d1
move.l pi(pc),d2
add.l #vsb,d2
move.l #nsb,d3
cmp.w #2000,d3
bls.s pireadd3ok
move.l #2000,d3
pireadd3ok:
jsr read(a6); datei schreiben
move.l d7,d1
jsr close(a6); und wieder schließen
; nachkommastellenzahl von pi ermitteln
move.l a4,a0
move.l a0,a1
add.l #sb,a0
move.w #nsb,d0
pinachm:
tst.b -(a0)
bne.s pinachex
subq.w #1,d0
bne.s pinachm
bra.s pinachaus
pinsubeine:
subq.w #1,d0
bra.s pinachaus
pinachex:
add.w d0,d0
move.b (a0),d1
lsl.b #4,d1
beq.s pinsubeine
pinachaus:
move.w d0,st2(a1)
bra.s piliesaus
pi_notfound:
prtxt 41
bsr r_buf
move.l #$14159265,vsb(a4)
move.w #8,st2(a4)
piliesaus:
movem.l (sp)+,d0-d7/a0-a3
bra haupt
;----------- operand nach op holen ------------
operand:
print miplu+1,4
opin:
move.l conhandle(pc),d1
lea op(pc),a2
move.l a2,d2
moveq #1,d3
jsr read(a6)
move.b (a2),d4
cmp.b #"+",d4
beq.s op1
cmp.b #"-",d4
beq.s op1
cmp.b #"*",d4
beq.s op1
cmp.b #"/",d4
beq.s op1
cmp.b #"v",d4
beq.s op1
cmp.b #"m",d4
beq.s op1
cmp.b #"s",d4
beq.s op1
cmp.b #"q",d4
beq.s op1
cmp.b #"w",d4
beq.s op1
cmp.b #"!",d4
beq.s op1
cmp.b #"i",d4
beq.s op1
cmp.b #"k",d4
beq.s op1
cmp.b #"S",d4
beq.s op1
bra opin
op1:
print op,1
op2:
move.l conhandle(pc),d1
lea op+1(pc),a0
move.l a0,d2
moveq #1,d3
jsr read(a6)
move.b op+1(pc),d4
cmp.b #$d,d4
beq.s opaus
cmp.b #8,d4
beq.s oploe
bra.s op2
oploe:
bsr backspace
bra opin
opaus:
lea op(pc),a0
move.b (a0),d4
cmp.b #"m",d4
beq.s memin
cmp.b #"s",d4
beq.s opwurzel
cmp.b #"q",d4
beq.L opquadrat
cmp.b #"w",d4
beq opwechsel
cmp.b #"!",d4
beq opfak
cmp.b #"k",d4
beq opkehr
cmp.b #"i",d4
beq opinteg
cmp.b #"S",d4
beq opsin
bsr lf_cr
bra rueckoperand
;---------- speichern ---------------
memin:
mkopieren bcd1(pc),speicher(pc)
bra rechnen
;------------ wurzelziehen -----------------
opwurzel:
prtxt 8
move.l bcd1(pc),a0
bsr sqrroot
mdruck bcd1(pc)
bra rueck2
;-------------- quadrieren -----------------
opquadrat:
prtxt 9
mquadrat bcd1(pc)
mdruck bcd1(pc)
bra rueck2
;------------ vorzeichen wechseln ------------
opwechsel:
prtxt 35
move.l bcd1(pc),a0
bsr vorz_wechsel
mdruck bcd1(pc)
bra rueck2
;------------ fakultät ------------
opfak:
prtxt 20
move.l bcd1(pc),a0
bsr fakultaet
mdruck bcd1(pc)
bra rueck2
;------------ kehrwert ------------
opkehr:
prtxt 36
mkopieren bcd1(pc),bcd2(pc)
mkopieren dez1(pc),bcd1(pc)
mdiv bcd2(pc),bcd1(pc)
mdruck bcd1(pc)
bra rueck2
;------------ integer ------------
opinteg:
prtxt 37
move.l bcd1(pc),a0
bsr integer
mdruck bcd1(pc)
bra rueck2
;------------ fakultät ------------
opsin:
prtxt 42
move.l bcd1(pc),a0
bsr sinus
mdruck bcd1(pc)
bra rueck2
;---------- operation ausführen -----------
operation:
lea op(pc),a0
move.b op(pc),d4
cmp.b #"v",d4
beq vergleich
cmp.b #"+",d4
beq.s opplus
cmp.b #"-",d4
beq.s opminus
cmp.b #"*",d4
beq.s opmal
cmp.b #"/",d4
beq.s opdiv
bra a
opplus:
move.l bcd2(pc),a0
move.l bcd1(pc),a1
bsr pluss
bra.s operationaus
opminus:
move.l bcd2(pc),a0
move.l bcd1(pc),a1
bsr minuss
bra.s operationaus
opmal:
move.l bcd2(pc),a0
move.l bcd1(pc),a1
bsr mals
bra.s operationaus
opdiv:
move.l bcd2(pc),a0
move.l bcd1(pc),a1
bsr div
bra.s operationaus
vergleich:
move.l bcd1(pc),a0
move.l bcd2(pc),a1
bsr vers
operationaus:
bra rueck1
;---------- ergebnis ausgeben -----------
ergebnis:
lea op(pc),a0
cmp.b #"v",(a0)
beq.s verglergebnis
print ergeb,8
mdruck bcd1(pc)
bra.s ergaus
verglergebnis:
cmp.w #1,(a0)
beq.s glei
cmp.w #2,(a0)
beq.s v1gr2
prtxt 5
bra.s ergaus
glei:
prtxt 3
bra.s ergaus
v1gr2:
prtxt 4
ergaus:
bra rueck2
;************** subroutinen **************
;========== zeichenausgabe ==========
lf_cr:
print lflf,1
rts
backspace:
print bs1,3
rts
; liest ein zeichen in feld `buffer`
r_buf:
move.l conhandle(pc),d1
move.l buffer(pc),d2
moveq #1,d3
jsr read(a6)
rts
; subroutinen für die macros prtxt, p_buf und print
print_text:
lea text_tab(pc),a0
move.l (a0)+,d1
move.l (a0)+,d2
add.l d3,a0
add.l d2,a0
move.l (a0)+,d2
move.l (a0)+,d3
jsr write(a6)
rts
print_buf:
move.l conhandle(pc),d1
move.l buffer(pc),d2
jsr write(a6)
rts
print_sub:
move.l conhandle(pc),d1
move.l a0,d2
jsr write(a6)
rts
;============================================
; zahl in d4 (wort)
zahlaus:
movem.l d0-d5/a4/a5,-(sp)
tst.w d4
beq.s znull
move.l buffer(pc),a4
and.l #$ffff,d4
dodez:
move.l d4,d5
divu #10,d5
move.w d5,d4
swap d5
add.b #$30,d5
move.b d5,(a4)+
tst.w d4
bne.s dodez
move.l buffer(pc),d5
move.l d5,a5
addq.l #5,a5
addq.l #5,a5
move.l a5,d2
sub.l a4,d5
neg.l d5
move.l d5,d3
zahlin:
move.b -(a4),(a5)+
dbf d5,zahlin
move.l conhandle(pc),d1
jsr write(a6)
bra.s zahlausex
znull:
print nu,1
zahlausex:
movem.l (sp)+,d0-d5/a4/a5
rts
;==========================================
; stellenzahl in d4
rechts:
movem.l d4/a0,-(sp)
lea r(pc),a0
move.l a0,d2
move.b #$9b,(a0)+
and.l #$ffff,d4
divu #10,d4
tst.b d4
beq.s nur_eine
add.b #$30,d4
move.b d4,(a0)+
nur_eine:
swap d4
add.w #$30,d4
move.b d4,(a0)+
move.b #$43,(a0)+
move.l conhandle(pc),d1
move.l a0,d3
sub.l d2,d3
jsr write(a6)
movem.l (sp)+,d4/a0
rts
;===========================================
nullsetzen:
move.l buffer(pc),a0
move.w #st2+1,d4
nullsetz1:
clr.b (a0)+
dbf d4,nullsetz1
moveq #variab_anz,d4
subq.w #1,d4
lea buffer(pc),a1
nullsetz2:
move.l (a1)+,a0
bsr feldloesch
dbf d4,nullsetz2
clr.l -(sp)
movem.l (sp),d0-d7/a0-a5
addq.l #4,sp
lea op(pc),a0
clr.b (a0)
rts
;================================================
; diese routine liest eine zahl in das feld ein, das in a0
; angegeben ist
zahlein:
movem.l d4-d7/a0-a5,-(sp)
; (a5) : punknum
; 2(a5) : vor
; 4(a5) : nach
; 6(a5) : vorzei
vorp=2
nachp=4
vorzeip=6
move.l a0,a3
bsr feldloesch
lea punknum(pc),a5
clr.l (a5)
clr.w 4(a5)
clr.b 6(a5)
print miplu+1,4
move.l buffer(pc),a4
ein2:
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #$d,d4
beq return
cmp.b #8,d4
beq fbackspace
cmp.b #"-",d4
beq minzei
cmp.b #".",d4
beq punkt
cmp.b #"0",d4
beq zeinull
cmp.b #"m",d4
beq memory_pi
cmp.b #"p",d4
beq memory_pi
cmp.b #$30,d4
blo.s ein2
cmp.b #$39,d4
bhi.s ein2
zeichein:
tst.w (a5)
beq.s verglvor
cmp.w #nst,nachp(a5)
beq.s ein2
bra.s verglnach
zeinull:
cmp.l buffer(pc),a4
beq ein2
bra.s zeichein
verglvor:
cmp.w #vst,vorp(a5)
beq ein2
verglnach:
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr write(a6)
tst.w (a5)
beq.s vorincrem
addq.w #1,nachp(a5)
bra vorret
vorincrem:
addq.w #1,vorp(a5)
vorret:
addq.l #1,a4
bra ein2
memory_pi:
cmp.l buffer(pc),a4
bne ein2
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr write(a6)
addq.l #1,a4
mem:
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #$d,d4
beq.s memaus
cmp.b #$8,d4
beq.s mback
bra.s mem
mback:
bsr backspace
move.l buffer(pc),a4
clr.w (a4)
bra ein2
memaus:
cmp.b #"m",-1(a4)
beq.s memsp
move.l pi(pc),a0
bra.s memsp1
memsp:
move.l speicher(pc),a0
memsp1:
move.l a3,a1
bsr kopieren
print plumi,1
move.l a3,a0
bsr druck
bra zahleinex1
return:
cmp.l buffer(pc),a4
beq nullzahl
tst.w nachp(a5)
bne nulloesch
loein:
move.l a4,d6
sub.l buffer(pc),d6
cmp.w (a5),d6
beq punktloesch
bra einaus
nullzahl:
cmp.b #1,vorzeip(a5)
beq.s minloe
minloeret:
print nu,1
bra zahleinex
minloe:
move.l byte1(pc),a0
move.l a0,d2
move.l #$0d3e2020,(a0)+
move.b #$20,(a0)+
move.l conhandle(pc),d1
moveq #5,d3
jsr write(a6)
clr.b vorzeip(a5)
bra.s minloeret
nulloesch:
move.l buffer(pc),a0
add.w vor(pc),a0
add.w nach(pc),a0
cmp.b #$30,(a0)
beq.s nullo
bra loein
nullo:
subq.w #1,nachp(a5)
subq.l #1,a4
bsr backspace
bra nulloesch
punktloesch:
bsr backspace
move.l a4,d4
subq.l #1,d4
cmp.l buffer(pc),d4
beq nullzahl
einaus:
moveq #0,d4
moveq #0,d5
moveq #0,d6
move.w vor(pc),d4
move.w nach(pc),d5
move.b vorzei(pc),d6
move.l buffer(pc),a2
move.l a3,a4
move.l byte1(pc),a3
move.l a3,a0
move.w #st/2+3,d7
lbyte1:
clr.w (a0)+
dbf d7,lbyte1
bsr mittwandord
move.l byte1(pc),a0
move.l a4,a1
bsr wandbyte_bcd
zahleinex:
bsr lf_cr
zahleinex1:
movem.l (sp)+,d4-d7/a0-a5
rts
;------------ backspace ------------
fbackspace:
cmp.l buffer(pc),a4
beq ein2
move.l buffer(pc),a0
addq.l #1,a0
cmp.l a0,a4
beq loeschen
addq.l #1,a0
cmp.l a0,a4
beq loeschen2
rueckk:
tst.w (a5)
bne backpunkt
backein:
bsr backspace
tst.w (a5)
beq.s vordecr
subq.w #1,nachp(a5)
bra.s backweiter
vordecr:
subq.w #1,vorp(a5)
backweiter:
clr.b (a4)
subq.l #1,a4
bra ein2
loeschen:
cmp.w #1,(a5)
beq nullpuloe
tst.b vorzeip(a5)
beq.s backein
move.l buffer(pc),a0
move.l #$08200d3e,(a0)+
move.l #$20202020,(a0)+
p_buf 8
subq.w #1,vorp(a5)
subq.l #1,a4
clr.b vorzeip(a5)
bra ein2
loeschen2:
cmp.w #1,(a5)
bne rueckk
lea vorzei(pc),a0
tst.b (a0)
beq rueckk
move.l buffer(pc),a0
move.l #$9b302070,(a0)+
move.l #$08200d3e,(a0)+
move.l #$20209b31,(a0)+
move.l #$439b2070,(a0)
p_buf 16
subq.w #1,a4
subq.w #1,nachp(a5)
clr.b vorzeip(a5)
bra ein2
backpunkt:
move.l buffer(pc),d5
move.l a4,d6
sub.l d5,d6
cmp.w (a5),d6
bne backein
clr.w (a5)
addq.w #1,vorp(a5)
bra backein
nullpuloe:
subq.l #1,a4
clr.w (a5)
bsr backspace
bra ein2
;-------- minuszeichen --------------
minzei:
cmp.l buffer(pc),a4
beq ein2
move.l buffer(pc),a0
addq.l #1,a0
cmp.l a0,a4
beq.s stell1
bra.s stellgr1
stell1:
cmp.b #`.`,-1(a4)
beq ein2
stellgr1:
tst.b vorzeip(a5)
beq.s plumin
print miplu,4
clr.b vorzeip(a5)
bra.s wechsaus
plumin:
print plumi,4
move.b #1,vorzeip(a5)
wechsaus:
move.l a4,d6
sub.l buffer(pc),d6
addq.w #1,d6
move.w d6,d4
bsr rechts
bra ein2
;---------------- punkt ----------------
punkt:
tst.w (a5)
bne ein2
print pu,1
move.l a4,d7
sub.l buffer(pc),d7
lea punknum(pc),a0
move.w d7,(a0)
addq.w #1,(a0)
addq.l #1,a4
bra ein2
;============================================
; quelladresse in a2 , zieladrsse in a3
; vorkomma in d4 , nachkomma in d5
; vorzeichen in d6 : 0 = + , 1 = -
mittwandord:
movem.l d0-d7/a0-a5,-(sp)
move.w d4,ast1(a3)
move.w d5,ast2(a3)
cmp.w #1,d6
beq.s vorz_min
tst.w d4
beq.s vor_nix
mrueck3:
move.w #2,ast3(a3)
bra anford
vor_nix:
tst.w d5
beq.s mittwausnull
bra.s mrueck3
vorz_min:
move.w #3,ast3(a3)
anford:
move.l d4,d6
move.l a2,a4
move.l a3,a5
tst.w d4
beq.s s2
add.l d4,a2
add.l #vst,a3
subq.w #1,d4
s1:
move.b -(a2),-(a3)
sub.b #$30,(a3)
dbf d4,s1
s2:
tst.w d5
beq.s s4
cmp.b #$2e,(a2)
beq.s nullp
bra.s nuk
nullp:
addq.l #1,a2
nuk:
move.l a4,a2
move.l a5,a3
add.l d6,a4
add.l #vst,a5
addq.l #1,a4
subq.w #1,d5
s3:
move.b (a4)+,(a5)+
sub.b #$30,-1(a5)
dbf d5,s3
s4:
bra.s mittwaus
mittwausnull:
move.w #1,ast3(a3)
move.l a3,a0
bsr feldloesch
mittwaus:
movem.l (sp)+,d0-d7/a0-a5
rts
;====================================================
; adresse des feldes in a0
; außerdem wichtige variablen :
; fdruck : 0 = druck im fenster, 1 = druck in datei
; format : 0 = druck nicht formatiert, 1 = druck formatiert
druck:
bsr testa0
movem.l d0-d7/a0-a6,-(sp)
lea fehler(pc),a1
clr.w (a1)
move.l byte1(pc),a1
bsr wandbcd_byte
move.l a1,a0
move.l a0,a1
move.l buffer(pc),a2
cmp.w #1,ast3(a0)
beq.s dnullzahl
cmp.w #3,ast3(a0)
beq.s negativ
positiv:
move.l #$3e202020,(a2)+
bra.s dru1
negativ:
move.l #$3e202d20,(a2)+
dru1:
tst.b fdruck
bne.s nouns
move.l #$9b302070,(a2)+
nouns:
moveq #0,d4
moveq #0,d5
moveq #0,d7
move.w ast1(a0),d4
move.w ast2(a0),d5
tst.w d4
beq.s drvornull
bra.s vorkop
drvornull:
move.w #$302e,(a2)+
bra.s nachkop
dnullzahl:
move.l #$3e202020,(a2)+
move.b #$30,(a2)+
bra ausdruck
vorkop:
subq.w #1,d4
move.l #vst,d6
sub.w ast1(a0),d6
add.l d6,a1
vkop:
move.b (a1)+,(a2)
add.b #$30,(a2)+
dbf d4,vkop
tst.w ast2(a0)
beq ausdruck
move.b #$2e,(a2)+
nachkop:
move.l a0,a1
move.w ast2(a0),d4
subq.w #1,d4
move.l a0,a1
add.l #vst,a1
lea z1(pc),a3
move.w #5,(a3)
move.w #11,2(a3)
moveq #0,d7
tst.b format
beq.s nkop
move.w #$30,4(a3)
move.b #$a,(a2)+
move.b #$30,(a2)+
move.b #$20,(a2)+
nkop:
move.b (a1)+,d0
tst.b format
beq.s z1rueck
subq.w #1,(a3)
bcs.s z1neu
z1rueck:
add.b #$30,d0
move.b d0,(a2)+
dbf d4,nkop
bra.s ausdruck
z1neu:
move.b #$20,(a2)+
addq.w #1,d7
cmp.w #6,d7
beq.s zd71w
zd71r:
move.w #4,(a3)
subq.w #1,2(a3)
bcc.s z1rueck
move.b #$a,(a2)+
move.w #11,2(a3)
moveq #0,d7
addq.w #1,4(a3)
cmp.w #$39,4(a3)
bhi.s z3neu
z3ok:
move.b z3+1(pc),(a2)+
move.b #$20,(a2)+
bra.s z1rueck
zd71w:
move.b #$20,(a2)+
move.b #$20,(a2)+
bra.s zd71r
z3neu:
move.w #$30,4(a3)
bra.s z3ok
ausdruck:
lea fdruck(pc),a0
tst.b (a0)
beq.s winddruck
; datei schreiben
lea datname(pc),a0
move.l a0,d1
move.l #mode_new,d2
jsr open(a6)
move.l d0,d7; datei öffnen
beq.s dat_fehler
move.l d7,d1
move.l buffer(pc),d2
move.l a2,d3
sub.l d2,d3
jsr write(a6); datei schreiben
move.l d7,d1
jsr close(a6); und wieder schließen
bra.s druck2aus
dat_fehler:
lea fehler(pc),a0
move.w #1,(a0)
bra.s druck2aus
winddruck:
move.b #$9b,(a2)+
move.b #$4b,(a2)+
move.b #$a,(a2)+
move.b #$9b,(a2)+
move.b #$20,(a2)+
move.b #$70,(a2)+
move.l a2,d3
move.l buffer(pc),d2
sub.l d2,d3
move.l conhandle(pc),d1
jsr write(a6)
druck2aus:
movem.l (sp)+,d0-d7/a0-a6
rts
; =================================================
; adresse des bcdfeldes in a0
; benutzt feld : buffer
alldruck:
movem.l d4-d7/a0-a6,-(sp)
move.l a0,a1
move.l buffer(pc),a2
move.l #$3e202020,(a2)+
move.w #vsb/2-1,d4
bsr makehex
; nachkommateil kopieren
move.b #".",(a2)+
move.w #nsb/2-1,d4
bsr makehex
move.b #" ",(a2)+
moveq #3,d4
bsr makehex
move.b #$9b,(a2)+
move.b #$4b,(a2)+
move.b #$a,(a2)+
move.l a2,d3
sub.l buffer(pc),d3
move.l conhandle(pc),d1
move.l buffer(pc),d2
jsr write(a6)
movem.l (sp)+,d4-d7/a0-a6
rts
makehex:
moveq #3,d3
move.w (a1)+,d5
makehex1:
rol.w #4,d5
move.w d5,d6
and.w #$f,d6
cmp.w #9,d6
bhi.s abuchst
add.b #$30,d6
bra.s az_ok
abuchst:
add.b #$37,d6
az_ok:
move.b d6,(a2)+
dbf d3,makehex1
dbf d4,makehex
rts
;==================================================
;================ rechenroutinen ==================
;====== teil 1 : grundrechenarten und andere ======
;======= basis operationen wie vergleichen ========
;================ und feld löschen ================
;==================================================
testa0:
tst.w st3(a0)
beq st3fehler
cmp.w #3,st3(a0)
bhi st3fehler
rts
testa0a1:
tst.w st3(a0)
beq st3fehler
cmp.w #3,st3(a0)
bhi st3fehler
tst.w st3(a1)
beq st3fehler
cmp.w #3,st3(a1)
bhi st3fehler
rts
; adresse von bytefeld in a0
; adresse von bcdfeld und Ergebnisfeld in a1
wandbyte_bcd:
movem.l d0/d1/a0/a1,-(sp)
move.w #sb-1,d0
byte_bcd:
move.b (a0)+,d1
lsl.b #4,d1
add.b (a0)+,d1
move.b d1,(a1)+
dbf d0,byte_bcd
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
movem.l (sp)+,d0/d1/a0/a1
rts
;==============================================
; adresse von bcdfeld in a0
; adresse von bytefeld und Ergebnisfeld in a1
wandbcd_byte:
movem.l d0-d2/a0/a1,-(sp)
move.w #sb-1,d0
bcd_byte:
move.b (a0)+,d1
move.b d1,d2
lsr.b #4,d1
move.b d1,(a1)+
and.b #$f,d2
move.b d2,(a1)+
dbf d0,bcd_byte
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
movem.l (sp)+,d0-d2/a0/a1
rts
;=======================================================
; adresse von feld in a0
; teilt ein feld durch 2
durch2:
bsr testa0
movem.l d3-d5/a0/a1,-(sp)
cmp.w #1,st3(a0)
beq durch2aus
bsr dist_st
move.l a0,a1
lsr.w #1,d4
bcc.s no2a
btst #0,d5
bne.s no2a
addq.l #2,d5
no2a:
add.l d4,a1
addq.w #1,d5
lsr.w #1,d5
add.l d5,a1
subq.w #1,d5
durch21:
move.b -(a1),d4
move.b d4,d3
and.b #$f,d4
lsr.b #1,d4
bcc.s nopl51
add.b #$50,1(a1)
nopl51:
lsr.b #4,d3
lsr.b #1,d3
bcc.s nopl52
addq.b #5,d4
nopl52:
lsl.b #4,d3
add.b d3,d4
move.b d4,(a1)
dbf d5,durch21
moveq #0,d4
move.w st1(a0),d4
beq.s d2vaus
move.l a0,a1
add.l #vsb,a1
clr.w d5
lsr.w #1,d4
addx.w d5,d5
sub.l d4,a1
tst.w d5
beq.s tsteq
tst.b -1(a1)
bne.s d2vaus
bra.s subd2v
tsteq:
cmp.b #9,(a1)
bhi.s d2vaus
subd2v:
subq.w #1,st1(a0)
d2vaus:
moveq #0,d4
move.w st2(a0),d4
move.l a0,a1
add.l #vsb,a1
clr.w d5
lsr.w #1,d4
addx.w d5,d5
add.l d4,a1
tst.w d5
beq.s tst2eq
move.b (a1),d4
and.b #$f,d4
beq.s durch2aus
bra.s d2npl
tst2eq:
tst.b (a1)
beq.s durch2aus
d2npl:
addq.w #1,st2(a0)
cmp.w #nst,st2(a0)
bls.s durch2aus
clr.w sb(a0)
move.w #nst,st2(a0)
durch2aus:
movem.l (sp)+,d3-d5/a0/a1
rts
;=================================================
; plus mit vorzeichen
; adresse von Summand 1 in a0
; adresse von Summand 2 und Ergebnisfeld in a1
pluss:
bsr testa0a1
movem.l d4/d5/a0/a1,-(sp)
move.w st3(a0),d4
move.w st3(a1),d5
cmp.w #1,d4
beq plussex
cmp.w #2,d4
beq.s p_pl1
bra.s p_mi1
p_kop_plussex:
bsr kopieren
bra.s plussex
p_pl1:
cmp.w #1,d5
beq.s p_kop_plussex
cmp.w #2,d5
beq.s p_pl1_pl2
p_pl1_mi2:
bsr minusu
cmp.w #2,st3(a1)
beq.s p_pl_mi
move.w #2,st3(a1)
bra.s plussex
p_pl_mi:
move.w #3,st3(a1)
bra.s plussex
p_mi1:
cmp.w #1,d5
beq.s p_kop_plussex
cmp.w #2,d5
beq.s p_mi1_pl2
p_mi1_mi2:
bsr plusu
move.w #3,st3(a1)
bra.s plussex
p_pl1_pl2:
bsr plusu
bra.s plussex
p_mi1_pl2:
bsr minusu
plussex:
movem.l (sp)+,d4/d5/a0/a1
rts
;=====================================================
; minus mit vorzeichen
; adresse von minuend 1 in a0
; adresse von subtrahent und ergebnisfeld in a1
minuss:
bsr testa0a1
movem.l d4/d5/a0/a1,-(sp)
move.w st3(a0),d4
move.w st3(a1),d5
cmp.w #1,d4
beq.s minussex
cmp.w #2,d4
beq.s m_pl1
m_mi1:
cmp.w #1,d5
beq.s kop_minussex
cmp.w #2,d5
beq.s m_mi1_pl2
m_mi1_mi2:
bsr minusu
cmp.w #2,st3(a1)
beq.s m_pl_mi
move.w #2,st3(a1)
bra.s minussex
m_pl_mi:
move.w #3,st3(a1)
bra.s minussex
m_pl1:
cmp.w #1,d5
beq.s m_pl1_n2
cmp.w #2,d5
beq.s m_pl1_pl2
m_pl1_mi2:
bsr plusu
move.w #3,st3(a1)
bra.s minussex
m_pl1_n2:
bsr kopieren
move.w #3,st3(a1)
bra.s minussex
m_pl1_pl2:
bsr minusu
bra.s minussex
kop_minussex:
bsr kopieren
bra.s minussex
m_mi1_pl2:
bsr plusu
move.w #2,st3(a1)
minussex:
movem.l (sp)+,d4/d5/a0/a1
rts
;====================================================
; vergleich mit vorzeichen
; adresse der felder in a0 und in a1
; ergebnis in d4
; 1 : beide gleich
; 2 : a0 grösser a1
; 3 : a1 grösser a0
vers:
bsr testa0a1
movem.l d5/a0/a1,-(sp)
move.w st3(a0),d4
move.w st3(a1),d5
cmp.w #1,d4
beq.s v_n1
cmp.w #2,d4
beq.s v_pl1
bra.s v_mi1
v_n1:
cmp.w #1,d5
beq.s v_n1_n2
cmp.w #2,d5
beq.s v_n1_pl2
v_n1_mi2:
moveq #2,d4
bra.s versex
v_pl1:
cmp.w #1,d5
beq.s v_pl1_n2
cmp.w #2,d5
beq.s v_pl1_pl2
v_pl1_mi2:
moveq #2,d4
bra.s versex
v_mi1:
cmp.w #1,d5
beq.s v_mi1_n2
cmp.w #2,d5
beq.s v_mi1_pl2
v_mi1_mi2:
bsr veru
cmp.b #2,d4
beq.s v_gr_kl
cmp.b #1,d4
beq.s v_gl
v_kl_gr:
moveq #2,d4
bra.s versex
v_gr_kl:
moveq #3,d4
bra.s versex
v_gl:
move.l #1,d4
bra versex
v_n1_n2:
moveq #1,d4
bra versex
v_n1_pl2:
moveq #3,d4
bra versex
v_pl1_n2:
moveq #2,d4
bra.s versex
v_pl1_pl2:
bsr veru
bra.s versex
v_mi1_n2:
v_mi1_pl2:
moveq #3,d4
versex:
movem.l (sp)+,d5/a0/a1
rts
;==================================================
; plus ohne vorzeichen
; adresse von Summand 1 in a0
; adresse von Summand 2 und Ergebnisfeld in a1
plusu:
bsr testa0a1
movem.l d4-d7/a0-a4,-(sp)
cmp.w #1,st3(a0)
beq pende
move.b (a0),d4
move.b (a1),d5
sub.w d6,d6
abcd d5,d4
bcs add_uberlauf
cmp.w #1,st3(a1)
beq kop0
bsr findrausgrkl
move.w d4,st1(a1)
move.w d5,st2(a1)
move.l a0,a3; a3 : summand 1
move.l a1,a4; a4 : summand 2 und ergebnis
add.l #vsb,a3
add.l #vsb,a4
move.w d4,d6
addq.w #1,d4
addq.w #1,d5
lsr.w #1,d4
lsr.w #1,d5
move.l d5,d7
add.l d5,a3
add.l d5,a4
move.l a4,a2
add.w d4,d5
sub.w d4,d4; x-flag löschen
plus1:
abcd -(a3),-(a4)
dbf d5,plus1
; vorkomma
btst #0,d6
beq.s plu_ger
move.b 1(a4),d4
lsr.b #4,d4
bne.s addeinestelle
bra.s plaus
plu_ger:
tst.b (a4)
bne.s addeinestelle
bra.s plaus
addeinestelle:
addq.w #1,st1(a1)
plaus:
move.w #2,st3(a1)
move.w d7,d4
beq.s movd4a1
move.l a1,a3
add.l #vsb,a3
add.l d7,a3
pin:
tst.b -(a3)
beq.s subeinestelle
bra.s paus
subeinestelle:
subq.w #1,d4
beq.s paus0
bra.s pin
paus0:
clr.w st2(a1)
bra.s pende
paus:
add.w d4,d4
move.b (a3),d5
and.b #$f,d5
beq.s plnaeinweni
movd4a1:
move.w d4,st2(a1)
bra.s pende
plnaeinweni:
subq.w #1,d4
bra.s movd4a1
kop0:
bsr kopieren
pende:
movem.l (sp)+,d4-d7/a0-a4
rts
;=======================================================
; minus ohne vorzeichen
; adresse von Subtrahent in a0
; adresse von Subtraktor und Ergebnisfeld in a1
minusu:
bsr testa0a1
movem.l d3-d7/a0-a4,-(sp)
move.l a0,a2
move.l a1,a3
bsr veru
move.b d4,d3
cmp.b #1,d4
beq minnull
bsr findrausgrkl
move.w d4,st1(a1)
move.w d5,st2(a1)
move.l a0,a3; a3 : summand 1
move.l a1,a4; a4 : summand 2 und ergebnis
add.l #vsb,a3
add.l #vsb,a4
addq.w #1,d4
addq.w #1,d5
lsr.w #1,d4
lsr.w #1,d5
move.w d4,d6
move.l d5,d7
add.l d5,a3
add.l d5,a4
move.l a4,a2
add.w d4,d5
cmp.b #2,d3
beq.s tauschsubtr
move.w #2,st3(a1)
bra.s subtr_ok
tauschsubtr:
movem.l d0/a0/a1,-(sp)
move.l a4,a0
move.l rt1(pc),a1
add.l #sb,a1
move.w d5,d0
tauschsub:
move.b -(a0),-(a1)
move.b -(a3),(a0)
dbf d0,tauschsub
movem.l (sp)+,d0/a0/a1
move.l rt1(pc),a3
add.l #sb,a3
move.w #3,st3(a1)
subtr_ok:
sub.w d4,d4; x-flag löschen
minus1:
sbcd -(a3),-(a4)
dbf d5,minus1
; vorkommastellenzahl errechnen
tst.w d6
beq.s mind6ok
addq.l #1,a4
minsubback:
tst.b (a4)
beq.s minsubein
bra.s minvaus
minsubein:
subq.w #1,d6
beq.s mind6ok
addq.l #1,a4
bra.s minsubback
minvaus:
add.w d6,d6
move.b (a4),d4
lsr.b #4,d4
beq.s subnaein
bra.s mind6ok
subnaein:
subq.w #1,d6
mind6ok:
move.w d6,st1(a1)
; nachkommastellenzahl errechnen
move.w d7,d4
beq.s mid4ok
move.l a1,a3
add.l #vsb,a3
add.l d7,a3
miin:
tst.b -(a3)
beq.s misubnein
bra.s miaus
misubnein:
subq.w #1,d4
beq.s miaus0
bra.s miin
miaus0:
clr.w st2(a1)
bra.s minex
miaus:
add.w d4,d4
move.b (a3),d5
and.b #$f,d5
beq.s minaeinweni
mid4ok:
move.w d4,st2(a1)
bra.s minex
minaeinweni:
subq.w #1,d4
bra.s mid4ok
minnull:
move.l a1,a0
bsr feldloesch
minex:
movem.l (sp)+,d3-d7/a0-a4
rts
;=======================================================
; multiplikation mit vorzeichen
; adresse von faktor 1 in a0
; adresse von faktor 2 und ergebnisfeld in a1
mals:
bsr testa0a1
movem.l d0-d7/a0-a5,-(sp)
cmp.w #1,st3(a0)
beq malnull1
cmp.w #1,st3(a1)
beq malsaus
; vorzeichen des ergebnisses ermitteln
move.w st3(a0),d0
cmp.w st3(a1),d0
beq.s mgleich
move.w #3,st3(a1)
bra.s mvorzaus
mgleich:
move.w #2,st3(a1)
mvorzaus:
; rechenfeld rt1 loeschen
move.w #sb*3/2+10,d4
move.l rt1(pc),a3
mlo:
clr.w (a3)+
dbf d4,mlo
; stellenzahlen und distanzwerte
moveq #0,d4
moveq #0,d5
move.l a0,a2; a3 : adresse von faktor 1
move.l a1,a3; a4 : adresse von faktor 2
bsr dist_st
move.l d4,d0
move.l d5,d1
bsr maketab
move.l a1,a5; a5 : adresse des ergebnisfeldes
moveq #0,d4
moveq #0,d5
move.l a1,a0
bsr dist_st
moveq #0,d7
move.w d4,d7
clr.w d6
lsr.w #1,d7
addx.w d6,d6
tst.w d6
sne d6
add.l d7,a0
; anfangsadresse im rechenfeld rt1 ermitteln
move.l rt1(pc),a3
move.l #vst+8,d2
move.l d0,d3
sub.l #vst,d3
add.l d3,d2
sub.l #vst,d4
add.l d4,d2
moveq #0,d7
asr.l #1,d2
addx.w d7,d7
tst.w d7
sne d7
moveq #0,d3
btst d3,d4
beq.s d0test
subq.l #1,d2
bra.s d2aus1
d0test:
btst d3,d0
bne.s d2aus1
subq.l #2,d2
d2aus1:
btst d3,d0
bne.s d1test
btst d3,d1
beq.s d2aus2
addq.l #1,d2
bra.s d2aus2
d1test:
btst d3,d1
bne.s d2aus2
subq.l #1,d2
d2aus2:
cmp.w #2,d2
blo mal_uberlauf
tst.w d2
bmi mal_uberlauf
moveq #0,d3
move.w d1,d3
lsr.w #1,d3
add.l d3,d2
add.l d2,a3
move.l tabr(pc),a1
subq.w #1,d5
move.w d1,d2
lsr.w #1,d1
addq.w #1,d2
lsr.w #1,d2
move.w d2,d1
move.l r1(pc),a5
move.w #sb+10/2-1,d0
clrr1a:
clr.w (a5)+
dbf d0,clrr1a
move.l a5,d2
move.w #sb+4,d3
move.l #sb+4*10+2,d4
; verwendete rechenfelder:
;
; r1 : 01
; rt1: rechenfeld für subtraktion (rest, 3-fache länge)
; tabr: tabelle fur multiplikation von 1 bis 10
;
; register:
;
; d0 : rechenregister
; d1 : laufzahl multergebnis
; d2 : zeiger auf r1, rechts
; d3 : sb+4
; d4 : sb+4*10+2
; d5 : laufzahl gesamt
; d6 : bit für wechsel von neuer zahl
; d7 : bit für wechsel von tabr
;
; a0 : zeiger auf nächste zahl
; a1 : zeiger auf tabr
; a2 : rechenregister
; a3 : zeiger auf rt1 rechts
; a4 : rechenregister
; a5 : adresse von nullbytes (ende)
; a6 : nicht benutzt
mmulanf:
moveq #0,d0
not.b d6
beq.s mbcdr
move.b (a0),d0
lsr.b #4,d0
bra.s mbcdraus
mbcdr:
move.b (a0)+,d0
and.b #$f,d0
mbcdraus:
tst.b d0
beq.s muladdnull
mulu d3,d0
move.l a1,a2
add.l d0,a2
not.b d7
beq.s noadd
add.l d4,a2
addq.l #1,a3
noadd:
move.l a3,a4
sub.w d0,d0
move.w d1,d0
muladd:
abcd -(a2),-(a4)
dbf d0,muladd
bcs.s weiadd
bra.s muladdaus
muladdnull:
not.b d7
beq.s muladdaus
addq.l #1,a3
bra.s muladdaus
weiadd:
abcd -(a5),-(a4)
bcs.s weiadd
move.l d2,d0
sub.l a5,d0
subq.w #1,d0
clrr1b:
clr.b (a5)+
dbf d0,clrr1b
move.l d2,a5
muladdaus:
dbf d5,mmulanf
move.l 4*9(sp),a5
move.l rt1,a0
tst.w (a0)
bne mal_uberlauf
; ergebnis vom rechenfeld zum ergebnisfeld kopieren
addq.l #2,a0
move.l a5,a4
move.w #sb/2-1,d0
moveq #0,d1
moveq #0,d2
kopmal:
move.w (a0)+,(a4)+
sne d1
or.w d1,d2
dbf d0,kopmal
tst.w d2
beq malnullerg
; letzte stelle aufrunden
cmp.b #$49,(a0)
bhi.s maufrd
bra.s maufrdaus
maufrd:
move.l a4,a3
move.l rt1(pc),a0
move.w #sb,d0
mclrrt1:
clr.w (a0)+
dbf d0,mclrrt1
move.b #1,-1(a0)
sub.w d0,d0
contrm:
abcd -(a0),-(a4)
bcs.s contrm
move.l a3,a4
maufrdaus:
; nachkommastellenzahl ermitteln
move.w #nsb,d0
mnachm:
tst.b -(a4)
bne.s mnachex
subq.w #1,d0
bne.s mnachm
bra.s mnachaus
mnsubeine:
subq.w #1,d0
bra.s mnachaus
mnachex:
add.w d0,d0
move.b (a4),d1
lsl.b #4,d1
beq.s mnsubeine
mnachaus:
move.w d0,st2(a5)
; vorkommastellen ermitteln
move.l a5,a4
move.w #vsb-1,d0
tsta4:
tst.b (a4)+
bne.s mvor
dbf d0,tsta4
clr.w d0
bra.s mvoraus
mvor:
addq.w #1,d0
add.w d0,d0
move.b -1(a4),d1
lsr.b #4,d1
bne.s mvoraus
subq.w #1,d0
mvoraus:
move.w d0,st1(a5)
bra.s malsaus
malnullerg:
clr.l (a4)+
move.l #$00000001,(a4)
bra.s malsaus
malnull1:
move.l a1,a0
bsr feldloesch
malsaus:
movem.l (sp)+,d0-d7/a0-a5
rts
;===========================================================
; division mit vorzeichen
; adresse von dividend in a0
; adresse von divisor und ergebnisfeld in a1
; f1 ist das feld in a0
; f2 ist das feld in a1
div:
bsr testa0a1
cmp.w #1,st3(a0)
beq div_null
movem.l d0-d7/a0-a5,-(sp)
cmp.w #1,st3(a1)
beq divaus
; vorzeichen ermitteln
move.w st3(a1),d4
cmp.w st3(a0),d4
beq.s dgleich
move.w #3,st3(a1)
bra.s dvorzaus
dgleich:
move.w #2,st3(a1)
dvorzaus:
; rechenfeld rt1 löschen
move.l rt1(pc),a5
move.w #sb*3/2,d4
div1:
clr.w (a5)+
dbf d4,div1
; distanzwert und stellenzahl für f1 ermitteln
exg a0,a1
bsr dist_st
exg a0,a1
move.l d4,d0
move.l d5,d1
clr.w d7
lsr.w #1,d4
bcs.s koprt11
move.l a1,a4
add.l d4,a4
subq.w #1,d5
move.l rt1(pc),a5
addq.l #2,a5
div2:
move.b (a4)+,(a5)+
dbf d5,div2
bra.s koprt1aus
koprt11:
move.l a1,a4
add.l d4,a4
moveq #0,d7
lsr.w #1,d5
addx.w d7,d7
add.l d5,a4
addq.l #1,a4
move.l rt1(pc),a5
addq.l #2,a5
add.l d5,a5
tst.w d7
beq.s d7eq
bra.s kop_rt12
d7eq:
move.b (a4),d7
lsr.b #4,d7
move.b d7,(a5)
kop_rt12:
move.b -(a4),d7
move.b d7,d4
lsl.b #4,d4
add.b d4,(a5)
lsr.b #4,d7
move.b d7,-(a5)
dbf d5,kop_rt12
koprt1aus:
; distanzwert und stellenzahl für f2 ermitteln
bsr dist_st
move.w d4,d2
; beginn des ergebnisses ermitteln
cmp.w d0,d2
beq.s d0gld2
cmp.w #vst,d2
beq.s d2_vst
cmp.w #vst,d2
bhi.s grglvst
klvst:
cmp.w d2,d0
bhi.s d2_gr_d0
move.w #vst,d1
sub.w d2,d1
add.w d1,d0
subq.w #1,d0
bra.s staus
d2_gr_d0:
move.w #vst-1,d1
sub.w d2,d1
add.w d1,d0
bra.s staus
d2_vst:
subq.w #1,d0
bra.s staus
d0gld2:
move.w #vst-1,d0
bra.s staus
grglvst:
sub.w #vst-1,d2
sub.w d2,d0
staus:
; in d0 : distanzwert für anfang des ergebnisses
; tabelle erstellen
bsr maketab
move.l d0,d2
clr.w d3
lsr.w #1,d2
addx.w d3,d3; d3 : flag für wechsel von ergebnis
tst.w d3
seq d3
move.l a1,a2
add.l d2,a2; a2 : zeiger auf ergebnisfeld, richtige stelle
move.w d0,a5
move.w #st,d6
sub.w d0,d6
bcs divergnull
cmp.w #st+1,d6
bhi div_uberlauf; wenn das ergebnis zu groß ist
lea divzaeh(pc),a3
move.w d6,(a3); divzaeh : divisionszähler
; die ersten 3 zahlen von f2 nach d6
move.l a0,a3
moveq #0,d0
move.w d4,d0
clr.w d1
lsr.w #1,d0
addx.w d1,d1
add.l d0,a3; a3 : zeiger auf f2, links
moveq #0,d6
moveq #0,d7
tst.b d1
bne.s deiw
move.b (a3)+,d6
move.b d6,d7
lsr.w #4,d6
mal10 d6
and.w #$f,d7
add.w d7,d6
move.b (a3),d7
lsr.w #4,d7
mal10 d6
add.w d7,d6
bra.s deiwaus
deiw:
move.b (a3)+,d6
move.b (a3),d7
lsr.w #4,d7
mal10 d6
add.w d7,d6
move.b (a3),d7
and.w #$f,d7
mal10 d6
add.w d7,d6
deiwaus:
tst.w d1
bne.s vb
btst #0,d5
bne.s ok
bra.s lk
vb:
btst #0,d5
beq.s ok
bra.s lk
ok:
bchg #0,d1
lk:
lsr.w #1,d5
; f2 (ergebnisfeld) löschen
move.w #sb/2+1,d7
div4:
clr.w (a1)+
dbf d7,div4
move.l rt1(pc),a0; a0 : zeiger auf rechenfeld, links
addq.l #1,a0
move.l tabr(pc),a4
addq.l #1,a4; a4 : basisadresse des multiplikationsfeldes
tst.w d1
sne d1
st d4
; verwendete rechenfelder :
;
; rt1: rechenfeld für subtraktion (rest, 3-fache länge)
; tabr: tabelle fur multiplikation von 1 bis 10
;
; register:
;
; d0 : rechenregister
; d1 : bit für wechsel von tabr
; d2 : rechenregister
; d3 : bit für wechsel von ergebnis
; d4 : bit für wechsel von rt1
; d5 : stellenzahl von f2
; d6 : 3 zahlen von f2 (konstant)
; d7 : 4 zahlen von rt1
;
; a0 : zeiger auf rechenfeld rt1
; a1 : arbeitsregister für subtraktion
; a2 : zeiger auf ergebnisfeld, richtige stelle
; a3 : adresse des multiplikationsergebnisses, rechts
; a4 : basis des multiplikationsfeldes
; a5 : zähler für division (stellen insgesamt)
; a6 : nicht benutzt
divanf:
; 4 zahlen vom rest nach d7
moveq #0,d7
moveq #0,d2
move.l a4,a3
move.l a0,a1
not.b d4
beq.s wandrt11
move.b 1(a0),d7
move.b d7,d2
lsr.b #4,d7
mal10 d7
and.b #$f,d2
add.b d2,d7
mal10 d7
move.b 2(a0),d2
lsr.b #4,d2
add.w d2,d7
mal10 d7
move.b 2(a0),d2
and.b #$f,d2
add.w d2,d7
addq.l #1,a0
add.l #sb+4*10,a3
addq.l #2,a1
not.b d1
bne.s wandrt1aus
addq.l #1,a3
bra.s wandrt1aus
wandrt11:
move.b (a0),d7
mal10 d7
move.b 1(a0),d2
lsr.b #4,d2
add.b d2,d7
mal10 d7
move.b 1(a0),d2
and.b #$f,d2
add.w d2,d7
mal10 d7
move.b 2(a0),d2
lsr.b #4,d2
add.w d2,d7
subq.l #1,a3
not.b d1
bne.s nomuladd2
addq.l #2,a1
bra.s wandrt1aus
nomuladd2:
addq.l #1,a1
wandrt1aus:
divu d6,d7
not.b d3
beq.s ergli
add.b d7,(a2)+
bra.s divergaus
ergli:
lsl.b #4,d7
move.b d7,(a2)
lsr.b #4,d7
divergaus:
tst.b d7
beq.s dminaus
; adresse des multiplikationsergebnisses errechnen
mulanf:
move.w d7,d0
mulu #sb+4,d0
add.l d0,a3
; mult.ergebnis von rt1 abziehen
; adresse des mult.ergebnisses in a3
divminin:
move.w d5,d2
addq.w #1,d2
add.l d5,a1
sub.w d0,d0
divmin:
sbcd -(a3),-(a1)
dbf d2,divmin
bcs.s wiederadd
dminaus:
lea divzaeh(pc),a1
subq.w #1,(a1)
bcc divanf
bra.s divschleifaus
; wenn fehler, dann f2 wieder auf rt1 addieren
wiederadd:
move.w d5,d2
addq.w #1,d2
add.l d5,a1
addq.l #2,a1
add.l d5,a3
addq.l #2,a3
sub.w d0,d0
divadd:
abcd -(a3),-(a1)
dbf d2,divadd
tst.b d3
beq.s neuerg1
subq.b #1,-1(a2)
bra.s neuergaus
neuerg1:
sub.b #%10000,(a2)
neuergaus:
subq.w #1,d7
beq.s dminaus
addq.l #2,a1
add.l d5,a3
sub.l #sb+2,a3
bra.s divminin
divschleifaus:
; letzte stelle aufrunden
cmp.b #$49,(a2)
bhi.s daufrd
bra.s aufrdaus
daufrd:
move.l a2,a1
move.l rt1(pc),a0
move.w #sb,d0
dclrrt1:
clr.w (a0)+
dbf d0,dclrrt1
move.b #1,-1(a0)
sub.w d0,d0
contrd:
abcd -(a0),-(a2)
bcs.s contrd
move.l a1,a2
aufrdaus:
clr.b (a2)
move.l 9*4(sp),a4
; vorkommastellenzahl
cmp.w #vst,a5
bhi.s dvornull
move.w #vst,d0
sub.w a5,d0
beq.s dvoraus
move.w d0,d1
clr.w d2
lsr.w #1,d1
addx.w d2,d2
move.l a4,a5
add.l #vsb,a5
and.l #$ffff,d1
sub.l d1,a5
tst.w d2
beq.s tsta0cl
tst.b -1(a5)
beq.s subeine
bra.s dvoraus
tsta0cl:
move.b (a5),d1
lsr.b #4,d1
beq.s subeine
bra.s dvoraus
subeine:
subq.w #1,d0
bra.s dvoraus
dvornull:
clr.w d0
dvoraus:
move.w d0,st1(a4)
; nachkommastellenzahl ermitteln
move.l a4,a5
add.l #sb,a5
move.w #nsb,d4
dnachm:
tst.b -(a5)
bne.s dnachex
subq.w #1,d4
bne.s dnachm
bra.s dnachaus
dnsubeine:
subq.w #1,d4
bra.s dnachaus
dnachex:
add.w d4,d4
move.b (a5),d0
lsl.b #4,d0
beq.s dnsubeine
dnachaus:
move.w d4,st2(a4)
bra.s divaus
divergnull:
move.l a1,a0
bsr feldloesch
divaus:
movem.l (sp)+,d0-d7/a0-a5
rts
;==================================================
; adresse des feldes in a0
; ergebnis: distanzwert in d4
; stellenzahl in d5
dist_st:
movem.l d3/d6/d7/a0,-(sp)
move.w st2(a0),d7
move.w st1(a0),d6
beq.s vnull
move.l #vst,d4
sub.w d6,d4
tst.w d7
beq.s suchen
moveq #0,d5
move.w d6,d5
add.w d7,d5
bra.s distaus
suchen:
add.l #vsb,a0
moveq #0,d7
nnull1:
tst.b -(a0)
bne.s naus
addq.w #1,d7
bra.s nnull1
naus:
add.w d7,d7
move.b (a0),d3
and.b #$f,d3
beq.s nauspl1
bra.s nausd4ok
nauspl1:
addq.w #1,d7
nausd4ok:
moveq #0,d5
move.w d6,d5
sub.w d7,d5
bra.s distaus
distnullaus:
moveq #0,d4
moveq #0,d5
bra.s distaus
vnull:
tst.w d7
beq.s distnullaus
move.l #vsb,d4
vnull1:
tst.b (a0,d4.w)
bne.s vaus
addq.w #1,d4
bra.s vnull1
vaus:
move.b (a0,d4.w),d6
add.w d4,d4
lsr.b #4,d6
beq.s vnullpl1
bra.s vnulld4ok
vnullpl1:
addq.w #1,d4
vnulld4ok:
moveq #0,d5
move.w d7,d5
add.w #vst,d5
sub.w d4,d5
distaus:
movem.l (sp)+,d3/d6/d7/a0
rts
;==========================================
; diese routine erstellt die tabelle für multiplikation und
; division bei tabr. alle register bleiben unverändert.
; kann direkt im anschluß an dist_st aufgerufen werden.
; a0 : zeiger auf feld
; d4 : distanzwert
; d5 : stellenzahl
maketab:
movem.l d2-d7/a0-a3,-(sp)
move.l #sb+4,d2
subq.w #1,d5
move.l tabr(pc),a1
move.w #sb+4*20+20/4,d6
clrtabr:
clr.l (a1)+
dbf d6,clrtabr
lsr.w #1,d4
bcs.s kop1m
add.l d4,a0
lsr.w #1,d5
add.l d5,a0
addq.l #1,a0; a0 : zeiger rechts
move.l a0,a1
move.l tabr(pc),a2
add.l d2,a2
move.w d5,d6
kop_f1:
move.b -(a1),-(a2)
dbf d6,kop_f1
bra.s addtab1aus
kop1m:
add.l d4,a0
moveq #0,d7
lsr.w #1,d5
addx.w d7,d7
add.l d5,a0; a0 : f2 rechts
addq.l #1,a0
move.l a0,a1
move.l tabr(pc),a2
add.l #sb+3,a2
move.w d5,d6
addq.w #1,d6
tst.w d7
bne d7ne
bra.s kop_f11
d7ne:
move.b (a1),d7
lsr.b #4,d7
move.b d7,(a2)
addq.w #1,d5
kop_f11:
move.b -(a1),d7
move.b d7,d4
lsl.b #4,d4
add.b d4,(a2)
lsr.b #4,d7
move.b d7,-(a2)
dbf d6,kop_f11
addtab1aus:
move.l tabr(pc),a0
move.l a0,a2
add.l d2,a0
add.l d2,a2
add.l d2,a2
moveq #8,d7
addtab1:
move.w d5,d6
move.l a0,a1
move.l a2,a3
addtab2:
move.b -(a1),-(a3)
dbf d6,addtab2
move.l a2,a1
move.l a2,a3
sub.l d2,a1
move.w d5,d6
addq.w #1,d6
sub.w d3,d3
addtab3:
abcd -(a1),-(a3)
dbf d6,addtab3
add.l d2,a2
dbf d7,addtab1
; verschobene tabelle erstellen
move.l tabr(pc),a0
move.l a0,a2
add.l d2,a0
add.l #sb+4*11+2,a2
moveq #9,d7
verschtab1:
move.w d5,d6
addq.w #1,d6
move.l a0,a1
move.l a2,a3
verschtab2:
move.b -(a1),d4
move.b d4,d3
lsl.b #4,d3
add.b d3,-(a3)
lsr.b #4,d4
move.b d4,-1(a3)
dbf d6,verschtab2
add.l d2,a0
add.l d2,a2
dbf d7,verschtab1
movem.l (sp)+,d2-d7/a0-a3
rts
;==============================================
; setzt ein feld auf null
; feldadresse in a0
feldloesch:
movem.l d0/a0,-(sp)
move.w #sb/2+2,d0
lanf:
clr.w (a0)+
dbf d0,lanf
move.w #1,(a0)+
movem.l (sp)+,d0/a0
rts
;================================================
; adresse des 1. feldes in a0
; adresse des 2. feldes in a1
; grössere vorkommazahl in d4
; grössere nachkommazahl in d5
findrausgrkl:
move.l d6,-(sp)
moveq #0,d4
moveq #0,d5
move.w st1(a1),d6
cmp.w st1(a0),d6
blt.s vor1grvor2
bgt.s vor1klvor2
move.w st1(a0),d4
frueck1:
move.w st2(a1),d6
cmp.w st2(a0),d6
blt.s nach1grnach2
bgt.s nach1klnach2
move.w st2(a1),d5
bra.s findaus
vor1grvor2:
move.w st1(a0),d4
bra.s frueck1
vor1klvor2:
move.w st1(a1),d4
bra.s frueck1
nach1grnach2:
move.w st2(a0),d5
bra.s findaus
nach1klnach2:
move.w st2(a1),d5
findaus:
move.l (sp)+,d6
rts
;=====================================================
; kopiert feld in a0 auf feld in a1
; adresse des quellfeldes in a0
; adresse des zielfeldes in a1
kopieren:
movem.l d4/a0/a1,-(sp)
move.w #sb/2+3,d4
kopieren1:
move.w (a0)+,(a1)+
dbf d4,kopieren1
movem.l (sp)+,d4/a0/a1
rts
;=====================================================
; tauscht felder in a0 und a1 aus
; adresse der felder in a0 und in a1
tausch:
movem.l d4/d5/a0/a1,-(sp)
move.w #sb/2+3,d4
tau1:
move.w (a0),d5
move.w (a1),(a0)+
move.w d5,(a1)+
dbf d4,tau1
movem.l (sp)+,d4/d5/a0/a1
rts
;=====================================================
; vergleich ohne vorzeichen
; adresse der felder in a0 und in a1
; ergebnis in d4
; 1 : beide gleich
; 2 : a0 grösser a1
; 3 : a1 grösser a0
veru:
bsr testa0a1
movem.l a0/a1,-(sp)
move.w #sb/2-1,d4
ver1:
cmpm.w (a1)+,(a0)+
blo.s a1_gr_a0
bhi.s a0_gr_a1
dbf d4,ver1
moveq #1,d4
bra.s veraus
a1_gr_a0:
moveq #3,d4
bra.s veraus
a0_gr_a1:
moveq #2,d4
veraus:
movem.l (sp)+,a0/a1
rts
;=================================================
; feld(a0) := feld(a0) - 1
; adresse des feldes in a0
decrem:
bsr testa0
movem.l d0/d1/a0-a2,-(sp)
cmp.w #1,st3(a0)
beq.s decremex
tst.w st2(a0)
bne.s decremex
move.l dez1(pc),a2
add.l #vsb,a2
move.l a0,a1
add.l #vsb,a1
sub.w d0,d0
decweiadd:
sbcd -(a2),-(a1)
bcs.s decweiadd
move.w st1(a0),d0
moveq #0,d1
move.w d0,d1
lsr.w #1,d1
move.l a0,a1
add.l #vsb,a1
sub.l d1,a1
btst #0,d0
bne.s tstm1
move.b (a1),d0
lsr.b #4,d0
beq.s dec1weniger
bra.s decremex
tstm1:
tst.b -1(a1)
beq.s dec1weniger
bra.s decremex
alloe:
move.w #1,st3(a0)
bra.s decremex
dec1weniger:
subq.w #1,st1(a0)
beq.s alloe
decremex:
movem.l (sp)+,d0/d1/a0-a2
rts
;==============================================
; feld(a0) := feld(a0) + 1
; adresse des feldes in a0
increm:
bsr testa0
movem.l d0/d1/a0-a2,-(sp)
cmp.w #1,st3(a0)
beq.s increm0_1
tst.w st2(a0)
bne.s incremex
move.l dez1(pc),a2
add.l #vsb,a2
move.l a0,a1
add.l #vsb,a1
sub.w d0,d0
incweiadd:
abcd -(a2),-(a1)
bcs.s incweiadd
move.w st1(a0),d0
moveq #0,d1
move.w d0,d1
lsr.w #1,d1
move.l a0,a1
add.l #vsb-1,a1
sub.l d1,a1
btst #0,d0
bne.s itstm1
tst.b (a1)
bne.s inc1mehr
bra.s incremex
itstm1:
move.b (a1),d0
lsr.b #4,d0
bne.s inc1mehr
bra.s incremex
increm0_1:
move.w #1,st1(a0)
move.w #2,st3(a0)
move.b #1,vsb-1(a0)
bra.s incremex
inc1mehr:
addq.w #1,st1(a0)
incremex:
movem.l (sp)+,d0/d1/a0-a2
rts
;==============================================
; wechselt das vorzeichen
; adresse des feldes in a0
vorz_wechsel:
bsr testa0
move.l d0,-(sp)
move.w st3(a0),d0
cmp.w #1,d0
beq.s vor_wechsaus
cmp.w #2,d0
beq.s plus_minus
move.w #2,st3(a0)
bra.s vor_wechsaus
plus_minus:
move.w #3,st3(a0)
vor_wechsaus:
move.l (sp)+,d0
rts
;==================================================
; löscht den nachkommateil des feldes in a0
; adresse des feldes in a0
integer:
bsr testa0
movem.l d0/a0,-(sp)
cmp.w #1,st3(a0)
beq.s integ_aus
tst.w st2(a0)
beq.s integ_aus
tst.w st1(a0)
bne.s integnnull
move.w #1,st3(a0)
integnnull:
clr.w st2(a0)
move.w #nsb/2-1,d0
add.l #vsb,a0
clrinteg:
clr.w (a0)+
dbf d0,clrinteg
integ_aus:
movem.l (sp)+,d0/a0
rts
;===========================================
;============= rechenroutinen ==============
;=== teil 2 : routinen, die die grund- =====
;====== rechenfunktionen benutzen. =========
;======== z.b. sqrroot oder pi1 ============
;===========================================
; adresse des feldes in a0
sinus:
bsr testa0
movem.l d0/d1/a0-a2,-(sp)
move.l a0,a2
; zahl zwischen +pi/2 und -pi/2 bringen
mkopieren a2,sqr1(pc)
mdiv pi(pc),sqr1(pc)
move.l sqr1(pc),a0
cmp.b #$49,vsb(a0)
bhi.s sinaufrd
bsr integer
bra.s sinaufrdaus
sinaufrd:
bsr integer
bsr increm
sinaufrdaus:
mmals pi(pc),sqr1(pc)
mminusu sqr1(pc),a2
mkopieren a2,sqr1(pc)
mkopieren a2,sqr2(pc)
mquadrat sqr2(pc)
mkopieren dez1(pc),sqr3(pc)
mkopieren dez1(pc),sqr4(pc)
; sin(x) = x - x^3/3! + x^5/5! -x^7/7! ...
; sqr1 : jeweiliges x^n
; sqr2 : x^2
; sqr3 : n!
; sqr4 : n
st d4
moveq #82,d5
makesin:
mincrem sqr4(pc)
mmals sqr4(pc),sqr3(pc)
mincrem sqr4(pc)
mmals sqr4(pc),sqr3(pc)
mmals sqr2(pc),sqr1(pc)
sin_in:
mfeldloesch sqr5(pc)
mkopieren sqr1(pc),sqr5(pc)
mdiv sqr3(pc),sqr5(pc)
cmp.w #1,st3(a1)
beq.s sin_aus
not.b d4
beq.s sinabzieh
mplusu sqr5(pc),a2
bra.s sin_2
sinabzieh:
mminusu sqr5(pc),a2
sin_2:
dbf d5,makesin
sin_aus:
movem.l (sp)+,d0/d1/a0-a2
rts
;================================================
; adresse des feldes in a0
fakultaet:
bsr testa0
movem.l d0/d1/a0-a2,-(sp)
cmp.w #1,st3(a0)
beq fak_1
cmp.w #3,st3(a0)
beq fakfehler
tst.w st2(a0)
bne fakfehler
moveq #0,d0
move.b vsb-2(a0),d0
move.w d0,d1
lsr.w #4,d0
mulu #10,d0
and.w #$f,d1
add.w d1,d0
mulu #10,d0
moveq #0,d1
move.b vsb-1(a0),d1
lsr.w #4,d1
add.w d1,d0
mulu #10,d0
move.b vsb-1(a0),d1
and.w #$f,d1
add.w d1,d0
tst.w d0
beq fakfehler
cmp.w #1,d0
beq fakaus
cmp.w #2,d0
beq fakaus
move.l a0,a2
move.l sqr1(pc),a1
bsr kopieren
subq.w #2,d0
fak:
move.l sqr1(pc),a0
bsr decrem
mmals sqr1(pc),a2
dbf d0,fak
bra.s fakaus
fak_1:
bsr feldloesch
move.b #1,vsb-1(a0)
move.w #1,st1(a0)
move.w #2,st3(a0)
fakaus:
movem.l (sp)+,d0/d1/a0-a2
rts
;===============================================
; adresse des feldes in a0
sqrroot:
bsr testa0
cmp.w #3,st3(a0)
beq sqr_negativ
cmp.w #1,st3(a0)
beq wurzaus2
movem.l d4-d7/a0-a5,-(sp)
move.l sqr1(pc),a1
bsr kopieren
cmp.w #4,st1(a0)
bhi.s kleinermachen
bsr dist_st
cmp.w #vst,d4
bhi.s groessermachen
bra.s anfwurz
groessermachen:
sub.w #vst-1,d4
lsr.w #1,d4
add.w #vst-1,d4
moveq #0,d5
move.w d4,d5
lsr.w #1,d5
move.l sqr1(pc),a1
add.l d5,a1
move.b #5,(a1)
bra.s anfwurz
kleinermachen:
move.w st1(a0),d4
lsr.w #1,d4
move.l #vst,d5
sub.w d4,d5
lsr.w #1,d5
move.l sqr1,a1
add.l d5,a1
move.w d5,d4
subq.w #1,d5
move.b #$50,(a1)
kl1:
clr.b -(a1)
dbf d5,kl1
move.w #vsb,d5
sub.w d4,d5
add.w d5,d5
move.l sqr1,a1
move.w d5,st1(a1)
; x[n+1] = 0.5 * ( x[n] + a / x[n] )
; sqr1 : x[n]
; sqr3 : rechenfeld für überprüfung
; sqr4 : zwischenergebnis der division
anfwurz:
move.l a0,a4; a4 : originaladresse
moveq #10,d4; anzahl der iterationen
move.l sqr1(pc),d6
move.l sqr4(pc),d7
move.l sqr3(pc),a5
wurz:
mkopieren a4,sqr4(pc)
mdiv d6,d7
mplusu d7,d6
move.l d6,a0
bsr durch2
dbf d4,wurz
ueberpruefen:
mkopieren d6,a5; sqr3 : x[n]
mkopieren a4,d7
mdiv d6,d7
mplusu d7,d6
move.l d6,a0
bsr durch2; sqr1 : x[n+1]
mveru d6,a5
cmp.b #1,d4
beq.s wurzaus1
bra.s ueberpruefen
wurzaus1:
mkopieren d6,a4
wurzaus:
movem.l (sp)+,d4-d7/a0-a5
wurzaus2:
rts
;=============================================
; adresse des feldes in a0
quadrat:
bsr testa0
movem.l a0/a1,-(sp)
move.l sqr1(pc),a1
bsr kopieren
exg a0,a1
bsr mals
movem.l (sp)+,a0/a1
rts
;=============================================
; adresse des feldes in a0
pi1:
movem.l d4-d7/a0-a6,-(sp)
prtxt 16
move.l buffer(pc),a4
moveq #0,d6
piein:
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #$d,d4
beq pireturn
cmp.b #$8,d4
beq pibackspace
cmp.b #$30,d4
beq pizeinull
cmp.b #$30,d4
blt.s piein
cmp.b #$39,d4
bgt.s piein
move.l buffer(pc),a0
addq.l #4,a0
cmp.l a0,a4
beq piein
inordnung:
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr write(a6)
sub.b #$30,(a4)
addq.l #1,a4
addq.w #1,d6
bra piein
pibackspace:
cmp.l buffer(pc),a4
beq piein
bsr backspace
clr.b (a4)
subq.l #1,a4
subq.w #1,d6
bra piein
pizeinull:
cmp.l buffer(pc),a4
beq piein
bra inordnung
pireturn:
cmp.l buffer(pc),a4
beq pi1aus
subq.w #1,d6
move.l buffer(pc),a4
clr.l d5
clr.w d7
wand:
move.b (a4)+,d7
mulu #10,d5
add.w d7,d5
dbf d6,wand
; felder vorbesetzen
prtxt 19
mkopieren dez2(pc),bcd1(pc)
mquadrat bcd1(pc)
mkopieren dez3(pc),bcd2(pc)
mquadrat bcd2(pc)
mkopieren dez2(pc),bcd3(pc)
mkopieren dez3(pc),bcd4(pc)
mkopieren dez2(pc),bcd5(pc)
mkopieren dez3(pc),bcd6(pc)
mkopieren dez1(pc),bcd7(pc)
prtxt 22
move.w #vst,d4
bsr zahlaus
prtxt 23
move.w #nst,d4
bsr zahlaus
prtxt 11
move.w d5,d4
bsr zahlaus
; pi = 4 * ( 4*arctan(1/5) - arctan(1/239) )
; arctan(x) = x - x^3/3 + x^5/5 - x^7/7 + x^9/9 ...
; bcd1 : (1/5)^2
; bcd2 : (1/239)^2
; bcd3 : zwischenergebnis arctan(1/5)
; bcd4 : zwischenergebnis arctan(1/239)
; bcd5 : (1/5)^n
; bcd6 : (1/239)^n
; bcd7 : zähler
move.w d5,d6
moveq #1,d7; anzeigen
lea plflag(pc),a0
st (a0)
move.l 4.w,a5
lea bcd1(pc),a3
schlanf1:
print str2,6
move.w d5,d4
sub.w d6,d4
bsr zahlaus
print miplu+2,1
cmp.w #2,d7
beq.s ueberspring
prtxt 18
bsr berecherg
mdruck bcd8(pc)
ueberspring:
btst #6,$bfe001
beq piweiter
cmp.b #$3d,$bfec01
beq piweiter
berechwei:
exg a5,a6
jsr forbid(a6)
mmals (a3),4*4(a3); v6 : v3 : (1/5)^2
mkopieren 4*4(a3),7*4(a3)
mmals 4(a3),5*4(a3); v7 : v4 * (1/239)^2
mkopieren 5*4(a3),8*4(a3)
mincrem 6*4(a3)
mincrem 6*4(a3); v5 := v5+2
mdiv 6*4(a3),7*4(a3)
mdiv 6*4(a3),8*4(a3)
lea plflag(pc),a0
not.b (a0)
beq.s plabzieh
mplusu 7*4(a3),2*4(a3)
mplusu 8*4(a3),3*4(a3)
bra.s arcaus
plabzieh:
mminusu 7*4(a3),2*4(a3)
mminusu 8*4(a3),3*4(a3)
arcaus:
jsr permit(a6)
exg a5,a6
dbf d6,schlanf1
prtxt 18
bsr berecherg
mdruck bcd8
print dt24,5
bra fragsave0
berechweiin:
cmp.w #2,d7
beq.s q_ja
move.l buffer(pc),a0
move.l #$0d9b4b00,(a0)
p_buf 3
bra berechwei
q_ja:
prtxt 25
bra berechwei
zquiet:
cmp.w #1,d7
beq.s anz_qu
qu_wiederanz:
moveq #1,d7
bra.s berechweiin
anz_qu:
moveq #2,d7
prtxt 25
bra berechwei
piweiter:
cmp.w #1,d7
beq.s qtext
prtxt 24
bra.s pireadin
qtext:
prtxt 17
pireadin:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #"y",d4
beq.s piread1
cmp.b #"n",d4
beq.s piread1
cmp.b #"q",d4
beq.s piread1
bra.s pireadin
piread1:
move.l buffer(pc),a4
lea z1(pc),a0
move.l (a4),(a0)
p_buf 1
piread2:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #$d,d4
beq pireadaus
cmp.b #8,d4
beq.s pireadloe
bra.s piread2
pireadloe:
bsr backspace
bra.s pireadin
pireadaus:
move.b z1(pc),d4
cmp.b #"y",d4
beq berechweiin
cmp.b #"q",d4
beq zquiet
fragsave0:
prtxt 30
fragsave:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #"y",d4
beq.s fragsave2
cmp.b #"n",d4
beq.s fragsave2
bra.s fragsave
fragsave2:
move.l buffer(pc),a4
lea z1(pc),a0
move.l (a4),(a0)
p_buf 1
fragsave3:
move.l buffer(pc),a4
move.l conhandle(pc),d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
move.b (a4),d4
cmp.b #$d,d4
beq.s fragsaveaus
cmp.b #$8,d4
beq.s fragsaveloe
bra.s fragsave3
fragsaveloe:
bsr backspace
bra.s fragsave
fragsaveaus:
move.b z1(pc),d4
cmp.b #"n",d4
beq berechaus
bsr namein; dateinamen eingeben
lea datname(pc),a0
tst.b (a0)
beq.s no_name
bsr berecherg
lea fdruck(pc),a3
move.b #1,(a3)
mdruck bcd8(pc); zahl in datei speichern
clr.b (a3)
lea fehler(pc),a0
tst.w (a0)
bne piwrite_err
bsr namedruck
prtxt 33
bsr r_buf
bra pi1aus
piwrite_err:
prtxt 40
bsr r_buf
bra.s pi1aus
no_name:
prtxt 43
bra.s pi1aus1
berechaus:
print str3,5
prtxt 13
pi1aus1:
bsr r_buf
pi1aus:
movem.l (sp)+,d4-d7/a0-a6
rts
;--------------------
berecherg:
mkopieren 2*4(a3),7*4(a3)
mkopieren 2*4(a3),8*4(a3)
mplusu 7*4(a3),8*4(a3)
mkopieren 8*4(a3),7*4(a3)
mplusu 8*4(a3),7*4(a3); v8 : 4*arctan(1/5)
mminusu 3*4(a3),7*4(a3); v8 : 4*arctan(1/5)-arctan(1/239)
mkopieren 7*4(a3),8*4(a3)
mplusu 7*4(a3),8*4(a3)
mkopieren 8*4(a3),7*4(a3)
mplusu 8*4(a3),7*4(a3); v8 : pi-ergebnis
rts
;--------------------
namein:
prtxt 32
lea datname(pc),a4
move.l conhandle(pc),d7
nnamein:
move.l d7,d1
move.l a4,d2
moveq #1,d3
jsr read(a6)
cmp.b #$d,(a4)
beq.s nameex
cmp.b #$8,(a4)
beq.s nback
cmp.b #$9b,(a4)
beq.s frgs_ctrl
cmp.l #datname+40,a4
beq.s nnamein
move.l d7,d1
move.l a4,d2
move.l #1,d3
jsr write(a6)
addq.l #1,a4
bra.s nnamein
frgs_ctrl:
move.l d7,d1
move.l a4,d2
moveq #10,d3
jsr read(a6)
bra.s nnamein
nback:
lea datname(pc),a0
cmp.l a0,a4
beq.s nnamein
bsr backspace
subq.l #1,a4
bra.s nnamein
nameex:
clr.b (a4)
rts
;--------------------
namedruck:
prtxt 31
lea datname(pc),a4
move.l a4,d2
moveq #0,d3
addname:
tst.b (a4)+
beq.s addraus
addq.w #1,d3
bra.s addname
addraus:
move.l conhandle(pc),d1
jsr write(a6)
print zeiloe,2
rts
;************ daten,variablen ***********
dosname:dc.b `dos.library`,0
intname:dc.b `intuition.library`,0
piname: dc.b `pidat`,0
name: dc.b `raw:0/0/`
windsize: dc.b `640/200/************** ADAM_V3 **************`,0
; deutsche texte
dt1:
dc.b $c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mManulle Eingabe`
dc.b $9b,`0;31;40m`,$a,$a
dc.b ` Das Prompt-Zeichen > fordert zur Eingabe auf. In der`
dc.b ` ersten und in der`,$a,` dritten Zeile`
dc.b ` wird die Eingabe einer Zahl erwartet, in der`,$a
dc.b ` zweiten Zeile die Eingabe eines Befehls.`,$a
dc.b ` Hier können die Zeichen +, -, *, /`
dc.b ` oder ein Buchstabe eingegegeben werden.`,$a
dc.b ` Buchstaben, die Befehle auslösen:`,$a,$a,9
dc.b `m = speichern`,9,9,9,`q = quadrieren`,$a,9
dc.b `s = Wurzel ziehen`,9,9,`v = vergleichen`,$a,9
dc.b `k = Kehrwert`,9,9,9,`! = Fakultät`,$a,9
dc.b `w = Vorzeichen wechseln`,9,9,`i = Integer`,$a,9
dc.b `S = Sinus`,$a,$a
dc.b ` Anstatt eine Zahl einzugeben kann auch`,$a
dc.b ` - p für pi`,$a
dc.b ` - m für die Zahl im Speicher`,$a
dc.b ` eingegeben werden.`,$a
dc.b ` Jede Eingabe kann mit der Backspace-Taste gelöscht`
dc.b ` werden`,$a,` und muß mit Return-Taste abgeschlossen`
dc.b ` werden.`,$a,$a,9,9,`Drücke eine Taste `
dt2:
dc.b $9b,`0 p`,$9b
dc.b `K f1, Esc = Hauptmenü`,9,9,9,`f2 = nochmal`,$a,$9b
dc.b `K f3 = nochmal mit dem Ergebnis`,9,9,`f4 = format ändern `
dc.b $a,$9b,`K f5 = Ergebnis speichern und nochmal f6 = help `
dc.b $9b,` p`
dt3: dc.b ` Beide Zahlen sind gleich gross`,$a
dt4: dc.b ` Die erste Zahl ist grösser als die zweite`,$a
dt5: dc.b ` Die zweite Zahl ist grösser als die erste`,$a
dt6: dc.b ` Bedingungen für nst und vst:`,$a,9
dc.b `- vst und nst müssen durch 4 teilbar sein`,$a,9
dc.b `- vst und nst müssen kleiner als 30000 und größer`
dc.b `als 19 sein`
dt7: dc.b $c,$9b,`20B Speicher =`,$a
dt8: dc.b `qr =`,$a
dt9: dc.b 8,`^2 =`,$a
dt10: dc.b $9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mHauptmenü`
dc.b $9b,`0;31;40m`,$9b
dc.b `3E f1, Esc = Ende`,$9b
dc.b `2E f2 = rechnen`,$9b
dc.b `2E f3 = Pi berechnen`,$9b
dc.b `2E f4 = Hilfe `,$9b
dc.b `2E f5 = Sprache : Deutsch`,$9b,`3E `
dc.b $9b,`4;31;40mFeldgröße :`,$9b,`0;31;40m`,$a,$a
dc.b 9,`vst =`,$a,9,`nst = `,$b
dt11: dc.b $9b,`1;42H`,$9b,`4;31;40mIterationen :`
dc.b $9b,`0;31;40m von `
dt12: dc.b $c,$a,$9b,`24C`,$9b,`4;33;40mFehlermeldung`
dc.b $9b,`0;31;40m`,$a,$a
dt13: dc.b $d,` Bitte eine Taste drücken `,$9b,$4b
dt14: dc.b ` Im Artwort des Feldes (st3) ist eine Null statt`
dc.b ` 1,2 oder 3`
dt15: dc.b ` Wurzel aus einer negativen Zahl`
dt16: dc.b $c,` Anzahl der Iterationen ?`,$9b,`4E`
dc.b ` Die Berechnung kann mit dem linken Mausknopf und`
dc.b ` der rechten Shifttaste`,$a,` unterbrochen werden`
dc.b $9b,`3F> `
dt17: dc.b $9b,`3;1H`
dc.b ` Weitermachen (y/n) oder quiet (q) ? `,$9b,$4b
dt18: dc.b $9b,`5;1H Pi = `,$a
dt19: dc.b $9b,`5E Einen Moment ... `
dt20: dc.b ` =`,$9b,$4b,$a
dt21: dc.b ` Division durch null`
dt22: dc.b $c,` `,$9b,`4;31;40mFeldgröße :`
dc.b $9b,`0;31;40m vst = `
dt23: dc.b `, nst = `
dt24: dc.b $9b,`3;1H Weitermachen`
dc.b ` (y/n) oder wieder anzeigen (q) ? `,$9b,$4b
dt25: dc.b $d,` quiet`,$9b,$4b
dt26:
dt27: dc.b ` Überlauf bei Addition`
dt28: dc.b ` Überlauf bei Division`
dt29: dc.b ` Überlauf bei Multiplikation`
dt30: dc.b $d,` Zahl speichern (y/n) ? `,$9b,$4b
dt31: dc.b $d,` Zahl gespeichert als : `,$9b,$4b
dt32: dc.b $d,` Dateiname : `,$9b,$4b
dt33: dc.b ` < Taste > `,$9b,$4b
dt34: dc.b ` Fakultät einer negativen Zahl und einer nicht`
dc.b `ganzen Zahl ist nicht erlaubt`
dt35: dc.b 8,`* -1 =`,$a
dt36: dc.b 8,`^ -1 =`,$a
dt37: dc.b 8,`integer =`,$a
dt38: dc.b $a,` Format : unformatiert`,$9b,$4b,$9b,`3F`
dt39: dc.b $a,` Format : formatiert`,$9b,$4b,$9b,`3F`
dt40: dc.b $d,` Fehler : Datei konnte nicht geöffnet werden `
dc.b ` < Taste >`,$9b,$4b
dt41: dc.b $a,` Datei `,34,`pidat`,34,` konnte nicht`
dc.b ` geöffnet werden < Taste > `,$9b,$4b
dt42: dc.b 8,`Sinus =`,$a
dt43: dc.b $d,` Nicht gespeichert < Taste > `
dt44: dc.b $a,9,`Nicht genug Speicher !`
dt45: dc.b $a,9,`Konnte Fenster nicht öffnen !`
dt46:
; englische texte
et1:
dc.b $c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mHow to enter a`
dc.b ` number`,$9b,`0;31;40m`,$a,$a
dc.b ` The prompt > requests your enters. `
dc.b `In the first`,$a,` and third line`
dc.b ` you are expected to type in a number,`,$a
dc.b ` in the second line a command.`,$a
dc.b ` These are the commands :`,$a,$a
dc.b 9,`+, -, *, / = add, subract, multiply, divide`,$a
dc.b 9,`m = copy to memory`,9,9,`q = square`,$a
dc.b 9,`s = square root`,9,9,9,`v = compare`,$a
dc.b 9,`k = reciprocal`,9,9,9,`! = faculty`,$a
dc.b 9,`w = change sign`,9,9,9,`i = integer`,$a
dc.b 9,`S = sine`,$a,$a
dc.b ` Instead of typing a number you can type`,$a
dc.b ` - m for the number that is currently in the `
dc.b `memory and `,$a,9,` is displayed at the bottom or `
dc.b $a,` - p for pi`
dc.b $a,` Each number and command must be concluded by `
dc.b `<RETURN>`,$a,` and can be erased by <BACKSPACE>.`
dc.b $a,$a,9,9,` Press any key `
et2:
dc.b $9b,`0 p`,$9b
dc.b `K f1, Esc = Main Menu`,9,9,9,`f2 = once again`,$a,$9b
dc.b `K f3 = once again with result`,9,9,`f4 = change format`
dc.b $a,$9b,`K f5 = store result and once again f6 = help `
dc.b $9b,` p`
et3: dc.b ` The numbers are equal`,$a
et4: dc.b ` The first number is higher`,$a
et5: dc.b ` The second number is higher`,$a
et6: dc.b ` Conditions for st : `,$a,$a
dc.b ` vst and nst can be divided by 4 without a rest`
dc.b $a,` vst and nst must be smaller than 30000 and `
dc.b `greater than 19`
et7: dc.b $c,$9b,`20B memory =`,$a
et8: dc.b `qr =`,$a
et9: dc.b 8,`^2 =`,$a
et10: dc.b $9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mMain menu`
dc.b $9b,`0;31;40m`,$9b
dc.b `3E f1, Esc = Exit`,$9b
dc.b `2E f2 = calculate`,$9b
dc.b `2E f3 = calculate pi`,$9b
dc.b `2E f4 = help `,$9b
dc.b `2E f5 = language : English`,$9b,`3E `
dc.b $9b,`4;31;40mSize of numbers :`,$9b,`0;31;40m`
dc.b $a,$a,9,`vst =`,$a,9,`nst = `,$b
et11: dc.b $9b,`1;43H`,$9b,`4;31;40mIterations :`
dc.b $9b,`0;31;40m of `
et12: dc.b $c,$a,$9b,`24C`,$9b,`4;33;40mErrormessage`
dc.b $9b,`0;31;40m`,$a,$a
et13: dc.b $d,` Press any key `,$9b,$4b
et14: dc.b ` In the signword of the array is 0 instead of`
dc.b ` 1,2 or 3`
et15: dc.b ` Squareroot of a negative number`
et16: dc.b $c,` How many iterations ?`,$9b,`4`,$45
dc.b ` The calculation can be interrupted by pressing `
dc.b `the left mousebutton`,$a,` or pressing the right`
dc.b ` shift-key`,$9b,`3F> `
et17: dc.b $9b,`3;1H`
dc.b ` Go on (y/n) oder quiet (q) ? `,$9b,$4b
et18: dc.b $9b,`5;1H pi = `,$a
et19: dc.b $9b,`5`,$45,` one moment please ... `
et20: dc.b ` =`,$9b,$4b,$a
et21: dc.b ` Division by 0`
et22: dc.b $c,` `,$9b,`4;31;40mSize of numbers :`
dc.b $9b,`0;31;40m vst = `
et23: dc.b `, nst = `
et24: dc.b $9b,`3;1H Go on`
dc.b ` (y/n) or print pi (q) ? `,$9b,$4b
et25: dc.b $d,` quiet`,$9b,$4b
et26:
et27: dc.b ` Overflow at addition`
et28: dc.b ` Overflow at division`
et29: dc.b ` Overflow at multiplikation`
et30: dc.b $d,` Write pi to file (y/n) ? `,$9b,$4b
et31: dc.b $d,` Number saved as : `,$9b,$4b
et32: dc.b $d,` File name : `,$9b,$4b
et33: dc.b ` < press any key > `,$9b,$4b
et34: dc.b ` Faculty of a negative and of a not integer number`
dc.b `is not allowed`
et35: dc.b 8,`* -1 =`,$a
et36: dc.b 8,`^ -1 =`,$a
et37: dc.b 8,`integer =`,$a
et38: dc.b $a,` format : not formatted`,$9b,$4b,$9b,`3F`
et39: dc.b $a,` format : formatted`,$9b,$4b,$9b,`3F`
et40: dc.b $a,` File `,34,`pidat`,34,` could not be opened `
dc.b ` < press any key >`,$9b,$4b
et41: dc.b $a,` File `,34,`pidat`,34,` not found`
dc.b ` < press any key >`,$9b,$4b
et42: dc.b 8,`sine =`,$a
et43: dc.b $d,$9b,`K Not done < press any key >`
et44: dc.b $a,9,`ADAM : short of memory !`
et45: dc.b $a,9,`Could not open window !`
et46:
even
conhandle:
text_tab:
dc.l 0; conhandle
dc.l eng_ttab-text_tabanf; distanzwert für sprache
text_tabanf:
dc.l 0,0; text0 gibt es nicht
dc.l dt1,dt2-dt1,dt2,dt3-dt2,dt3,dt4-dt3,dt4,dt5-dt4
dc.l dt5,dt6-dt5,dt6,dt7-dt6,dt7,dt8-dt7,dt8,dt9-dt8
dc.l dt9,dt10-dt9,dt10,dt11-dt10,dt11,dt12-dt11
dc.l dt12,dt13-dt12,dt13,dt14-dt13,dt14,dt15-dt14
dc.l dt15,dt16-dt15,dt16,dt17-dt16,dt17,dt18-dt17
dc.l dt18,dt19-dt18,dt19,dt20-dt19,dt20,dt21-dt20
dc.l dt21,dt22-dt21,dt22,dt23-dt22,dt23,dt24-dt23
dc.l dt24,dt25-dt24,dt25,dt26-dt25,dt26,dt27-dt26
dc.l dt27,dt28-dt27,dt28,dt29-dt28,dt29,dt30-dt29
dc.l dt30,dt31-dt30,dt31,dt32-dt31,dt32,dt33-dt32
dc.l dt33,dt34-dt33,dt34,dt35-dt34,dt35,dt36-dt35
dc.l dt36,dt37-dt36,dt37,dt38-dt37,dt38,dt39-dt38
dc.l dt39,dt40-dt39,dt40,dt41-dt40,dt41,dt42-dt41
dc.l dt42,dt43-dt42,dt43,dt44-dt43,dt44,dt45-dt44
dc.l dt45,dt46-dt45
eng_ttab:
dc.l 0,0,et1,et2-et1,et2,et3-et2,et3,et4-et3,et4,et5-et4
dc.l et5,et6-et5,et6,et7-et6,et7,et8-et7,et8,et9-et8
dc.l et9,et10-et9,et10,et11-et10,et11,et12-et11
dc.l et12,et13-et12,et13,et14-et13,et14,et15-et14
dc.l et15,et16-et15,et16,et17-et16,et17,et18-et17
dc.l et18,et19-et18,et19,et20-et19,et20,et21-et20
dc.l et21,et22-et21,et22,et23-et22,et23,et24-et23
dc.l et24,et25-et24,et25,et26-et25,et26,et27-et26
dc.l et27,et28-et27,et28,et29-et28,et29,et30-et29
dc.l et30,et31-et30,et31,et32-et31,et32,et33-et32
dc.l et33,et34-et33,et34,et35-et34,et35,et36-et35
dc.l et36,et37-et36,et37,et38-et37,et38,et39-et38
dc.l et39,et40-et39,et40,et41-et40,et41,et42-et41
dc.l et42,et43-et42,et43,et44-et43,et44,et45-et44
dc.l et45,et46-et45
; schriftzeichen
pu: dc.b `.`
nu: dc.b `0`
; steuerzeichen
bs1: dc.b 8,$20,8
home: dc.b $9b,$48
str2: dc.b $9b,`1;56H`
str3: dc.b $9b,`3;1H`
plumi: dc.b $d,`> -`
miplu: dc.b $d,`> `
zeiloe: dc.b $9b,$4b
lflf: dc.b $a,$a
ergeb: dc.b `> =`,$9b,$4b,$a
cmp_tab:dc.b `01234`
sicht: dc.b $9b,` p`
r: dc.b 0,0,0,0
; variablenfelder (anzahl auch bei variab_anz ändern !)
even
speicher: dc.l 0; memoryfeld
bcd1: dc.l 0
bcd2: dc.l 0
bcd3: dc.l 0
bcd4: dc.l 0
bcd5: dc.l 0
bcd6: dc.l 0
bcd7: dc.l 0
bcd8: dc.l 0
bcd9: dc.l 0
; rechenfelder (anzahl auch bei rech_anz ändern !)
sqr1: dc.l 0; für sqrroot
sqr2: dc.l 0; für sqrroot
sqr3: dc.l 0; für sqrroot
sqr4: dc.l 0; für sqrroot
sqr5: dc.l 0; für sqrroot
; dezimalkonstanten (anzahl auch bei dez_anz ändern !)
dez1: dc.l 0
dez2: dc.l 0
dez3: dc.l 0
; sonstige felder
r1: dc.l 0; für mals
rt1: dc.l 0; für div und mals und minusu und decrem
tabr: dc.l 0; multiplikationstabelle für div und mals
byte1: dc.l 0; für zahlein und druck
buffer: dc.l 0; eingabe- und ausgabefeld
pi: dc.l 0
; daten fur die zahlenkonstanten. bevor das ausgabefenster geöffnet
; wird, werden die daten in die variablen dez1,dez2... übertragen.
; sie dürfen vom programm nicht verändert werden !!!
dezdat1: dc.w 1,0,2; 1
dc.b 1,0
dc.w 0,1,2; 0.2
dc.b 2,0
dc.w 3,0,2; 1/239
dc.b 2,3,9,0
stackpt: dc.l 0
dosbase: dc.l 0
datname: blk.b 44,0
memlist: blk.l 30,0
fehler: dc.w 0
divzaeh: dc.w 0
; die folgenden variablen nicht umstellen !!!
z1: dc.w 0
z2: dc.w 0
z3: dc.w 0
punknum: dc.w 0
vor: dc.w 0
nach: dc.w 0
vorzei: dc.b 0
plflag: dc.b 0
fdruck: dc.b 0
format: dc.b 0
op: dc.b 0