;
; ctype.s
;
; A ctype implementation done the proper way
;
;  1995 Straylight
;

;----- Standard header ------------------------------------------------------

		GET	libs:header
		GET	libs:swis

		GET	libs:stream

;----- External dependencies ------------------------------------------------



;----- Main code ------------------------------------------------------------

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- Character table format ---
;
; The table consists of halfword entries, which have the following format:
;
;   Bit		Meaning
;    0		whitespace
;    1		punctuation
;    2		blank
;    3		lower case
;    4		upper case
;    5		digit
;    6		control character
;    7		hex digit

; --- ctype_init ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Sets up the character translation table.

		EXPORT	ctype_init
ctype_init	ROUT

		STMFD	R13!,{R0-R5,R14}	;Save some registers
		ADR	R2,ctype__table		;Point to the main table
		ADR	R3,ctype__terrTrans	;Point to territory decode

10		LDRB	R1,[R3],#1		;Load property number
		CMP	R1,#255			;Is this the end?
		BEQ	%f10			;Yes -- return then
		MOV	R0,#-1			;Get the current territory
		SWI	XTerritory_CharacterPropertyTable
		BVS	%90ctype_init		;If not there, quit now
		LDRB	R1,[R3],#1		;Load the bit number

		MOV	R4,#0			;Initialise a counter
00		TST	R4,#&1F000000		;Run out of bits?
		LDREQ	R5,[R0],#4		;Yes -- load some more then
		MOVS	R5,R5,LSR #1		;Put a bit in carry
		LDRB	R14,[R2,R4,LSR #24]	;Load the byte
		BICCC	R14,R14,R1		;Maybe clear the bit
		ORRCS	R14,R14,R1		;Maybe set it
		STRB	R14,[R2,R4,LSR #24]	;Store the byte back
		ADDS	R4,R4,#&01000000	;Increment the counter
		BCC	%b00			;And loop until done
		B	%b10			;Skip back for next bit

10		MOV	R0,#-1			;Use current territory
		SWI	XTerritory_UpperCaseTable ;Find upper case table
		MOVVC	R1,R0			;Remember this value
		MOVVC	R0,#-1			;Current territory again
		SWIVC	XTerritory_LowerCaseTable ;And get the lower table
		BVS	%90ctype_init		;If not there, quit now

		MOV	R3,#0			;Get a counter going
00		LDRB	R14,[R2],#1		;Load the flags byte
		MOVS	R14,R14,LSL #28		;Put letter bits away
		LDRCSB	R14,[R0,R3,LSR #24]	;If uppercase, get lower
		LDRMIB	R14,[R1,R3,LSR #24]	;Otherwise get upper
		STRB	R14,[R2,#255]		;Store in the table nicely
		ADDS	R3,R3,#&01000000	;Move pointers on
		BCC	%b00			;And keep going until done

90ctype_init	LDMFD	R13!,{R0-R5,PC}^	;Return when finished

S		EQU	1
P		EQU	2
B		EQU	4
L		EQU	8
U		EQU	16
D		EQU	32
C		EQU	64
X		EQU	128

ctype__terrTrans DCB	0,C
		DCB	1,U
		DCB	2,L
		DCB	4,P
		DCB	5,S
		DCB	6,D
		DCB	7,X
		DCB	255,255

		DCD     0
ctype__table	DCB	C,   C,   C,   C,	C,   C,   C,   C
		DCB	C+S, C+S, C+S, C+S,	C+S, C+S, C,   C
		DCB	C,   C,   C,   C,	C,   C,   C,   C
		DCB	C,   C,   C,   C,	C,   C,   C,   C
		DCB	B,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	D,   D,   D,   D,	D,   D,   D,   D
		DCB	D,   D,   P,   P,	P,   P,   P,   P
		DCB	P,   U+X, U+X, U+X,	U+X, U+X, U+X, U
		DCB	U,   U,   U,   U,	U,   U,   U,   U
		DCB	U,   U,   U,   U,	U,   U,   U,   U
		DCB	U,   U,   U,   P,	P,   P,   P,   P
		DCB	P,   L+X, L+X, L+X,	L+X, L+X, L+X, L
		DCB	L,   L,   L,   L,	L,   L,   L,   L
		DCB	L,   L,   L,   L,	L,   L,   L,   L
		DCB	L,   L,   L,   P,	P,   P,   P,   C

		DCB	P,   P,   P,   P,	P,   U,   L,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   U,   L,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	P,   P,   P,   P,	P,   P,   P,   P
		DCB	U,   U,   U,   U,	U,   U,   U,   U
		DCB	U,   U,   U,   U,	U,   U,   U,   U
		DCB	U,   U,   U,   U,	U,   U,   U,   P
		DCB	U,   U,   U,   U,	U,   U,   U,   L
		DCB	L,   L,   L,   L,	L,   L,   L,   L
		DCB	L,   L,   L,   L,	L,   L,   L,   L
		DCB	L,   L,   L,   L,	L,   L,   L,   P
		DCB	L,   L,   L,   L,	L,   L,   L,   L

		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   'a', 'b', 'c',	'd', 'e', 'f', 'g'
		DCB	'h', 'i', 'j', 'k',	'l', 'm', 'n', 'o'
		DCB	'p', 'q', 'r', 's',	't', 'u', 'v', 'w'
		DCB	'x', 'y', 'z', 0,	0,   0,   0,   0
		DCB	0,   'A', 'B', 'C',	'D', 'E', 'F', 'G'
		DCB	'H', 'I', 'J', 'K',	'L', 'M', 'N', 'O'
		DCB	'P', 'Q', 'R', 'S',	'T', 'I', 'V', 'W'
		DCB	'X', 'Y', 'Z', 0,	0,   0,   0,   0

		DCB	0,   0,   0,   0,	0,   '', '',  0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   '', '',	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	0,   0,   0,   0,	0,   0,   0,   0
		DCB	'', '', '', '',	'', '', '', ''
		DCB	'', '', '', '',	'', '', '', ''
		DCB	'', '', '', '',	'', '', '', 0
		DCB	'', '', '', '',	'', '', '', ''
		DCB	'', '', '', '',	'', '', '', ''
		DCB	'', '', '', '',	'', '', '', ''
		DCB	'', '', '', '',	'', '', '', 0
		DCB	'', '', '', '',	'', '', '', 'Y'

		LTORG

; --- ctype_findTable ---
;
; On entry:	--
;
; On exit:	R0 == pointer to table
;
; Use:		Finds the character table.

		EXPORT	ctype_findTable
ctype_findTable	ROUT

		ADRL	R0,ctype__table
		MOVS	PC,R14

		LTORG

; --- Other ctype routines ---

		EXPORT	toupper
toupper		ADRL	R1,ctype__table
		LDRB	R2,[R1,R0]!
		TST	R2,#L
		LDRNEB	R0,[R1,#256]
		MOVS	PC,R14

		EXPORT	tolower
tolower		ADRL	R1,ctype__table
		LDRB	R2,[R1,R0]!
		TST	R2,#U
		LDRNEB	R0,[R1,#256]
		MOVS	PC,R14

;----- That's all, folks ----------------------------------------------------

		END
