OBJNAM CVT.LIT	; Originally from AMUS, modified extensively by Irv Bromberg
; Created 8-Aug-85, Last edited 21-Jan-86
RADIX 10
VMAJOR=8
VMINOR=5
VEDIT=56
VSUB=0

IF EQ,1
8.5(56) 16-Apr-87 J.DEC redefined in MAC:SYS.UNV as most significant bit of
		  JOBTYP(JCB) for compatibility with AMOS/L 1.3C and later
8.4A(55) 21-Jan-86

Syntax:

	CVT <return>	short help message, current default RADIX shown
	CVT number	converts number to bin/oct/dec/hex/rad50/ascii
			default radix as per JOBTYP(JCB), including DEC mode
			base radix used has result shown in dim
			when sign bit set signed output used
			entry in any base can be preceeded by minus sign
	CVT ^B1011	forced binary entry
	CVT ^O123	forced octal
	CVT ^D123	forced decimal
	CVT 123.	trailing decimal also forces decimal processing
	CVT ^H123	forced hexadecimal (no leading 0 required after H)
	CVT ^H-123	signed hex entry (minus can follow any radix specifier)
	CVT [FILNAM]	RAD50 entry, can also be single triplet
	CVT 'g		ASCII entry (lowercase enabled at "#" prompt)
			note ASCII input/output is single byte only
	CVT '^g		specify control codes using circumflex
	CVT '^<return>	special case when circumflex is the input value
	CVT ^RMCMLX	ROMAN number entry
	CVT ^R_M_CMLX	ROMAN numeral preceeded by "_" or "-" taken as
			overbar numeral = 1000x next numeral

Switches:
	CVT/U {number}	display output results unsigned (default=signed)
			optional number can be in any format shown above

Lowercase input is enabled at the "#" prompt.  ROMAN numerals will
be folded to uppercase. Exit CVT program by entering blank line or
hit Control-C to abort.  The format displayed for OCT: and DEC:
depends on the value:

Value <=255 display only the least significant byte
Value <=65535 display the low word value and the separate bytes of that word

otherwise display  longword value, high-word value, low-word value, and
byte-by-byte value proceeding from most significant to least
significant byte.

Edit history:
28-Dec-85  8.4(54)  Fix CVTR50 routine not to output :80 if high word=FFFF.
21-Jan-86  8.4A(55) XON/XOFF were reversed.

ENDC

SEARCH SYS
SEARCH SYSSYM
SEARCH TRM

.OFINI
.OFDEF	STATUS,2
.OFDEF	R50WRK,4
.OFDEF	ASCWRK,80.
.OFSIZ	MEMSIZ

SavNum=D0
Decimal=D0
Char=D1
Number=D1
CrtCmd=D1
Subtract=D2
Count=D3
BitNum=D3
Flags=D4
	TmpNS=0			; temporary no-sign flag
	NegFlag=1		; temporary negative value flag
	NoSign=8		; permanent no-sign flag
	Repeat=9		; flag to repeat # prompt for more values
NSbits=^B100000001
Base=D5
Dtemp=D6

JCB=A0
RD50=A1
Roman=A1
Buffer=A2
Table=A3
Impure=A4
TCB=A5
Atemp=A6

HT=9
CR=13
SPACE=32
Cmd=^H0FF00

	PHDR	-1,0,PH$REE!PH$REU

	CLR	Flags		; pre-clear all flags

SAVTYP:	MOV	JOBCUR,JCB
	MOV	JOBTRM(JCB),TCB
	ORW	#ILC,T.STS(TCB)	; allow lowercase input for ASCII entry
	GETIMP	MEMSIZ,Impure
	MOVW	JOBTYP(JCB),STATUS(Impure)	; save current OCT/DEC/HEX status
CHKSWCH:CMPB	@Buffer,#'/	; any switches?
	JNE	CHKTRM
MORESW:	MOVB	1(Buffer),Char
	ADD	#2,Buffer	; bypass /c
	CMPB	Char,#'U	; unsigned output?
	BEQ	20$
	TYPE	<?Illegal switch - >
	TTY
	CRLF
	BR	Syntax
20$:	BSET	#NoSign,Flags	; set flag to output unsigned results
BYPSWCH:TRM
	JEQ	OK
	CMPB	@Buffer,#'/	; more switches?
	BEQ	MORESW
	BCALL	Syntax
	EXIT

Syntax:	TTYI
	ASCII	"Syntax: CVT{/u} {^radix code}{-}{value}{.}"
	BYTE	CR
	ASCII	"	/u switch for unsigned output"
	BYTE	CR
	ASCII	"	Radix:  R=ROMAN B=BIN O=OCT D=DEC. H=HEX"
	ASCII	", default as per JOBTYP(JCB)"
	BYTE	CR
	ASCII	"	CVT [rad50]"
	BYTE	CR
	ASCII	"	CVT '{^}ASCII character"
	BYTE	CR
	ASCII	"	Repeats # prompt if no parameter -- "
	ASCII	"Hit Return or ^C to exit"
	BYTE	CR,0
	EVEN
	RTN

OK:	BYP			; bypass tabs/spaces and check for TRM

CHKTRM:	TRM			; any parameter?
	JNE	PROCESS		; yes, process it immediately
	; if no parameters then give user some help:
TYPE	<CVT - converts ROMAN BIN OCT DEC HEX [RAD50] ASCII, current RADIX=>
	BSET	#Repeat,Flags	; and set the repeat flag
	MOVW	STATUS(Impure),Dtemp
	ANDW	#<J.DEC!J.HEX>,Dtemp
	BEQ	R.OCT
	ANDW	#<J.DEC>,Dtemp
	BEQ	R.HEX
R.DEC:	TYPECR	<10>
	BR	Prompt
R.OCT:	TYPECR	<8>
	BR	Prompt
R.HEX:	TYPECR	<16>
	BR	Prompt

Ready:	BTST	#Repeat,Flags	; are we supposed to repeat?
	JEQ	EXIT		; no, just exit
Prompt:	TYPE	<# >
	KBD	EXIT
	TRM			; blank line to terminate program
	JEQ	EXIT	

PROCESS:CLR	Char		; pre-clear for byte move
	CLRB	Flags		; clear transient flags
	MOVB	@Buffer,Char
	CMPB	Char,#'?
	BNE	5$
	CALL	Syntax
	BR	Ready
5$:	CMPB	Char,#'[	; RAD50 triplet?
	JEQ	GETR50
	CMPB	Char,#''	; ASCII character?
	JEQ	GETASC
	CMPB	Char,#'^	; base specified?
	JNE	ChkMinus
	INC	Buffer		; yes, bypass "^"
	MOVB	(Buffer)+,Char	; get base code BODH and bypass it
	UCS			; make sure uppercase
	CMPB	Char,#'R	; ROMAN numeral specified?
	JEQ	GETROME
	CMPB	(Buffer),#'-	; is minus sign following?
	BNE	10$
	BSET	#NegFlag,Flags	; yes, set negative flag
	INC	Buffer		; and bypass minus sign too
10$:	CMPB	Char,#'B
	JEQ	GETBIN
	CMPB	Char,#'O
	JEQ	GETOCT
	CMPB	Char,#'D
	JEQ	GETDEC
	CMPB	Char,#'H
	JEQ	GETHEX
	TYPECR	<?Illegal radix specifier:  ^B ^O ^D ^H  allowed>
	JMP	Ready

GETROME:			; get value of ROMAN number
	MOVB	#'R,Base
	LEA	Roman,ASCWRK(Impure) ; reset to start of ASCII workspace
10$:	TRM			; at end of line?
	BEQ	30$
	MOVB	(Buffer)+,Char
	UCS			; force uppercase as normal ROMAN numeral
	CMPB	Char,#'_	; leading underscore signals x1000 multiplier
	BNE	20$
15$:	MOVB	(Buffer)+,Char
	LCS			; force lowercase as x1000 signal
	BR	25$
20$:	CMPB	Char,#'-	; allow "-" same as underscore
	BEQ	15$
25$:	MOVB	Char,(Roman)+
	BR	10$
30$:	CLRB	(Roman)		; terminate the roman value
	LEA	Roman,ASCWRK(Impure)	; reset ptr to start of ROMAN value
	CLR	Decimal		; pre-clear
NxtRom:	MOVB	(Roman)+,Char
	BNE	10$
	MOV	Decimal,Number
	JMP	CONVRT		; reached end of roman value, ready to convert
10$:	CALL	ChkROME
	MOV	(Table),Count	; get numeral's value
	MOVB	(Roman),Char	; check next numeral to see if greater
	BEQ	AddIn		; unless there is none
	CALL	ChkROME
	CMP	Count,(Table)	; compare with next numeral's value
	BLO	TakeOut
AddIn:	ADD	Count,Decimal	; next numeral lesser, add this one in
	BR	NxtRom
TakeOut:SUB	Count,Decimal	; next numeral greater, subtract this one
	BR	NxtRom

ChkROME:LEA	Table,Numerals	; table lookup for corresponding value
10$:	MOVW	(Table)+,Dtemp	; is this end of table?
	BEQ	NotROME		; yes, not a valid roman numeral
	CMPB	Dtemp,Char	; is this the numeral?
	BEQ	GotIt
	ADD	#4,Table	; bypass corresponding decimal value
	BR	10$
GotIt:	RTN	; return with Table pointer pointing to value for this numeral
NotROME:POP			; pop the return address
	TYPE	<?Invalid ROMAN numeral - >
	TTY
	CRLF
	JMP	Ready

GETBIN:	CLR	Number		; pre-clear
	MOVB	#'B,Base
	MOVW	#31,BitNum
GtNxtBt:MOVB	(Buffer)+,Dtemp
	CMPB	Dtemp,#'0
	BNE	ChkONE
	LSL	Number
	BR	CntDwn
ChkONE:	CMPB	Dtemp,#'1
	BNE	BinErr
	LSL	Number
	ORW	#1,Number
CntDwn:	TRM			; end of line?
	DBEQ	BitNum,GtNxtBt
	JMP	CONVRT

BinErr:	TYPECR	<?Illegal binary digit>
	JMP	Ready

ChkMinus:	; default RADIX entry, check for minus sign first
	CMPB	Char,#'-
	BNE	GETNUM
	INC	Buffer
	BSET	#NegFlag,Flags
	BR	GETNUM

GETASC:	MOVB	#'A,Base	; signal ASCII as input base
	INC	Buffer		; bypass '
	MOVB	(Buffer)+,Char	; get next byte, may be char or ^
	CMPB	Char,#'^	; leading ^ means control code
	JNE	CONVRT		; no, process ASCII char already in D1
	CMPB	(Buffer),#CR	; if line terminator then take ^ as value
	JEQ	CONVRT		; yes, take ^ as value
	MOVB	(Buffer),Char	; get next character
	UCS
	SUBB	#64,Char	; convert to control code
	JMP	CONVRT		; ASCII control code in D1

GETNUM:	MOVW	STATUS(Impure),JOBTYP(JCB)	; restore default OCT/DEC/HEX mode
	MOVW	STATUS(Impure),Dtemp
	ANDW	#J.HEX!J.DEC,Dtemp	; DEC/HEX mode?
	BEQ	GETOCT
	ANDW	#J.DEC,Dtemp		; DEC mode?
	BEQ	GETHEX
GETDEC:	GTDEC
	MOVB	#'D,Base
	BR	CONVRT

GETOCT:	SAVE	A2
	MOVB	#'O,Base
	CALL	OCT
	GTOCT
CHKDEC:	CMPB	@Buffer,#'.
	REST	A2			; REST does not affect CCR
	BEQ	GETDEC
	BR	CONVRT

GETR50:	INC	Buffer			; bypass "["
	MOVB	#'[,Base
	BSET	#TmpNS,Flags
	LEA	RD50,R50WRK(Impure)
	CLR	Number			; pre-clear for word move
	PACK				; pack single triplet
	MOVW	-2(RD50),Number
	CMPB	(Buffer),#']	; single triplet only?
	BEQ	CONVRT
	TRM			; forgot to close brackets?
	BEQ	Forgot
	SWAP	Number
	PACK
	MOVW	-2(RD50),Number
	CMPB	(Buffer),#']
	BEQ	CONVRT
Forgot:	BYP			; bypass blanks/tabs
	CMPB	@Buffer,#']
	BEQ	CONVRT		; golly it wasn't forgotten after all...
	TYPECR	<?Missing ]>
	JMP	Ready

GETHEX:	CALL	HEX
	MOVB	#'H,Base
	SAVE	A2
	GTOCT
	BR	CHKDEC

CONVRT:	BTST	#NegFlag,Flags		; was it negative?
	BEQ	SaveIt			; no, proceed
	COM	Number			; yes, take two's complement
	INC	Number
SaveIt:	MOV	Number,SavNum

CVTROME:	; convert to ROMAN numeral format
	BTST	#NegFlag,Flags	; omit showing ROMAN if value <=0
	BNE	10$
	TST	Number
	BEQ	10$
	CMP	Number,#4000000	; or if out of range high (>3,999,999)
	BLO	20$
10$:	CRLF			; too high to convert to ROMAN
	JMP	CVTBIN
20$:	SAVE	D0,D1
	LEA	Table,TblEND
	LEA	Roman,ASCWRK(Impure)
	CLR	Count
NxtNum:	INC	Count		; iterate 13 times (Count=6*(0-12))
	SUB	#6,Table
	MOVW	(Table),Char	; iterate until end of table
	BEQ	OverBar
5$:	MOVB	Char,(Roman)+
	SUB	2(Table),Decimal
	BEQ	OverBar
	BPL	5$
	MOV	#<<TblEND-Numerals>/6>-1,Number
	SUB	Count,Number
	MOV	Number,Dtemp
	LSR	Number		; /2
	TST	Dtemp
	BPL	10$
	INC	Number
10$:	LSL	Number		; x2
	INC	Number
	BMI	CutOff
	MOV	#1,Subtract
	MOV	Decimal,D7
	NEG	D7
30$:	LEA	Atemp,Numerals
	MOV	Subtract,Dtemp
	MUL	Dtemp,#6
	SUB	#4,Dtemp
	MOV	0(Atemp)[Dtemp],Dtemp
	CMP	D7,Dtemp
	BLOS	Sub
	ADD	#2,Subtract
	CMP	Subtract,Number
	BLOS	30$
Cutoff: ADD	2(Table),Decimal ; restore value and
	CLRB	-(Roman)	; cut off last used Roman numeral because
	BR	NxtNum		; we shouldn't have used it

Sub:	MUL	Subtract,#6
	SUB	#4,Subtract
	LEA	Atemp,Numerals
	MOVB	-2(Atemp)[Subtract],Char
	MOVB	-(Roman),Dtemp
	MOVB	Char,(Roman)+
	MOVB	Dtemp,(Roman)+
	ADD	0(Atemp)[Subtract],Decimal
	BNE	NxtNum
OverBar:CLRB	(Roman)		; terminate with NULL for TTYL
	MOVB	#'R,Dtemp	; get correct video attribute
	CALL	CHKBAS
	TYPE	<        >	; To handle display of overbar for Roman
	LEA	Roman,ASCWRK(Impure) 	; numerals >1000 in value.
NxtBar:	MOVB	(Roman)+,Char
	BEQ	ShowRoman
	CMPB	Char,#'Z	; internally use lowercase letters for overbar
	BLO	NoBar		; numerals
	UCS
	MOVB	Char,-1(Roman)	; xlate internal lcs to ucs with overbar
	TYPE	<_>		; show overbar
	BR	NxtBar
NoBar:	TYPE	< >		; show no overbar (=space)
	BR	NxtBar

ShowRoman:CRLF
	TYPE	<ROMAN:  >
	TTYL	ASCWRK(Impure)
	CRLF
	REST	D0,D1		; restore values

CVTBIN:	MOVB	#'B,Dtemp
	CALL	CHKBAS
	TYPE	<BIN:    >
	CALL	Sign
	LEA	Buffer,ASCWRK(Impure)
	TST	Number			; =0?
	BNE	1$			; no, see how many nybbles to show
	MOVB	#'0,(Buffer)+		; yes, just show one 0
	BR	SHWBIN
1$:	MOVW	#31.,BitNum		; pre-decr DBF loop
5$:	MOV	#^H0FFFFFFFF,Dtemp	; see if one less nybble will fit
8$:	LSR	Dtemp,#4		; divide by 16
	BEQ	10$
	CMP	Number,Dtemp		; will fit?
	BHI	10$			; can't make nybble mask any smaller
	SUB	#4,BitNum		; one less nybble to show
	BR	8$
10$:	CMPW	BitNum,#31		; showing 32 bits?
	BLO	NxtBit
	MOVW	Flags,D7
	ANDW	#NSbits,D7
	BNE	NxtBit
	DECW	BitNum

NxtBit:	BTST	BitNum,Number
	BNE	10$
	MOVB	#'0,(Buffer)+
	BR	20$
10$:	MOVB	#'1,(Buffer)+
20$:	MOVB	BitNum,Dtemp
	BEQ	40$			; skip split if done last bit
	ANDB	#^H0F,Dtemp		; split into words, bytes, nibbles
	BNE	25$
	MOVB	#' ,(Buffer)+
25$:	ANDB	#^H7,Dtemp
	BNE	30$
	MOVB	#' ,(Buffer)+
30$:	ANDB	#^H3,Dtemp
	BNE	40$
	MOVB	#' ,(Buffer)+
40$:	DBF	BitNum,NxtBit
SHWBIN:	MOVB	#CR,(Buffer)+
	CLRB	@Buffer
	LEA	Atemp,ASCWRK(Impure)
	TTYL

CVTOCT:	MOVB	#'O,Dtemp
	CALL	CHKBAS
	TYPE	<OCT:    >
	CALL	Sign
	CALL	OCT
	OCVT	0,OT$TRM
	CMP	SavNum,#255
	BLOS	50$
	TYPE	<   (>
	MOV	SavNum,Number
	SWAP	Number
	AND	#^H0FFFF,Number	; show high word
	BEQ	10$		; skip if 0
	OCVT	0,OT$TRM!OT$TSP
	MOV	SavNum,Number
	AND	#^H0FFFF,Number
	OCVT	0,OT$TRM	; show low word
	TYPE	<    >
10$:	MOV	#32,Count
	CMP	SavNum,#^H0FFFF
	BLOS	30$
	BCALL	ShwOCT
	BCALL	ShwOCT
30$:	MOVB	#16,Count
	BCALL	ShwOCT
	BCALL	ShwOCT
	TYPE	<)>
50$:	CRLF
	BR	CVTDEC

ShwOCT:	MOV	SavNum,Number
	SUBB	#8,Count
	LSR	Number,Count
	AND	#^H0FF,Number
	OCVT	0,OT$TRM!OT$TSP
	RTN

ShwDEC:	MOV	SavNum,Number
	SUBB	#8,Count
	LSR	Number,Count
	AND	#^H0FF,Number
	DCVT	0,OT$TRM!OT$TSP
	RTN

CVTDEC:	MOVB	#'D,Dtemp
	CALL	CHKBAS
	TYPE	<DEC:    >
	CALL	Sign
	DCVT	0,OT$TRM
	CMP	SavNum,#255	; skip breakdown if <=255
	BLOS	50$
	TYPE	<   (>
	MOV	SavNum,Number
	SWAP	Number
	AND	#^H0FFFF,Number	; show high word
	BEQ	10$
	DCVT	0,OT$TRM!OT$TSP
	MOV	SavNum,Number
	AND	#^H0FFFF,Number
	DCVT	0,OT$TRM	; show low word
	TYPE	<    >
10$:	MOV	#32,Count
	CMP	SavNum,#^H0FFFF
	BLOS	30$
	BCALL	ShwDEC
	BCALL	ShwDEC
30$:	MOVB	#16,Count
	BCALL	ShwDEC
	BCALL	ShwDEC
	TYPE	<)>
50$:	CRLF

CVTHEX:	CALL	HEX
	MOVB	#'H,Dtemp
	CALL	CHKBAS
	TYPE	<HEX:    >
	CALL	Sign
	OCVT	0,OT$TRM
	CRLF

CVTR50:	MOVB	#'[,Dtemp
	CALL	CHKBAS
	TYPE	<RAD50:  [>
	MOV	SavNum,Number
	LEA	RD50,R50WRK(Impure)
	LEA	Buffer,ASCWRK(Impure)
	MOVW	Number,@RD50
	MOV	Number,Dtemp		; is upper word null?
	AND	#^H0FFFF0000,Dtemp
	BEQ	OneGrp			; skip first pack else 3 spaces output
	SWAP	Dtemp			; is upper word FFFF?
	COMW	Dtemp
	BEQ	OneGrp			; yes, skip else :80 output
	MOV	Number,@RD50
	UNPACK
OneGrp:	UNPACK
	CLRB	@Buffer
	TTYL	ASCWRK(Impure)
	TYPECR	<]>

CVTASC:	MOVB	#'A,Dtemp
	CALL	CHKBAS
	TYPE	<ASCII:  >
	MOV	SavNum,Number
	ANDB	#^H07F,Char	; strip parity bit
	CMPB	Char,#32.	; is it a control code?
	BHI	Norm
	BEQ	ShwMnem		; it's a space, show <space>
	TYPE	<^>		; yes, show it as ^Code
	ADDB	#64.,Char
	TTY
	SUBB	#64.,Char	; restore it for table index
	TYPE	< >
ShwMnem:TTYI
	ASCIZ	"<"
	EVEN
	LEA	Buffer,CtlTbl
	CLRB	Dtemp
NxtMnem:CMPB	Char,Dtemp	; have we found the right mnemonic?
	BHI	Skip		; no, skip to next
10$:	MOVB	(Buffer)+,Char	; get next char of mnemonic
	CMPB	Char,#',	; we're done if it's a comma
	BEQ	20$
	TTY			; output a char of the mnemonic
	BR	10$		; loop back for more
20$:	TTYI
	ASCIZ	">"
	EVEN
	BR	Last
	
Skip:	INCB	Dtemp
10$:	CMPB	(Buffer)+,#',	; skip past next comma
	BNE	10$
	BR	NxtMnem

Norm:	CMPB	Char,#^H7F	; is it a rubout?
	BNE	10$
	TTYI
	ASCIZ	"<rubout>"	; yes, show'em it is
	EVEN
	BR	Last
10$:	TTY
Last:	MOVB	#'?,Dtemp	; don't care for last call
	CALL	CHKBAS
	CRLF
	CRLF
	JMP	Ready

CHKBAS:	TSTB	Base		; -1 means DIM ON, turn it OFF
	BMI	DIMOFF
	BEQ	10$		; base already highlighted, no check
	CMPB	Base,Dtemp
	BNE	10$
	PUSH	Number
	MOVW	#Cmd!11,CrtCmd	; dim ON
	TCRT
	SETB	Base
	POP	Number
10$:	RTN

DIMOFF:	PUSH	Number
	MOVW	#Cmd!12,CrtCmd
	TCRT
	CLRB	Base
	POP	Number
	RTN

Sign:	MOV	SavNum,Number	; if minus then display in signed notation
	BPL	10$
	MOVW	Flags,D7
	ANDW	#NSbits,D7	; unsigned output?
	BNE	10$		; yes, don't complement the number, no minus
	TYPE	<->
	COM	Number
	INC	Number		; convert two's complement to positive
10$:	RTN

OCT:	ANDW	#^C<J.DEC!J.HEX>,JOBTYP(JCB)
	RTN

HEX:	ORW	#J.HEX,JOBTYP(JCB)
	ANDW	#^C<J.DEC>,JOBTYP(JCB)
	RTN

EXIT:	MOVW	STATUS(Impure),JOBTYP(JCB) ; restore original OCT/DEC/HEX mode
	EXIT

DEFINE	NUMVAL	Numeral,Value
	WORD	Numeral
	LWORD	Value
	ENDM

	WORD	0	; as backwards table terminator
	LWORD	0
Numerals:		; table of ROMAN numerals & their decimal values
	NUMVAL	'I,1
	NUMVAL	'V,5
	NUMVAL	'X,10
	NUMVAL	'L,50
	NUMVAL	'C,100
	NUMVAL	'D,500
	NUMVAL	'M,1000
	NUMVAL	'v,5000
	NUMVAL	'x,10000
	NUMVAL	'l,50000
	NUMVAL	'c,100000
	NUMVAL	'd,500000
	NUMVAL	'm,1000000
TblEND:	WORD	0	; as forwards table terminator

CtlTbl:	; table of control code mnemonics
	ASCII	"NULL,SOH,STX,ETX,EOT,ENQ,ACK,BELL,BKSP,HT,LF,VT,FF,"
	ASCII	"CR,SO,SI,DLE,DC1-XON,DC2,DC3-XOFF,DC4,NAK,SYNC,ETB,"
	ASCII	"CAN,EM,SUB,ESC,FS,GS,RS,US,space,"
	EVEN

	END

.