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.
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
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
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
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
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
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