*
*	Strings.asm of PCQ Pascal
*	Copyright 1989 Patrick Quaid
*
*	Since PCQ strings are similar to C strings, these
*	routines are similar in operation and name to the
*	standard C stuff.
*

	XREF	_p%new
	XREF	_p%dispose

	SECTION	StringLib,CODE

	XDEF	_isupper
_isupper
	move.w	4(sp),d0
isup_	cmp.b	#'A',d0
	blt.s	1$
	cmp.b	#'Z',d0
	bgt.s	1$
	move.b	#-1,d0
	rts
1$
	moveq	#0,d0
	rts

	XDEF	_islower
_islower
	move.w	4(sp),d0
islo_	cmp.b	#'a',d0
	blt.s	1$
	cmp.b	#'z',d0
	bgt.s	1$
	move.b	#-1,d0
	rts
1$
	moveq	#0,d0
	rts

	XDEF	_isalpha
_isalpha
	move.w	4(sp),d0
	bsr	isup_
	tst.b	d0
	bne.s	1$
	move.w	4(sp),d0
	bsr	islo_
1$	rts

	XDEF	_isdigit
_isdigit
	move.w	4(sp),d0
isdig_	cmp.b	#'0',d0
	blt.s	1$
	cmp.b	#'9',d0
	bgt.s	1$
	move.b	#-1,d0
	rts
1$
	moveq	#0,d0
	rts

	XDEF	_isalnum
_isalnum
	move.w	4(sp),d0
	move.w	d0,-(sp)
	bsr	_isalpha
	addq.l	#2,sp
	tst.b	d0
	bne.s	1$
	move.w	4(sp),d0
	bsr	isdig_
1$	rts

	XDEF	_isspace
_isspace
	move.w	4(sp),d0
	cmp.b	#' ',d0
	beq.s	1$
	cmp.b	#10,d0
	beq.s	1$
	cmp.b	#13,d0
	beq.s	1$
	cmp.b	#9,d0
	beq.s	1$
	cmp.b	#12,d0
	beq.s	1$
	moveq	#0,d0
	rts
1$
	move.b	#-1,d0
	rts

	XDEF	_toupper
_toupper
	move.w	4(sp),d0
toup_	cmp.b	#'a',d0
	blt.s	1$
	cmp.b	#'z',d0
	bgt.s	1$
	and.b	#%11011111,d0
1$	rts

	XDEF	_tolower
_tolower
	move.w	4(sp),d0
tolo_	cmp.b	#'A',d0
	blt.s	1$
	cmp.b	#'Z',d0
	bgt.s	1$
	or.b	#%00100000,d0
1$	rts

	XDEF	_streq
_streq:
	move.l	4(sp),a1
	move.l	8(sp),a0
1$:
	move.b	(a1)+,d1
	move.b	(a0)+,d0
	cmp.b	d0,d1
	bne.s	2$
	tst.b	d1
	bne	1$
	moveq	#-1,d0
	rts
2$:
	moveq	#0,d0
	rts

	XDEF	_strieq
_strieq:
	move.l	4(sp),a1
	move.l	8(sp),a0
1$:
	move.b	(a1)+,d0
	bsr	toup_
	move.b	d0,d1
	move.b	(a0)+,d0
	bsr	toup_
	cmp.b	d0,d1
	bne.s	2$
	tst.b	d1
	bne	1$
	moveq	#-1,d0
	rts
2$:
	moveq	#0,d0
	rts

	XDEF	_strneq
_strneq:
	move.l	6(sp),a1
	move.l	10(sp),a0
1$:
	move.b	(a1)+,d1
	move.b	(a0)+,d0
	cmp.b	d0,d1
	bne.s	2$
	subq.w	#1,4(sp)
	beq.s	3$
	tst.b	d1
	bne	1$
3$	moveq	#-1,d0
	rts
2$:
	moveq	#0,d0
	rts

	XDEF	_strnieq
_strnieq
	move.l	6(sp),a1
	move.l	10(sp),a0
1$:
	move.b	(a1)+,d0
	bsr	toup_
	move.b	d0,d1
	move.b	(a0)+,d0
	bsr	toup_
	cmp.b	d0,d1
	bne.s	2$
	tst.b	d1
	beq.s	3$
	subq.w	#1,4(sp)
	bgt.s	1$
3$	moveq	#-1,d0
	rts
2$:
	moveq	#0,d0
	rts

	XDEF	_strcmp
_strcmp:
	move.l	4(sp),a1
	move.l	8(sp),a0
1$:
	move.b	(a0)+,d0
	move.b	(a1)+,d1
	cmp.b	d1,d0
	bne.s	2$
	tst.b	d0
	bne.s	1$
2$	sub.b	d1,d0
	ext.w	d0
	ext.l	d0
	rts

	XDEF	_stricmp
_stricmp:
	move.l	4(sp),a1
	move.l	8(sp),a0
1$:
	move.b	(a0)+,d0
	bsr	toup_
	move.b	d0,d1
	move.b	(a1)+,d0
	bsr	toup_
	cmp.b	d0,d1
	bne.s	2$
	tst.b	d0
	bne.s	1$
2$	sub.b	d1,d0
	neg.b	d0
	ext.w	d0
	ext.l	d0
	rts

	XDEF	_strncmp
_strncmp:
	move.l	6(sp),a1
	move.l	10(sp),a0
1$:
	move.b	(a0)+,d0
	move.b	(a1)+,d1
	cmp.b	d1,d0
	bne.s	2$
	subq.w	#1,4(sp)
	beq.s	2$
	tst.b	d0
	bne.s	1$
2$	sub.b	d1,d0
	ext.w	d0
	ext.l	d0
	rts

	XDEF	_strnicmp
_strnicmp:
	move.l	6(sp),a1
	move.l	10(sp),a0
1$:
	move.b	(a0)+,d0
	bsr	toup_
	move.b	d0,d1
	move.b	(a1)+,d0
	bsr	toup_
	cmp.b	d0,d1
	bne.s	2$
	subq.w	#1,4(sp)
	beq.s	2$
	tst.b	d0
	bne.s	1$
2$	sub.b	d1,d0
	neg.b	d0
	ext.w	d0
	ext.l	d0
	rts

	XDEF	_strlen
_strlen:
	move.l	4(sp),d1
	move.l	d1,a0
_in_strlen
	tst.b	(a0)+
	bne.s	_in_strlen
	move.l	a0,d0
	sub.l	d1,d0
	subq	#1,d0
	rts

	XDEF	_strcpy
_strcpy
	move.l	8(sp),a1
	move.l	4(sp),a0
1$
	move.b	(a0)+,d0
	move.b	d0,(a1)+
	bne	1$
	rts

	XDEF	_strncpy
_strncpy
	move.l	10(sp),a0
	move.l	6(sp),a1
1$
	move.b	(a1)+,d0
	move.b	d0,(a0)+
	beq.s	2$
	subq.w	#1,4(sp)
	bne.s	1$
	move.b	#0,(a0)
2$	rts

	XDEF	_strcat
_strcat
	move.l	8(sp),a0
	move.l	4(sp),a1
1$	move.b	(a0)+,d0
	bne	1$
	subq.l	#1,a0
2$	move.b	(a1)+,d0
	move.b	d0,(a0)+
	bne	2$
	rts

	XDEF	_strncat
_strncat
	move.l	10(sp),a0
	move.l	6(sp),a1
1$	tst.b	(a0)+
	bne	1$
	subq.l	#1,a0
2$	move.b	(a1)+,d0
	move.b	d0,(a0)+
	beq.s	3$
	subq.w	#1,4(sp)
	bne.s	2$
	move.b	#0,(a0)
3$	rts

	XDEF	_strpos
_strpos
	move.l	6(sp),a0
	move.w	4(sp),d0
1$	move.b	(a0)+,d1
	beq.s	2$
	cmp.b	d1,d0
	bne.s	1$
	subq.l	#1,a0
	sub.l	6(sp),a0
	move.l	a0,d0
	rts
2$	move.l	#-1,d0
	rts

	XDEF	_strrpos
_strrpos
	move.l	6(sp),a0
	move.w	4(sp),d0
1$	tst.b	(a0)+
	bne.s	1$
	subq.l	#1,a0
2$	cmp.b	-(a0),d0
	beq.s	3$
	cmp.l	6(sp),a0
	bne.s	2$
	move.l	#-1,d0
	rts
3$	sub.l	6(sp),a0
	move.l	a0,d0
	rts

	XDEF	_Hash
_Hash
	move.l	4(sp),-(sp)
	jsr	_strlen
	addq.l	#4,sp
	move.l	4(sp),a0
	moveq.l	#0,d1
1$
	move.b	(a0)+,d1
	beq.s	3$
	cmp.b	#'a',d1
	blt.s	2$
	cmp.b	#'z',d1
	bgt.s	2$
	and.b	#%11011111,d1
2$	move.w	d0,d2		; d2 := d0
	lsl.w	#2,d2		; d2 := d0 * 4
	add.w	d2,d0		; d0 := d0 + d0 * 4
	lsl.w	#1,d2		; d2 := d0 * 8
	add.w	d2,d0		; d0 := d0 * 13
	add.w	d1,d0
	and.w	#$07ff,d0
	bra	1$
3$	rts
	
	XDEF	_AllocString
_AllocString:
	jsr	_p%new
	rts

	XDEF	_FreeString
_FreeString:
	move.l	4(sp),d0
	jsr	_p%dispose
	rts

	XDEF	_strdup
_strdup
	move.l	4(sp),-(sp)	; set up param
	jsr	_strlen		; get string's length
	adda.l	#4,sp		; fix stack
	addq.l	#1,d0		; add one for null byte
	jsr	_p%new		; try to allocate
	beq.s	2$		; if it failed, continue
	move.l	d0,a1		; get new mem address
	move.l	4(sp),a0	; and old string address
1$
	move.b	(a0)+,d1	; copy one byte
	move.b	d1,(a1)+
	bne	1$		; if not finished, loop
2$	rts			; return

	END