/* REXX: convert whole number N given as string of S-digits from */ /* source base S to target base T. Base can be 2..60 where */ /* characters 'A' etc. represent digit '10' etc. as usual */ /* upto 'Z' = 35, and abcdefgh,jk,mnopqrtuvwxyz (excluding */ /* small I and small L) represent the digits '36' .. '60'. */ /* Usage as external function: BASECONV( N, T, S ) */ /* Usage as external command: BASECONV N T S */ /* If no source base S is specified the default is 10 (dec.), and */ /* if no target base T is specified the default is 12 (dodec.). */ /* REXX internal functions X2D, X2B, D2X, and B2X are used below */ /* to accelerate certain conversions of non-negative numbers. */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP ? = '0123456789AB' ; ? = ? || 'CDEFGHIJKLMN' ? = ? || 'OPQRSTUVWXYZ' ; ? = ? || 'abcdefghjkmn' ? = ? || 'opqrstuvwxyz' ; DIGITS = ? parse value arg( 1 ) arg( 2 ) arg( 3 ) with N T S ? numeric digits max( length( DIGITS ) * length( N ), digits()) if S = '' then S = 10 ; if T = '' then T = 12 if ? > '' then return USAGE( ? ) ; parse upper source . ? . if ? <> 'COMMAND' then return BASE( N, T, S ) ? = BASE( N, T, S ) ; if ? = '.' then exit 1 say N '(base' S || ') =>' ? '(base' T || ')' ; exit 0 BASE: procedure expose DIGITS /* calls itself for signed N < 0 */ parse arg N, T, S /* result '.' is "Not A Number" */ select when \ datatype( S, 'w' ) then return USAGE( S ) when \ datatype( T, 'w' ) then return USAGE( T ) when S > 60 | S < 2 then return USAGE( S ) when T > 60 | T < 2 then return USAGE( T ) when N = '' then return USAGE() when abbrev( N, '-' ) = 0 then nop otherwise /* one leading minus sign is ok. */ N = substr( N, 2 ) if sign( pos( '+', N )) then return USAGE( '-' || N ) N = BASE( N, T, S ) /* if '.' (NAN) don't add minus: */ if N = '.' then return N else return '-' || N end D = left( DIGITS, S ) /* for S <= 35 ignore lower case */ if S <= 35 then N = translate( N ) select /* check valid B2D source digits */ when verify( N, D ) > 0 then return USAGE( N ) when T = S then return N when T = 10 & S = 16 then return x2d( N ) when T = 16 & S = 10 then return d2x( N ) when S = 16 then return D2B( x2d( N ), T ) when T = 16 then return d2x( B2D( N, S ) ) when S = 10 then return D2B( N, T ) when T = 10 then return B2D( N, S ) otherwise return D2B( B2D( N, S ), T ) end USAGE: procedure /* handle any invalid argument */ parse upper source . . ? ; ? = translate( ?, '/', '\' ) parse value substr( ?, 1 + lastpos( '/', ? )) with ? '.' . if arg( 1 ) > '' then say 'error:' arg( 1 ) say 'usage:' ? || '(decimal, base) or' ? || '(digits, to, from)' say 'limit: 1 < base <= 60, digits 36..60 shown as a..h jk m..z' return '.' /* dummy result (not a number) */ D2B: procedure expose DIGITS /* decimal to base 2 <= B <= 60: */ arg D, B ; if B = 2 then return strip( x2b( d2x( D )), 'L', 0 ) N = '' ; if D = 0 then return 0 do while D > 0 N = substr( DIGITS, 1 + D // B, 1 ) || N ; D = D % B end return N B2D: procedure expose DIGITS /* base 2 <= B <= 60 to decimal: */ arg N, B ; if B = 2 then return strip( x2d( b2x( N )), 'L', 0 ) D = 0 ; if B > 35 then parse arg N X = 1 do L = length( N ) to 1 by -1 D = D + X * ( pos( substr( N, L, 1 ), DIGITS ) - 1 ) X = X * B end L return D /* see , (c) F. Ellermann */ TRAP: /* select REXX exception handler */ call trace 'O' ; trace N /* don't trace interactive */ parse source TRAP /* source on separate line */ TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A ) TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */ TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' )) select when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do if condition( 'd' ) > '' /* need an additional line */ then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP '(RC' rc || ')' /* any system error codes */ if condition( 'c' ) = 'FAILURE' then rc = -3 end when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do if condition( 'c' ) = 'HALT' then rc = 4 if condition( 'd' ) > '' & condition( 'd' ) <> rc then do if condition( 'd' ) <> errortext( rc ) then do TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP errortext( rc ) end /* future condition( 'd' ) */ end /* may use errortext( rc ) */ else TRAP = TRAP errortext( rc ) rc = -rc /* rc < 0: REXX error code */ end when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */ when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */ otherwise /* force non-zero whole rc */ if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1 if rc = 0 then rc = 1 if condition() = '' then TRAP = TRAP arg( 1 ) end /* direct: TRAP( message ) */ TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 ) signal on syntax name TRAP.SIGL /* throw syntax error 3... */ if 0 < sigl & sigl <= sourceline() /* if no handle for source */ then TRAP = TRAP '*-*' strip( sourceline( sigl )) else TRAP = TRAP '+++ (source line unavailable)' TRAP.SIGL: /* ...catch syntax error 3 */ if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc end select when 0 then do /* in pipes STDERR: output */ parse version TRAP.REXX /* REXX/Personal: \dev\con */ if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ , 6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR' else TRAP.REXX = '\dev\con' signal on syntax name TRAP.FAIL call lineout TRAP.REXX , TRAP /* fails if no more handle */ end when 0 then do /* OS/2 PM or ooREXX on NT */ signal on syntax name TRAP.FAIL call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ , 'Trap' time(),, 'ERROR' end otherwise say TRAP ; trace ?L /* interactive Label trace */ end if condition() = 'SIGNAL' then signal TRAP.EXIT TRAP.CALL: return rc /* continue after CALL ON */ TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */ TRAP.EXIT: exit rc /* exit for any SIGNAL ON */