Imported Upstream version 9.5.0upstream/9.5.0upstream

4 files changed, 279 insertions, 96 deletions

diff --git a/ipl/procs/calls.icn b/ipl/procs/calls.icn
index 6ebb8a1..00f6114 100644
--- a/ipl/procs/calls.icn
+++ b/ipl/procs/calls.icn
@@ -6,7 +6,7 @@
 #
 #	Author:   Ralph E. Griswold
 #
-#	Date:     March 25, 2002
+#	Date:     March 6, 2008
 #
 ############################################################################
 #
@@ -137,7 +137,7 @@ procedure read_calltable(f)
 
    T := table()
 
-   every line := read(f) do
+   while line := read(f) do
       line ? {
          name := tab(upto('="')) | fail
          move(1)
diff --git a/ipl/procs/echo.icn b/ipl/procs/echo.icn
new file mode 100644
index 0000000..5a90c97
--- /dev/null
+++ b/ipl/procs/echo.icn
@@ -0,0 +1,227 @@
+############################################################################
+#
+#	File:     echo.icn
+#
+#	Subject:  Procedure to perform "variable interpolation" a la Perl
+#
+#	Authors:  Charles L Hethcoat III and Carl Sturtivant
+#
+#	Date:     February 9, 2010
+#
+############################################################################
+#
+# This file is in the public domain.
+#
+############################################################################
+#
+#  echo() substitutes global variables for occurrences of $name in &subject,
+#  and writes the result to standard output.
+#
+############################################################################
+#
+# Background:
+#
+# String "interpolation", as used in Perl, Tcl, Bash, and so on,
+# involves a special notation used within a string that causes the
+# value of a variable to be inserted into the string at runtime.  A
+# common notation for this is a dollar sign, e. g. "The price is
+# $price pfennig."  If a variable named "price" has the value 10, then
+# on output the string becomes "The price is 10 pfennig."
+#
+# Interpolation is lacking in Icon, so we must use the fussier syntax
+# of an Icon write() procedure:  write("The price is ", price,
+# "pfennig.").  Here is a slightly more complex example, assuming
+# variables `price' = 10, `article' == "thimble", and `currency' ==
+# "pfennig":
+#
+#    write("The price of a ", article, " is ", price, " ", currency, ".")
+#
+# This can be annoying and error-prone if we must use many such
+# strings in a program.
+#
+# The echo() procedure provides a very nice solution for Icon
+# programmers.  Compare the preceding write() call to this:
+#
+#    "The price of a $article is $price $currency" ? echo()
+#
+# Is this not much simpler?  Both examples will print out the string
+#
+#    "The price of a thimble is 10 pfennig."
+#
+# but interpolation with echo() greatly reduces the low-level
+# syntactic requirements (and reduces the number of characters to type
+# from 68 to 54).  It is much easier to write, read, and check.  If
+# many such lines of code are needed, the difference adds up.
+# Consider, for example, how this would pay off if your program needs
+# to generate hundreds of lines of HTML or PostScript.
+#
+############################################################################
+#
+# Usage:
+#
+# A string to
+# be printed with interpolated values should be set up in a scanning
+# environment, using echo() as the scanning procedure, as in
+# "foo$variable" ? echo().  Here is an actual example for testing:
+#
+#    link echo
+#    global month, day, year
+#
+#    procedure main()
+#       month := "February"
+#       day := 30
+#       year := 2010
+#       "Free beer on $month $day, $year." ? echo()
+#    end
+#
+# Assuming echo.icn has been compiled with the -c option beforehand,
+# compiling, linking, and running this program produces the string
+# "Free beer on February 30, 2010." on standard output.
+#
+############################################################################
+#
+# Notes:
+#
+# Since there is no way for any Icon procedure to discover the values of
+# any another procedure's local variables, all variables to be used via
+# the echo() procedure must be global.  This restriction ought not to be
+# too serious for smaller programs, or even longer ones if they are of
+# simple construction.  But it may be a limitation for sophisticated
+# Icon programming projects.  You will have to be the judge.
+#
+# If x is a global variable with value 10,
+#
+#    "x" ? echo()         prints "x"
+#    "$x" ? echo()        prints "10"
+#    "$$x" ? echo()       prints "$x"
+#    "$$$x" ? echo()      prints "$10"
+#    "$$$$x" ? echo()     prints "$$x"
+#    "$$$$$x" ? echo()    prints "$$10"
+#
+# and so on.  The rule is:  take dollar signs off in pairs from the
+# left.  Each pair prints ONE literal dollar sign on the output.
+#
+# If there were an odd number of dollar signs to begin with, then one
+# will be left over, and this will print the value of the variable (10).
+#
+# If there were an even number to begin with, then none are left, and a
+# literal "x" is printed.
+#
+# There is an extended notation that helps disambiguate some usage
+# scenarios.  Here are some examples:
+#
+#    "${x}" is the same as $x.
+#    "${x}:" is the same as $x:.
+#    "${x}${y}" is the same as $x$y.
+#
+# However, "${x}avier" is NOT the same as $xavier!  Can you see why?
+#
+# You may use any variable names you like.  There are no restrictions.
+# echo() uses no global variable names of its own, but receives the
+# string it interpolates in a string scanning environment.
+#
+############################################################################
+#
+# Using echo() on a larger scale , with input from a generator:
+# 
+# global time, date, save, wombats
+# 
+# link echo
+# 
+# procedure main()
+#   time := &clock
+#   date := &date
+#   save := ?100000
+#   wombats := 22
+#   "It is now $time on $date and you have savings of $$$save." |
+#      "The number of wombats is $wombats." |
+#      "It is now ${time} on ${date} and you have ${wombats} wombats." |
+#      "There is no global variable named \"$foo\"." |
+#      "This does not work:  It is now ${&clock}." |
+#      "" |
+#      "The previous input line printed an empty output line." ? echo()
+# end
+# 
+# Because echo() always fails (in the Icon sense), evaluation of
+# 
+#     a | b | c | d ? echo()
+# 
+# will group as
+# 
+#     (a | b | c | d) ? echo()
+# 
+# because of operator precedence, and the left-hand expression produces
+# _a_ first, which is assigned to &subject.  Then echo() is evaluated --
+# and fails.  This makes the whole expression fail, so Icon backtracks
+# to the first expression, resumes its evaluation to produce its second
+# value b, which is assigned to &subject and then echo() is called,
+# which fails, and so forth, until all possibilities are exhausted.
+# 
+############################################################################
+#
+# Taking input from a template file:
+# 
+# You can create a template file (with $-strings in it) and use an Icon
+# program to read it and write it out to standard output.  Your main
+# Icon program will supply the needed variable values for the $-strings
+# in the template.
+# 
+# As an example, suppose your program will generate a hundred business
+# cards for you as a PostScript file.  You have a template file named
+# template.ps with $-strings such as $firstname, $lastname, $address,
+# $companyname, and so on --- all embedded in it at the proper places.
+# Your main program will read this template and substitute the actual
+# name and address information.
+# 
+# This is one way your program can read template.ps and pass it to
+# echo():
+# 
+# ...
+# firstname := "Joe"
+# lastname := "Smith"
+# # ... etc. ...
+# reads("template.ps",1000000) ? echo()
+# ...
+# 
+# When this is run, your customized business cards appear on standard
+# output.
+# 
+############################################################################
+# 
+# This trick relies upon concatenation having a higher precedence
+# than alternation:
+# 
+#     "................" ||
+#     "................" ||
+#     "................" |
+#     "................" ||
+#     "................" |
+#     "................" ||
+#     "................" ? echo()
+# 
+# This prints out three messages, one specified on three lines, one on
+# two, and one on two. The alternations fix the newlines provided at the
+# end of each message by echo().
+# 
+#  &subject is the empty string if it's unassigned.  So echo() called
+# without ? will under those circumstances print a blank line.
+#
+############################################################################
+
+procedure echo()			#: interpolate variables and print
+
+   $define idchars 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'
+   while writes(tab(find("$")) ) do {
+      move(1)
+      writes( ="$" |
+             variable(tab(many(idchars)) |
+                      2( ="{", tab(find("}")), ="}" )
+                      )
+             ) |
+                tab(many(idchars)) |
+                ( ="{" & tab(find("}")) & ="}" )
+   }
+   write(tab(0))
+   $undef idchars
+
+end
diff --git a/ipl/procs/printf.icn b/ipl/procs/printf.icn
index b5f99b9..b264692 100644
--- a/ipl/procs/printf.icn
+++ b/ipl/procs/printf.icn
@@ -6,7 +6,7 @@
 #
 #	Author:   William H. Mitchell
 #
-#	Date:     July 20, 2005
+#	Date:     February 13, 2006
 #
 ############################################################################
 #
@@ -14,30 +14,19 @@
 #
 ############################################################################
 #
-#	Contributors:   Cheyenne Wills, Phillip Lee Thomas, Michael Glass
+#	Contributors:   Cheyenne Wills, Phillip Lee Thomas,
+#			Michael Glass, Gregg M. Townsend
 #
 ############################################################################
 #
 #     This procedure behaves somewhat like the standard printf.
 #  Supports d, e, s, o, and x formats like printf.  An "r" format
-#  prints real numbers in a manner similar to that of printf's "f",
-#  but will produce a result in an exponential format if the number
-#  is larger than the largest integer plus one.  Though "e" differs
-#  from printf in some details, it always produces exponential format.
+#  prints real numbers in a manner similar to that of printf's "f".
+#  Though "e" differs from printf in some details, it always produces
+#  exponential format.
 #
-#     Left or right justification and field width control are pro-
-#  vided as in printf.   %s, %r, and %e handle precision specifications.
-#
-#     The %r format is quite a bit of a hack, but it meets the
-#  author's requirements for accuracy and speed.  Code contributions
-#  for %f, %e, and %g formats that work like printf are welcome.
-#
-#     Possible new formats:
-#
-#	   %t -- print a real number as a time in hh:mm
-#	   %R -- roman numerals
-#	   %w -- integers in English
-#	   %b -- binary
+#     Left or right justification and field width control are provided
+#  as in printf.   %s, %r, and %e handle precision specifications.
 #
 ############################################################################
 
@@ -100,86 +89,52 @@ procedure _doprnt(format, args)
 end
 
 procedure hexstr(n)
-   local h, neg
-   static BigNeg, hexdigs, hexfix
-
-	initial {
-		BigNeg := -2147483647-1
-		hexdigs := "0123456789abcdef"
-		hexfix := "89abcdef"
-		}
-
-	n := integer(n)
-	if n = BigNeg then
-		return "80000000"
-	h := ""
-	if n < 0 then {
-		n := -(BigNeg - n)
-		neg := 1
-		}
-	repeat {
-		h := hexdigs[n%16+1]||h
-		if (n /:= 16) = 0 then
-			break
-		}
-	if \neg then {
-		h := right(h,8,"0")
-		h[1] := hexfix[h[1]+1]
-		}
-	return h
+   return _basestr(n, 4)
 end
+
 procedure octstr(n)
-   local h, neg
-   static BigNeg, octdigs, octfix
+   return _basestr(n, 3)
+end
 
-	initial {
-		BigNeg := -2147483647-1
-		octdigs := "01234567"
-		octfix := "23"
-		}
+procedure _basestr(n, b)
+   local s, mask
 
-	n := integer(n)
-	if n = BigNeg then
-		return "20000000000"
-	h := ""
-	if n < 0 then {
-		n := -(BigNeg - n)
-		neg := 1
-		}
-	repeat {
-		h := octdigs[n%8+1]||h
-		if (n /:= 8) = 0 then
-			break
-		}
-	if \neg then {
-		h := right(h,11,"0")
-		h[1] := octfix[h[1]+1]
+	n := integer(n) | return image(n)
+
+	if n = 0 then
+		return "0"
+
+	# backwards compatibility hack
+	# treat 31-bit negative integers as positive values
+	if -16r80000000 <= n <= -1 then
+		n +:= 16r100000000
+
+	s := ""
+	mask := ishift(1, b) - 1
+	while n ~= 0 & n ~= -1 do {
+		s := "0123456789abcdef" [1 + iand(n, mask)] || s
+		n := ishift(n, -b)
 		}
-	return h
+	return s
 end
 
 procedure fixnum(x, prec)
-   local int, frac, f1, f2, p10
+   local s
 
 	/prec := 6
 	x := real(x) | return image(x)
-	int := integer(x) | return image(x)
-	frac := image(x - int)
-	if find("e", frac) then {
-		frac ?:= {
-			f1 := tab(upto('.')) &
-			move(1) &
-			f2 := tab(upto('e')) &
-			move(1) &
-			p10 := -integer(tab(0)) &
-			repl("0",p10-1) || f1 || f2
-			}
-		}
+
+	if x < 0 then {
+	   s := "-"
+	   x := -x
+	   }
 	else
-		frac ?:= (tab(upto('.')) & move(1) & tab(0))
-        frac := adjustfracprec(frac, prec)
-        int +:= if int >= 0 then frac[2] else -frac[2]
-	return int || "." || frac[1]
+	   s := ""
+
+	x := string(integer(x * 10 ^ prec + 0.5))
+	if *x <= prec then
+	   x := right(x, prec + 1, "0")
+	return s || x[1:-prec] || "." || x[-prec:0]
 end
 
 
@@ -302,10 +257,10 @@ procedure adjustfracprec(fracpart, prec)
             carryout := 1
             }
          #  In the usual case, round up simply increments the
-         #     fractional part.  (We put back any trailing
+         #     fractional part.  (We put back any leading
          #     zeros that got lost.) 
          else {
-            fracpart := left(integer(fracpart)+1, prec, "0")
+            fracpart := right(integer(fracpart)+1, prec, "0")
             }
          }
       }
diff --git a/ipl/procs/random.icn b/ipl/procs/random.icn
index 8dc58f2..2749bb7 100644
--- a/ipl/procs/random.icn
+++ b/ipl/procs/random.icn
@@ -6,7 +6,7 @@
 #
 #	Authors:  Ralph E. Griswold and Gregg M. Townsend
 #
-#	Date:     June 24, 2002
+#	Date:     November 5, 2009
 #
 ############################################################################
 #
@@ -87,18 +87,19 @@ procedure rand_int(i)			#: model ?i
 end
 
 procedure randomize()			#: randomize
-   local f, s
+   local f, s, i
    static ncalls
    initial ncalls := 0
 
    ncalls +:= 1
 
    if f := open("/dev/urandom", "ru") then {
-      s := reads(f, 3)
+      s := reads(f, 4)
       close(f)
       if *\s > 0 then {
-         &random := ncalls % 113
-         every &random := 256 * &random + ord(!s)
+         &random := 1
+         every i := ord(!s) do
+            &random := 167 * &random + i
          return
          }
       }