.TITLE	CABF - Convert ASCII to Binary Formatted
.IDENT	/060983/
.ENABL	LC
;
;
;	Written by	Bruce McClenahan
;			 6-Sep-83
;
;	Version		140783/02
;
;
;-----------------------------------------------------------------------------
;
; This module contains the CABF macro and subroutine. The user may envoke the
; macro (or call the subroutine directly) to cause the ASCII representation of
; an OCTAL, DECIMAL, HEXADECIMAL or RAD50 value to be converted to its 16-bit
; value.
;
; The subroutine allows a number to be read in free-format mode where leading
; non-radix characters are skipped or in fixed-format mode where the number of
; characters to be read is specified.
;
; Lower case characters are treated as upper case in the conversion process.
;
;
.SBTTL	Modifications
;
;  6-Sep-83	Place code in CODE PSECT
;
;

.SBTTL	Documentation	...	Register usage and argument passing
;
; At entry, the CABF routine expects
;
;	R1	to hold the address of the input STRING
;	R2	to hold the FORMAT word
;
;
; At exit
;
;	R0	contains the value of the ASCII string
;
;	R1	points to the character following the last character converted
;
;	PSW	the "C" flag is set iff an error was detected.
;		The C flag will be set if, in free-field mode, the number was
;		too large to represent in 16 bits, or if, in fixed-field mode,
;		an out-of-radix character was encountered before the specified
;		number of characters had been read.
;
; All other registers are preserved by the routine.
;
;
; The FORMAT word, passed over in R2, consists of a 2-bit RADIX code (in the
; least significant 2 bits) and the number of characters to be read (in bits 
; 2 - 15).
;
; The RADIX code selects the radix to be used in the conversion.
; The codes are
;
;	0	-->	Octal
;	1	-->	Decimal
;	2	-->	Hexadecimal
;	3	-->	Radix-50
;
; If the number of characters to be read is non-zero, fixed-field mode is used
; to read them in. If the number is zero, free-field mode is used, and the
; routine skips leading spaces then converts characters until a non-radix 
; character is encountered or an overflow occurs in the conversion.
;
;

.SBTTL	Documentation	...	CABF macro
;
; The CABF macro is included to simplify usage of this module.
; The macro can be extracted from this module using the LIBR librarian.
;
; The macro format is
;
;	CABF	[FIELD] [RADIX] [NUMBER] [STRING] [REGSAV]
;
; The macro will automatically declare CABF to be a global symbol. If no 
; arguments are specified, the macro expands to a CALL to CABF and the user
; must set up all registers.
;
; The [FIELD] argument is used to specify the format used in decoding the
; input string and the radix to be used. The [RADIX] argument can be specified
; only if the [FIELD] is specified. It is not necessary but is included to
; allow the user to explicitly specify the radix. The [RADIX] can be replaced
; with one of the strings OCTAL, DECIMAL, HEX or RAD50.
;
; The [NUMBER] argument specifies the destination of the result and defaults
; to R0.
;
; The [STRING] argument specifies the start address of the ASCIZ string to be
; converted. If not specified, the address is assumed to be in R1.
;
; The [REGSAV] argument, if given a value other than NO, causes the macro to
; preserve the registers R0, R1 and R2.
;
;

.SBTTL	Documentation	...	CABF macro [FIELD] argument
;
; The [FIELD] argument is a string consisting of the following characters
;
;	O D H R	-->	specify fixed-format size & radix
;
;	F	-->	specify free-format
;
; The first character in the [FIELD] string determines the format to be used.
;
; If the first character in the [FIELD] string is an "F" , free format will be
; used in the conversion. The radix may be specified by following
; the F with a radix character or by the [RADIX] argument. In free
; format mode, the input string will be scanned until a valid character for 
; the specified radix is found. The conversion will then take place until
; either end-of-string is reached, an out-of-radix character is encountered or
; an overflow occurs in the conversion process.
;
; If the first character in the [FIELD] string is a radix specifier, fixed
; format will be used in the conversion. The number of characters in the 
; [FIELD] string will determine the number of characters to be read from the 
; input string. In fixed-format mode, the specified number of characters are
; read from the input string unless end-of-string or an out-of-radix character
; is encountered first. An embedded space is treated as a zero.
;
; The following examples demonstrate the use of the [FIELD] argument.
;
;	STRING		FIELD		RESULT
;
;	10000		DDD		100.
;	10000		DDDDD		10000.
;
;	1   0		DDDDD		10000.
;	100<0>		DDDDD		100.
;	100M		DDDDD		100.	+ C set (bad character)
;
;	10000<0>	FD		10000.
;	10000.		FD		10000.
;	  100#		FD		100.
;	100000		FD		10000.	+ C set (overflow)
;
;	TEST.MAC	RRR		^RTES
;	T.MAC		RRR		^RT	+ C set (bad character)
;
;

.SBTTL	Definition	CABF	Macro	Convert ASCII --> number
;
; The caller should envoke the CABF routine via the CABF macro. 
;
; The macro format is
;
;		CABF [FIELD] [RADIX] [NUMBER] [STRING] [REGSAV]
;
;	where
;
;		[FIELD] is an optional field specifer string
;		[RADIX] is an optional radix specifier
;		[NUMBER] is the number to be converted (optional)
;		[STRING] is the address of the output buffer (optional)
;		[REGSAV] if not ommitted or "NO", causes reg preservation
;
;
; The macro functions as follows
;
;	If [REGSAV] is not ommitted or identical to "NO",
;	registers R0-R2 are saved on the stack and later
;	restored. These registers are used for argument passing.
;
;	If [NUMBER] and/or [STRING] are specified then the
;	R0/R1 registers are set up.
;
;	The [FIELD] string is decoded and the resulting format
;	word built up.
;
;	If [RADIX] is specified, the radix code is added to the
;	format word.
;
;	The CABF routine is envoked via a CALL.
;
;
;

.MACRO	CABF	FIELD,RADIX,NUMBER=R0,STRING=R1,REGSAV=NO
	.GLOBL	CABF
	.IF	DIF,REGSAV,NO
		MOV	R0,-(SP)
		MOV	R1,-(SP)
		MOV	R2,-(SP)
	.ENDC
	.IIF	DIF,STRING,R1,	MOV	STRING,R1
	.IF	NB,FIELD
		ZZZZZB	= 0
		ZZZZZI	= -1
		ZZZZZR	= -1
		.IRPC	X,<FIELD>
			ZZZZZA = -1
			.IIF	IDN,X,O,	ZZZZZA = 1
			.IIF	IDN,X,D,	ZZZZZA = 1
			.IIF	IDN,X,H,	ZZZZZA = 1
			.IIF	IDN,X,R,	ZZZZZA = 1
			.IF	NZ,ZZZZZA+1
				.IF	Z,ZZZZZR+1
					.IIF IDN,X,O,	ZZZZZR = 0
					.IIF IDN,X,D,	ZZZZZR = 1
					.IIF IDN,X,H,	ZZZZZR = 2
					.IIF IDN,X,R,	ZZZZZR = 3
				.ENDC
			.ENDC
			.IIF	IDN,X,F,	ZZZZZA	= 0
			.IF	Z,ZZZZZA+1
				.ERROR FIELD ;	ILLEGAL  F I E L D  SPECIFIER
				.MEXIT
			.ENDC
			.IIF	Z,ZZZZZI+1,	ZZZZZI	= ZZZZZA
			ZZZZZB	= ZZZZZB + ZZZZZI
		.ENDR
		.IF	NB,RADIX
			.IF	Z,ZZZZZR+1
				.IIF	IDN,RADIX,OCTAL,	ZZZZZR = 0
				.IIF	IDN,RADIX,DECIMAL,	ZZZZZR = 1
				.IIF	IDN,RADIX,HEX,		ZZZZZR = 2
				.IIF	IDN,RADIX,RAD50,	ZZZZZR = 3
			.ENDC
		.ENDC
		.IF	Z,ZZZZZR+1
			.ERROR	RADIX	;	ILLEGAL  R A D I X  SPECIFIER
			.MEXIT
		.ENDC
		MOV	#<<ZZZZZB*4>!ZZZZZR>,R2
	.ENDC
	CALL	CABF
	.IIF	DIF,NUMBER,R0,	MOV	R0,NUMBER
	.IF	DIF,REGSAV,NO
		MOV	(SP)+,R2
		MOV	(SP)+,R1
		MOV	(SP)+,R0
	.ENDC
.ENDM	CABF
;
;

.SBTTL	Declarations
;
.GLOBL	CABF				; Entry point
;
;
	.PSECT	CODE
;	======	====
;
;
.SBTTL	Routine		CABF	ASCII string @R1 -> Binary R0 
;
;
; Save all registers except R0 and R1
;
CABF:	.IRP	X,<2,3,4,5>		;	---- For all registers ----
		MOV	R'X,-(SP)	;		save register
	.ENDR				;	---------------------------
;
;
; Set up registers such that
;
;	R0 =	Initial result 	= 0
;	R2 =	Field length: 0	-> Skip leading spaces
;	R4 =	<Radix code>*2 	(table offset)
;
;
	CLR	R0			;	Initialize result
	MOV	R2,R4			; R4 =	Format word
	BIC	#^C3,R4			;	 Leave radix specifier only
	ASL	R4			; R4 =	2 * Radix code (table offset)
	ASR	R2			; R2 =	Field
	ASR	R2			;	 length
;
;

.SBTTL	Code		...	Scanning loop
;
1000$:	MOVB	(R1),R3			; R3 =	Character from string
	BEQ	8000$			;	 End of string -> done
	CMPB	R3,#'a			;	Lower case ?
	BLO	2000$			;	 No --> skip
	CMPB	R3,#'z			;	Lower case ?
	BHI	2000$			;	 No --> skip
	BICB	#40,R3			;	Convert to upper case
;
; Scan character decode table for specified radix
;
2000$:	MOV	CHRTAB(R4),R5		; R5 ->	Character decode table
;
2100$:	CMPB	R3,(R5)			;	Check char against low limit
	BLO	2200$			;	 Below -> skip
	CMPB	R3,1(R5)		;	Check char against high limit
	BHI	2200$			;	 Above -> skip
;
	SUB	2(R5),R3		;	In range -> subtract offset
	BR	4000$			;	 Skip to process character
;
2200$:	ADD	#4,R5			; R5 -> Next entry
	TST	(R5)			;	EOT ?
	BNE	2100$			;	 No --> loop
;
; Have detected an illegal character - decide what to do
;
3000$:	TST	R2			;	Test format word
	BGT	3100$			;	 Fixed field -> skip
	BMI	8000$			;	 Looking for end -> done
	CMPB	R3,#40			;
	BGT	9000$			;
	INC	R1			;	Free field -> get next char
	BR	1000$			;	Loop back to process
;
3100$:	SUB	#40,R3			;	Space ?
	BEQ	4000$			;	 Yes -> treat as 0
	CALL	R50FIX			;	 No --> fix up RAD50 value
	BR	9000$			;	Exit - carry set
;
; Have read in character successfully - character in range for current base
;
4000$:	CMP	R0,OVFTAB(R4)		;	Will multiply cause overflow ?
	BHIS	9000$			;	 Yes -> exit
	CALL	@MULTAB(R4)		;	Multiply current result
	ADD	R3,R0			;	Add new value
	BCS	9000$			;	 Overflow -> exit
4100$:	INC	R1			; R1 ->	Next character
	SOB	R2,1000$		;	Loop till done
;
;

.SBTTL	Code		...	Exit
;
8000$:	CALL	R50FIX			;	Massage RAD50 result
;
;
; Normal exit point - Clear CARRY and restore registers
;
	TST	(PC)+			;	Clear carry and skip
;
; Error exit point - Set CARRY and restore registers
;
9000$:	SEC				;	Set carry
;
;
; Restore registers R2 - R5
;
	.IRP	X,<5,4,3,2>		;	--- For all registers ---
		MOV	(SP)+,R'X	;	    restore register
	.ENDR				;	-------------------------
;
	RETURN				; Done
;
;
R50FIX:	CMP	R4,#6			;	RAD50 conversion ?
	BNE	2000$			;	 No --> done
	TST	R0			;	Zero result ?
	BEQ	2000$			;	 Yes -> done
;
1000$:	CMP	R0,#^RA  		;	Character in first position ?
	BHIS	2000$			;	 Yes -> exit
	CALL	R50MUL			;	 No --> shift left
	BR	1000$			;	  Loop till done
;
2000$:	RETURN				; Done
;
;

.SBTTL	Routines	...	Radix multiplication
;
MULTAB:	.WORD	OCTMUL			; R0 =	R0 * 8.		Octal
	.WORD	DECMUL			; R0 =	R0 * 10.	Decimal
	.WORD	HEXMUL			; R0 =	R0 * 16.	Hex
	.WORD	R50MUL			; R0 =	R0 * 50		RAD50
;
;
HEXMUL:	ASL	R0			; R0 =	R0 * 2	Entry for R0 * 16.
OCTMUL:	ASL	R0			; R0 =	R0 * 2	Entry for R0 * 8.
	ASL	R0			; R0 =	R0 * 2
	ASL	R0			; R0 =	R0 * 2
	RETURN				; Done
;
;
R50MUL:	ASL	R0			; R0 =	R0 * 2	Entry for R0 * 40.
	ASL	R0			; R0 =	R0 * 2
DECMUL:	ASL	R0			; R0 =	R0 * 2	Entry for R0 * 10.
	MOV	R0,-(SP)		;	Push R0
	ASL	R0			; R0 =	R0 * 2
	ASL	R0			; R0 =	R0 * 2
	ADD	(SP)+,R0		; R0 =	R0 + <R0/4>
	RETURN				; Done
;
;

.SBTTL	Table		OVFTAB	Overflow values
;
OVFTAB:	.WORD	20000			;	Octal
	.WORD	6554.			;	Decimal
	.WORD	10000			;	Hex
	.WORD	^RA  			;	RAD50
;
;
.SBTTL	Tables		...	CHRTAB, DIGTAB, R50TAB
;
; This table determines which character set is to be used for each radix 
; when converting to ASCII.
;
CHRTAB:	.WORD	OCTTAB			;	Octal
	.WORD	DECTAB			;	Decimal
	.WORD	HEXTAB			;	Hex
	.WORD	R50TAB			;	RAD50
;
;
HEXTAB:	.WORD	<'A + <'F * 400>>,<'A - 10.>	;	Hex digits
DECTAB:	.WORD	<'8 + <'9 * 400>>,<'0>		;	Decimal digits
OCTTAB:	.WORD	<'0 + <'7 * 400>>,<'0>		;	Octal digits
	.WORD	0				; EOT
;
R50TAB:	.WORD	<40 + <40 * 400>>,<40>		;	RAD50 characters
	.WORD	<'A + <'Z * 400>>,<'A - 1>	;
	.WORD	<'$ + <'$ * 400>>,<'$ - 27.>	;
	.WORD	<'% + <'% * 400>>,<'% - 28.>	;
	.WORD	<'* + <'* * 400>>,<'* - 29.>	;
	.WORD	<'0 + <'9 * 400>>,<'0 - 30.>	;
	.WORD	0				; EOT
;
;
.END