;
;		(c) Copyright 1998, 1998   BinGate Automation
;		Version 0.01 (Apr 13 1998)
;
;	File:	fp100.asm
;       Date:   Mon Jan 26 15:59:04 1998
;       CPU:    MOS Technology 6502
;
FPROC	     EQU      0
FPADD	     EQU      1
FPSUB	     EQU      2
FPMUL	     EQU      3
FPDIV	     EQU      4
FPABS	     EQU      5
FPRNDINT     EQU      6
FPSQRT	     EQU      7
FPTAN	     EQU      8
FPSIN	     EQU      9
FPCOS	     EQU      10
FPDEG	     EQU      11
FPRAD	     EQU      12
FPOWER	     EQU      13
FPHTN	     EQU      14
FPLN	     EQU      15
FPLOG	     EQU      16
FPYTOX	     EQU      17
FPEXP	     EQU      18
FPTENTOX     EQU      19
FPACOT	     EQU      20
FPACS	     EQU      21
FPASN	     EQU      22
FPSEC	     EQU      23
FPCSC	     EQU      24
FPATN	     EQU      25
FPTWOTOX     EQU      26
FPATHH       EQU      27
FPCOMP	     EQU      28

; 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"		; deze moet nog
	DFB	SGN/256
	DFB	SGN%256
	FCS     "VAL"
	DFB	VAL/256
	DFB	VAL%256
	FCS	"FLT"		;; deze moet nog
	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"		; lijkt te werken
	DFB	FIF/256
	DFB	FIF%256 	; lijkt te werken
	FCS     "FUNTIL"
	DFB	FUNTIL/256
	DFB	FUNTIL%256
	FCS	"COLOUR"	; later weer opnemen
	DFB	LEE7C/256
	DFB	LEE7C%256
	FCS	"FDIM"		; werkt
	DFB	FDIM/256
	DFB	FDIM%256
	FCS	"STR"		; puntje van aandacht
	DFB	STR/256
	DFB	STR%256
	FCS	"FPRINT"	; werkt
	DFB	FPRINT/256
	DFB	FPRINT%256
	FCS	"FINPUT"	; werkt
	DFB	FINPUT/256
	DFB	FINPUT%256
	FCS	"FPUT"		; werkt
	DFB	FPUT/256
	DFB	FPUT%256
	DFB	OTHERROM/256
	DFB	OTHERROM%256
	FCS	"+"		; nog te testen
	DFB	FP_PLS/256
	DFB	FP_PLS%256
	FCS	"-"		; nog te testen
	DFB	FP_MIN/256
	DFB	FP_MIN%256
	DFB	$FE
	FCS	"*"		; nog te testen
	DFB	FP_MAAL/256
	DFB	FP_MAAL%256
	FCS	"/"		; nog te testen
	DFB	FP_DIV/256
	DFB	FP_DIV%256
	DFB	$FE
	FCS	"^"		; nog te testen
	DFB	FP_MACH/256
	DFB	FP_MACH%256
	DFB	$FE
	FCS	"+"		; nog te testen
	DFB	FPL_pl/256
	DFB	FPL_pl%256
	FCS	"-"		; nog te testen
	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
