An ordinary application wrote:
Heh ? How much is it now ? 5 TiB ? 500 GiB ? 50 GiB ?File size : 536870912000
At very same occasion
An application using my routines wrote:
Much better, isn't it ? :-)File size : 536'870'912'000 = $7D'0000'0000 = 500 GiB
Built-in number conversion of FB (actually DGJPP/MinGW/GCC) is just cloned from QB, upgraded to 64-bit and unsigned, but otherwise keeping old QB's faults alive.
My improvements:
- Group separation for HEX and DEC, for output and input
- Always even size of HEX
- Minimal size 2 or 3 for DEC and 4 for HEX possible (better tables)
- BUOB with auto-pick, covering full 64-bit range, decimals for 1...9, and exact or inexact hint
- Accepts HEX numbers prefixed with "$" for input
Code: Select all
DATA "Silly test of my great number conversion routines"
DATA "-------------------------------------------------"
DATA "Routines SSTRH, SBUOB, VALX64, SFORNUM are (C) 2008-11-03 by DOS386"
DATA "BSD-like, use at your own risk, don't missrepresent the origin."
DATA "Other stuff (VALX32, VALX8, main) is (CL) 2008 Public Domain"
DATA "ABUSE at YOUR own risk !"
REM Compiler: FreeBASIC 0.20 or above
'' --------------------------------------------------------------------
#define CL32 4294967295ul '' $FFFF'FFFF
#define CL32X64 4294967295ull '' $0000'0000'FFFF'FFFF
#define CL64X64 18446744073709551615ull '' $FFFF'FFFF'FFFF'FFFF
'' --------------------------------------------------------------------
#define incv(Q) Q=Q+1
#define decv(Q) Q=Q-1
#define addv(A,B) A=A+B
#define subv(A,B) A=A-B
#define gluestr(X,Y) X=X+Y
#define ueglstr(X,Y) X=Y+X
'' --------------------------------------------------------------------
#undef CALL
#define CALL
'' --------------------------------------------------------------------
type UINT64 as ULONGINT
type UINT32 as UINTEGER
type UINT8 as UBYTE
'' --------------------------------------------------------------------
''
'' Global DIM's
''
'' --------------------------------------------------------------------
DIM SHARED AS STRING VGSPASS
'' Global ^^^ string passing into and from SUB's and misc junk usage
DIM SHARED AS STRING VGSKMGTPE
'' Const ^^^ for BUOB
DIM SHARED AS UINT32 VGN32KMGTPE
'' Address ^^^ of the stuff
DIM SHARED AS UINT64 VGN64TEST
'' --------------------------------------------------------------------
''
'' LOW level SUB's
''
'' --------------------------------------------------------------------
SUB SSTRH (BYVAL VLN64NUM AS UINT64, BYVAL VLN8FF AS UINT8)
DIM AS UINT64 VLN64REM
DIM AS UINT8 VLN8DIG, VLN8COUNT
DIM AS UINT8 VLBFFB
'' STR$ and HEX$ replacement, 64-bit unsigned, HEX numbers use UPPERCASE
'' Minimal number formatting as DEC or HEX
'' Adds apo's by default, doesn't add dollar "$" or cross "#"
'' Value can be 0 ... $FFFF'FFFF'FFFF'FFFF = #18'446'744'073'709'551'615
'' Format flag VLN8FF controls output format:
'' - 0 is HEX, pads to even number only
'' - 1 to 3 is DEC, 2 or 3 is minimal size padded to
'' - 4 is HEX again, but padded to even number and 4 digits at least
'' - 5, 6, 7 prohibited
'' - Bit b3 (8) disables adding apo's
'' Hex numbers including 0 are always padded to even number
'' of digits - "0" -> "00" , "FFFFF" -> "0F'FFFF"
'' Dec numbers can be padded to at least 2 or 3 digits: 7 -> "07" or "007"
'' Decimal ZERO can be padded as well 0 -> "00" or "000"
'' Result in VGSPASS, decimal string size can be up
'' to 26 bytes (not including a "#" or terminating ZERO)
'' VLN64REM is division by 10 remainder
'' VLN8DIG is just picked digit, later reused for missing ZERO's counting
'' VLN8COUNT amount of digits (not including the apo's)
'' VLBFFB is booleanious flag brewed from VLN8FF : 0 HEX , 1 DEC
VGSPASS="0" : VLN8COUNT=1 : VLBFFB=0 '' Pre-Assume HEX and ZERO
IF ((VLN8FF AND 3)<>0) THEN VLBFFB=1 '' Indeed DEC
IF (VLN64NUM<>0) THEN '' Indeed non-ZERO
VGSPASS="" : VLN8COUNT=0
DO
IF (VLN64NUM=0) THEN EXIT DO
IF (VLBFFB=1) THEN '' DEC
VLN64REM = VLN64NUM MOD 10
VLN64NUM = VLN64NUM \ 10
VLN8DIG=CAST(UINT8,VLN64REM)
ELSE '' Above DEC, below HEX
VLN8DIG=CAST(UINT8,VLN64NUM) AND 15
IF (VLN8DIG>9) THEN addv(VLN8DIG,7) '' No "DAS" in FB :-(((((
VLN64NUM = VLN64NUM SHR 4
ENDIF
addv(VLN8DIG,48)
IF (((VLN8FF AND 8)=0) AND (VLN8COUNT>0) AND _
(((VLBFFB=1) AND ((VLN8COUNT MOD 3)=0)) OR _
((VLBFFB=0) AND ((VLN8COUNT AND 3)=0)))) THEN ueglstr(VGSPASS,"'")
ueglstr(VGSPASS,CHR$(VLN8DIG)) : incv(VLN8COUNT)
LOOP
ENDIF '' (VLN64NUM<>0) THEN '' Indeed non-ZERO
VLN8FF = VLN8FF AND 7 '' Delete possible no-apo-flag now
VLN8DIG=0 '' Now counts "missing" ZERO's
IF ((VLBFFB=0) AND ((VLN8COUNT AND 1)=1)) THEN VLN8DIG=1 '' Even pad of HEX
IF (VLN8COUNT<VLN8FF) THEN VLN8DIG=VLN8FF-VLN8COUNT '' Min. pad DEC or HEX
DO
IF (VLN8DIG=0) THEN EXIT DO
ueglstr(VGSPASS,"0")
decv(VLN8DIG)
LOOP
END SUB '' SSTRH
'' --------------------------------------------------------------------
SUB SBUOB (BYVAL VLN64BUM AS UINT64, BYVAL VLN8BUK AS UINT8)
DIM AS STRING VLSMOW
DIM AS UINT8 VLN8QQ2, VLN8QQ3
DIM AS UINT32 VLN32QQ4
'' Formats number as BUOB, input can be ZERO also
'' Will return an empty string if BUOB not available (value<1024)
'' If (and all conditions)
'' - BUOB is inexact
'' - BUOB is < 10
'' - There are decimlas 1 to 9 avaialable
'' then 1/10th are given, otherwise integer only.
'' 0 to 1 KiB-1 no BUOB available, 1023 bytes __NOT__ round up
'' 1 KiB to 10 KiB BUOB is KiB, 1/10th are given if inexact, > 0.5 round up
'' 10 KiB to 1 MiB-1 BUOB is KiB, no 1/10th, 1023.9xx KiB __NOT__ round up
'' 1 MiB to 10 MiB BUOB is MiB, 1/10th are given if inexact
'' Doesn't add any leading or trailing spaces
'' VLN8BUK bits: b0: add "= " or "~ " | b1: skip space | b2: input is in KiB
'' Setting both b0 and b1 is valid but not very useful: "= 2MiB" or "~ 2MiB"
'' Effect of b1 and b2 set: 0 -> "" | 1 -> "1KiB" | 1'048'575 -> "1'023MiB"
'' If BUOB is additional can be exact integer amount -> "=" or inexact -> "~"
'' VLN8QQ2 is evaluating BUOB type: 0 no BUOB 1 K 2 M 3 G 4 T 5 P 6 E
'' VLN8QQ3 holds upper 8 bits of remainder for later, 0 if all 60 bits exact
'' VLN32QQ4 holds temporarily the reduced value 1...1023
'' Control bit b2
IF (VLN8BUK AND 4) THEN VLN64BUM = VLN64BUM SHL 10
'' Pre-assume BUOB not available or exact if at all
VLSMOW="" : VLN8QQ2=0 : VLN8QQ3=0
'' Division loop, find out what we got
DO
IF (VLN64BUM<1024) THEN EXIT DO '' Can't SHR anymore
incv(VLN8QQ2) '' Got BUOB or bigger BUOB
IF ((CAST(UINT32,VLN64BUM) AND 1023) = 0) THEN '' Chance for exact
VLN64BUM=VLN64BUM SHR 10 '' DIV by 1024, keep QQ3 as is good or bad
ELSE '' Above chance for exact, below definitely inexact
VLN64BUM=VLN64BUM SHR 2 '' DIV by 4
VLN8QQ3=CAST(UINT8,VLN64BUM) '' Now we have high 8 bits from 10
IF (VLN8QQ3=0) THEN VLN8QQ3=1 '' Here ZERO is prohibited !!!
VLN64BUM=VLN64BUM SHR 8 '' DIV by 256 -> total by 10 | DIV 1024
ENDIF
LOOP
IF (VLN8QQ2<>0) THEN '' BUOB's are available ???
VLN32QQ4=CAST(UINT32,VLN64BUM) '' Get reasonale integer
IF (VLN8QQ3=0) THEN '' BUOB's are exact ???
IF (VLN8BUK AND 1) THEN gluestr(VLSMOW,"= ")
CALL SSTRH (VLN32QQ4,1) '' Decimal, no padding, 1 to 1023
gluestr(VLSMOW,VGSPASS) '' Got integer
ELSE '' Above exact, below inexact
IF (VLN8BUK AND 1) THEN gluestr(VLSMOW,"~ ")
IF (VLN32QQ4>=10) THEN '' No decimlas, round up
IF ((VLN8QQ3>127) AND (VLN32QQ4<1023)) THEN incv(VLN32QQ4) '' Up
CALL SSTRH (VLN32QQ4,1) : gluestr(VLSMOW,VGSPASS) '' Got integer
ELSE '' Below 1...9, possibly decimals, get just one digit via CHR$
gluestr(VLSMOW,CHR$(CAST(UINT8,VLN32QQ4)+48))
IF (VLN8QQ3<244) THEN addv(VLN8QQ3,12) '' Round up, 255\26 is 9
VLN8QQ3=VLN8QQ3 \ 26 '' Convert 1/256th to 1/10th, precision is bad
IF (VLN8QQ3<>0) THEN '' Got decimals | 1.05xxx becomes 1.1
gluestr(VLSMOW,".")
gluestr(VLSMOW,CHR$(VLN8QQ3+48)) '' Can be 1 ... 9 only
ENDIF '' (VLN8QQ3<>0) THEN '' Got decimals | 1.05xxx becomes 1.1
ENDIF '' (VLN32QQ4>=10) ELSE '' No decimlas, round up
ENDIF '' (VLN8QQ3=0) ELSE '' BUOB's are exact ???
IF ((VLN8BUK AND 2)=0) THEN gluestr(VLSMOW," ") '' Add space if not prohi
decv(VLN8QQ2) '' 1 ... 6 to 0 ... 5
VLN8QQ3=PEEK(VGN32KMGTPE+CAST(UINT32,VLN8QQ2))
gluestr(VLSMOW,CHR$(VLN8QQ3)) : gluestr(VLSMOW,"iB")
ENDIF '' (VLN8QQ2<>0) THEN '' BUOB's are available ???
'' Return it
VGSPASS=VLSMOW
END SUB '' SBUOB
'' --------------------------------------------------------------------
SUB VALX64 (BYVAL VLBFAG AS UINT8, BYREF VRN64RES AS UINT64)
DIM AS UINT64 VLN64RESU
DIM AS UINT8 VLN8QUAK, VLN8QUAL, VLN8QUAM '' Chars and counters
DIM AS UINT8 VLBO, VLBP, VLBQ '' Internal flags: HEX, negative, digit occur
'' VAL...blah (VALINT, VALUINT, VALLNG, VALIUM, VAULULNG, ...) replacement
'' For DEC and HEX numbers, 64-bit, also negative, skips apo's
'' Value can be 0 ... $FFFF'FFFF'FFFF'FFFF = #18'446'744'073'709'551'615
'' Checks for overflow - unreasonably big strings return $FFFF'FFFF'FFFF'FFFF
'' Note: A decimal string can be up
'' to 26 bytes (including useful apo's, not including the "#" or sign)
'' If VLBFAG is 0 faulty chars (apo isn't) will be skipped, otherwise abort
'' Empty or not valid input returns ZERO
'' Input in VGSPASS, preserved
'' Hex numbers are supported, prefix with "$" , both lowercase and UPPERCASE
'' Prefixing decimal numbers with "#" isn't required but won't hurt
'' Negative numbers are supported (returned as UINT as well), prefix with "-"
'' Multiple prefixes possible, "-$" is valid as $-" , "$#" or "#$##" does HEX
'' Apo's are skipped, "$FFFF'FFFF" is valid, also "1'024" or ugly "'''4'5'6'"
VLN64RESU=0 : VLBO=0 : VLBP=0 : VLBQ=0 '' Pre-assume not negative not HEX
'' Prepare convert loop, handle "$" , "#" and "-" , skip apo's + other junk
VLN8QUAK=1 : VLN8QUAL=LEN(VGSPASS)
IF (VLN8QUAL>28) THEN VLN8QUAL=28 '' Don't process > 28 chars
DO '' Convert loop
IF (VLN8QUAK>VLN8QUAL) THEN EXIT DO '' Done
VLN8QUAM=ASC(VGSPASS,VLN8QUAK) '' 35 cross 36 dollar 39 apo 45 minus
IF (VLBQ=0) THEN '' Accept cross, dollar & minus only preceding digits
IF (VLN8QUAM=35) THEN VLN8QUAM=39 '' Cross: no action, silently ignore
IF (VLN8QUAM=36) THEN '' Dollar
VLBO=1 : VLN8QUAM=39 '' Hex
ENDIF
IF (VLN8QUAM=45) THEN '' Minus
VLBP=1 : VLN8QUAM=39 '' Negative
ENDIF
ENDIF '' (VLBQ=0) THEN '' Accept cross, dollar & apo only preceding
IF (VLN8QUAM<>39) THEN '' Char not yet eaten as good, try HEX nd DEC
IF (VLN8QUAM>96) THEN subv(VLN8QUAM,32) '' UCASE possible letters
subv(VLN8QUAM,48)
IF (VLBO=1) THEN '' HEX
IF (VLN8QUAM>9) THEN '' Could be "A" to "F"
IF (VLN8QUAM<17) THEN '' 48+17 = 65 | 17 is good 16 is evil
VLN8QUAM=255 '' Tag as junk
ELSE
subv(VLN8QUAM,7) '' Yeah ... chance to be valid
ENDIF
ENDIF '' (VLN8QUAM>9) '' Could be "A" to "F"
IF (VLN8QUAM<16) THEN '' Try to add HEX digit
IF (VLN64RESU>=1152921504606846976) THEN '' Can't add digit anymore
VLN64RESU=CL64X64 : EXIT DO
ENDIF
VLN64RESU=(VLN64RESU SHL 4) + CAST(UINT64,VLN8QUAM)
'' Safe ^^^ to SHL and add, HEX 0...15 only, add :-)
VLBQ=1 : VLN8QUAM=39 '' Tag as valid
ENDIF
ELSE '' Above HEX, below DEC
IF (VLN8QUAM<10) THEN
IF (VLN64RESU>=1844674407370955162) THEN '' Can't add digit anymore
VLN64RESU=CL64X64 : EXIT DO
ENDIF
VLN64RESU=VLN64RESU * 10 '' Safe to MUL for now
IF (VLN64RESU>=18446744073709551610) THEN '' Risky to add digit
addv(VLN64RESU,CAST(UINT64,VLN8QUAM))
IF (VLN64RESU<10ull) THEN VLN64RESU=CL64X64 '' Overflowed
EXIT DO '' Added or not, in either case give up now
ENDIF
addv(VLN64RESU,CAST(UINT64,VLN8QUAM)) '' Here 0...9 only, add :-)
VLBQ=1 : VLN8QUAM=39 '' Tag as valid
ENDIF
ENDIF '' (VLBO=1) ELSE
ENDIF '' (VLN8QUAM<>39) THEN '' Char not yet eaten as good
IF ((VLN8QUAM<>39) AND (VLBFAG=1)) THEN EXIT DO '' Faulty char, give up
incv(VLN8QUAK)
LOOP
IF (VLBP=1) THEN VLN64RESU = 0 - VLN64RESU '' Negative
VRN64RES=VLN64RESU
END SUB '' VALX64
'' --------------------------------------------------------------------
SUB VALX32 (BYVAL VLBFAPG AS UINT8, BYREF VRN32REES AS UINT32)
DIM AS UINT64 VLN64RESTEMP
DIM AS UINT32 VLN32RESRED
CALL VALX64 (VLBFAPG, VLN64RESTEMP)
IF (VLN64RESTEMP>CL32X64) THEN
VLN32RESRED=CL32
ELSE
VLN32RESRED=CAST(UINT32,VLN64RESTEMP)
ENDIF
VRN32REES=VLN32RESRED
END SUB '' VALX32
'' --------------------------------------------------------------------
SUB VALX8 (BYVAL VLBFOAPG AS UINT8, BYREF VRN8REIS AS UINT8)
DIM AS UINT64 VLN64RESETEMP
DIM AS UINT8 VLN8RESURED
CALL VALX64 (VLBFOAPG, VLN64RESETEMP)
IF (VLN64RESETEMP>255ull) THEN
VLN8RESURED=255
ELSE
VLN8RESURED=CAST(UINT8,VLN64RESETEMP)
ENDIF
VRN8REIS=VLN8RESURED
END SUB '' VALX8
'' --------------------------------------------------------------------
''
'' MEDIUM level SUB's
''
'' --------------------------------------------------------------------
SUB SFORNUM (BYVAL VLN64QYQ AS UINT64, BYVAL VLN8FLAGS AS UINT8)
DIM AS STRING VLSQQ1
DIM AS UINT8 VLN8CRBITS
'' Formats number for output DEC, HEX and BUOB (binary units of bloat)
'' VLN64QYQ is input number, can be 0 , returns just "0"
'' VLN8FLAGS holds control flags: b0:DEC b1:HEX b2:BUOB | >=8 is prohibited
'' At least 1 of 3 bits must be used/set, otherwise result is just "0"
'' Additional BUOB can be exact integer amount -> "=" or inexact -> "~"
'' BUOB only is possible, no "=" or "~" then, just number + space + BUOB text
'' Uses SSTRH and SBUOB
'' VLSQQ1 is growing output string, VGSPASS is set at the end
'' VLN8CRBITS holds control bits for SBUOB called from here
'' We use neither STR$ nor HEX$ here :-)))
IF ((VLN64QYQ=0) OR (VLN8FLAGS=0)) THEN
VGSPASS="0"
ELSE
'' Common
VLSQQ1=""
'' DEC
IF ((VLN8FLAGS AND 1) = 1 ) THEN '' We want DEC
CALL SSTRH (VLN64QYQ,1) : VLSQQ1=VGSPASS '' Not padded
ENDIF '' ((VLN8FLAGS AND 1) = 1 ) THEN '' We want DEC
'' Separate dec and hex
IF ((VLN8FLAGS AND 3) = 3 ) THEN gluestr(VLSQQ1," = $") '' Want DEC&HEX
'' Hex
IF ((VLN8FLAGS AND 2) = 2 ) THEN '' We want HEX
CALL SSTRH (VLN64QYQ,0) : gluestr(VLSQQ1,VGSPASS) '' No "pad to 4 min"
ENDIF '' ((VLN8FLAGS AND 2) = 2 ) THEN '' We want HEX
'' BUOB
IF ((VLN8FLAGS AND 4) = 4 ) THEN '' We want BUOB
VLN8CRBITS=0 '' b0: add "= " or "~ " | b1: skip space | b2: input KiB
IF ((VLN8FLAGS AND 3)<>0) THEN '' Have DEC or HEX already
gluestr(VLSQQ1," ") '' SBUOB will __NOT__ add the leading space
VLN8CRBITS=1 '' Add "= " or "~ "
ENDIF
CALL SBUOB (VLN64QYQ,VLN8CRBITS) : gluestr(VLSQQ1,VGSPASS)
ENDIF '' ((VLN8FLAGS AND 4) = 4 ) THEN '' We want BUOB
'' Common
VGSPASS=VLSQQ1
ENDIF '' ((VLN64QYQ=0) OR (VLN8FLAGS=0)) ELSE
END SUB '' SFORNUM
'' --------------------------------------------------------------------
''
'' MAIN
''
'' --------------------------------------------------------------------
VGSKMGTPE="KMGTPE" : VGN32KMGTPE=CAST(UINT32,STRPTR(VGSKMGTPE))
?
DO
READ VGSPASS : ? VGSPASS : IF (LEN(VGSPASS)=24) THEN EXIT DO
LOOP
?
VGN64TEST = 500ull * (1ull SHL 30) '' 500 * 2^30 AKA 500 GiB bloat
VGSPASS="File size : "
? VGSPASS ;
? VGN64TEST : ? '' "ordinary" PRINT, same result would come from STR$
? VGSPASS ;
CALL SFORNUM (VGN64TEST,7) '' My cool converion, brew all: DEC, HEX, BUOB
? VGSPASS : ? '' SFORNUM result :-)))
DO
? "Line & SFORNUM (7) !!!" : ? ">" ;
LINE INPUT VGSPASS : VGN64TEST=VALULNG(VGSPASS)
CALL SFORNUM (VGN64TEST,7) : ? VGSPASS : ?
? "Line & SSTRH (5,6,7 prohibited) & SBUOB !!!" : ? ">" ;
LINE INPUT VGSPASS : VGN64TEST=VALULNG(VGSPASS)
CALL SSTRH(VGN64TEST,0) : ? "SH0 " ; VGSPASS ; " (HEX)"
CALL SSTRH(VGN64TEST,1) : ? "SH1 " ; VGSPASS
CALL SSTRH(VGN64TEST,2) : ? "SH2 " ; VGSPASS
CALL SSTRH(VGN64TEST,3) : ? "SH3 " ; VGSPASS
CALL SSTRH(VGN64TEST,4) : ? "SH4 " ; VGSPASS ; " (HEX)"
CALL SSTRH(VGN64TEST,8) : ? "SH8 " ; VGSPASS ; " (HEX)"
CALL SSTRH(VGN64TEST,9) : ? "SH9 " ; VGSPASS
CALL SSTRH(VGN64TEST,10) : ? "SH10 " ; VGSPASS
CALL SSTRH(VGN64TEST,11) : ? "SH11 " ; VGSPASS
CALL SSTRH(VGN64TEST,12) : ? "SH12 " ; VGSPASS ; " (HEX)"
CALL SBUOB(VGN64TEST,0) : ? "B0 " ; VGSPASS
CALL SBUOB(VGN64TEST,1) : ? "B1 " ; VGSPASS ; " (Add ""="" or ""~"")"
CALL SBUOB(VGN64TEST,2) : ? "B2 " ; VGSPASS ; " (Skip space)"
CALL SBUOB(VGN64TEST,6) : ? "B6 " ; VGSPASS ; " (Skip space, Input in KiB)"
?
? "VALX64 (skip junk) & STR$ & HEX$ !!!" : ? ">" ;
LINE INPUT VGSPASS : CALL VALX64 (0,VGN64TEST)
? "STR$ " ; STR$(VGN64TEST) : ? "HEX$ " ; HEX$(VGN64TEST) : ?
? "VALX64 (abort on junk) & STR$ & HEX$ !!!" : ? ">" ;
LINE INPUT VGSPASS : CALL VALX64 (1,VGN64TEST)
? "STR$ " ; STR$(VGN64TEST) : ? "HEX$ " ; HEX$(VGN64TEST) : ?
LOOP
'' --------------------------------------------------------------------
END '' No way out from this application, must cut power cable :-D
Download now (88 KiB, includes .BAS & DOS .EXE & Win32 .EXE & .PNG) http://jafile.com/uploads/dos386/numbuob.zip
(@DrV: I haven't forgotten...) (@counting_pine: Reduced brightness a bit ... not sure why it should be critical ...)
EDIT (2008-11-03) : replaced post + code fixing critical BUG ... if someone downloaded it before (no feedback ???) , please download again
EDIT (2011-08-07) : fixed dead links