CASE	OBJECT 

;-----------------------------------------------
;
;   Imported addresses
;
;-----------------------------------------------

	IMPORT	Clxbintab
	IMPORT	Clxdata
	IMPORT	Clxflag
	IMPORT	Clxflags
	IMPORT	Clxlettab
	IMPORT	Clxsword
	IMPORT	doingins
	IMPORT	rankalt
	IMPORT	strcmp
	IMPORT	theclxword
*****************************************************************
*
*   CLXASM.SRC - Various routines from clx.c I hand-coded
*
*   Robert A. Hearn
*
*****************************************************************

		load 'macros.dump'

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

clxgetbin	PROC		EXPORT

CLX_COMMON	equ 1

		input func:l,bin:w,bs:w
		local tmp:w,bt:w,gn:w,cdptr:l,endptr:l,binend:l
		local tptr:l,flags:l
		output result:w

		begin

		stz result
		movelong Clxdata,tptr
		movelong [tptr],cdptr
		movelong cdptr,binend
		movelong Clxbintab,tptr
		lda bin
		asl a
		tay
		lda [tptr],y
		eval '.+cdptr'
		sta cdptr
		iny
		iny
		lda [tptr],y
		eval '.+binend'
		sta binend
		movelong Clxlettab,tptr
		movelong Clxflags,flags

		movelong #theclxword,endptr
		stz gn
loop0	;{
loop1	dec bs
		bmi out
;		{
		stz tmp
		lda gn
		beq loop2
		lda bt
		and #$0f
		sta tmp
		cmp #$0f
		beq loop2
;		{
		stz gn
		tay
		moveword [tptr]:y,[endptr]
		inc endptr
		bra loop1
;		}
loop2	;{
		lda [cdptr]
		inc cdptr
		and #$ff
		sta bt
		cmp #$f0
		bpl else1
;		{
		inc gn
		lsr a
		lsr a
		lsr a
		lsr a
		eval '.+tmp'
		tay
		lda [tptr],y
		sta [endptr]
		inc endptr
		bra loop1
;		}
else1	cmp #$ff
		beq else2
;		{
		stz gn
		eval '.+tmp.-#$e1'
		tay
		lda [tptr],y
		sta [endptr]
		inc endptr
		bra loop1
;		}
else2	eval 'tmp.+#$1e'
		sta tmp
		bra loop2
;		}
;		}
out	lda #0
		sta [endptr]

		cmpw cdptr,binend
		bne else3
callit	;{
		moveword func,slot+1
		moveword func+1,slot+2
		pha
		pushlong #theclxword
		pea CLX_COMMON
slot	jsl >0
		pla
		beq bad
		inc result
bad	brl done
;		}
else3	lda gn
		beq else4
;		{
		stz gn
		lda bt
		and #$0f
		sta tmp
		bne callit2
;		{
		moveword func,slot2+1
		moveword func+1,slot2+2
		pha
		pushlong #theclxword
		lda [cdptr]
		inc cdptr
		and #$ff
		sta bt
		lsr a
		lsr a
		lsr a
		lsr a
		tay
		lda [flags],y
		and #$ff
		pha
slot2	jsl >0
		pla
		beq keepgoing
		inc result
		brl done
keepgoing	cmpw cdptr,binend
		bne still
		brl done
still	lda bt
		and #$0f
		sta tmp
		brl next
;		}
;		}
callit2	;{
		moveword func,slot4+1
		moveword func+1,slot4+2
		pha
		pushlong #theclxword
		pea CLX_COMMON
slot4	jsl >0
		pla
		bne good2
		brl next
good2	inc result
		brl done
;		}
else4	;{
		inc gn
		lda [cdptr]
		inc cdptr
		and #$ff
		sta bt
		lsr a
		lsr a
		lsr a
		lsr a
		sta tmp
		beq _ok
		bra callit2
_ok	;{
		moveword func,slot3+1
		moveword func+1,slot3+2
		pha
		pushlong #theclxword
		lda bt
		and #$0f
		tay
		lda [flags],y
		and #$ff
		pha
slot3	jsl >0
		pla
		beq keepon
		inc result
		bra done
keepon	cmpw cdptr,binend
		beq done
		lda [cdptr]
		inc cdptr
		and #$ff
		sta bt
		lsr a
		lsr a
		lsr a
		lsr a
		sta tmp
;		}
;		}
next	moveword tmp,bs
		eval 'endptr.-tmp'
		sta endptr
		brl loop0
;		}

done	return

		ENDP

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

typoins	PROC		EXPORT

		input word:l,flag:w
		output result:w
		local str1:l,str2:l,inscnt:w

		begin

		stz result
		lda doingins
		bne yes
no	movelong word,str1
		movelong Clxsword,str2
		bra goahead
yes	movelong Clxsword,str1
		movelong word,str2

goahead	stz inscnt
		shortm
loop	lda [str2]
		beq out
;		{
		lda [str1]
		cmp [str2]
		longm
		beq next
;		{
		lda inscnt
		bne done
		inc inscnt
		dec str2
;		}
next	inc str1
		inc str2
		shortm
		bra loop
;		}
out	longm
		pushword flag
		lda doingins
		bne omit
		pea $ffdd
		bra goon
omit	pea $ffcd
goon	pushlong word
		jsl rankalt
		ply
		ply
		ply
		ply

done	return

		ENDP

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

typosub	PROC		EXPORT

		input word:l,flag:w
		output result:w
		local str1:l,str2:l,retval:w,cptr:l

		begin

		movelong Clxsword,cptr
		movelong Clxsword,str1
		movelong word,str2
		stz result

loop	;{
		lda #0
		shortm
		lda [str2]
		cmp [str1]
		bne break
;		{
		longm
		inc str1
		inc str2
		cmp #0
		bne loop
		pushword flag
		pea $ffff
		pushlong word
		jsl rankalt
		ply
		ply
		ply
		ply
		brl done
;		}
;		}
break	ldy #1
		lda [str1],y
		cmp [str2],y
		longm
		bne else
;		{
		moveword #$ffb8,retval
		bra preloop
;		}
else	;{
		lda [str1]
		xba
		cmp [str2]
		beq _ok
		bra done
_ok	inc str1
		inc str2
		moveword #$fff6,retval
;		}
preloop	inc str1
		inc str2
loop2	;{
		lda #0
		shortm
		lda [str1]
		cmp [str2]
		longm
		bne done
		inc str1
		inc str2
		cmp #0
		bne loop2
;		{
		cmpw retval,#$ffb8
		bne nosu1
		shortm
		lda [word]
		cmp [cptr]
		longm
		beq nosu1
		moveword #$ffc8,retval
nosu1	pushword flag
		pushword retval
		pushlong word
		jsl rankalt
		ply
		ply
		ply
		ply
;		}
;		}

done	return

		ENDP

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

clxffunc	PROC		EXPORT

		input word:l,flag:w
		output result:w

		begin

		stz result
		pushlong Clxsword
		pushlong word
		jsl strcmp
		ply
		ply
		ply
		ply
		cmp #0
		bmi done
		bne good
		moveword flag,Clxflag
good	inc result
done	return

		ENDP
		END