;	Some macros used by the math routines
;	-------------------------------------

cmp.w:		.macro	field1, [#] field2
		lda	%1+1
		.ifm	2 immediate
		cmp	%2 / 256
		.else
		cmp	%2 + 1
		.endif
		bne	~a
		lda	%1
		.ifm	2 immediate
		cmp	%2 & $ff
		.else
		cmp	%2
		.endif
~a:
		.endm


sub.w:		.macro	field_1, [#] field_2, [field_3]
		sec
		.ifm	2 immediate
		  lda	%1
		  sbc	%2 & $ff
		  pha
		  lda	%1+1
		  sbc	%2 / 256
		.else
		  lda	%1
		  sbc	%2
		  pha
		  lda	%1+1
		  sbc	%2+1
		.endif
		.ifm	3 exists
		  sta	%3+1
		  pla
		  sta	%3
		.else
		  sta	%1+1
		  pla
		  sta	%1
		.endif
		.endm


;======================================================================
;		Low level fetch and get instructions
;======================================================================

__rts:		rts


	.IF_REFERENCED _saveax
_saveax:	sta _save_a	;save A,X into temp area
		stx _save_x
		rts
_getax: 	lda _save_a
		ldx _save_x
		rts
	.ENDIF


	.IF_REFERENCED _saveop1
_saveop1:	sta _oper1		;save operator
		stx _oper1+1
		rts
	.ENDIF

	.IF_REFERENCED _saveop2
_saveop2:	sta _oper2
		stx _oper2+1
		rts
	.ENDIF


	.IF_REFERENCED _loadiptr
_loadiptr:	sta _iptr		;load IPTR with value in A,X
		stx _iptr+1
		rts
	.ENDIF


	.IF_REFERENCED _loadiofst
_loadiofst: sta _iofst
		stx _iofst+1
		rts
	.ENDIF


	.IF_REFERENCED _gchar
_gchar: 	sta _iptr		;fetch char at @ in A,X
		stx _iptr+1
		ldy #0
		lda (_iptr),y
		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED _gint
_gint:		sta _iptr		;fetch int at @ in A,X
		stx _iptr+1
		ldy #1
		lda (_iptr),y
		tax
		dey
		lda (_iptr),y
		rts
	.ENDIF


	.IF_REFERENCED _gochar
_gochar:	clc		;fetch char at @ in A,X with
		adc _iofst		; offset of IOFST
		sta _iptr
		txa
		adc _iofst+1
		sta _iptr+1
		ldy #0
		lda (_iptr),y
		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED _goint
_goint: 	asl _iofst			;double the offset
		rol _iofst+1
		clc
		adc _iofst
		sta _iptr
		txa
		adc _iofst+1
		sta _iptr+1
		ldy #1
		lda (_iptr),y
		tax
		dey
		lda (_iptr),y
		rts
	.ENDIF


	.IF_REFERENCED _pchar
_pchar: 	ldy #0
		sta (_iptr),y
		rts
	.ENDIF


	.IF_REFERENCED _pint
_pint:		ldy #0
		sta (_iptr),y
		iny
		txa
		sta (_iptr),y
		rts
	.ENDIF


	.IF_REFERENCED _pochar
_pochar:	pha
		jsr _calcofst
		ldy #0
		pla
		sta (_iptr),y
		rts
	.ENDIF


	.IF_REFERENCED _point
_point: 	asl _iofst			;double the offset
		rol _iofst+1
		sta .tempa
		stx .tempx
		jsr _calcofst
		ldy #0
		lda .tempa
		sta (_iptr),y
		iny
		lda .tempx
		sta (_iptr),y
		rts
.tempa: 	dc.b	0
.tempx: 	dc.b	0
	.ENDIF


	.IF_REFERENCED _calcofst
_calcofst:	lda _iptr
		clc
		adc _iofst
		sta _iptr
		lda _iptr+1
		adc _iofst+1
		sta _iptr+1
		rts
	.ENDIF



;	Compare (16-bit) value at _comp1 to value in A,X
;
;	Returns:	 BEQ  ->  operands are equal
;			 BMI  ->  _oper1 < _oper2
;			 BNE  ->  _oper1 > _oper2
;	---------------------------------------------------

	.IF_REFERENCED _compare
_compare:	cpx	_comp1+1
		bne	.noteq
		cmp	_comp1
		bne	.noteq
.equal: 	rts
.noteq: 	bcs	.less1
.great1:	lda #1
		rts
.less1: 	lda #$ff
		rts
	.ENDIF



_getdev:	asl		;multiply device in A * 16
		asl
		asl
		asl
		tax
_rts:		rts




;======================================================================
;		High level Input and Output functions
;======================================================================

	.IF_REFERENCED printf
printf: 	lda #0		;printf to device 0
		jmp _printf
	.ENDIF

	.IF_REFERENCED fprintf
fprintf:	lda _parm1		;printf to a specified device
		pha		;save device
		ldy #0
.move:		lda _parm2,y	;move parms down
		sta _parm1,y
		iny
		cpy #18
		bcc .move
		pla
		jmp _printf
	.ENDIF


	.IF_REFERENCED _printf
_printf:	sta .device	;the actual printf routine
		lda _parm1
		sta _pfptr
		lda _parm1+1
		sta _pfptr+1
		ldy #0		;make our own private copy of
.gstack:	lda _parm2,y	; the stack parameters
		sta .stack,y
		iny
		cpy #18
		bcc .gstack

		ldy #0
		sty .stkidx
		lda (_pfptr),y	;length of mask
		sta .strlth
		iny
		sty .stridx

.loop:		ldy .stridx
		cpy .strlth
		bcc .notdone
		beq .notdone
		lda #1
		ldx #0
		rts
.notdone:	lda (_pfptr),y		;next byte of string
		cmp #'%'			;special lead-in?
		beq .special
.thischar:	sta _parm1
		ldx .device
		jsr __putchar
		bmi .error
.nextbyte:	inc .stridx
		jmp .loop
.error: 	lda #0
		ldx #0
		rts
.special:	iny
		sty .stridx
		lda (_pfptr),y
		cmp #'s'			;string?
		beq .string
		cmp #'d'
		beq .decimal
		cmp #'e'
		beq .eol
		cmp #'c'			;string?
		beq .char
		cmp #'h'			;hex?
		beq .hex
		cmp #'f'			;floating point?
		bne .notfl
		jmp .float
.notfl: 	jmp .thischar
.eol:		lda #$9b
		ldx .device
		jsr __putchar
		bmi .error
		jmp .nextbyte
.string:	lda .stkidx
		asl
		tay
		lda .stack,y
		sta _parm1
		lda .stack+1,y
		sta _parm1+1
		ldx .device
		lda _parm1
		ldy _parm1+1
		jsr __putstr
		bmi .strerr
		inc .stkidx
		jmp .nextbyte
.strerr:	jmp .error
.decimal:	lda .stkidx
		asl
		tay
		lda .stack,y
		sta _parm1
		lda .stack+1,y
		sta _parm1+1
		ldx .device
		lda _parm1
		ldy _parm1+1
		jsr __putnum
		bmi .strerr
		inc .stkidx
		jmp .nextbyte
.char:		lda .stkidx
		asl
		tay
		lda .stack,y
		ldx .device
		jsr __putchar
		bmi .strerr
		inc .stkidx
		jmp .nextbyte
.hex:		lda .stkidx
		asl
		tay
		lda .stack,y
		sta _parm1
		lda .stack+1,y
		sta _parm1+1
		ldx .device
		lda _parm1
		ldy _parm1+1
		jsr __puthex
		bmi .strerr
		inc .stkidx
		jmp .nextbyte
.float: 	lda .stkidx
		asl
		tay
		lda .stack,y
		sta _parm1
		lda .stack+1,y
		sta _parm1+1
		ldx .device
		lda _parm1
		ldy _parm1+1
		jsr __putfloat
		bmi .strerr
		inc .stkidx
		jmp .nextbyte
.device:	ds.b	1
.strlth:	ds.b	1
.stridx:	ds.b	1
.stkidx:	ds.b	1
.stack: 	ds.b	20
	.ENDIF




	.IF_REFERENCED write_ram
write_ram:	lda	88
		sta	_ptr
		lda	89
		sta	_ptr+1
		ldy	_parm2		;ypos in parm2
		beq	.done
		cpy	#25		;must be 1-24..
		bcc	.ckidx
		jmp	.done
.calc:		lda	_ptr
		clc
		adc	#40
		sta	_ptr
		lda	_ptr+1
		adc	#0
		sta	_ptr+1
.ckidx: 	dey
		bne	.calc
.done:		dec	_parm1
		lda	_ptr
		clc
		adc	_parm1
		sta	_ptr
		lda	_ptr+1
		adc	#0
		sta	_ptr+1

		lda	_parm3
		sta	_sptr
		lda	_parm3+1
		sta	_sptr+1
		ldy #0
		lda (_sptr),y		;get length byte
		sta _freslo		;use freslo as length byte
		iny			;move to first byte of string
		sty _freshi		;use freshi as length pointer
.loop:		ldy _freshi
		cpy _freslo		;done yet?
		bcc .notdone
		beq .notdone
		rts
.notdone:	lda (_sptr),y		;get byte
		jsr	.xlate		;translate it
		ldy	#0
		sta	(_ptr),y
		inc	_ptr
		bne	.novf1
		inc	_ptr+1
.novf1: 	inc _freshi
		bne .loop
.exit:		rts
.temp:		ds.b	1
.xlate: 	sta	.temp
		and	#$7f
		cmp	#32
		bcc	.add64
		cmp	#96
		bcc	.sub32
		jmp	.asis
.add64: 	clc
		adc	#64
		jmp	.asis
.sub32: 	sec
		sbc	#32
.asis:		bit	.temp
		bpl	.xxlate
		ora	#$80
.xxlate:	rts
	.ENDIF




	.IF_REFERENCED pute
pute:		ldx #0
		lda #$9b
		sta _parm1
		jmp put
	.ENDIF


	.IF_REFERENCED put
put:		lda _parm1
		ldx #0
		jsr __putchar
		bpl .ok
.err:		lda #0
		beq .exit
.ok:		lda #1
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED putd
putd:		ldx _parm1
		lda _parm2
		jsr __putchar
		bpl .ok
.err:		lda #0
		beq .exit
.ok:		lda #1
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED getd
getd:		ldx _parm1
		jsr __getchar
		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED open
open:		jsr close		;close the device
		lda _parm2
		sta _sptr
		lda _parm2+1
		sta _sptr+1
		jsr _toascii
		lda _parm1
		jsr _getdev	 ;dev = dev * 16
		lda #3
		sta _iccom,x
		lda #_asciistr&$ff
		sta _icbal,x
		lda #_asciistr/256
		sta _icbah,x
		lda #80
		sta _icbll,x
		lda #0
		sta _icblh,x
		lda _parm3
		sta _icax1,x
		lda _parm4
		sta _icax2,x
		jsr _CIO
		bpl .ok
.err:		lda #0
		beq .exit
.ok:		lda #1
.exit:		ldx #0
		rts
	.ENDIF




	.IF_REFERENCED blockread
blockread:	lda _parm3
		ora _parm3+1
		bne .ok
		ldy #0
		jmp .error
.ok:		lda _parm1
		jsr _getdev	 ;dev = dev * 16
		lda #7
		sta _iccom,x
		lda _parm2
		sta _icbal,x
		lda _parm2+1
		sta _icbah,x
		lda _parm3
		sta _icbll,x
		lda _parm3+1
		sta _icblh,x
		jsr _CIO
		bmi .error
.noerror:	lda _icbll,x
		pha
		lda _icblh,x	 ;get lth actually read in
		tax
		pla
		rts
.error: 	cpy #136		;EOF is ok..
		beq .noerror
		lda #0
		ldx #0
		rts
	.ENDIF



	.IF_REFERENCED blockwrite
blockwrite: lda _parm3
		ora _parm3+1
		bne .ok
		jmp .error
.ok:		lda _parm1
		jsr _getdev	 ;dev = dev * 16
		lda #11
		sta _iccom,x
		lda _parm2
		sta _icbal,x
		lda _parm2+1
		sta _icbah,x
		lda _parm3
		sta _icbll,x
		lda _parm3+1
		sta _icblh,x
		jsr _CIO
		bmi .error
.noerror:	lda _icbll,x
		pha
		lda _icblh,x	 ;get lth actually read in
		tax
		pla
		rts
.error: 	lda #0
		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED point
point:		lda _parm1
		jsr _getdev
		lda #37
		sta _iccom,x
		lda _parm2
		sta $34c,x
		lda _parm3
		sta $34d,x
		lda _parm4
		sta $34e,x
		jsr _CIO
		bpl .ok
.err:		lda #0
		beq .exit
.ok:		lda #1
.exit:		ldx #0
		rts
	.ENDIF



	.IF_REFERENCED close
close:		lda _parm1
		jsr _getdev
		lda #12
		sta _iccom,x
		jsr _CIO
		bpl .ok
.err:		lda #0
		beq .exit
.ok:		lda #1
.exit:		ldx #0
		rts
	.ENDIF



	.IF_REFERENCED inputs
inputs: 	lda _parm1			; inputs (string)
		ldx _parm1+1
		sta _parm2
		stx _parm2+1
		lda #0
		sta _parm1
		sta _parm1+1
		jmp inputsd
	.ENDIF


	.IF_REFERENCED inputsd
inputsd:	lda _parm1
		jsr _getdev	 ;dev = dev * 16
		lda #5
		sta _iccom,x
		lda _parm2
		clc
		adc #1
		sta _icbal,x
		lda _parm2+1
		adc #0
		sta _icbah,x
		lda #100
		sta _icbll,x
		lda #0
		sta _icblh,x
		jsr _CIO
		bmi .error
.noerror:	lda _icbll,x	 ;get lth actually read in
		sec
		sbc #1		; minus 1
		ldy #0
		sta (_parm2),y	 ; and place it in length byte
		lda #1
		ldx #0
		rts
.error: 	lda #0
		ldx #0
		rts
	.ENDIF




	.IF_REFERENCED fdelete
fdelete:	lda #33
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED frename
frename:	lda #32
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF


	.IF_REFERENCED flock
flock:		lda #34
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED fprotect
fprotect:	lda #35
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED funprotect
funprotect: lda #36
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED funlock
funlock:	lda #46
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED fcredir
fcredir:	lda #42
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED fdeldir
fdeldir:	lda #43
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED fcwd
fcwd:		lda #44
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF

	.IF_REFERENCED fainit
fainit: 	lda #254
		ldx #0
		ldy #0
		jmp __xio
	.ENDIF




;======================================================================
;		Low level Input and Output functions
;======================================================================


	.IF_REFERENCED __xio
__xio:		sta .cmd		;cmd -> A, ax1 -> X, ax2 -> Y
		stx .ax1
		sty .ax2
		jsr freeiocb
		cmp #0
		bne .gotone
		jmp .err
.gotone:	sta .device
		lda _parm1
		sta _sptr
		lda _parm1+1
		sta _sptr+1
		jsr _toascii
		lda .device
		jsr _getdev	 ;dev = dev * 16
		lda .cmd
		sta _iccom,x
		lda #_asciistr&$ff
		sta _icbal,x
		lda #_asciistr/256
		sta _icbah,x
		lda #128
		sta _icbll,x
		lda #0
		sta _icblh,x
		lda .ax1
		sta _icax1,x
		lda .ax2
		sta _icax2,x
		jsr _CIO
		tya
		ldx #0
		rts
.err:		lda #0
		ldx #0
		rts
.device:	ds.b	1
.cmd:		ds.b	1
.ax1:		ds.b	1
.ax2:		ds.b	1
	.ENDIF


	.IF_REFERENCED freeiocb

freeiocb:	ldx #$10		;find a free IOCB; return in A
		ldy #1
.loop:		lda _ichid,x
		cmp #$ff		;free?
		beq .gotone
		txa
		clc
		adc #$10
		tax
		iny
		cpy #8
		bcc .loop
.none:		lda #0		;none free!
		ldx #0
		rts
.gotone:	tya
		ldx #0
		rts
	.ENDIF

	.IF_REFERENCED __putstr
__putstr:	stx .device		; device -> X, string -> A,Y
		sta _sptr
		sty _sptr+1
		ldy #0
		lda (_sptr),y		;get length byte
		sta _freslo		;use freslo as length byte
		iny			;move to first byte of string
		sty _freshi		;use freshi as length pointer
.loop:		ldy _freshi
		cpy _freslo		;done yet?
		bcc .notdone
		beq .notdone
		rts
.notdone:	lda (_sptr),y		;get byte
		ldx .device		;get device
		jsr __putchar
		bmi .exit		;exit with MINUS if error
		inc _freshi
		bne .loop
.exit:		rts
.device:	ds.b	1
	.ENDIF


	.IF_REFERENCED __putnum
__putnum:	stx .device		; device -> X, number -> A,Y
		sta _fr0
		sty _fr0+1
		jsr _ifp			;float it
		jsr _fasc			;to ascii
		ldy #0
.loop:		lda (_inbuff),y
		sta .saveb
		and #$7f			;last byte is negative
		ldx .device
		sty .tempy
		jsr __putchar
		bmi .exit		;exit with MINUS on error
		ldy .tempy
		iny
		lda .saveb
		bpl .loop
		lda #0		;clear MINUS flag
.exit:		rts
.tempy: 	ds.b	1
.device:	ds.b	1
.saveb: 	ds.b	1
	.ENDIF

	.IF_REFERENCED __putfloat
__putfloat: stx .device 		; device -> X, fp @ -> A,Y
		tax
		jsr _fld0r			;load into fr0
		jsr _fasc			;to ascii
		ldy #0
.loop:		lda (_inbuff),y
		sta .saveb
		and #$7f			;last byte is negative
		ldx .device
		sty .tempy
		jsr __putchar
		bmi .exit		;exit with MINUS on error
		ldy .tempy
		iny
		lda .saveb
		bpl .loop
		lda #0		;clear MINUS flag
.exit:		rts
.tempy: 	ds.b	1
.device:	ds.b	1
.saveb: 	ds.b	1
	.ENDIF


	.IF_REFERENCED __puthex
__puthex:	stx .device		; device -> X, number -> A,Y
		sta .lo
		sty .hi
		lda .hi
		lsr
		lsr
		lsr
		lsr
		jsr .out
		lda .hi
		and #$0f
		jsr .out
		lda .lo
		lsr
		lsr
		lsr
		lsr
		jsr .out
		lda .lo
		and #$0f
		jsr .out
		lda #0		;clear MINUS flag
		rts

.out:		tay
		lda .digits,y
		ldx .device
		jsr __putchar
		bmi .error
		rts
.error: 	sty .tempy
		pla
		pla
		ldy .tempy
		rts

.tempy: 	ds.b	1
.device:	ds.b	1
.lo:		ds.b	1
.hi:		ds.b	1
.digits:	dc.b	"0123456789ABCDEF"
	.ENDIF



	.IF_REFERENCED __putchar
__putchar:	pha		  ; char -> A,	device -> X
		txa
		asl
		asl
		asl
		asl
		tax
		lda #11
		sta _iccom,x
		lda #0
		sta _icbll,x
		sta _icblh,x
		pla
		jmp _CIO
	.ENDIF


	.IF_REFERENCED __getchar
__getchar:	txa		  ; device -> X
		asl
		asl
		asl
		asl
		tax
		lda #7
		sta _iccom,x
		lda #0
		sta _icbll,x
		sta _icblh,x
		jmp _CIO
	.ENDIF



;======================================================================
;		Miscellaneous functions and procs
;======================================================================


;	call an assembler routine
;	-------------------------

	.IF_REFERENCED call

call:		sta .go+1
		stx .go+2
.go:		jmp $ffff

	.ENDIF



	.IF_REFERENCED keypressed
keypressed: lda 764
		cmp #$ff
		beq .no
.yes:		lda #1
		bne .exit
.no:		lda #0
.exit:		ldx #0
		rts
	.ENDIF


;	   strcpy (dest, source)
;	   ---------------------

	.IF_REFERENCED scopy
scopy:		jmp strcpy
	.ENDIF


	.IF_REFERENCED strcpy

strcpy: 	jsr _loadstr
		ldy #0
		lda (_dptr),y		;get lth byte
		tay			;go backwards
.loop:		lda (_dptr),y
		sta (_sptr),y
		cpy #0
		beq .done
		dey
		jmp .loop
.done:		rts
	.ENDIF


;	   strcmp  (string1, string2)
;	   strcmpi (string1, string2)
;	   -------------------------

	.IF_REFERENCED strcmp

strcmp: 	lda  #$80
		jmp  _cmpstr
	.ENDIF


	.IF_REFERENCED strcmpi
strcmpi:	lda  #0
		jmp _cmpstr
	.ENDIF


	.IF_REFERENCED _cmpstr

_cmpstr:	sta .dofold
		jsr _loadstr
		ldy #0		;zero index
		lda (_sptr),y	;get length byte
		sta .lth
.loop:		lda (_sptr),y	;get next byte
		bit .dofold
		bmi .nofold1
		jsr upcase
.nofold1:	sta .temp
		lda (_dptr),y	;they match?
		bit .dofold
		bmi .nofold2
		jsr upcase
.nofold2:	cmp .temp
		bne .noteq		;nope..
		cpy .lth		;end of string?
		beq .end		;yes -- they match
		iny
		bne .loop
.noteq: 	lda #1		;set BNE
		bne .exit
.end:		lda #0		;set BEQ
.exit:		ldx #0
		rts
.lth:		ds.b	1
.temp:		ds.b	1
.dofold:	ds.b	1
	.ENDIF


;	   strcat  (dest, source)
;	   ----------------------

	.IF_REFERENCED strcat

strcat: 	jsr _loadstr
		ldy #0
		lda (_dptr),y		;get source lth
		sta .srclth
		beq .end			;null string..exit
		lda (_sptr),y		;get dest lth
		sta .desty
		inc .srcy
		inc .desty
		ldy #1			;always start at 1 on
		sty .srcy			; the source string
.loop:		ldy .srcy
		lda (_dptr),y		;get byte from source
		ldy .desty
		sta (_sptr),y		;store into dest
		lda .srcy
		cmp .srclth		;end of string?
		beq .end			;yes
		inc .srcy
		inc .desty			;up indexes
		bne .loop			;and keep going
.end:		ldy #0
		lda (_sptr),y		;up the length byte
		clc			; of the dest string
		adc .srclth
		sta (_sptr),y
		rts
.srcy:		dc.b	1
.desty: 	dc.b	1
.srclth:	dc.b	1
	.ENDIF



;	x = valb (string)
;	x = valc (string)
;	~~~~~~~~~~~~~~~~~

	.IF_REFERENCED valb

valb:		jmp valc
	.ENDIF

	.IF_REFERENCED valc

valc:		lda _parm1
		sta _sptr
		lda _parm1+1
		sta _sptr+1
		jsr _toascii		;convert to asciiz string
		lda #_asciistr&$ff
		sta _inbuff
		lda #_asciistr/256
		sta _inbuff+1
		lda #0
		sta _cix
		jsr _afp			 ;ascii --> floating pt.
		bcs .default
		jsr _fpi			 ;floating --> integer
		bcs .default
		lda _fr0
		ldx _fr0+1
		rts
.default:	lda #0
		tax
		rts
	.ENDIF



;	call an action-type routine
;	---------------------------

	.IF_REFERENCED action

action: 	sta .go+1
		stx .go+2
.go:		jsr $ffff
		lda _freslo
		ldx _freshi
		rts
	.ENDIF



	.IF_REFERENCED _add

_add:		sta _oper2
		stx _oper2+1
		lda _oper1
		clc
		adc _oper2
		sta _oper1
		lda _oper1+1
		adc _oper2+1
		tax
		lda _oper1
		rts
	.ENDIF


	.IF_REFERENCED _subtract

_subtract:	sta _oper2
		stx _oper2+1
		lda _oper1
		sec
		sbc _oper2
		sta _oper1
		lda _oper1+1
		sbc _oper2+1
		tax
		lda _oper1
		rts
	.ENDIF


	.IF_REFERENCED _multiply

_multiply:	sta _oper2
		stx _oper2+1
		lda #0
		sta	_fr0
		sta	_fr0+1
.loop:		lda	_oper2
		ora	_oper2+1
		beq	.done
		lda	_fr0
		clc
		adc	_oper1
		sta	_fr0
		lda	_fr0+1
		adc	_oper1+1
		sta	_fr0+1
		dec	_oper2
		lda	_oper2
		cmp	#$ff
		bne	.loop
		dec	_oper2+1
		jmp	.loop
.done:		lda	_fr0
		ldx	_fr0+1
		rts
	.ENDIF



	.IF_REFERENCED _divide

_divide:	sta _oper2
		stx _oper2+1
		ora _oper2+1		;must catch divide by zero!
		beq .moddone
		lda #0
		sta .result
		sta .result+1
.modloop:	lda _oper2+1		;while (oper2 <= oper1)
		cmp _oper1+1		;	oper1 -= oper2
		bcc .modok
		beq .cklow
		bcs .moddone
.cklow: 	lda _oper2
		cmp _oper1
		beq .modok
		bcs .moddone
.modok: 	lda _oper1
		sec
		sbc _oper2
		sta _oper1
		lda _oper1+1
		sbc _oper2+1
		sta _oper1+1
		inc .result
		bne .novf1
		inc .result+1
.novf1:		jmp .modloop
.moddone:	lda .result
		ldx .result+1
		rts
.result:	ds.b	2
	.ENDIF




;	.IF_REFERENCED _divide
;
;_divide:	sta _oper2
;		stx _oper2+1
;		lda _oper2
;		sta _fr0
;		lda _oper2+1
;		sta _fr0+1
;		jsr _ifp
;		jsr _fmove
;		lda _oper1
;		sta _fr0
;		lda _oper1+1
;		sta _fr0+1
;		jsr _ifp
;		jsr _fdiv
;		bcs	.error
;		jsr _fpi
;		bcs	.error
;		lda _fr0
;		ldx _fr0+1
;		rts
;.error:	lda	#0
;		tax
;		rts
;	.ENDIF


	.IF_REFERENCED _and

_and:		sta _oper2
		stx _oper2+1
		lda _oper1
		and _oper2
		sta _oper1
		lda _oper1+1
		and _oper2+1
		tax
		lda _oper1
		rts
	.ENDIF



	.IF_REFERENCED _or

_or:		sta _oper2
		stx _oper2+1
		lda _oper1
		ora _oper2
		sta _oper1
		lda _oper1+1
		ora _oper2+1
		tax
		lda _oper1
		rts
	.ENDIF


	.IF_REFERENCED _xor

_xor:		sta _oper2
		stx _oper2+1
		lda _oper1
		eor _oper2
		sta _oper1
		lda _oper1+1
		eor _oper2+1
		tax
		lda _oper1
		rts
	.ENDIF



	.IF_REFERENCED _mod

_mod:		sta _oper2
		stx _oper2+1
.modloop:	lda _oper2+1		;while (oper2 <= oper1)
		cmp _oper1+1		;	oper1 -= oper2
		bcc .modok
		beq .cklow
		bcs .moddone
.cklow: 	lda _oper2
		cmp _oper1
		beq .modok
		bcs .moddone
.modok: 	lda _oper1
		sec
		sbc _oper2
		sta _oper1
		lda _oper1+1
		sbc _oper2+1
		sta _oper1+1
		jmp .modloop
.moddone:	lda _oper1
		ldx _oper1+1
		rts
	.ENDIF



	.IF_REFERENCED _lshift

_lshift:	tay
		cpy #0
		beq .exit
.cont:		asl _oper1
		rol _oper1+1
		dey
		bne .cont
.exit:		lda _oper1
		ldx _oper1+1
		rts
	.ENDIF


	.IF_REFERENCED _rshift

_rshift:	tay
		cpy #0
		beq .exit
.cont:		lsr _oper1+1
		ror _oper1
		dey
		bne .cont
.exit:		lda _oper1
		ldx _oper1+1
		rts
	.ENDIF


	.IF_REFERENCED isdigit

isdigit:	cmp #'0'
		bcc .no
		cmp #'9'+1
		bcs .no
		lda #1
		bne .exit
.no:		lda #0
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED isalpha

isalpha:	jsr upcase
		cmp #'A'
		bcc .no
		cmp #'Z'+1
		bcs .no
		lda #1
		bne .exit
.no:		lda #0
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED islower

islower:	cmp #'a'
		bcc .no
		cmp #'z'+1
		bcs .no
		lda #1
		bne .exit
.no:		lda #0
.exit:		ldx #0
		rts
	.ENDIF





	.IF_REFERENCED zero

zero:		lda #0
		sta _parm3			;parms 1/2 already there
		jmp setblock
	.ENDIF



	.IF_REFERENCED setblock

setblock:	lda _parm1			; setblock (dest,size,val)
		clc
		adc _parm2
		sta _parm2
		lda _parm1+1
		adc _parm2+1
		sta _parm2+1
		ldy #0
		lda _parm3
.move:		sta (_parm1),y
		inc _parm1
		bne .ov1
		inc _parm1+1
.ov1:		ldx _parm1+1
		cpx _parm2+1
		bcc	.move
		ldx _parm1
		cpx _parm2
		bcc .move
		rts
	.ENDIF


	.IF_REFERENCED moveblock

moveblock:	lda _parm2		 ; MoveBlock (char *dest,*src; card size)
		clc
		adc _parm3
		sta _parm3
		lda _parm2+1
		adc _parm3+1
		sta _parm3+1
		ldy #0
.move:		lda (_parm2),y
		sta (_parm1),y
		inc _parm2
		bne .ov1
		inc _parm2+1
.ov1:		inc _parm1
		bne .ov2
		inc _parm1+1
.ov2:		lda _parm2+1
		cmp _parm3+1
		bne .move
		lda _parm2
		cmp _parm3
		bcc .move
		rts
	.ENDIF



	.IF_REFERENCED pos


pos:		ldy #0
		lda (_parm1),y
		sta .s_lth
		lda (_parm2),y
		sta .d_lth
		lda _parm1
		sta .comp+1
		lda _parm1+1
		sta .comp+2
		lda _parm2
		sta .get+1
		lda _parm2+1
		sta .get+2
		lda #1
		sta .loc
		ldy #0
		ldx #0
		jsr .up_str
		jsr .up_sub
.comp:		lda $ffff,y
		jsr upcase
		sta .temp
.get:		lda $ffff,x
		jsr upcase
		cmp .temp
		beq .match
.nomatch:	ldx #1
		inc .loc
		jsr .up_str
		jmp .comp
.match: 	jsr .up_sub
		jsr .up_str
		jmp .comp
.up_str:	iny
		cpy .s_lth
		bcc .xup
		beq .xup
		pla
		pla
		lda #0
		ldx #0
.xup:		rts
.up_sub:	inx
		cpx .d_lth
		bcc .xsub
		beq .xsub
		pla
		pla
		lda .loc
		ldx #0
.xsub:		rts
.temp:		dc.b	0
.loc:		dc.b	0
.s_lth: 	dc.b	0
.d_lth: 	dc.b	0
	.ENDIF



	.IF_REFERENCED isupper

isupper:	cmp #'A'
		bcc .no
		cmp #'Z'+1
		bcs .no
		lda #1
		bne .exit
.no:		lda #0
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED eof

eof:		jsr _getdev		;dev = dev * 16
		lda _icstat,x
		cmp #136
		beq .goteof
.noteof:	lda #0
		beq .exit
.goteof:	lda #1
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED halt

halt:		lda #1
		sta .idx
.closem:	lda .idx
		sta _parm1
		jsr close
		inc .idx
		lda .idx
		cmp #8
		bcc .closem
		ldx #$ff
		txs
		jmp ($0a)
.idx:		ds.b	1

	.ENDIF

	.IF_REFERENCED toupper

toupper:	jmp upcase
	.ENDIF


	.IF_REFERENCED upcase

upcase: 	cmp #'a'
		bcc .xupcase
		cmp #'z'+1
		beq .xupcase
		bcs .xupcase
		sec
		sbc #32
.xupcase:	rts
	.ENDIF


	.IF_REFERENCED tolower

tolower:	jmp locase
	.ENDIF


	.IF_REFERENCED locase

locase: 	cmp #'A'
		bcc .xlocase
		cmp #'Z'+1
		beq .xlocase
		bcs .xlocase
		clc
		adc #32
.xlocase:	rts
	.ENDIF




	.IF_REFERENCED _loadstr
_loadstr:	lda _parm1
		sta _sptr
		lda _parm1+1
		sta _sptr+1
		lda _parm2
		sta _dptr
		lda _parm2+1
		sta _dptr+1
		rts
	.ENDIF


	.IF_REFERENCED strc
strc:		jmp __itostr
	.ENDIF

	.IF_REFERENCED strb
strb:		jmp __itostr
	.ENDIF

	.IF_REFERENCED __itostr
__itostr:	lda _parm1
		sta _fr0
		lda _parm1+1
		sta _fr0+1
		jsr _ifp			;float it
		jsr _fasc			;to ascii
		ldy #0
.loop:		lda (_inbuff),y 	;get a byte
		php
		and #$7f			;last byte is negative
		iny
		sta (_parm2),y		;put it in string
		plp
		bpl .loop
		tya
		ldy #0
		sta (_parm2),y		;set length byte
		rts
	.ENDIF



;======================================================================
;		Floating-point support routines
;======================================================================

;	int_val = ftoi(fp_number)

	.IF_REFERENCED ftoi
ftoi:		ldx _parm1			;fp --> integer
		ldy _parm1+1
		jsr _fld0r			;load to fr0
		jsr _fpi			;to integer
		bcs .zero			;error!
		lda _fr0
		ldx _fr0+1
		rts
.zero:		lda #0
		tax
		rts
	.ENDIF


;	ftostr (fp_number, string)

	.IF_REFERENCED ftostr
ftostr: 	ldx _parm1
		ldy _parm1+1 
		jsr _fld0r
		jsr _fasc			;to ascii
		ldy #0
.loop:		lda (_inbuff),y 	;get a byte
		php
		and #$7f			;last byte is negative
		iny
		sta (_parm2),y		;put it in string
		plp
		bpl .loop
		tya
		ldy #0
		sta (_parm2),y		;set length byte
		rts
	.ENDIF



;	strtof (string, fp_number)

	.IF_REFERENCED strtof

strtof: 	lda _parm1
		sta _sptr
		lda _parm1+1
		sta _sptr+1
		jsr _toascii		;convert to asciiz string
		lda #_asciistr&$ff
		sta _inbuff
		lda #_asciistr/256
		sta _inbuff+1
		lda #0
		sta _cix
		jsr _afp			;ascii --> floating pt.
		bcs .default
		ldx _parm2
		ldy _parm2+1
		jsr _fst0r			;store it
		rts
.default:	ldy #0			;error occurred, so
		tya			; just zero it out
.deflp: 	sta (_parm2),y
		iny
		cpy #6
		bne .deflp
		rts
	.ENDIF


;	itof (int_number, fp_number)

	.IF_REFERENCED itof
itof:		lda _parm1			;int --> fp
		sta _fr0
		lda _parm1+1
		sta _fr0+1
		jsr _ifp
		ldx _parm2
		ldy _parm2+1
		jsr _fst0r			;store it
		rts
	.ENDIF


;	fadd (target_fp, fp1, fp2)

	.IF_REFERENCED fadd
fadd:		jsr __setfr01		;set up registers
		jsr _fadd
		ldx _parm1
		ldy _parm1+1
		jsr _fst0r			;store it
		rts
	.ENDIF

	.IF_REFERENCED fsub
fsub:		jsr __setfr01		;set up registers
		jsr _fsub
		ldx _parm1
		ldy _parm1+1
		jsr _fst0r			;store it
		rts
	.ENDIF


;	fdiv (target_fp, fp1, fp2)

	.IF_REFERENCED fdiv
fdiv:		jsr __setfr01		;set up registers
		jsr _fdiv
		ldx _parm1
		ldy _parm1+1
		jsr _fst0r			;store it
		rts
	.ENDIF

;	fmult (target_fp, fp1, fp2)

	.IF_REFERENCED fmult
fmult:		jsr __setfr01		;set up registers
		jsr _fmult
		ldx _parm1
		ldy _parm1+1
		jsr _fst0r			;store it
		rts
	.ENDIF

;	fsub (target_fp, fp1, fp2)

;	fmove (target_fp, source_fp)

	.IF_REFERENCED fmove
fmove:		ldy #0
.loop:		lda (_parm2),y		;just move 6 bytes
		sta (_parm1),y
		iny
		cpy #6
		bne .loop
		rts
	.ENDIF

;	fzero (fp_number);

	.IF_REFERENCED fzero
fzero:		ldy #0
		tya
.loop:		sta (_parm1),y
		iny
		cpy #6
		bne .loop
		rts
	.ENDIF


;	result = fcompare (fp1, fp2);
;
;	returns: 0 = match, 1 = fp1 > fp2, 2 = fp2 > fp1

	.IF_REFERENCED fcompare
fcompare:	ldy #0
		lda (_parm1),y
		and #$80
		sta .exp1
		lda (_parm2),y
		and #$80
		sta .exp2
		lda .exp1
		cmp .exp2
		beq .samesign		;signs match
		bcc .ex1gr			;fp1 is greater
		jmp .ex2gr			;fp2 is greater
.ex1gr: 	lda #1
		jmp .exit
.ex2gr: 	lda #2
		jmp .exit
.samesign:	lda (_parm1),y
		and #$7f
		sta .exp3
		lda (_parm2),y
		and #$7f
		sta .exp4
		lda .exp3
		cmp .exp4
		beq .sameexp		;exponents match
		bcc .fp2gr			;fp2 is greater
		jmp .fp1gr			;fp1 is greater

;	exponents match, so go thru the mantissa comparing bytes

.sameexp:	ldy #1
.seloop:	lda (_parm1),y		;compare next byte
		cmp (_parm2),y
		beq .nxtbyt
		bcc .fp2gr
		bcs .fp1gr
.nxtbyt:	iny
		cpy #6
		bne .seloop
.equal: 	lda #0			;they equal!
		beq .exit
.fp1gr: 	lda .exp1			;if minus, then reverse
		bpl .fp1ok
		lda #2
		bne .exit
.fp1ok: 	lda #1
		bne .exit
.fp2gr: 	lda .exp1			;if minus, then reverse
		bpl .fp2ok
		lda #1
		bne .exit
.fp2ok: 	lda #2
.exit:		ldx #0
		rts
.exp1:		ds.b	1
.exp2:		ds.b	1
.exp3:		ds.b	1
.exp4:		ds.b	1
	.ENDIF

;	negative (fp1);
;
;	returns: 1 = it's negative, 0 = it's positive

	.IF_REFERENCED negative
negative:	ldy #0
		lda (_parm1),y
		and #$80
		bne .neg
.pos:		lda #0
		beq .exit
.neg:		lda #1
.exit:		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED __setfr01
__setfr01:	ldx _parm2
		ldy _parm2+1
		jsr _fld0r
		ldx _parm3
		ldy _parm3+1
		jsr _fld1r
		rts
	.ENDIF


	.IF_REFERENCED _toascii

_toascii:	ldy #0
		lda (_sptr),y		;get lth byte
		sta .lth
		beq .null
		iny
		inc .lth
.loop:		lda (_sptr),y
		dey
		sta _asciistr,y
		iny
		iny
		cpy .lth
		bne .loop
.done:		ldy .lth
		dey
.rtn:		lda #$9b
		sta _asciistr,y
		rts
.null:		ldy #0
		beq .rtn

.lth:		dc.b	1

	.ENDIF


	.IF_REFERENCED call_cio
call_cio:	lda _parm1
		jsr _getdev	;dev = dev * 16
		tax		;put it in X
		jsr _CIO
		tya		;return status
		ldx #0
		rts
	.ENDIF


	.IF_REFERENCED end_of_program
end_of_program: lda #__EOP & $ff
		ldx #__EOP / 256
		rts
	.ENDIF



;	.IF_REFERENCED load_bbs			 ;load BBS routines if needed
;
;		.include   bbs_c65
;
;	.ENDIF