Source code in the rexx programming language

/*REXX program  performs  long multiplication  on  two numbers  (without the "E").      */
numeric digits 300                               /*be able to handle gihugeic input #s. */
parse arg x y .                                  /*obtain optional arguments from the CL*/
if x=='' | x==","  then x= 2**64                 /*Not specified?  Then use the default.*/
if y=='' | y==","  then y= x                     /* "      "         "   "   "     "    */
if x<0  &&  y<0    then sign= '-'                /*there only a single negative number? */
                   else sign=                    /*no, then result sign must be positive*/
xx=x;    x=strip(x, 'T', .);      x1= left(x, 1) /*remove any trailing decimal points.  */
yy=y;    y=strip(y, 'T', .);      y1= left(y, 1) /*   "    "     "        "       "     */
if x1=='-' | x1=="+"  then x= substr(x, 2)       /*remove a leading  ±  sign.           */
if y1=='-' | y1=="+"  then y= substr(y, 2)       /*   "   "    "     "    "             */
parse var x  '.' xf;  parse var y  "." yf        /*obtain the fractional part of X and Y*/
#= length(xf || yf)                              /*#: digits past the decimal points (.)*/
x= space( translate( x, , .),  0)                /*remove decimal point if there is any.*/
y= space( translate( y, , .),  0)                /*   "       "     "    "    "   "  "  */
Lx= length(x);  Ly=length(y)                     /*get the lengths of the new  X and Y. */
numeric digits max(digits(), Lx + Ly)            /*use a new  decimal digits  precision.*/
$= 0                                             /*$:  is the product  (so far).        */
                  do j=Ly  by -1  for Ly         /*almost like REXX does it, ··· but no.*/
                  $= $  +  ((x*substr(y, j, 1))copies(0, Ly-j) )
                  end   /*j*/
f= length($) - #                                 /*does product has enough decimal digs?*/
if f<0  then $=copies(0, abs(f) + 1)$            /*Negative?  Add leading 0s for INSERT.*/
say 'long mult:'  xx  "*"  yy  '──►'   sign || strip( insert(., $, length($) - #), 'T', .)
say ' built─in:'  xx  "*"  yy  '──►'   xx*yy     /*stick a fork in it,  we're all done. */


/* REXX **************************************************************
* While REXX can multiply arbitrary large integers 
* here is the algorithm asked for by the task description
* 13.05.2013 Walter Pachl
*********************************************************************/
cnt.=0
Numeric Digits 100
Call test 123 123
Call test 12 12
Call test 123456789012 44444444444
Call test 2**64 2**64
Call test 0 0
say cnt.0ok 'ok'
say cnt.0nok 'not ok'
Exit
test:
  Parse Arg a b
  soll=a*b
  haben=multiply(a b)
  Say 'soll =' soll
  Say 'haben=' haben
  If haben<>soll Then 
    cnt.0nok=cnt.0nok+1
  Else
    cnt.0ok=cnt.0ok+1
  Return

multiply: Procedure
/* REXX **************************************************************
* Multiply(a b) -> a*b
*********************************************************************/
  Parse Arg a b
  Call s2a 'a'
  Call s2a 'b'
  r.=0
  rim=1
  r0=0
  Do bi=1 To b.0
    Do ai=1 To a.0
      ri=ai+bi-1
      p=a.ai*b.bi
      Do i=ri by 1 Until p=0
        s=r.i+p
        r.i=s//10
        p=s%10
        End
      rim=max(rim,i)
      End
    End
  res=strip(a2s('r'),'L','0')
  If res='' Then
    res='0'
  Return res

s2a:
/**********************************************************************
* copy characters of a string into a corresponding array
* digits are numbered 1 to n fron right to left
**********************************************************************/
  Parse arg name
  string=value(name)
  lstring=length(string)
  do z=1 to lstring
    Call value name'.'z,substr(string,lstring-z+1,1)
    End
  Call value name'.0',lstring
  Return

a2s:
/**********************************************************************
* turn the array of digits into a string
**********************************************************************/
  call trace 'o'
  Parse Arg name
  ol=''
  Do z=rim To 1 By -1
    ol=ol||value(name'.z')
    End
  Return ol