unit strlib;
{$I-,R-,S-,V-}

interface
const
  unitID: string[19] = 'strlib #1.0 (wiz.)'#0;
function strupr(s: string): string;
function strlwr(s: string): string;
function strpack(s: string; len: byte; c: char): string;
function itoa(x: integer): string;
function utoa(x: word): string;
function ltoa(x: longint): string;
function strzero(x: word; len: byte): string;
function hex(x: longint; len: byte): string;
function strchr(s: string; c: char): byte;
function strrchr(s: string; c: char): byte;
function jstratr(s: string): string;
function jstrchr(s: string; c: word): byte;
function jstrrchr(s: string; c: word): byte;

implementation

procedure iskanji; assembler;
asm
	cmp	al,81h
	jb	@2
	cmp	al,0a0h
	jb	@1
	cmp	al,0e0h
	jb	@2
	cmp	al,0f1h
	jae	@2
@1:
	stc
	jmp	@3
@2:
	clc
@3:
end;

function strupr(s: string): string; assembler;
asm
	push	ds
	lds	si,s
	les	di,@result
	cld
	lodsb
	stosb
	mov	cl,al
	mov	ch,0
	jcxz	@3
	mov	al,ch
@1:
	call	iskanji
	lodsb
	jc	@2
	cmp	al,'a'
	jb	@2
	cmp	al,'z'
	ja	@2
	add	al,'A'-'a'
@2:	stosb
	loop	@1
@3:
	pop	ds
end;

function strlwr(s: string): string; assembler;
asm
	push	ds
	lds	si,s
	les	di,@result
	cld
	lodsb
	stosb
	mov	cl,al
	mov	ch,0
	jcxz	@3
	mov	al,ch
@1:
	call	iskanji
	lodsb
	jc	@2
	cmp	al,'A'
	jb	@2
	cmp	al,'Z'
	ja	@2
	add	al,'a'-'A'
@2:
	stosb
	loop	@1
@3:
	pop	ds
end;

function strpack(s: string; len: byte; c: char): string; assembler;
asm
	push	ds
	lds	si,s
	les	di,@result
	cld
	mov	al,len
	stosb
	mov	cl,al
	mov	ch,0
	lodsb
	cmp	cl,al
	jbe	@1
	push	ax
	sub	cl,al
	mov	al,c
	rep	stosb
	pop	cx
	mov	ch,0
@1:
	jcxz	@2
	rep	movsb
@2:
	pop	ds
end;

procedure _utoa; assembler;
asm
	mov	bx,10
@1:
	mov	dx,0
	div	bx
	add	dl,'0'
	mov	ss:[si],dl
	dec	si
	inc	cx
	or	ax,ax
	jnz	@1
end;

procedure _ltoa; assembler;
asm
	mov	cx,0
	cmp	dx,2710h
	jc	@1
	mov	byte ptr ss:[si],'E';
	dec	si
	inc	cx
	jmp	@4
@1:
	or	dx,dx
	jz	@3
	mov	bx,10000
	div	bx
	push	ax
	mov	ax,dx
	call	_utoa
	pop	ax
@2:
	cmp	cx,4
	jz	@3
	mov	byte ptr ss:[si],'0'
	dec	si
	inc	cx
	jmp	@2
@3:
	call	_utoa
@4:
end;

procedure store; assembler;
asm
	mov	ss:[si],cl
	inc	cx
	push	ds
	push	ss
	pop	ds
	cld
	rep	movsb
	pop	ds
end;

function utoa(x: word): string;
var
  s: string[6];
begin
  asm
	lea	si,s[6]
	mov	ax,x
	mov	cx,0
	call	_utoa
	les	di,@result
	call	store
  end;
end;

function itoa(x: integer): string;
var
  s: string[6];
begin
  asm
	lea	si,s[6]
	mov	ax,x
	mov	cx,0
	or	ah,ah
	js	@1
	call	_utoa
	jmp	@2
@1:
	neg	ax
	call	_utoa
	mov	byte ptr ss:[si],'-'
	dec	si
	inc	cx
@2:
	les	di,@result
	call	store
  end;
end;

function ltoa(x: longint): string;
var
  s: string[10];
begin
  asm
	lea	si,s[10]
	mov	ax,word ptr x
	mov	dx,word ptr x[2]
	or	dh,dh
	js	@1
	call	_ltoa
	jmp	@2
@1:
	not	dx
	not	ax
	add	ax,1
	adc	dx,0
	call	_ltoa
	mov	byte ptr ss:[si],'-'
	dec	si
	inc	cx
@2:
	les	di,@result
	call	store
  end;
end;

function strzero(x: word; len: byte): string; assembler;
asm
	mov	ax,x
	mov	cl,len
	mov	ch,0
	les	di,@result
	add	di,cx
	std
	jcxz	@2
	push	cx
@1:
	mov	bx,10
	mov	dx,0
	div	bx
	xchg	ax,dx
	add	al,'0'
	stosb
	xchg	ax,dx
	loop	@1
	pop	cx
@2:
	mov	al,cl
	stosb
	cld
end;

function hex(x: longint; len: byte): string; assembler;
asm
	mov	bx,word ptr x
	mov	dx,word ptr x[2]
	mov	cl,len
	mov	ch,0
	les	di,@result
	cld
	mov	al,cl
	stosb
	jcxz	@3
	mov	al,'0'
	push	cx
	rep	stosb
	pop	cx
	dec	di
	std
@1:
	push	cx
	mov	al,bl
	and	al,0fh
	cmp	al,10
	jb	@2
	add	al,7
@2:
	add	al,'0'
	stosb
	mov	al,dl
	mov	cl,4
	shr	bx,cl
	shr	dx,cl
	shl	al,cl
	or	bh,al
	pop	cx
	loop	@1
@3:
end;

function strchr(s: string; c: char): byte; assembler;
asm
	les	di,s
	cld
	mov	al,es:[di]
	inc	di
	mov	cl,al
	mov	ch,0
	mov	ah,al
	jcxz	@1
	mov	al,c
	repnz	scasb
	mov	al,0
	jnz	@1
	mov	al,ah
	sub	al,cl
@1:
end;

function strrchr(s: string; c: char): byte; assembler;
asm
	les	di,s
	mov	al,es:[di]
	mov	cl,al
	mov	ch,0
	jcxz	@1
	mov	al,c
	add	di,cx
	std
	repnz	scasb
	mov	al,0
	jnz	@1
	mov	al,cl
	inc	al
@1:
end;

function jstratr(s: string): string; assembler;
asm
	push	ds
	lds	si,s
	les	di,@result
	cld
	lodsb
	stosb
	mov	cl,al
	mov	ch,0
	jcxz	@3
@1:
	lodsb
	call	iskanji
	mov	al,'0'
	jnc	@2
	mov	al,'1'
	stosb
	inc	ax
	inc	si
@2:
	stosb
	loop	@1
@3:
	pop	ds
end;

function jstrchr(s: string; c: word): byte; assembler;
asm
	les	si,s
	mov	bx,1
	mov	cl,es:[si]
@1:
	mov	ch,bl
	cmp	bl,cl
	mov	al,0
	ja	@3
	mov	ax,es:[si][bx]
	inc	bx
	call	iskanji
	jnc	@2
	xchg	ah,al
	inc	bx
@2:
	cmp	ax,c
	jnz	@1
	mov	al,ch
@3:
end;

function jstrrchr(s: string; c: word): byte; assembler;
asm
	les	si,s
	mov	bx,1
	mov	cl,es:[si]
	mov	ch,0
@1:
	mov	dl,bl
	cmp	bl,cl
	ja	@3
	mov	ax,es:[si][bx]
	inc	bx
	call	iskanji
	jnc	@2
	xchg	ah,al
	inc	bx
@2:
	cmp	ax,c
	jnz	@1
	mov	ch,dl
	jmp	@1
@3:
	mov	al,ch
end;

end.