unit ctype;

{$I-,R-,S-,V-}

interface
const
  unitID: string[18] = 'ctype #1.2 (wiz.)'#0;
function isalpha(c: char): boolean;
function isupper(c: char): boolean;
function islower(c: char): boolean;
function isdigit(c: char): boolean;
function isxdigit(c: char): boolean;
function isspace(c: char): boolean;
function ispunct(c: char): boolean;
function isalnum(c: char): boolean;
function iscntrl(c: char): boolean;
function toupper(c: char): char;
function tolower(c: char): char;
function iskanji(c: char): boolean;
function iskanji2(c: char): boolean;
function jistojms(c: word): word;
function jmstojis(c: word): word;

implementation

function isalpha(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,'A'
	jb	@f
	cmp	al,'Z'
	jbe	@t
	cmp	al,'a'
	jb	@f
	cmp	al,'z'
	jbe	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function isupper(c: char): boolean; assembler;
asm
	mov	al,c
	sub	al,'A'
	cmp	al,'Z'-'A'
	mov	al,0
	ja	@exit
	inc	ax
@exit:
end;

function islower(c: char): boolean; assembler;
asm
	mov	al,c
	sub	al,'a'
	cmp	al,'z'-'a'
	mov	al,0
	ja	@exit
	inc	ax
@exit:
end;

function isdigit(c: char): boolean; assembler;
asm
	mov	al,c
	sub	al,'0'
	cmp	al,'9'-'0'
	mov	al,0
	ja	@exit
	inc	ax
@exit:
end;

function isxdigit(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,'0'
	jb	@f
	cmp	al,'9'
	jbe	@t
	cmp	al,'A'
	jb	@f
	cmp	al,'F'
	jbe	@t
	cmp	al,'a'
	jb	@f
	cmp	al,'f'
	jbe	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function isspace(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,' '
	je	@t
	cmp	al,9
	jb	@f
	cmp	al,13
	ja	@f
@t:
	mov	al,1
	jmp	@exit
@f:
	mov	al,0
@exit:
end;

function ispunct(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,'!'
	jb	@f
	cmp	al,'/'
	jbe	@t
	cmp	al,':'
	jb	@f
	cmp	al,'@'
	jbe	@t
	cmp	al,'['
	jb	@f
	cmp	al,'`'
	jbe	@t
	cmp	al,'{'
	jb	@f
	cmp	al,'~'
	jbe	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function isalnum(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,'0'
	jb	@f
	cmp	al,'9'
	jbe	@t
	cmp	al,'A'
	jb	@f
	cmp	al,'Z'
	jbe	@t
	cmp	al,'a'
	jb	@f
	cmp	al,'z'
	jbe	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function iscntrl(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,7fh
	je	@t
	cmp	al,' '
	jb	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function toupper(c: char): char; assembler;
asm
	mov	al,c
	cmp	al,'a'
	jb	@exit
	cmp	al,'z'
	ja	@exit
	add	al,'A'-'a'
@exit:
end;

function tolower(c: char): char; assembler;
asm
	mov	al,c
	cmp	al,'A'
	jb	@exit
	cmp	al,'Z'
	ja	@exit
	add	al,'a'-'A'
@exit:
end;

function iskanji(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,81h
	jb	@f
	cmp	al,09fh
	jbe	@t
	cmp	al,0e0h
	jb	@f
	cmp	al,0f0h
	jbe	@t
@f:
	mov	al,0
	jmp	@exit
@t:
	mov	al,1
@exit:
end;

function iskanji2(c: char): boolean; assembler;
asm
	mov	al,c
	cmp	al,40h
	jb	@f
	cmp	al,0fch
	ja	@f
	cmp	al,7fh
	je	@f
@t:
	mov	al,1
	jmp	@exit
@f:
	mov	al,0
@exit:
end;

function jistojms(c: word): word; assembler;
asm
	mov	ax,c
@1:
	add	al,7eh
	test	ah,1
	jz	@2
	sub	al,5fh
	cmp	al,7fh
	jb	@2
	inc	al
@2:
	sub	ah,21h
	shr	ah,1
	add	ah,81h
	cmp	ah,0a0h
	jb	@3
	add	ah,40H
@3:
end;

function jmstojis(c: word): word; assembler;
asm
	mov	ax,c
	or	ah,ah
	jz	@3
	cmp	ah,0e0h
	jb	@1
	sub	ah,40h
@1:
	sub	ah,70h
	shl	ah,1
	cmp	al,9fh
	jb	@2
	sub	al,7eh
	jmp	@3
@2:
	dec	ah
	sub	al,1fh
	cmp	al,61h
	jb	@3
	dec	al
@3:
end;

end.