***************************************


* This macro takes the value of a string and returns it in the acc,y.
* If there is no op1, then the string number is assumed to be in the xreg.
	MACRO
&lab	_fstrval	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fstrval
	MEND


***************************************


* This macro takes the value of op1 string starting at op2 character and
* returns it in the acc,y.  If there is no op1, then the string number is
* assumed to be in the xreg.  If there is no op2, then the character number
* is assumed to be in the yreg.
	MACRO
&lab	_fmidstrval &op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ycorm	&op2
.jsr	jsr	fmidstrval
	MEND


***************************************


* This macro reads a float from the current data pointer and advances the
* pointer by five bytes.  If there is no op1, then the destination variable
* number is assumed to be in the xreg.
	MACRO
&lab	_readfloat &op
&lab	
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	readfloat
	MEND


***************************************


* This macro converts an integer variable into a floating-point variable.
	MACRO
&lab	_i2f	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	i2f
	MEND


***************************************


* This macro converts a floating-point variable into an integer variable.
	MACRO
&lab	_f2i	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	f2i
	MEND


***************************************


* This macro prints a float value.  fout expects a pointer to the float.
* The pointer is either already in a,y (no operand), or is
* determined by the operand.
	MACRO
&lab	_fout &op
&lab	
	if	&op='' goto .jsr
	fparm	&op
	if	finline=0 goto .jsr
	jsr	frtsout
	_asc2fp	&op
	mexit
.jsr	jsr	fout
	MEND


***************************************


* This macro prints a float value.  This value is stored in a variable.
* The variable number is either already in the xreg (no operand), or is
* determined by the operand.
	MACRO
&lab	_fvout &op
&lab	
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fvout
	MEND


***************************************


* This macro multiplies the destination float variable by a float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.
	MACRO
&lab	_fmulvar	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fmulvar
	MEND


***************************************


* This macro multiplies the destination float variable by a float constant.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fmul	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtsmul
	_asc2fp	&op2
	mexit
.jsr	jsr	fmulcon
	MEND


***************************************


* This macro divides the destination float variable by a float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.
	MACRO
&lab	_fdivvar	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fdivvar
	MEND


***************************************


* This macro divides the destination float variable by a float constant.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fdiv	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtsdiv
	_asc2fp	&op2
	mexit
.jsr	jsr	fdivcon
	MEND


***************************************


* This macro adds a float variable to the destination float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.
	MACRO
&lab	_faddvar	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	faddvar
	MEND


***************************************


* This macro adds a float constant the destination float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fadd	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtsadd
	_asc2fp	&op2
	mexit
.jsr	jsr	faddcon
	MEND


***************************************


* This macro subtracts a float variable from the destination float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.
	MACRO
&lab	_fsubvar	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fsubvar
	MEND


***************************************


* This macro subtracts a float constant from the destination float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fsub	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtssub
	_asc2fp	&op2
	mexit
.jsr	jsr	fsubcon
	MEND


***************************************


* This macro raises the destination float variable by the source float variable.
* If there is no op1, then the destination variable number is assumed to be in
* the xreg.  If there is no op2, then the source variable number is assumed to
* be in the yreg.
	MACRO
&lab	_fv2v	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fv2v
	MEND


***************************************


* This macro raises the destination float variable by the a float constant.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fv2con	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtsv2con
	_asc2fp	&op2
	mexit
.jsr	jsr	fv2con
	MEND



***************************************


* This macro gets the sign of the destination float variable and stores it in
* the destination variable.  If there is no op, then the destination variable
* number is assumed to be in the xreg.
	MACRO
&lab	_fsgn	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fsgn
	MEND


***************************************


* This macro gets the absolute value of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fabs	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fabs
	MEND


***************************************


* This macro gets the integer value of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fint	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fint
	MEND


***************************************


* This macro gets the square root of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fsqr	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fsqr
	MEND


***************************************


* This macro gets the log base e of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_flog	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	flog
	MEND


***************************************


* This macro raises e to the destination float variable power and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fexp	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fexp
	MEND


***************************************


* This macro forms a 'random' number and stores it in the destination
* variable.  If there is no op, then the destination variable number
* is assumed to be in the xreg.
	MACRO
&lab	_frnd	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	frnd
	MEND


***************************************


* This macro gets the cos of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fcos	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fcos
	MEND


***************************************


* This macro gets the sin of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fsin	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fsin
	MEND


***************************************


* This macro gets the tan of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_ftan	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	ftan
	MEND


***************************************


* This macro gets the arctan of the destination float variable and
* stores it in the destination variable.  If there is no op, then the
* destination variable number is assumed to be in the xreg.
	MACRO
&lab	_fatn	&op
&lab
	if	&op='' goto .jsr
	ldx	#<&op
.jsr	jsr	fatn
	MEND


***************************************


* This macro sets a float variable to a 1-byte value.  If there is no op1,
* then the destination variable number is assumed to be in the xreg.  If
* there is no op2, then the value is assumed to be in the acc.
	MACRO
&lab	_i2fsetl	&op1,&op2
&lab	
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	acorm	&op2
.jsr	jsr	i2fsetconl
	MEND


***************************************


* This macro sets a float variable to a 2-byte value.  If there is no op1,
* then the destination variable number is assumed to be in the xreg.  If
* there is no op2, then the value is assumed to be in the acc.
	MACRO
&lab	_i2fset	&op1,&op2
&lab	
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	aycorm	&op2
	if	ayisbyte=1 then
	jsr	i2fsetconl
	mexit
	endif
.jsr	jsr	i2fsetcon
	MEND


***************************************


* This macro is used to set a bunch of float variables to integer constant
* values.  There must be a non-zero even number of parameters.  The odd
* parameters are the variables, and the even parameters are the constant
* values for the preceeding parameter.  The setvars routine uses the
* return address as a pointer to the data (just like the write routine).
* It simply sets the designated variable to the designated constant until
* it encounters a 255 as a variable value.  A 255 is reserved for this
* purpose.  This macro places a 255 at the end of the data list
* automatically.
	MACRO
&lab	_i2fsetvars
&lab	
	if	&syslist[2]='' then
	aerror	'_setvars:  must have at least two parameters'
	mexit
	endif
	jsr	i2fsetvars
	lcla	&i,&j,&n
&i	seta	1
&j	seta	2
&n	seta	&nbr(&syslist)
.a	if	&syslist[&j]='' then
	aerror	'_i2fsetvars:  must have even number of parameters'
	mexit
	endif
	dc.b	&syslist[&i]
	if	&substr(&syslist[&j],1,1)<>'#' then
	aerror	'_i2fsetvars:  variables can only be set to constants -- missing #'
	mexit
	endif
	dc.w	&substr(&syslist[&j],2,999)
&i	seta	&i+2
&j	seta	&j+2
	if	&i<=&n goto .a
	dc.b	255
	MEND


***************************************


* This macro is used to set a bunch of float variables to float constant
* values.  There must be a non-zero even number of parameters.  The odd
* parameters are the variables, and the even parameters are the constant
* values for the preceeding parameter.  The setvars routine uses the
* return address as a pointer to the data (just like the write routine).
* It simply sets the designated variable to the designated constant until
* it encounters a 255 as a variable value.  A 255 is reserved for this
* purpose.  This macro places a 255 at the end of the data list
* automatically.
	MACRO
&lab	_fsetvars
&lab	
	if	&syslist[2]='' then
	aerror	'_setvars:  must have at least two parameters'
	mexit
	endif
	jsr	fsetvars
	lcla	&i,&j,&n
&i	seta	1
&j	seta	2
&n	seta	&nbr(&syslist)
.a	if	&syslist[&j]='' then
	aerror	'_fsetvars:  must have even number of parameters'
	mexit
	endif
	dc.b	&syslist[&i]
	if	&substr(&syslist[&j],1,1)<>'#' then
	aerror	'_fsetvars:  variables can only be set to constants -- missing #'
	mexit
	endif
	_asc2fp	&syslist[&j]
&i	seta	&i+2
&j	seta	&j+2
	if	&i<=&n goto .a
	dc.b	255
	MEND


***************************************


* This macro sets the destination float variable to a float constant.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source float pointer is
* assumed to be in a,y.
	MACRO
&lab	_fset	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtssetcon
	_asc2fp	&op2
	mexit
.jsr	jsr	fsetcon
	MEND


***************************************


	MACRO
&lab	_fset0	&op
&lab
	if	&op='' goto .a
	ldx	#<&op
.a	
	jsr	fsetzero
	MEND


***************************************


* This macro compares the destination float variable with a float variable.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.  The equal status is true if the variables are
* equal.  If the xreg variable is greater or equal, then the carry is set.
* If the xreg variable is smaller, then the carry is clear.  
	MACRO
&lab	_fvcmp	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fvcmp
	MEND


***************************************


* This macro compares the destination float variable with a float constant.
* If there is no op1, then the destination variable number is assumed to be
* in the xreg.  If there is no op2, then the source variable number is
* assumed to be in the yreg.  The equal status is true if the values are
* equal.  If the xreg variable is greater or equal, then the carry is set.
* If the xreg variable is smaller, then the carry is clear.  
	MACRO
&lab	_fcmp	&op1,&op2
&lab
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	fparm	&op2
	if	finline=0 goto .jsr
	jsr	frtscmp
	_asc2fp	&op2
	mexit
.jsr	jsr	fcmp
	MEND


***************************************


* This macro sets a float variable to another float variable.  If there is
* no op1, then the destination variable number is assumed to be in the
* xreg.  If there is no op2, then the source variable number is assumed
* to be in the yreg.
	MACRO
&lab	_fvarcpy	&op1,&op2
&lab	
	if	&op1='' goto .a
	ldx	#<&op1
.a	if	&op2='' goto .jsr
	ldy	#<&op2
.jsr	jsr	fvarcpy
	MEND


***************************************
***************************************
***************************************


* This macro generates an AppleSoft floating-point number.
	MACRO
&lab	_asc2fp	&op
	lcla	&exp,&mant			;Exponent and mantissa portions.
	lclc	&str
&str	setc	&op				;We can't modify the parm, so copy it.
&lab
	if	&substr(&str,1,1)='#' goto .const
	aerror	'floating-point constant parameter must start with a #'
	mexit
.const
&str	setc	&substr(&str,2,999)		;Get rid of #.

	lcla	&sgn				;Get sign of number.
&sgn	seta	$80000000			;Assume positive.
	if	&substr(&str,1,1)='-' then
&sgn	seta	0
&str	setc	&substr(&str,2,999)		;Get rid of -.
	endif

	if	&substr(&str,1,1)='+' then		;Get rid of optional +.
&str	setc	&substr(&str,2,999)
	endif



	lcla	&dptflg,&dptcnt			;Setup work values.
&dptflg	seta	0				;Decimal-point flag.
&dptcnt	seta	0				;Decimal-point count.
	lclc	&c,&s				;Work character and string.
&s	setc	''



* This loop moves digits into &s, looks for a decimal-point, and
* counts digits after a decimal-point.

.loop1
&c	setc	&substr(&str,1,1)			;Get left-most character.
	if	&c='' goto .brk1			;End of string.
&str	setc	&substr(&str,2,999)
	if	&c<'0' goto .b			;Not digit.
	if	&c>'9' goto .b			;Not digit.

&s	setc	&concat(&s,&c)			;Collect the digit.
	if	&dptflg=1 then
&dptcnt	seta	&dptcnt+1			;Count digits right of decimal.
	endif
	goto	.loop1

.b	if	&c<>'.' goto .c
	if	&dptflg=1 then
	aerror	'bad floating-point constant'	;Don't allow 2 decimal-points.
	endif
&dptflg	seta	1				;Flag that we found first decimal-point.
	goto	.loop1

.c	if	&c='e' goto .brk1			;At exponent part.
	if	&c='E' goto .brk1			;At exponent part.
	aerror	'bad floating-point constant'	;Any other character is an error.
	mexit
.brk1

&mant	seta	&strtoint(&s)			;Convert digits into a 4-byte integer.

	if	&mant=0 then			;Special-case for 0.
	dc.b	0,0,0,0,0
	mexit
	endif

&exp	seta	128+32				;Normalize the number.
.loop2	if	&mant<0 goto .brk2
&exp	seta	&exp-1
&mant	seta	&mant<<1
	goto	.loop2
.brk2

	lcla	&expval,&expneg
&expval	seta	0				;Default exponent value is 0.
&expneg	seta	0				;Assume positive.
	if	&str='' goto .doexp		;We have no exponent part.

	if	&substr(&str,1,1)='-' then		;Check sign of exponent.
&expneg	seta	1
&str	setc	&substr(&str,2,999)		;Get rid of -.
	endif

	if	&substr(&str,1,1)='+' then
&str	setc	&substr(&str,2,999)		;Get rid of optional +.
	endif

&expval	seta	&strtoint(&str)			;Get the exponent value.
	if	&expneg=1 then
&expval	seta	-&expval
	endif

.doexp						;Process exponent portion.
	lcla	&num,&mantlo,&manthi,&test		;Use this as a work variable.
&expval	seta	&expval-&dptcnt			;Subtract frac digits from exponent.
	if	&expval=0 goto .out		;No exponent adjustment.
	if	&expval<0 goto .div10		;Negative exponent adjustment.

.mul10
&mantlo	seta	&mant**$00FFFFFF			;Break mantissa into lo and hi parts.
&manthi	seta	&mant**$FF000000
&manthi	seta	&manthi>>1
&manthi	seta	&manthi**$7FFFFFFF
&manthi	seta	&manthi>>7
&mantlo	seta	&mantlo*10			;Multiply mantissa by 10.
&manthi	seta	&manthi*10
.ma	
&test	seta	&manthi**$FF000000
	if	&test=0 goto .mb
&exp	seta	&exp+1
&num	seta	&mantlo**$01			;Keep this for rounding later.
&manthi	seta	&manthi>>1
&manthi	seta	&manthi**$7FFFFFFF
&mantlo	seta	&mantlo>>1
	goto	.ma
.mb
&manthi	seta	&manthi<<8
&mant	seta	&manthi+&mantlo+&num
	if	&mant<0 goto .mc
&mant	seta	$FFFFFFFF
.mc
&expval	seta	&expval-1
	if	&expval>0 goto .mul10		;More multiplies.
	goto	.out				;Finally, go do it.

.div10						;Keep as much precision as possible.
&mantlo	seta	&mant>>1				;Break mantissa into lo and hi parts.
&mantlo	seta	&mantlo**$7FFFFFFF
&mantlo	seta	&mantlo/1280
&mantlo	seta	&mantlo*2560
&mantlo	seta	&mant-&mantlo
&manthi	seta	&mant-&mantlo
&mantlo	seta	&mantlo<<8

&mantlo	seta	&mantlo/10			;Divide mantissa by 10.
&manthi	seta	&manthi>>1
&manthi	seta	&manthi**$7FFFFFFF
&manthi	seta	&manthi/5

.da	if	&manthi<0 goto .db
&exp	seta	&exp-1
&manthi	seta	&manthi<<1
&mantlo	seta	&mantlo<<1
	goto	.da
.db
&mantlo	seta	&mantlo>>7
&num	seta	&mantlo**$01
&mantlo	seta	&mantlo>>1
&mant	seta	&manthi+&mantlo+&num
	if	&mant<0 goto .dc			;Final add didn't cause problems.
&mant	seta	$FFFFFFFF
.dc
&expval	seta	&expval+1
	if	&expval<0 goto .div10		;More divides.

.out						;Finally, do it.
&mant	seta	&mant--&sgn			;Pack the sign into the mantissa.
	lcla	&m0,&m1,&m2,&m3
&m0	seta	&mant**$FF
&mant	seta	&mant>>8
&mant	seta	&mant**$00FFFFFF
&m1	seta	&mant**$FF
&mant	seta	&mant>>8
&m2	seta	&mant**$FF
&m3	seta	&mant>>8

	dc.b	&exp,&m3,&m2,&m1,&m0		;Generate the code.

	mend

