; hooks to other roms
L1002 EQU $1002
LA002 EQU $A002
LC231 EQU $C231
LC278 EQU $C278
LC279 EQU $C279
LC3CB EQU $C3CB
LC372 EQU $C372
LC3CD EQU $C3CD
LC434 EQU $C434
LC4D9 EQU $C4D9
LC4E1 EQU $C4E1
LC4E4 EQU $C4E4
LC54A EQU $C54A
LC558 EQU $C558
LC55B EQU $C55B
LC569 EQU $C569
LC78B EQU $C78B
LC8BC EQU $C8BC
LC99F EQU $C99F
LCA1B EQU $CA1B
LCA4C EQU $CA4C
LCB29 EQU $CB29
LCCD5 EQU $CCD5
LCD09 EQU $CD09
LCEB1 EQU $CEB1
LCF3E EQU $CF3E
LCF41 EQU $CF41
LEE7C EQU $EE7C
LF802 EQU $F802
LFFD1 EQU $FFD1
LFFC5 EQU $FFC5
LFFC8 EQU $FFC8
LFFD4 EQU $FFD4
;
org $CFF0
DFB 0, 0, 0, 0,0, 0, 0, 0,0, 0, 0, 0,0, 0, 0, 0 ; 16 dummy's
DFB $AA
DFB $55
DFB $0E, $d1
DFB $5e, $d1
XD006:
DFB '('
DFB INIT1/256
DFB INIT1%256
FCS "ACS"
DFB ACS/256
DFB ACS%256
FCS "ASN"
DFB ASN/256
DFB ASN%256
FCS "ATN"
DFB ATN/256
DFB ATN%256
FCS "ABS"
DFB ABS/256
DFB ABS%256
FCS "COS"
DFB COS/256
DFB COS%256
;FCS
"FPINIT"
;DFB
FPINIT/256
;DFB
FPINIT%256
FCS "EXP"
DFB EXP/256
DFB EXP%256
FCS "HTN"
DFB HTN/256
DFB HTN%256
FCS "LOG"
DFB LOG/256
DFB LOG%256
FCS "PI"
DFB PI/256
DFB PI%256
FCS "SIN"
DFB SIN/256
DFB SIN%256
FCS "SQR"
DFB SQR/256
DFB SQR%256
FCS "TAN"
DFB TAN/256
DFB TAN%256
FCS "DEG"
DFB DEG/256
DFB DEG%256
FCS "RAD"
DFB RAD/256
DFB RAD%256
FCS "SGN"
DFB SGN/256
DFB SGN%256
FCS "VAL"
DFB VAL/256
DFB VAL%256
FCS "FLT"
DFB FLT/256
DFB FLT%256
FCS "FGET"
DFB FGET/256
DFB FGET%256
DFB PER1/256
DFB PER1%256
FCS "%"
DFB VAR/256
DFB VAR%256
FCS "FIF"
DFB FIF/256
DFB FIF%256
FCS "FUNTIL"
DFB FUNTIL/256
DFB FUNTIL%256
FCS "COLOUR"
DFB LEE7C/256
DFB LEE7C%256
FCS "FDIM"
DFB FDIM/256
DFB FDIM%256
FCS "STR"
DFB STR/256
DFB STR%256
FCS "FPRINT"
DFB FPRINT/256
DFB FPRINT%256
FCS "FINPUT"
DFB FINPUT/256
DFB FINPUT%256
FCS "FPUT"
DFB FPUT/256
DFB FPUT%256
DFB OTHERROM/256
DFB OTHERROM%256
FCS "+"
DFB FP_PLS/256
DFB FP_PLS%256
FCS "-"
DFB FP_MIN/256
DFB FP_MIN%256
DFB $FE
FCS "*"
DFB FP_MAAL/256
DFB FP_MAAL%256
FCS "/"
DFB FP_DIV/256
DFB FP_DIV%256
DFB $FE
FCS "^"
DFB FP_MACH/256
DFB FP_MACH%256
DFB $FE
FCS "+"
DFB FPL_pl/256
DFB FPL_pl%256
FCS "-"
DFB FPL_min/256
DFB FPL_min%256
DFB FPL_pl/256
DFB FPL_pl%256
FCS ")"
DFB LC278/256
DFB LC278%256
DFB $FF
dfb ';', LC54A/256, LC54A%256
dfb $0d, LC54A/256, LC54A%256
dfb ',', FPRINT/256, FPRINT%256, LD339/256, LD339%256
dfb ',', FINPUT/256, FINPUT%256, LC558/256, LC558%256
dfb
'=', EQUAL/256, EQUAL%256 ; nog te
testen ; DONE
dfb
'<>', NEQUAL/256, NEQUAL%256 ; nog te testen ; DONE
dfb
'<=', LEQUAL/256, LEQUAL%256 ; nog te testen ; DONE
dfb
'<', LT/256, LT%256
; nog te testen ; DONE
dfb
'>=', GEQUAL/256, GEQUAL%256 ; nog te testen ; DONE
DFB
'>', GT/256, GT%256, $FF ; nog
te testen ; DONE
;
INIT1: JSR LD0FC
LDX #$B4
BNE LD10B
BEP_ARG:
clc
LD0EC:
ror $73
ldx #$AC
bne LD10B
LD0F2: jsr LD85D
LD0F5: jsr LD106 ; we doen wat recursie
LD0F8: ldx #$A1
bne LD10B
LD0FC: jsr LD0F5 ; nog meer recursie
LD0FF: ldx #$9A
bne LD10B
LD103: jsr LD85D ; copier waarde
LD106: jsr BEP_ARG
LD109: ldx #$A8
LD10B: clc
bcc LD113 ; geforceerde sprong in het duister
ldx #$5F
sty $03
LD112: sec
LD113: ror $53
ldy $03
dey
LD118: iny
lda ($05),y
cmp #$20
beq LD118
dey
sty $52
dex
LD123: ldy $52
LD125: inx
iny
LD127: lda XD006,x
bmi LD146
cmp ($05),y
beq LD125
dex
LD131: inx
lda XD006,x
bpl LD131
inx
bit $53
bpl LD123
lda ($05),y
cmp #'.' ; afgekort?
bne LD123
iny
dex
bcs LD127
LD146: cmp #$FE ; einde tabel?
bcs LD15B
sta $53
lda $D007,x
sta $52
sty $03
ldx $04
jmp ($0052) ; jump naar de
kanibalen.
LD158: ldx $04
rts
;
LD15B: beq LD158
brk ; valt geen chocola van
te maken: fp fout.
INIT: sty $03
jsr LD0EC
jsr LD89A
lda $5A
sta $60
lda $5B
sta $5F
lda $5C
sta $5E
ldy #$5D
jmp LC99F
;
FP_PLS: ; eerste argument is beschikbaar als
we hier zijn
jsr LD0F2 ; haal eerste en tweede argument op
jsr
LD870
jsr
LD804
lda #FPADD ; afdeling optelle
jsr
pc_opdracht2 ; eerste argument overpompen
jsr
naar_pc1 ; HIER TWEEDE argument
jsr van_pc
jmp LD0FF ; staat nu op 0x59 en verder
;
FP_MIN:
jsr
LD0F2 ; FP
MIN
jsr
LD870
jsr
LD804
lda
#FPSUB
jsr
pc_opdracht2
jsr
naar_pc1 ; plaats van stack naar
werkruimte
jsr van_pc
jmp LD0FF
;
FP_MAAL:
jsr
LD103 ; FP
MAAL
jsr
LD870
jsr
LD804
lda #FPMUL
jsr
pc_opdracht2
jsr
naar_pc1
jsr van_pc
jmp LD0F8
;
FP_DIV:
jsr
LD103 ; FP
GEDEELD
jsr
LD870
jsr
LD804
lda
#FPDIV
jsr
pc_opdracht2
jsr
naar_pc1
jsr van_pc
jmp LD0F8
;
FP_MACH:
jsr
LD103 ; FP
GEDEELD
jsr BEP_NUL ; bepaal waarde argument
beq END_MC ; bij 0 doen we nix
bpl mch_verder ; boven 0 kan wortel bepaald worden
brk ; daaronder gaan we gillend
op ons bek
mch_verder:
jsr
LD870
jsr
LD804
lda #FPYTOX
jsr
pc_opdracht2
jsr
naar_pc1
jsr van_pc
END_MC: jmp LD109
;
FPL_min: jsr FPL_pl
LD1BF: jsr BEP_NUL
beq FPL_end
chng_sg: lda $57
eor #$80 ; verander
teken
sta $57
FPL_end: rts
;
FPL_pl: ldy $03 FP plus?
dey
skp_spc: iny
lda ($05),y
cmp #' ' ; spatie
?
beq skp_spc ; ja, dan
skip
cmp #'%' ; fp.
variabele?
bne LD20B ; nee,
door naar ..
inc $03 ; verhoog adres
jsr waarde_uit_var ;
haal waarde uit var
bcc LD20B
ldy #$6F
jsr LC3CD
copy_waarde:
ldy #$04 clear waarde
lda #$0
sta $5E
sta $58
sta $57
copy_lus:
lda ($6F),y
sta $59,y
ora $57
sta $57
dey
bpl copy_lus
tax
beq LD207 ; hij, de laagste waarde 59 is 0
lda $5A
sta $57 ; zet
koud in 57
ora
#$80 ; forceer
bit
sta $5A ; en terug
in zijn hok (maar waarom???
txa ; een return waarde 59 in a
LD207: rts
;
LD208:
sty $03
rts
;
LD20B:
jsr LD5A5
bcs LD208
ldx #$0
jmp LD112
;
ABS: jsr BEP_ARG
jsr BEP_NUL
bmi chng_sg ; voor <1 naar
de 0 anders klaar
rts
;
ACS: jsr BEP_ARG ; buurten bij argument
routine
lda #FPACS ; afdeling arc cosinus
jsr pc_opdracht
rts
;
ASN: jsr BEP_ARG
lda #FPASN ; afdeling arc sinus
jsr pc_opdracht
rts
;
RAD: jsr BEP_ARG
lda #FPRAD ; afdeling radiatoren
jsr pc_opdracht
rts
;
DEG: jsr BEP_ARG
lda #FPDEG ; afdeling GRADEN
jsr pc_opdracht
rts
SGN: jsr BEP_ARG
jsr BEP_NUL
beq isalnul
pha
jsr LDE8D ; een -1 een 0 of een 1
pla
sta $57
isalnul:
rts
;
PER1: bit $73
bmi LD2C0
FLT: jsr LC8BC
ldy #$5D
jsr LC3CD
sta $5A
lda $5F
sta $5B
lda $5E
sta $5C
lda #$A0
sta $59
ldy #$0
sty $5E
lda $5A
sta $57
bpl LD2BD
jsr LD8D5
LD2BD:
jmp LD7C8
LD2C0:
jmp LCA1B
;
PI: lda #$82
sta $59
lda
#$C9
sta $5a
lda
#$0f
sta $5b
lda
#$da
sta $5c
lda
#$a2
sta $5d
rts
;
FGET:
jsr LCF3E
ldx #$04 ; haal 5 bytes uit geopende file
LD2D1:
jsr LFFD4 ; get byte uit handle
sta $03C5,x ; zet hem weg
dex
bpl LD2D1 ; totdat we er 5 hebben
jsr LDBAA ; ?
jmp copy_waarde ; zet hem op de gewenst plek
LDbrk: BRK ; inserted om ass. error te voorkomen
;
VAL: jsr LCEB1 ; neem het fatsoenlijk numeriek deel
ldy #$0
LD2E4:
jsr LD304
cmp #'+'
beq LD2FB
cmp #'-'
bne LD2FE
jsr LD303
sty $54
jsr LD5B1
jmp LD1BF
;
LD2FB:
jsr LD303
LD2FE:
sty $54
jmp LD5B1 ; hier zijn we klaar
;
LD303: ; skip space
iny
LD304:
lda ($52),y
cmp #' ' ; is het een spatie
beq LD303
rts
;
VAR: jsr waarde_uit_var
bcc LDbrk
jsr LC279
jsr LD0FC
jsr LC4E4
jsr
Sla_op
jmp LC55B ; volgende statement
;
STR: jsr LD0FC
jsr LC231
jsr LC4E1
jsr LC3CB
jsr LD4D0
jmp LC55B ; volgende statement
;
FPRINT: jsr LC372
ldx #$B8
jmp LD10B ; bepaal deel van argument
;
LD339: jsr LD0FC
lda #$C5
sta $52
lda #$03
sta $53
jsr LD4D0
dec $6F
lda $0321 ; neemde waarde in @
sec
sbc $6F
bcc LD35C
beq LD35C
tay
lda #$20
pr_sp:
jsr LCA4C ; print 'Y' spaties
dey
bne pr_sp
LD35C:
ldy #$0
LD35E:
lda ($52),y
cmp #$0D ; einde van de opdracht
beq FPRINT
jsr LCA4C
iny
bne LD35E
FINPUT: jsr LC372
lda ($05),y
cmp #'%' ; fp. variabele in aantocht?
bne LD37B ; nee,
iny
sty $03
jsr waarde_uit_var
bcs LD380
LD37B:
ldx #$C3
jmp LD10B ; bepaal deel van argument
;
LD380:
jsr LCD09
tay
lda $05
pha
lda $06
pha
lda $03
pha
sty $03
iny
sty $06
lda #$40
sta $05
jsr LD0FC
pla
sta $03
pla
sta $06
pla
sta $05
jsr Sla_op
jmp LD37B
;
FIF: jsr LD9EB ; vergelijken; Zet Cxxx
adres op stack
jmp LC569
;
FUNTIL: jsr LD9EB ; zet het return adres
HIGH van Cxxx op stack
jmp LCCD5 ; ook vergelijken
;
FPUT: jsr LD494 ; plaats 5 bytes naar output
jsr LD0FC
jsr LC4E4
jsr LD831
ldx $04 ; 5 bytes
jsr LCF41
ldx #$04 ; 5 bytes
LD3C7:
lda $03C5,x ; haal hem op
jsr LFFD1 ; stuur hem weg
dex
bpl LD3C7 ; en dat 5 keer
jmp LC55B ; klaar zijn we
;
FDIM: lda $01
ora $02
beq LD443
jsr LC434
bcs LD443
ldy $03
lda ($05),y
cmp #'%' ; praten we over fp. getallen
bne LD443 ; nee.
iny
lda ($05),y ; haal
waarde op
iny
cmp ($05),y ; vergelijk
met bovenbuurvrouw (AA-ZZ)
bne LD443 ; nee, niet gelijk. Helemaal fout dus.
cmp #'[' ; groter dan Z
bcs LD443 ; Ja, helemaal fout dus.
sbc #$3F ; maak van ascii absolute waarde
bcc LD443 ; <0? (A), foute boel dus. Wegwezen.
iny
sty $03
pha
jsr LC78B ; argument ophalen.
inc $15,x
bne LD403
inc $24,x
LD403:
jsr LD49A
pla
tay
clc
lda $23 ; top
sta $0687,y ; basisopstelling
adc $16
sta $23
lda $24
sta $06A2,y ; basisopstelling high
adc $25
sta $24
ldy #$0
sty $04
lda #$AA
sta ($23),y ; kijk
of hier ook ram zit
cmp ($23),y
bne LD443 ; helaas. Past dus niet meer. Fout.
lsr a ; extra testje, ivm spiegels
sta ($23),y
cmp ($23),y
bne LD443 ; alsnog fout. Zonde, he?
jsr LC434 ; alles fris.
bcs LD443
ldy $03
lda ($05),y
cmp #',' ; wordt er soms nog meer gedimmed?
bne LD440 ; nee, het volgende statement aande
beurt
inc $03
jmp FDIM ; ja, dan doen we het nog eens.
LD440:
jmp LC558
;
LD443: brk
;
waarde_uit_var:
jsr LC434 ; geldige variabele naam?
bcc LD457 ; neen. Dikke mik dus. Misschien direct?
lda $15,x
asl a
asl a
adc $15,x
sta $15,x
lda #$06
sta $24,x
sec
rts
;
LD457:
ldy $03
lda ($05),y ; byte from commandline
cmp #'!' ; is het de
pling?
bne no_pling ; nee.
inc $03
jsr LC8BC
LD464:
sec
rts
;
no_pling:
iny
cmp ($05),y
bne LD473
cmp #'[' ; zitten we in de reeks van A-Z
bcs LD473
sbc #$3F ; maak absolute waarde van
bcs LD475 ; als geldig (>0) gaan we door
LD473: clc ; ziet er niet fris uit.
rts
;
LD475: iny
sty $03
pha
jsr LC8BC
jsr LD49A ; bepaal y-> als variabele
pla
tay
bcs LD493
lda $0687,y ; haal onze vrienden op uit page
6
adc $15,x
sta $15,x
lda $06A2,y
adc $24,x
sta $24,x ; en
sla ze op
bcc LD464
LD493:
brk
LD494:
jsr LC8BC
jmp LC231
;
LD49A:
ldy $24,x
lda $15,x
asl a
rol $24,x
asl a
rol $24,x
clc
adc $15,x
sta $15,x
tya
adc $24,x
sta $24,x
rts
;
OTHERROM: lda $1000
cmp #$40
beq LD4C0
lda $A001
cmp #$BF
bne LD440
jmp LA002
LD4C0:
jmp L1002 ; naar onze rom manager.
;
ASC2DEC:
cmp #$3A HEX A-F
bcs A_error
cmp #$30 LAGER DAN 0
bcc A_ok
sbc #$30
A_ok: rts
;
A_error:
clc
rts
;
LD4D0:
lda #$0
sta $6F
jsr BEP_NUL
bne LD4EB ; geen null, dus geen default print 0.0
lda #'0' ; een null
jsr In_Buf ; store waarde in buffer en verhoog
adres
lda #'.' ; een punt
jsr In_Buf ; store waarde in buffer en verhoog
adres
lda #'0' ; een null
jsr In_Buf ; store waarde in buffer en verhoog
adres
jmp LD571
;
LD4EB:
bpl LD4F2 ; groter dan 0? ja,
lda #'-' ; een minnetje
jsr In_Buf ; store waarde in buffer en verhoog
adres
LD4F2:
lda #$0
sta $6D
LD4F6:
lda $59
cmp #$81
bcs LD504
jsr LD6A0
dec $6D
jmp LD4F6
;
LD504:
cmp #$84
bcc LD518
bne LD510
lda $5A
cmp #$A0 ; groter dan ?
bcc LD518 ; nee
LD510:
jsr LD71B
inc $6D
jmp LD4F6
;
LD518:
lda $59
cmp #$84
bcs LD525
jsr LD6D8
inc $59
bne LD518
LD525:
sec
lda #$FF
jsr LD636
lda $5A
cmp #$A0
bcs LD510
lda #$01
ldy $6D
bmi LD541
cpy #$08
bcs LD541
iny
lda #$0
sta $6D
tya
LD541:
sta $70
ldx #$09
stx $54
LD547:
jsr LD575
dec $70
bne LD553
lda #'.'
jsr In_Buf ; store waarde in buffer en verhoog adres
LD553:
dec $54
bne LD547
lda $6D
beq LD571
lda #'E' ; pratend over e macht notatie
jsr In_Buf ; store waarde in buffer en verhoog adres
lda $6D
bpl LD56E ; niet te klein?
lda #'-'
jsr In_Buf
sec
lda #$0
sbc $6D
LD56E:
jsr LD587
LD571:
lda #$0D ; een CR als einde buffer
bne In_Buf ; store waarde in buffer en verhoog adres
LD575:
lda $5A
lsr a
lsr a
lsr a
lsr a
jsr LD58B
lda $5A
and #$0F
sta $5A
jmp LD64E
;
LD587:
cmp #$0A
bcs LD594
LD58B:
ora #$30
In_Buf:
ldy $6F ; plaats
de ASCII in buffer
sta ($52),y
inc $6F
rts
;
LD594:
ldx #$FF
LD596:
inx
sbc #$0A
bcs LD596
adc #$0A
pha
txa
jsr LD587
pla
bpl LD58B
LD5A5:
lda $03
sta $54
lda $05
sta $52
lda $06
sta $53
LD5B1:
jsr CLR_WRK
sta $6C
sta $6D
jsr LD67B
cmp #'.'
beq LD5CD
jsr ASC2DEC
bcc LD635
sta $5E
LD5C6:
jsr LD67B
cmp #'.'
bne LD5D6
LD5CD:
lda $6C
clc
bne LD60C
inc $6C
bne LD5C6
LD5D6:
cmp #'E'
beq LD601
jsr ASC2DEC
bcc LD60C
sta $6E
lda $5A
cmp #$18
bcc LD5EF
lda $6C
bne LD5C6
inc $6D
bcs LD5C6
LD5EF:
lda $6C
beq LD5F5
dec $6D
LD5F5:
jsr LD64E
clc
lda $6E
jsr LD636
jmp LD5C6
;
LD601:
jsr LD67B
jsr LD778
clc
adc $6D
sta $6D
LD60C:
lda #$A8
sta $59
jsr BEP_NUL
beq LD631
jsr LD7C8
lda $6D
bmi LD627
beq LD62E
LD61E:
jsr LD6A0
dec $6D
bne LD61E
beq LD62E
LD627:
jsr LD71B
inc $6D
bne LD627
LD62E:
jsr LDA9B
LD631:
sec
ldy $54
dey
LD635:
rts
;
LD636:
ldx #$05
LD638:
adc $59,x
sta $59,x
lda #$0
dex
bne LD638
rts
;
LD642:
ldx #$05
LD644:
lda $59,x
adc $61,x
sta $59,x
dex
bne LD644
rts
;
LD64E:
ldx #$05
lda #$0
sta $67
LD654:
lda #$0
sta $68
lda $59,x
asl a
rol $68
asl a
rol $68
clc
adc $59,x
bcc LD667
inc $68
LD667:
asl a
rol $68
clc
adc $67
bcc LD671
inc $68
LD671:
sta $59,x
lda $68
sta $67
dex
bne LD654
rts
;
LD67B:
sty $55
ldy $54
lda ($52),y
ldy $55
inc $54
rts
;
BEP_NUL: ; test op nullen
lda $5A
ora $5B
ora $5C
ora $5D
ora $5E
beq LD699
lda $57
bne LD69F
lda #$01
rts
;
LD699: ; store waarde in fp.
werkruimte
sta $57
sta $59
sta $58
LD69F:
rts
;
LD6A0:
clc
lda $59
adc #$03
sta $59
bcc LD6AB
inc $58
LD6AB:
jsr LD6C3
jsr LD6FB
jsr LD6FB
LD6B4:
jsr LD642
LD6B7:
bcc LD6C2
jsr LD6D8
inc $59
bne LD6C2
inc $58
LD6C2:
rts
;
LD6C3: ; copy waarde in werkruimte
ldx #$08
LD6C5:
lda $56,x
sta $5E,x
dex
bne LD6C5
rts
;
LD6CD: ; * 2 routine
asl $5E
rol $5D
rol $5C
rol $5B
rol $5A
rts
;
LD6D8: ; / 2 routine
ror $5A
ror $5B
ror $5C
ror $5D
ror $5E
rts
;
lda $5D ; schuif de zaak
1 byte op
sta $5E
lda $5C
sta $5D
lda $5B
sta $5C
lda $5A
sta $5B
lda
#$0 ; en schoon het hoogste
byte
sta $5A
rts
;
LD6F8:
jsr LD6C3
LD6FB:
lsr $62 ; /2 routine
ror $63
ror $64
ror $65
ror $66
rts
;
lda $65 ; copieer wat
bytes
sta $66
lda $64
sta $65
lda $63
sta $64
lda $62
sta $63
lda
#$0 ; en schoon
de hoogste vriend
sta $62
rts
;
LD71B:
sec
lda $59
sbc #$04
sta $59
bcs LD726
dec $58
LD726:
jsr LD6F8
jsr LD6B4
jsr LD6F8
jsr LD6FB
jsr LD6FB
jsr LD6FB
jsr LD6B4
lda #$0
sta $62
lda $5A
sta $63
lda $5B
sta $64
lda $5C
sta $65
lda $5D
sta $66
lda $5E
rol a
jsr LD6B4
lda #$
sta $62
sta $63
lda $5A
sta $64
lda $5B
sta $65
lda $5C
sta $66
lda $5D
rol a
jsr LD6B4
lda $5B
rol a
lda $5A
LD772:
jsr LD636
jmp LD6B7
;
LD778:
ldy #$FF
cmp #$2B
beq LD783
cmp #$2D
bne LD786
iny
LD783:
jsr LD67B
LD786:
jsr ASC2DEC
bcc LD7AF
tax
jsr LD67B
jsr ASC2DEC
bcc LD7A4
sta $6E
jsr LD67B
txa
sta $67
asl a
asl a
adc $67
asl a
adc $6E
tax
LD7A4:
tya
bne LD7AD
stx $6E
sec
sbc $6E
rts
;
LD7AD:
txa
rts
;
LD7AF:
lda #$0
LD7B1:
rts
LD7C8:
jsr BEP_NUL
beq LD7B1
LD7CD:
lda $5A
bne LD7F2
lda $5B
sta $5A
lda $5C
sta $5B
lda $5D
sta $5C
lda $5E
sta $5D
lda #$0
sta $5E
sec
lda $59
sbc #$08
sta $59
bcs LD7CD
dec $58
bcc LD7CD
LD7F2:
lda $5A
bmi LD7B1
jsr LD6CD
lda $59
bne LD7FF
dec $58
LD7FF:
dec $59
jmp LD7F2
LD804:
ldy #$04
lda #$0
sta $66
sta $60
sta $5F
LD80E:
lda ($6F),y
sta $61,y
ora $5F
sta $5F
dey
bpl LD80E
tax
beq LD826
lda $62
sta $5F
ora
#$80
sta $62
txa
LD826:
rts
;
LD831:
jsr LDBAA
bne LD83D
Sla_op:
ldx $04
ldy #$6F
jsr LC3CD zet in basic stack
LD83D:
ldy #$0
lda $59
sta ($6F),y
iny
lda $57
and #$80
sta $57
lda $5A
and #$7F
ora $57
sta ($6F),y
LD852:
iny
lda $59,y
sta ($6F),y
cpy
#$04
bne LD852
rts
;
LD85D: ; kopier stack
naar werkruimte
ldy #$52
sty $6F
lda #$0
sta $70
jsr LD83D ; kopier een deel
jsr LC4D9 ; basis rom doet
de rest
lda $56
sta $73,x
rts
;
LD870: ; plaats van stack
naar werkruimte
ldx $04
jsr LC3CB
lda $74,x
sta $56
sty $6F
lda #$0
sta $70
rts
;
LD880:
lda $5E
cmp #$80
bcc LD88D
beq LD892
lda #$FF
jsr LD772
LD88D:
lda #$0
sta $5E
rts
;
LD892:
lda $5D
ora #$01
sta $5D
bne LD88D
LD89A:
jsr LD8C7
beq LD8A5
LD89F:
lda $59
cmp #$A0
bcs LD8B9
LD8A5:
lsr $5A
ror $5B
ror $5C
ror $5D
ror $62
ror $63
ror $64
ror $65
inc $59
bne LD89F
LD8B9:
beq LD8D1
LD8BB:
lda #$7F
sta $5A
lda #$FF
sta $5B
sta $5C
sta $5D
LD8C7:
ldx #$08
lda #$0
LD8CB:
sta $5F,x
dex
bne LD8CB
rts
;
LD8D1:
lda $57
bpl LD8E1
LD8D5:
sec
ldx #$04
LD8D8:
lda #$0
sbc $59,x
sta $59,x
dex
bne LD8D8
LD8E1:
rts
;
LD8E8:
lda #$0
sbc $61,x
sta $61,x
dex
bne LD8E8
lda $57
eor #$80
sta $57
bpl LD90A
LD8F9:
inc $5D
bne LD909
inc $5C
bne LD909
inc $5B
bne LD909
inc $5A
beq LD8BB
LD909:
rts
;
LD90A:
jsr LD8D5
jsr LD8F9
jmp LD8D5
;
LD913:
ldx #$05
LD915:
lda $61,x
sta $59,x
dex
bne LD915
lda #$80
sta $59
jmp LD7C8
;
LD929:
ldx #$08
LD92B:
lda $5E,x
sta $56,x
dex
bne LD92B
LD932:
rts
;
LD939:
jsr LD1BF
jsr LD804
beq LD932
LD941:
jsr BEP_NUL
beq LD929
lda $59
cmp $61
beq LD972
bcc LD95D
sbc $61
cmp #$21
bcs LD932
tax
LD955:
jsr LD6FB
dex
bne LD955
beq LD972
LD95D:
sec
lda $61
sbc $59
cmp #$21
bcs LD929
tax
LD967:
clc
jsr LD6D8
dex
bne LD967
lda $61
sta $59
LD972:
lda $57
eor $5F
bpl LD9C1
lda $5A
cmp $62
bne LD999
lda $5B
cmp $63
bne LD999
lda $5C
cmp $64
bne LD999
lda $5D
cmp $65
bne LD999
lda $5E
cmp $66
bne LD999
jmp CLR_WRK
;
LD999:
bcs LD9C8
sec
lda $66
sbc $5E
sta $5E
lda $65
sbc $5D
sta $5D
lda $64
sbc $5C
sta $5C
lda $63
sbc $5B
sta $5B
lda $62
sbc $5A
sta $5A
lda $5F
sta $57
jmp LDA98
;
LD9C1:
clc
jsr LD6B4
jmp LDA9B
;
LD9C8:
sec
lda $5E
sbc $66
sta $5E
lda $5D
sbc $65
sta $5D
lda $5C
sbc $64
sta $5C
lda $5B
sbc $63
sta $5B
lda $5A
sbc $62
sta $5A
jmp LDA98
;
brk
LD9EB:
jsr LD0FC
lda #$C7 ; het high adres op de stack voor de
latere return
pha
ldx #$C8
jmp LD10B ; bepaal het argument
;
EQUAL:
jsr jsrcomp
lda
#$5D ; Hier worden bijdehande geintjes uitgehaald
bne LDA0C ; het basic adres voor vergelijkingen uit
de C000
LEQUAL:
jsr jsrcomp
lda
#$66 ; rom wordt van stal gehaald en het low adres wordt
bne
LDA0C ; op de stack gezet
NEQUAL:
jsr jsrcomp
lda
#$6F
bne
LDA0C
LT:
jsr jsrcomp
lda
#$76
bne
LDA0C
GEQUAL:
jsr jsrcomp
lda
#$7D
bne
LDA0C
GT:
jsr jsrcomp
lda
#$84
LDA0C:
pha
; zet returadres low op de stack
jsr
LD0FC
; als alles gelijk is. anders NE
jsr
naar_pc1 ;
tweede argument naar de PC
jsr
LFFC5
; haal byte op. Hierin het resultaat.
and #$03 ; hoogste
6 bits resetten
sta $59 ; tijdelijk
opslaan
php ; status op stack
pla ; status in accu
and #$fc ; bovenste
6 bits bewaren
ora #59 ; zero en carry
erbij schrijven
pha ; en accu via stack
plp ; naar status register
LDA3C:
rts ; en jump naar de
basic rom
;
jsrcomp: lda #FPCOMP ; om de zaak
iets in te korten
jmp pc_opdracht1 ; via externe RTS
terug naar caller
LDA45:
jsr BEP_NUL
beq LDA3C
jsr LD804
bne LDA52
jmp CLR_WRK
;
LDA52:
clc
lda $59
adc $61
sta $59
bcc LDA5D
inc $58
LDA5D:
sec
lda $59
sbc #$80
sta $59
bcs LDA68
dec $58
LDA68:
ldx #$05
ldy #$0
LDA6C:
lda $59,x
sta $66,x
sty $59,x
dex
bne LDA6C
lda $57
eor $5F
sta $57
ldy #$20
jsr LD6FB
LDA80:
lda $67
bpl LDA88
clc
jsr LD642
LDA88:
jsr LD6FB
asl $6B
rol $6A
rol $69
rol $68
rol $67
dey
bne LDA80
LDA98:
jsr LD7C8
LDA9B:
jsr LD880
lda $58
beq LDAAD
bpl LDAA7
CLR_WRK:
ldx #$08
;
lda #$0
;
LDAA8:
sta $56,x
dex
bne LDAA8
LDAAD:
rts
LDAA7:
brk
;
LDAAE:
jsr LD831
jsr LDE8D
LDAB6:
jsr BEP_NUL
beq LDAA7
jsr LD6C3
jsr copy_waarde
rts
;
TAN: jsr BEP_ARG
jsr BEP_NUL ; als ie nul is
houdt alles op
beq tan_exit
lda #FPTAN ; afdeling tangers
jsr pc_opdracht
tan_exit:
rts
;
SQR: jsr BEP_ARG ; bepaal waarde argument
LDB72: jsr BEP_NUL ; bepaal waarde argument
beq ENDSQR ; bij 0 doen we nix
bpl sqr_verder ; boven 0 kan wortel bepaald worden
brk ; daaronder gaan we gillend
op ons bek
sqr_verder:
lda #FPSQRT ; afdeling wortels
jsr pc_opdracht
ENDSQR: rts
;
LDB9E:
lda
#$D4 ; hier weer een bijdehante
waarde
bne LDBAC
LDBA2:
lda #$CA
bne LDBAC
LDBA6:
lda #$CF
bne LDBAC
LDBAA:
lda #$C5
LDBAC:
sta $6F
lda #$03
sta $70
rts
;
LOG: jsr BEP_ARG
LDBB6:
jsr BEP_NUL
beq te_klein
bpl log_verder
te_klein:
brk
log_verder:
lda #FPLOG ; afdeling logge rakkers
jsr pc_opdracht
rts
;
ATN: jsr BEP_ARG
LDC67: jsr BEP_NUL
beq atn_exit ; bij 0 houdt alles op
lda #FPATN ; afdeling wortels
jsr pc_opdracht
atn_exit:
rts
;
COS: JSR BEP_ARG
lda #FPCOS ; afdeling ko en sinas
jsr pc_opdracht
rts
;
SIN: jsr BEP_ARG
lda #FPSIN ; afdeling ko en sinas
jsr pc_opdracht
rts
EXP: jsr BEP_ARG
LDDD7: lda $59
cmp #$87
bcc LDDED
bne LDDE5
lda $5A
cmp #$B3
bcc LDDED
LDDE5:
lda $57
bpl L_tegroot
bmi LDDED
jmp CLR_WRK
;
L_tegroot:
brk
LDDED:
lda #FPEXP ; afdeling exponentiele
gevallen
jsr pc_opdracht
rts
;
HTN: jsr BEP_ARG ; bepaal hyperbolische
tangens
lda #FPHTN ; afdeling exponentiele
gevallen
jsr pc_opdracht
rts
;
naar_pc2:
ldx #$0 ; op 0
lda $62 ; met 62 is
iets geks. Daar staat: -
;or
#$80 ; masker bit 7
sta $62
LD02: txa
pha
; x als index koud stellen
lda $61,x
jsr
LFFC8 ; stuur een 5 bytes argument
op
pla
tax
; x weer terug van stack
inx
cpx
#$05 ; alles gehad
bne
LD02
rts
naar_pc1:
ldx #$0 ; op 0
lda
$5a ; met 5a is iets geks.
Daar staat: -
;or
#$80 ; masker bit 7
sta
$5a
LD01: txa
pha
; x als index koud stellen
lda
$59,x
jsr
LFFC8 ; stuur een 5 bytes argument
op
pla
tax
; x weer terug van stack
inx
cpx
#$05 ; alles gehad
bne
LD01
rts
van_pc:
lda
#$0 clear waarde
sta $5E
sta $58
sta $57
LL01: pha ; a wordt koud gezet
jsr LFFC5 ; haal byte op
tax ; berg tijdelijk in x
pla ; wat was de index waarde
tay ; die doen we in y
txa ; x copieren we
sta $59,y ; sla waarde op
ora $57 ; test op 0
sta $57
iny ; index verhogen we
tya ; copie
cmp #$05 ; alles gehad
bne LL01
ldx $57
beq LLexit
lda $5a
sta $57
ORA
#$80
sta $5a
txa
LLexit: rts
pc_opdracht2:
sta $70
lda #$0 ; attentie terminal: er komt
iets!!!
jsr
LFFC8
lda #$62 ; floating point routines
jsr
LFFC8
lda $70 ; tijdelijke jongen
jsr
LFFC8
jsr
naar_pc2
rts
pc_opdracht1:
sta $70
lda #$0 ; attentie terminal: er komt
iets!!!
jsr
LFFC8
lda #$62 ; floating point routines
jsr
LFFC8
lda $70 ; tijdelijke jongen
jsr
LFFC8
jsr
naar_pc1
rts
pc_opdracht:
sta $70
lda #$0 ; attentie terminal: er komt
iets!!!
jsr
LFFC8
lda #$62 ; floating point routines
jsr
LFFC8
lda $70 ; tijdelijke jongen
jsr
LFFC8
jsr
naar_pc1
jsr van_pc ; deze copieert de waarde
van stack
rts
LDE8D:
jsr CLR_WRK
ldy #$80
sty $5A
iny
sty $59
rts
FPINIT: lda #$00
jsr
LFFC8
lda #$62 ; floating point routines
jsr
LFFC8
lda $0 ; tijdelijke jongen
jsr LFFC8
lda $0 ; tijdelijke jongen
jsr LFFC8
jsr LFFC5 ; hier het resultaat
pha
jsr LF802
pla
rts
JMP
LC55B ; einde init
fill $ea,255
fill $ea,255
fill $ea,255
fill $ea,51
nop
; vanaf hier colour routines
lda $52
and #$03
tay
lda XDF4E,y
sta $03FD
lda $03DA
and #$F0
cmp #$70
bne LDF25
lda #$0
tay
LDF1C:
sta $8600,y
sta $8700,y
dey
bne LDF1C
LDF25:
lda $03DA
and #$DF
sta $03DA
rol a
rol a
rol a
and #$03
tay
lda XDF42,y
sta $03FE
lda XDF46,y
sta $03FF
jmp LC558
XDF42: DFB colo1%256, colo2%256, colo3%256, colo4%256
XDF46: DFB colo1/256, colo2/256, colo3/256, colo4/256
XDF4A: DFB $3F, $cf, $f3, $FC
XDF4E: DFB $0, $55, $aa, $ff
colo1: lda $5B
ora $5D
bne TE_GROOT
lda $5A
cmp #$40
bcs TE_GROOT
lsr a
lsr a
sta $5F
ldy #$0
sty $60
lda #$3F
sec
sbc $5C
cmp #$40
bcc LDFBE
rts
;
colo2: lda $5B
ora $5D
bne TE_GROOT
lda $5A
bmi TE_GROOT
lsr a
lsr a
sta $5F
lda #$3F
sec
sbc $5C
cmp #$40
bcc LDFB7
rts
;
colo3: lda $5B
ora $5D
bne TE_GROOT
lda $5A
bmi TE_GROOT
lsr a
lsr a
sta $5F
lda #$5F
sec
sbc $5C
cmp #$60
bcc LDFB7
TE_GROOT:
rts
;
colo4: lda $5B
ora $5D
bne TE_GROOT
lda $5A
bmi TE_GROOT
lsr a
lsr a
sta $5F
lda #$BF
sec
sbc $5C
cmp #$C0
bcs TE_GROOT
LDFB7:
ldy #$0
sty $60
asl a
rol $60
LDFBE:
asl a
rol $60
asl a
rol $60
asl a
rol $60
asl a
rol $60
adc $5F
sta $5F
lda $60
adc #$80
sta $60
lda $5A
and #$03
tax
lda XDF4A,x
ldx $5E
dex
beq LDFF0
dex
beq LDFE9
and ($5F),y
sta ($5F),y
rts
;
LDFE9:
eor #$FF
eor ($5F),y
sta ($5F),y
rts
;
LDFF0:
tax
and ($5F),y
sta ($5F),y
txa
eor #$FF
and $03FD
ora ($5F),y
sta ($5F),y
rts
;
end